📄 yunkongzhi.frm
字号:
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
Visible = 0 'False
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 = "frmkongzhi"
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 clschuankou '串口类对象，存储串口设置参数
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 clsanniu
frmYunKong.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
'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 clsanniu
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
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
'*****************************************
'功能：确定是第一次运行本程序以及相关文件是否存在
'*****************************************
Private Sub FileTest()
Dim IsInstalled As Boolean
Dim IsExist As Boolean
Dim file As New clswenjian
Dim strMsg As String
'检测相关文件是否存在
IsExist = file.IsFileExist(App.Path + "\" + "WinIo.sys")
If Not IsExist Then
MsgBox "找不到文件WinIo.sys，请确定与本应用程序在同一目录下！", vbCritical
End
End If
IsExist = file.IsFileExist(App.Path + "\" + "WinIo.dll")
If Not IsExist Then
MsgBox "找不到文件WinIo.dll，请确定与本应用程序在同一目录下！", vbCritical
End
End If
IsExist = file.IsFileExist(App.Path + "\" + "WinIo.vxd")
If Not IsExist Then
MsgBox "找不到文件WinIo.vxd，请确定与本应用程序在同一目录下！", vbCritical
End
End If
Dim st As String
st = GetSetting("Yuntai", "Settings", "IsInstalled")
'第一次运行，安装WinIo库，写入注册信息
If st <> "1" Then
SaveSetting "Yuntai", "Settings", "WinioPath", App.Path + "\" + "winio.sys"
SaveSetting "Yuntai", "Settings", "IsInstalled", "1"
'安装WinIo库
IsInstalled = InstallWinIoDriver(App.Path + "\" + "winio.sys", False)
If Not IsInstalled Then
MsgBox "WinIo库安装失败，请确认是否有管理员权限，详细问题请与管理员联系" _
+ Chr(13) + "警告：WinIo库安装失败的情况下只可以使用串口通讯，并口无法使用。", vbCritical
Call RemoveWinIoDriver
Else
strMsg = "云台控制系统在您当前操作系统中成功安装了WinIo库 "
Call SystemUpdatedRestart(strMsg, EWX_REBOOT)
End
End If
End If
End Sub
'*****************************************
'初始化
'*****************************************
Private Sub Form_Load()
'指定颜色值
frameRgb = RGB(173, 166, 156)
brightRgb = RGB(255, 255, 255)
darkRgb = RGB(115, 105, 99)
bkUpRgb = RGB(215, 215, 215)
bkDownRgb = &H8000000F
'求得pixel和twip之间的关系
Scale_X = Screen.TwipsPerPixelX
Scale_Y = Screen.TwipsPerPixelY
strFileName = "YuntaiConfig.ini"
StatusBar1.Panels(1).Width = Me.Width
'确定是第一次运行本程序以及相关文件是否存在
Call FileTest
'绘制按钮
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -