frmmain.frm

云台开发程序

       LblStatus = "向右向下转动"
 End Select
End Sub

'********************************************
'动作按钮响应鼠标抬起事件
'********************************************
Private Sub cmdAct_MouseUp(Index As Integer, Button As Integer, Shift As Integer, x As Single, Y As Single)
  LblStatus = "ready"
  ByteCodeAct(1) = "&H" + data1(4)
  ByteCodeAct(2) = "&H" + data2(4)
  ByteCodeAct(3) = ByteCodeChoose(curChoose)
  ByteCodeAct(4) = "&H" + data4(4)
  If curChoose < 1 Or curChoose > 32 Then Exit Sub
  Select Case Index
    Case 0:
       codeact
    Case 1:
       codeact
    Case 2:
       codeact
    Case 3:
       codeact
    Case 4:
       codeact
       leftuptime.Enabled = False
    Case 5:
       codeact
       righupttime.Enabled = False
    Case 6:
       codeact
       leftdowntime.Enabled = False
    Case 7:
       codeact
       ridhtdowntime.Enabled = False
  End Select
End Sub
Sub codeact() '调用开关代码
    Dim para(4) As Long
    Dim sum As Long
    Dim i As Integer
    For i = 1 To 4
       para(i) = ByteCodeAct(i)
    Next i
    sum = 0
    For i = 1 To 4
       sum = sum + para(i)
    Next i
    If sum > 255 Then sum = sum - 256
    ByteCodeAct(5) = sum
    MSComm1.PortOpen = True
    MSComm1.Output = ByteCodeAct
    MSComm1.PortOpen = False
End Sub
'***********************************************
'调用frmCode窗体
'***********************************************
Private Sub cmdCode_Click()
    '将当前指令集传送给编码对话框
    FrmCodeEdit.Show vbModal
End Sub
'********************************************
'调用frmConfig窗体，并实现数据的传递
'********************************************
Private Sub cmdConfig_Click()
    FrmConfigEdit.Show vbModal
    '若在控制端口对话框中用户点击"确定"退出…
    If FrmConfigEdit.UserResult = vbCancel Then
        Exit Sub
    End If
End Sub
Private Sub cmdOK_Click()
    End
End Sub

'********************
'右向下,时间为2s和2s
'********************
Private Sub ridhtdowntime_Timer()
  intC = intC + 1
  If intC = 2 Then
      ByteCodeAct(1) = "&H" + data1(1)
      ByteCodeAct(2) = "&H" + data2(1)
      ByteCodeAct(3) = ByteCodeChoose(curChoose)
      ByteCodeAct(4) = "&h" + data4(1)
      codeact
  End If
  If intC = 4 Then
      ByteCodeAct(1) = "&H" + data1(3)
      ByteCodeAct(2) = "&H" + data2(3)
      ByteCodeAct(3) = ByteCodeChoose(curChoose)
      ByteCodeAct(4) = "&H" + data4(3)
      codeact
      intC = 0
  End If
End Sub
'********************
'右向上,时间为2s和2s
'********************
Private Sub righupttime_Timer() '右上
  intC = intC + 1
  If intC = 2 Then
      ByteCodeAct(1) = "&H" + data1(0)
      ByteCodeAct(2) = "&H" + data2(0)
      ByteCodeAct(3) = ByteCodeChoose(curChoose)
      ByteCodeAct(4) = "&h" + data4(0)
      codeact
  End If
  If intC = 4 Then
      ByteCodeAct(1) = "&H" + data1(3)
      ByteCodeAct(2) = "&H" + data2(3)
      ByteCodeAct(3) = ByteCodeChoose(curChoose)
      ByteCodeAct(4) = "&H" + data4(3)
      codeact
      intC = 0
  End If
End Sub
'********************
'左向下,时间为2s和2s
'********************
Private Sub leftdowntime_Timer() '左下
  intC = intC + 1
  If intC = 2 Then
      ByteCodeAct(1) = "&H" + data1(1)
      ByteCodeAct(2) = "&H" + data2(1)
      ByteCodeAct(3) = ByteCodeChoose(curChoose)
      ByteCodeAct(4) = "&H" + data4(1)
      codeact
  End If
  If intC = 4 Then
      ByteCodeAct(1) = "&H" + data1(2)
      ByteCodeAct(2) = "&H" + data2(2)
      ByteCodeAct(3) = ByteCodeChoose(curChoose)
      ByteCodeAct(4) = "&H" + data4(2)
      codeact
      intC = 0
  End If
End Sub
'********************
'左向上,时间为2s和2s
'********************
Private Sub leftuptime_Timer() '左上
  intC = intC + 1
  If intC = 2 Then
      ByteCodeAct(1) = "&H" + data1(0)
      ByteCodeAct(2) = "&H" + data2(0)
      ByteCodeAct(3) = ByteCodeChoose(curChoose)
      ByteCodeAct(4) = "&h" + data4(0)
      codeact
  End If
  If intC = 4 Then
      ByteCodeAct(1) = "&H" + data1(2)
      ByteCodeAct(2) = "&H" + data2(2)
      ByteCodeAct(3) = ByteCodeChoose(curChoose)
      ByteCodeAct(4) = "&h" + data4(2)
      codeact
      intC = 0
  End If
End Sub

Private Sub cmdMir_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, Y As Single)
  Select Case Index
    Case 0:
        ByteCodeAct(1) = "&H" + data1(5)
        ByteCodeAct(2) = "&H" + data2(5)
        ByteCodeAct(3) = ByteCodeChoose(curChoose)
        ByteCodeAct(4) = "&H" + data4(5)
        codeact
        LblStatus = "变焦近"
    Case 1:
        ByteCodeAct(1) = "&H" + data1(6)
        ByteCodeAct(2) = "&H" + data2(6)
        ByteCodeAct(3) = ByteCodeChoose(curChoose)
        ByteCodeAct(4) = "&h" + data4(6)
        codeact
        LblStatus = "变焦近"
   End Select
End Sub
Private Sub cmdMir_MouseUp(Index As Integer, Button As Integer, Shift As Integer, x As Single, Y As Single)
   LblStatus = "ready"
   ByteCodeAct(1) = "&H" + data1(4)
   ByteCodeAct(2) = "&H" + data2(4)
   ByteCodeAct(3) = ByteCodeChoose(curChoose)
   ByteCodeAct(4) = "&H" + data4(4)
   codeact
End Sub
Private Sub labChoose_Click(Index As Integer)
    picChoose_Click Index
End Sub

'*****************************
'功能：绘制云台选择按钮
'参数说明：
'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
       
    FrmMain.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
'*********************************************
'功能：使指定按钮浮起
'参数：index，被浮起按钮在控件数组中的index值
'*********************************************
Private Sub LiftButton(Index As Integer)
    InnerLineTop(Index).BorderColor = brightRgb
    InnerLineLeft(Index).BorderColor = brightRgb
    picChoose(Index).BackColor = bkUpRgb
    shpFrame(Index).BorderColor = frameRgb
End Sub

'*********************************************
'功能：使指定按钮下沉
'参数：index，被下沉按钮在控件数组中的index值
'*********************************************
Private Sub DownButton(Index As Integer)
    InnerLineTop(Index).BorderColor = darkRgb
    InnerLineLeft(Index).BorderColor = darkRgb
    picChoose(Index).BackColor = bkDownRgb
    shpFrame(Index).BorderColor = bkUpRgb
End Sub
'*******************************************
'功能：响应对云台选择按钮和状态按钮的单击响应
'参数：Index:被点击的picChoose的index值
'*******************************************
Private Sub picChoose_Click(Index As Integer)
    Dim i As Integer
    Dim fileNumber As Integer
    fileNumber = FreeFile
    '点击选择云台按钮
    If Index < 33 Then
        If Index = curChoose Then Exit Sub
        '重画按钮，使原按钮浮起
        Call LiftButton(curChoose)
        '重画按钮，使当前被点击按钮凹下
        Call DownButton(Index)
        curChoose = Index
        Open strFileName For Output As #fileNumber
        Print #fileNumber, curChoose
        Close #fileNumber
        LblPos = "" & curChoose & "号"
    End If
    LblPos = "" & curChoose & "号"
    If Index = 35 Then
        '重画按钮，使当前被点击按钮凹下
       If m_bAuto = False Then
          Call DownButton(Index)
          m_bAuto = True
          labChoose(35).Caption = "自动关"
          LblStatus = "自动开"
          BytecodeAuto(1) = "&H" + data1(11)
          BytecodeAuto(2) = "&H" + data2(11)
          BytecodeAuto(3) = ByteCodeChoose(curChoose)
          BytecodeAuto(4) = "&H" + data4(11)
          BytecodeAuto(5) = "&H" + data5(11)
          codeauto
        Else
          Call LiftButton(Index)
          m_bAuto = False
          labChoose(35).Caption = "自动开"
          LblStatus = "自动关"
          BytecodeAuto(1) = "&H" + data1(12)
          BytecodeAuto(2) = "&H" + data2(12)
          BytecodeAuto(3) = ByteCodeChoose(curChoose)
          BytecodeAuto(4) = "&H" + data4(12)
          BytecodeAuto(5) = "&H" + data5(12)
          codeauto
       End If
    End If
End Sub
Sub codeauto() '调用自动开关代码
    Dim para(5), sum As Long
    Dim i As Integer
    For i = 1 To 5 - 1
       para(i) = ByteCodeAct(i)
    Next i
    sum = 0
    For i = 1 To 5 - 1
       sum = sum + para(i)
    Next i
    If sum > 255 Then sum = sum - 256  '如果字节数超过255，则减掉256,即进的一位
    BytecodeAuto(6) = sum
    MSComm1.PortOpen = True
    MSComm1.Output = BytecodeAuto
    MSComm1.PortOpen = False
End Sub
Private Sub TimeShow_Timer()
  Lblweek = week(Weekday(Date))
  LblDate = Date
  LblTime = Time
End Sub
Private Function week(x As Integer) As String
 Select Case x
   Case 1:
      week = "星期日"
   Case 2:
      week = "星期一"
   Case 3:
      week = "星期二"
   Case 4:
      week = "星期三"
   Case 5:
      week = "星期四"
   Case 6:
      week = "星期五"
   Case 7:
      week = "星期六"
 End Select
End Function