?? yuntai.frm
字號:
Align = 2 'Align Bottom
Height = 285
Left = 0
TabIndex = 3
Top = 4320
Width = 7395
_ExtentX = 13044
_ExtentY = 503
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 1
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
EndProperty
EndProperty
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋體"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.Frame fraYuntai
Caption = "請選擇云臺鏡頭組合"
BeginProperty Font
Name = "宋體"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 3855
Left = 240
TabIndex = 2
Top = 240
Width = 2175
End
Begin VB.PictureBox picChoose
BackColor = &H8000000A&
BorderStyle = 0 'None
DrawStyle = 6 'Inside Solid
Height = 350
IMEMode = 1 'ON
Index = 0
Left = 1440
ScaleHeight = 345
ScaleMode = 0 'User
ScaleWidth = 345
TabIndex = 0
Top = 1920
Width = 350
Begin VB.Label labChoose
AutoSize = -1 'True
BackColor = &H8000000D&
BackStyle = 0 'Transparent
Caption = "0"
Height = 195
Index = 0
Left = 0
TabIndex = 1
Top = 0
Width = 90
End
End
Begin VB.Line OuterLineBottom
BorderColor = &H80000009&
Index = 0
X1 = 1560
X2 = 1920
Y1 = 3000
Y2 = 3000
End
Begin VB.Line OuterLineRight
BorderColor = &H80000009&
Index = 0
X1 = 2040
X2 = 2040
Y1 = 2280
Y2 = 2640
End
Begin VB.Shape shpFrame
Height = 375
Index = 0
Left = 1080
Top = 1200
Width = 375
End
Begin VB.Line InnerLineLeft
BorderColor = &H80000009&
Index = 0
X1 = 720
X2 = 720
Y1 = 2520
Y2 = 2160
End
Begin VB.Line InnerLineTop
BorderColor = &H80000009&
Index = 0
X1 = 960
X2 = 1320
Y1 = 2640
Y2 = 2640
End
End
Attribute VB_Name = "frmYuntai"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'*****************************
'定義顏色
'*****************************
Private frameRgb As Long '選擇按扭邊框的顏色
Private brightRgb As Long '亮色
Private darkRgb As Long '深色
Private bkUpRgb As Long '上浮按鈕的背景色
Private bkDownRgb As Long '下沉按鈕的背景色
'*****************************
'定義指令集和云臺狀態集
'*****************************
Private ByteCodeChoose(32) As Byte '云臺選擇指令集
Private ByteCodeAct(5) As Byte '狀態控制指令集
Private ByteCodeMir(6) As Byte '鏡頭控制指令集
Private ByteCodeStatus(3) As Byte '狀態控制指令集
Private ByteStatus(32, 2) As Byte '所有云臺的狀態集合
'*****************************
'其它
'*****************************
Private curChoose As Integer '當前選中的云臺
Private Scale_X, Scale_Y As Integer '當前屏幕上一個像素所包含的twip
Private bSerial As Byte '是否使用串口進行通信
Private IoPort As Long '使用IO口時端口號
Private conSerialPort As New clsSerialPort '串口類對象，存儲串口設置參數
Private strFileName As String '配置文件名
'*****************************
'定義結束
'*****************************
'*****************************
'功能：繪制云臺選擇按鈕
'參數說明：
'gLeft：按鈕組距離容器的左邊界距離
'gTop：按鈕組距離容器的上邊界距離
'*****************************
Private Sub DrawChooseButtom(gLeft As Integer, gTop As Integer)
Dim index As Integer '按鈕的序號
'兩個按鈕中心點的X方向距離和Y向距離
Dim eleWidth, eleHeight As Integer
Dim i, j As Integer '計數器，i表示行，j表示列
Dim curTop As Integer '當前按鈕的左上角相對y坐標值
Dim curLeft As Integer '當前按鈕的左上角相對x坐標值
'定義類模塊clsPushButton的對象，用于繪制按鈕
Dim PushButton As New clsPushButton
frmYuntai.ScaleMode = 1 '以twip為單位，繪制精確
'指定按鈕之間的距離
eleWidth = Scale_X * 30
eleHeight = Scale_Y * 28
index = 0 '初值
'指定控件數組中初始元素的屬性，新加載的均采取與之相同的默認值
'設置按鈕（圖片框）的背景色
picChoose(0).BackColor = bkUpRgb
picChoose(0).Visible = False
'設置按鈕邊框的顏色和大小
shpFrame(0).BorderColor = frameRgb
shpFrame(0).Width = picChoose(0).Width + Scale_X * 2
shpFrame(0).Height = picChoose(0).Height + Scale_Y * 2
'設置四條邊線的初始顏色
InnerLineTop(index).BorderColor = brightRgb
InnerLineLeft(index).BorderColor = brightRgb
OuterLineRight(0).BorderColor = brightRgb
OuterLineBottom(0).BorderColor = brightRgb
'加載和繪制32個按鈕
For i = 0 To 7
For j = 0 To 3 '添加8行4列共32個按鈕
index = index + 1
'加載繪制按鈕所需的各項材料
Load picChoose(index) '加載label
Load shpFrame(index)
Load labChoose(index) '加載label
Load InnerLineTop(index)
Load InnerLineLeft(index)
Load OuterLineRight(index)
Load OuterLineBottom(index)
labChoose(index).Caption = index '加載內容
'計算當前按鈕的左上角坐標
curTop = gTop + i * eleHeight
curLeft = gLeft + j * eleWidth
'設置按鈕位置，繪制按鈕
'step1
PushButton.SetBasePosition curLeft, curTop
'step2
PushButton.AttachObjectToFrame fraYuntai, shpFrame(index), _
picChoose(index), OuterLineRight(index), OuterLineBottom(index)
'step3
PushButton.AttachObjectToPictureBox picChoose(index), _
labChoose(index), InnerLineTop(index), InnerLineLeft(index)
Next j
Next i
End Sub
'**************************************
'功能：繪制程序中所有用到的選擇按鈕，包括32個云臺選擇按鈕和3個狀態按鈕
'**************************************
Private Sub DrawPushButton()
'定義類模塊的對象
Dim PushButton As New clsPushButton
Dim i As Integer
'繪制云臺選擇按鈕
DrawChooseButtom Scale_X * 15, Scale_Y * 25
'繪制“自動”、“射燈”和“雨刷”按鈕
'i=33:射燈
'i=34:雨刷
'i=35:自動
For i = 33 To 35
'加載各種線框
Load shpFrame(i)
Load InnerLineTop(i)
Load InnerLineLeft(i)
Load OuterLineRight(i)
Load OuterLineBottom(i)
'繪制
shpFrame(i).Width = picChoose(i).Width + Scale_X * 2
shpFrame(i).Height = picChoose(i).Height + Scale_Y * 2
'設置按鈕的基準位置（左上角坐標）
PushButton.SetBasePosition picChoose(i).left - Scale_X, _
picChoose(i).top - Scale_Y
'捆綁按鈕到對應的容器，繪制按鈕邊框，右邊線和下邊線
PushButton.AttachObjectToFrame FraControl, shpFrame(i), _
picChoose(i), OuterLineRight(i), OuterLineBottom(i)
'捆綁文本框到圖片框，繪制左邊線和上邊線
PushButton.AttachObjectToPictureBox picChoose(i), _
labChoose(i), InnerLineTop(i), InnerLineLeft(i)
Next i
End Sub
'********************************************
'動作按鈕響應鼠標按下事件
'********************************************
Private Sub cmdAct_MouseDown(index As Integer, Button As Integer, Shift As Integer, x As Single, Y As Single)
'若當前沒有云臺被選中，則返回
If curChoose < 1 Or curChoose > 32 Then Exit Sub
'若當前選中云臺正以自動狀態旋轉，則關閉自動狀態，停止旋轉
If ByteStatus(curChoose, 2) = 1 Then
Call picChoose_Click(35)
End If
'若云臺旋轉方向為上、下、左、右之一，則直接發送一條指令，
'使相應電機旋轉即可
If index < 4 Then
Call WriteToPort(ByteCodeAct(index), 1)
'若云臺旋轉方向為左上、左下、右上、右下之一，則必須同時發送兩條指令；
'如要使云臺向左上方旋轉，必須同時發送一條向左旋轉的指令和向上旋轉的指令
Else
If index = 4 Or index = 5 Then
Call WriteToPort(ByteCodeAct(0), 1)
Else
Call WriteToPort(ByteCodeAct(1), 1)
End If
If index = 4 Or index = 6 Then
Call WriteToPort(ByteCodeAct(2), 1)
Else
Call WriteToPort(ByteCodeAct(3), 1)
End If
End If
End Sub
'********************************************
'動作按鈕響應鼠標抬起事件
'********************************************
Private Sub cmdAct_MouseUp(index As Integer, Button As Integer, Shift As Integer, x As Single, Y As Single)
Dim i As Integer
'若當前沒有云臺被選中，則返回
If curChoose < 1 Or curChoose > 32 Then Exit Sub
'發送復位指令，停止方向控制或鏡頭控制電機旋轉
Call WriteToPort(ByteCodeAct(4), 1)
End Sub
'***********************************************
'調用frmCode窗體
'***********************************************
Private Sub cmdCode_Click()
'將當前指令集傳送給編碼對話框
frmCode.SetInitData ByteCodeChoose, ByteCodeAct, ByteCodeMir, ByteCodeStatus
frmCode.Show vbModal
'若在編碼對話框，用戶點擊確定退出，則將編碼對話框中
'新的指令集作為程序指令集
If frmCode.UserResult = vbOK Then
frmCode.GetCodeData ByteCodeChoose, ByteCodeAct, ByteCodeMir, ByteCodeStatus
End If
End Sub
'********************************************
'調用frmConfig窗體，并實現數據的傳遞
'********************************************
Private Sub cmdConfig_Click()
On Error GoTo ErrProcess:
frmConfig.SetInitData CBool(bSerial), conSerialPort, IoPort
frmConfig.Show vbModal
'若在控制端口對話框中用戶點擊"確定"退出…
If frmConfig.UserResult = vbCancel Then
Exit Sub
End If
'change變量確定用戶是否改變了通信方式
Dim change As Boolean
change = False
If bSerial <> frmConfig.bSerial Then
bSerial = frmConfig.bSerial
change = True
End If
'保存新的串口通信參數
With conSerialPort
.Parity = frmConfig.conSerialPort.Parity
.BaudRate = frmConfig.conSerialPort.BaudRate
.DataBits = frmConfig.conSerialPort.DataBits
.StopBits = frmConfig.conSerialPort.StopBits
.PortNr = frmConfig.conSerialPort.PortNr
'以新的串口參數初始化串口
If MSComm1.PortOpen = True Then
MSComm1.PortOpen = False
End If
MSComm1.CommPort = .PortNr
MSComm1.InputMode = comInputModeText
MSComm1.Settings = CStr(.BaudRate) + "," + Chr(.Parity) + "," + CStr(.DataBits) + "," + CStr(.StopBits)
End With
'保存新的IO端口通信參數
IoPort = frmConfig.txtIO
'若新的通信方式使用串口:
If bSerial Then
'若之前的通信采用IO端口，則終止WinIO庫
If change Then
ShutdownWinIo
'開啟串口監聽
If MSComm1.PortOpen = False Then
MSComm1.PortOpen = True
End If
End If
'若新的通信方式使用IO口:
Else
'若之前使用串口，則關閉串口，并初始化WinIO庫
If change Then
If MSComm1.PortOpen = True Then
MSComm1.PortOpen = False
End If
Dim bResult As Boolean
bResult = InitializeWinIo()
If bResult <> True Then
MsgBox ("WINIO庫初始化失敗")
End If
End If
End If
Exit Sub
ErrProcess:
MsgBox "錯誤提示：" + Err.Description, vbCritical
End Sub
Private Sub cmdMir_MouseDown(index As Integer, Button As Integer, Shift As Integer, x As Single, Y As Single)
'若當前沒有云臺被選中，則返回
If curChoose < 1 Or curChoose > 32 Then Exit Sub
'發送鏡頭控制指令
Call WriteToPort(ByteCodeMir(index), 1)
End Sub
Private Sub cmdMir_MouseUp(index As Integer, Button As Integer, Shift As Integer, x As Single, Y As Single)
'若當前沒有云臺被選中，則返回
If curChoose < 1 Or curChoose > 32 Then Exit Sub
'發送復位指令，停止方向控制或鏡頭控制電機旋轉
Call WriteToPort(ByteCodeAct(4), 1)
End Sub
Private Sub cmdOK_Click()
Unload Me
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -