VB6-以影像座標點位計算標準座標的線斜率

因工作上常常遇到影像座標系的計算與轉換,因此整理了一下目前的計算方式與程式的介紹,基本上都是用很簡單的公式去實現,在此只是把公式轉換成程式可以運算的方法:

影像座標示意圖

一般所使用的影像,如小畫家,相機,程式開發軟體中的圖片物件,相機擷取的影像,其影像座標系的規格,都是以影像的最左上角為原點(0,0),越往右邊X值越大,越往下方Y值越大,這樣的影像座標系(如上圖示),與標準的座標系的差別就是Y軸系的向性是相反的,假如要計算影像中的某一條線的斜率是多少時,直接用影像座標所算的就會是錯誤的,基本上我會先將影像座標系的Y軸數值取相反數,使影像座標系改變成標準座標系的第四象限後,然後才去做運算,如下圖所示:

座標轉換示意圖

以下來介紹幾個利用已知影像座標系,去計算某兩點在標準座標之斜率與線角度的作法:

程式介面圖

初始設定:
'主要是先設定picture的象限改成標準象限

'設定Form大小
Form1.Top = 0
Form1.Left = 0
Form1.Width = 10 * Screen.Width / Screen.TwipsPerPixelX
Form1.Height = 10 * Screen.Height / Screen.TwipsPerPixelY


'畫小圖設定
Picture1.ScaleHeight = -Picture1.ScaleHeight
Picture1.ScaleTop = -Picture1.ScaleHeight * 1 / 2
Picture1.ScaleLeft = -Picture1.ScaleWidth * 1 / 2

呼叫端:




    Dim ImgAxisStartX As Double
    Dim ImgAxisStartY As Double
    Dim ImgAxisEndX As Double
    Dim ImgAxisEndY As Double
    Dim GetValue() As String
    
    Dim M1 As Double
    Dim Degree1 As Double
    Dim Quadrant1 As String
    
    '檢查 起點影像座標X 與 起點影像座標Y 的值 是否為整數
    '使用的是CheckTextIsNumEricAndInteger Function來判斷
    If CheckTextIsNumEricAndInteger(Text_StartX, Text_StartX.Text, "起點影像座標X") = True Then
        ImgAxisStartX = Format(Text_StartX.Text)
    Else
        Exit Sub
    End If
    If CheckTextIsNumEricAndInteger(Text_StartY, Text_StartY.Text, "起點影像座標Y") = True Then
        ImgAxisStartY = Format(Text_StartY.Text)
    Else
        Exit Sub
    End If
    
    '檢查 終點影像座標X 與 終點影像座標Y 的值 是否為整數
    '使用的是CheckTextIsNumEricAndInteger Function來判斷
    If CheckTextIsNumEricAndInteger(Text_EndX, Text_EndX.Text, "終點影像座標X") = True Then
        ImgAxisEndX = Format(Text_EndX.Text)
    Else
        Exit Sub
    End If
    If CheckTextIsNumEricAndInteger(Text_EndY, Text_EndY.Text, "終點影像座標Y") = True Then
        ImgAxisEndY = Format(Text_EndY.Text)
    Else
        Exit Sub
    End If
    
    '轉換影像座標系至標準座標系的點位轉換
    '此時 Label_StartX.Caption...等,就是轉換後的座標
    GetValue = ImgAxisTransformStandardAxis(Picture1, ImgAxisStartX, ImgAxisStartY)
    Label_StartX.Caption = GetValue(0)
    Label_StartY.Caption = GetValue(1)
    GetValue = ImgAxisTransformStandardAxis(Picture1, ImgAxisEndX, ImgAxisEndY)
    Label_EndX.Caption = GetValue(0)
    Label_EndY.Caption = GetValue(1)
    
    '計算斜率
    GetValue = MountainAndAbsoluteDegreeCaculate(Val(Label_StartX.Caption), Val(Label_StartY.Caption), Val(Label_EndX.Caption), Val(Label_EndY.Caption))
    M1 = Val(GetValue(0))
    Degree1 = Val(GetValue(1))
    Quadrant1 = GetValue(2)
    Label_M1.Caption = Format(M1, "0.0000")
    Label_D1.Caption = Format(Degree1, "0.0000")
    Label_Q1.Caption = Format(Quadrant1, "0.0000")
    
    '清空picture的畫圖
    Picture1.Picture = Nothing
    '畫picture的X,Y基準線
    Picture1.DrawWidth = 1
    Picture1.Line (-Picture1.Width, 0)-(Picture1.Width, 0), vbGreen
    Picture1.Line (0, -Picture1.Height)-(0, Picture1.Height), vbGreen
    '畫線與點位
    Picture1.DrawWidth = 1
    Picture1.Circle (Val(Label_StartX.Caption), Val(Label_StartY.Caption)), ((ImgAxisStartX - ImgAxisEndX) ^ 2 + (ImgAxisStartY - ImgAxisEndY) ^ 2) ^ 0.5, vbRed
    Picture1.Line (Val(Label_StartX.Caption), Val(Label_StartY.Caption))-(Val(Label_EndX.Caption), Val(Label_EndY.Caption)), vbBlue
    Picture1.DrawWidth = 3
    Picture1.PSet (Val(Label_StartX.Caption), Val(Label_StartY.Caption)), vbRed
    Picture1.PSet (Val(Label_EndX.Caption), Val(Label_EndY.Caption)), vbBlue



使用Function:



'將影像或圖片座標轉換為正規座標系(第四象限)
'用法範例:(PictureBox物件名稱,影像或物件X座標,影像或物件Y座標)


Function CheckTextIsNumEricAndInteger(TString As TextBox, WordString As String, DataTitle As String) As Boolean
'檢查是否為整數
'用法範例: (TextBox物件名稱,要檢查的字串,字串的Title)--->(Text1,Text1.Text,"影像座標X")
    If TString.Text = "" Then
        MsgBox (DataTitle + ",沒有數值")
    Else
        If IsNumeric(TString.Text) = True Then
            If Int(WordString) = Format(WordString, "0.0000") Then
                CheckTextIsNumEricAndInteger = True
            Else
                MsgBox (DataTitle + ",非整數")
            End If
            
        Else
            MsgBox (DataTitle + ",非數字")
        End If
    End If
End Function




'檢查是否為整數
'用法範例: (TextBox物件名稱,要檢查的字串,字串的Title)--->(Text1,Text1.Text,"影像座標X")


Function MountainAndAbsoluteDegreeCaculate(StartX As Double, StartY As Double, EndX As Double, EndY As Double) As String()
'計算兩點成一線的斜率
'利用斜率與XY的關係式求絕對角度
'用法範例: (起點X座標,起點Y座標,終點X座標,終點Y座標)
Dim SendValue(2) As String
Dim SX As Double
Dim SY As Double
Dim EX As Double
Dim EY As Double
Dim M_PI As Double
M_PI = Atn(1) * 4
SX = StartX
SY = StartY
EX = EndX
EY = EndY


'計算斜率-----------------------------------------------------------
'非水平與垂直
If (SX <> EX) And SY <> EY Then
    SendValue(0) = Format((SY - EY) / (SX - EX), "0.0000")
End If
'起點與終點同一點
If (SX = EX) And (SY = EY) Then
    SendValue(0) = O
End If
'起點與終點之X值相同 Y值不同
If (SX = EX) Then
    If (SY > EY) Then
        SendValue(0) = -999999
    Else
        SendValue(0) = 999999
    End If
End If
'起點與終點之Y值相同 X值不同
If (SY = EY) Then
    SendValue(0) = 0
End If
'--------------------------------------------------------------------
'計算角度-----------------------------------------------------------
'起點與終點一樣
If EX = SX And EY = SY Then
    SendValue(1) = 0
    SendValue(2) = "起點終點同一點"
    MountainAndAbsoluteDegreeCaculate = SendValue
    Exit Function
End If


'第一象限
If EX > SX And EY > SY Then
    SendValue(1) = Atn(Val(SendValue(0))) * 180 / M_PI
    SendValue(2) = "第ㄧ象限"
    MountainAndAbsoluteDegreeCaculate = SendValue
    Exit Function
End If


'第二象限
If EX < SX And EY > SY Then
    SendValue(1) = 180 + Atn(Val(SendValue(0))) * 180 / M_PI
    SendValue(2) = "第二象限"
    MountainAndAbsoluteDegreeCaculate = SendValue
    Exit Function
End If


'第三象限
If EX < SX And EY < SY Then
    SendValue(1) = 180 + Atn(Val(SendValue(0))) * 180 / M_PI
    SendValue(2) = "第三象限"
    MountainAndAbsoluteDegreeCaculate = SendValue
    Exit Function
End If


'第四象限
If EX > SX And EY < SY Then
    SendValue(1) = 360 + Atn(Val(SendValue(0))) * 180 / M_PI
    SendValue(2) = "第四象限"
    MountainAndAbsoluteDegreeCaculate = SendValue
    Exit Function
End If


'90度
If EX = SX And EY > SY Then
    SendValue(1) = 90
    SendValue(2) = "垂直"
    MountainAndAbsoluteDegreeCaculate = SendValue
    Exit Function
End If


'270度
If EX = SX And EY < SY Then
    SendValue(1) = 270
    SendValue(2) = "垂直"
    MountainAndAbsoluteDegreeCaculate = SendValue
    Exit Function
End If


'0度
If EX > SX And EY = SY Then
    SendValue(1) = 0
    SendValue(2) = "垂直"
    MountainAndAbsoluteDegreeCaculate = SendValue
    Exit Function
End If


'0度
If EX < SX And EY = SY Then
    SendValue(1) = 180
    SendValue(2) = "垂直"
    MountainAndAbsoluteDegreeCaculate = SendValue
    Exit Function
End If
'--------------------------------------------------------------------
End Function



說明:

輸入已知的影像座標點位,程式會去檢察所輸入的值是否為數字與整數,接著轉換成標準座標系(第四象限)的點位,利用兩點成一線,兩點求斜率,以及有斜率的情況下,利用反三角函數Arctan,可求得絕對角度!!

VB6-傳送數值給Function與接收Function計算好的數值

範例1: 傳遞多資料與接收單一資料型態




'函數端
Function ReturnArrayArt(F1 As Integer,F2 As Integer) As Integer
        Dim ArrayQ As Integer
        ArrayQ = F1 - F2
        ReturnArrayArt = ArrayQ
End Function


'呼叫端
Dim GetValue As Integer
Dim GP As Integer
Dim GD As Integer
GP = 99
GD = 9
GetValue = ReturnArrayArt(GP,GD)

'執行結果:
GetValue = 90

範例2: 傳遞多資料(包含矩陣)與利用矩陣方式接收多資料型態


'函數端
Function ReturnArrayORZ(ByVal AString As String, ByVal ADouble As Double, TArray() As Integer, TStringArray() As String) As String()

         '請注意此Function是定義為String(),也就是說回傳直是字串的矩陣


         Dim ArrayQ(100) As String

         '把Function接收到的數值,指定給ArrayQ()的矩陣內
         ArrayQ(0) = AString
         ArrayQ(1) = Str(ADouble)                     '把 Double 轉型為 String
         ArrayQ(2) = Str(TArray(0))                   '把 Double 轉型為 String
         ArrayQ(3) = Str(TArray(1))                   '把 Double 轉型為 String
         ArrayQ(4) = Str(TArray(2))                   '把 Double 轉型為 String
         ArrayQ(5) = Str(TArray(3))                   '把 Double 轉型為 String
         ArrayQ(6) = Str(TArray(4))                   '把 Double 轉型為 String
         ArrayQ(7) = Str(TArray(5))                   '把 Double 轉型為 String
         ArrayQ(8) = TStringArray(0, 0)
         ArrayQ(9) = TStringArray(0, 1)
         ArrayQ(10) = TStringArray(0, 2)
         ArrayQ(11) = TStringArray(1, 0)
         ArrayQ(12) = TStringArray(1, 1)
         ArrayQ(13) = TStringArray(1, 2)
         ArrayQ(14) = TStringArray(2, 0)
         ArrayQ(15) = TStringArray(2, 1)
         ArrayQ(16) = TStringArray(2, 2)
       
         '請注意此Function是定義為String(),同型態才能接收相對應的值,固ArrayQ()
         '定義為String
         ReturnArrayORZ = ArrayQ
End Function




'呼叫端


Dim TestString As String                         '定義TestString 為String型態
Dim TestDouble As Double                    '定義TestDouble 為Double型態
Dim TestArray(5) As Integer                   '定義TestArray(5) 矩陣為Double型態
Dim TestStringArray(2, 2) As String        '定義 TestStringArray(2,2) 矩陣為Double型態
Dim GetValue() As String                        '定義 GetValue() 矩陣為String型態

'指定數值給 TestString , TestDouble , TestArray() ,TestStringArray( , )
TestString = "ABC"
TestDouble = 3.1415926
TestArray(0) = 90
TestArray(1) = 91
TestArray(2) = 92
TestArray(3) = 93
TestArray(4) = 94
TestArray(5) = 95
TestStringArray(0, 0) = "ㄅ"
TestStringArray(0, 1) = "ㄆ"
TestStringArray(0, 2) = "ㄇ"
TestStringArray(1, 0) = "A"
TestStringArray(1, 1) = "B"
TestStringArray(1, 2) = "C"
TestStringArray(2, 0) = "a"
TestStringArray(2, 1) = "b"
TestStringArray(2, 2) = "c"

'呼叫ReturnArrayORZ函數,並給予其傳送的參數
GetValue = ReturnArrayORZ(TestString, TestDouble, TestArray(), TestStringArray())

'執行結果:
GetValue(0) = ABC
GetValue(1) = 3.1415926
GetValue(2) = 90
GetValue(3) = 91
GetValue(4) = 92
GetValue(5) = 93
GetValue(6) = 94
GetValue(7) = 95
GetValue(8) = ㄅ
GetValue(9) = ㄆ
GetValue(10) = ㄇ
GetValue(11) = A
GetValue(12) = B
GetValue(13) = C
GetValue(14) = a
GetValue(15) = b
GetValue(16) = c


說明:
Function的使用在一般開發程式中,在處理有重複性的計算或處理方式是非常方邊的工具,以上分享了呼叫端與Function間的呼叫方式,多值傳遞,矩陣傳遞,等方式,提供一些範例,希望開發者有更便利的方法可以使用