?? yuntai.frm

?? 串口通信編程 visual basic language
?? FRM
?? 第 1 頁 / 共 3 頁
字號:
   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
'#######################################################################
'程序由迎風飄揚編寫,供大家參考.有什么意見可以在我的qq:5488700上給我留言.
'#######################################################################





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

'*****************************************
'功能：確定是第一次運行本程序以及相關文件是否存在
'*****************************************
Private Sub FileTest()
    Dim IsInstalled As Boolean
    Dim IsExist As Boolean
    Dim file As New clsFile
    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")
?? 文件大小 195 K
?? 上傳用戶 Kunlun_mrpii
?? 所屬分類串口編程
??? 相關標簽

#language #visual #basic #串口通信
?? 快捷鍵說明

復制代碼 Ctrl + C
搜索代碼 Ctrl + F
全屏模式 F11
切換主題 Ctrl + Shift + D
顯示快捷鍵 ?
增大字號 Ctrl + =
減小字號 Ctrl + -
亚洲欧美第一页_禁久久精品乱码_粉嫩av一区二区三区免费野_久草精品视频

?? yuntai.frm

?? 快捷鍵說明
