'************************************************
'打開
'打開標(biāo)準(zhǔn)對(duì)話框，選擇待發(fā)送的文件
'************************************************

Private Sub cmdFileOpen_Click()
   
    On Error GoTo cancel
    Call optSend_Click
    
    frmMain.ctrCommonDialog.ShowOpen
    strFileName = frmMain.ctrCommonDialog.FileTitle
    strFileDirectary = frmMain.ctrCommonDialog.FileName
    txtSendDir.Text = strFileDirectary
    
cancel:
End Sub

'************************************************
'保存
'打開標(biāo)準(zhǔn)對(duì)話框，選擇保存文件的路徑
'************************************************

Public Sub cmdFileSave_Click()
    On Error GoTo cancel
    Call optReceive_Click
    frmMain.ctrCommonDialog.ShowSave
    strFileDirectary = frmMain.ctrCommonDialog.FileName
    strFileName = frmMain.ctrCommonDialog.FileTitle
    
    txtReceiveDir.Text = strFileDirectary
    
cancel:
End Sub

'*************************************************
'配置串口
'響應(yīng)菜單，打開參數(shù)設(shè)置窗體
'*************************************************

Private Sub ConfigPort_Click()
    frmConfig.Show
    
End Sub


'************************************************
'主窗體初始化
'加載主窗體，并對(duì)串口、標(biāo)準(zhǔn)對(duì)話框及進(jìn)度條進(jìn)行初始化設(shè)置
'************************************************

Private Sub Form_Load()
    
    cmdShow.Caption = "<<隱藏"                          '初始化主窗體模式
    blnShowFlag = True
    
    frmMain.Height = 6400
    
    Call SetComm("9600,N,8,1", 2, 4096)                 '串口設(shè)置
    intInBufferSize = 4096
    intOutBufferSize = 2048
    
    intCommFlag = 0                                     '初始系統(tǒng)狀態(tài)
    
    frmMain.ctrCommonDialog.Flags = &H200000 Or &H2     '初始化標(biāo)準(zhǔn)對(duì)話框
    frmMain.ctrCommonDialog.CancelError = True
    
    blnFileTransFlag = False                            '初始發(fā)送接收標(biāo)志
    
    prgFileTransfer.Max = 100                           '初始化進(jìn)度條
    prgFileTransfer.Min = 0
    prgFileTransfer.Value = 0
    
    rtfReceive.Text = ""                                '信息顯示初始化
    
    intArrayCount = 0

End Sub

'*************************************************
'設(shè)置串行口
'為參數(shù)設(shè)置提供公共接口
'*************************************************

Public Sub SetComm(strSet As String, intPort As Long, intOutBuffer As Long)
    strCommSettings = strSet
    intCommPort = intPort
    intOutBufferSize = intOutBuffer
    
End Sub

'*************************************************
'獲取串行口設(shè)置
'返回串口設(shè)置（波特率等）
'*************************************************

Public Function GetSettings() As String
    GetSettings = strCommSettings
    
End Function

'**************************************************
'獲取當(dāng)前串口號(hào)
'
'**************************************************

Public Function GetCommPort() As Long
    GetCommPort = intCommPort
    
End Function


'**************************************************
'獲取當(dāng)前發(fā)送緩沖區(qū)大小
'
'**************************************************

Public Function GetOutBuffer() As Long
    GetOutBuffer = intOutBufferSize
    
End Function


'*************************************************
'打開串行口
'
'*************************************************

Public Sub CommPortOpen()
    
    On Error GoTo PortError
    
    ctrMSComm.CommPort = intCommPort                        '設(shè)置串行口號(hào)
    
    If ctrMSComm.PortOpen = True Then
        ctrMSComm.PortOpen = False
    End If
    ctrMSComm.Settings = strCommSettings                    '設(shè)置波特率.奇偶校驗(yàn)位.數(shù)據(jù)位和停止位
    ctrMSComm.InBufferSize = intInBufferSize                '設(shè)置接收緩沖區(qū)的字節(jié)長(zhǎng)度
    
    ctrMSComm.InBufferCount = 0                             '清除接收緩沖區(qū)數(shù)據(jù)
    
    ctrMSComm.OutBufferSize = intOutBufferSize              '設(shè)置發(fā)送緩沖區(qū)字節(jié)長(zhǎng)度
    ctrMSComm.OutBufferCount = 0                            '清除發(fā)送緩沖區(qū)數(shù)據(jù)
    ctrMSComm.RThreshold = 1                                '每次接收到字符即產(chǎn)生OnComm事件
    ctrMSComm.Handshaking = comRTSXOnXOff
    
    frmMain.ctrMSComm.InputLen = 100
    
    
        
    ctrMSComm.PortOpen = True

PortError:
    Select Case Err.Number
        Case 8005
            MsgBox ("該串口已經(jīng)被占用,請(qǐng)換其它串口!")
    End Select

End Sub

'*************************************************
'關(guān)閉串行口
'
'*************************************************


Public Sub CommPortClose()
    
    Dim strTemp As String
    
    If ctrMSComm.PortOpen = True Then
        ctrMSComm.PortOpen = False
        strTemp = "設(shè)置:關(guān)閉串行口!"
        Call ReceiveDisplay(strTemp, 3)
    Else
        strTemp = "設(shè)置:串行口已關(guān)閉!"
        Call ReceiveDisplay(strTemp, 3)
        
    End If
    
    
End Sub

'**************************************************
'打開串口
'響應(yīng)菜單，打開串行口并向用戶顯示相關(guān)信息
'**************************************************

Private Sub OpenPort_Click()

    Dim strTemp As String
    
    If frmMain.ctrMSComm.PortOpen = False Then
    
        Call CommPortOpen
        strTemp = "設(shè)置:打開串行口!"
        Call ReceiveDisplay(strTemp, 3)
        
        intCommFlag = 1
    Else
        strTemp = "設(shè)置:串行口已經(jīng)打開!"
        Call ReceiveDisplay(strTemp, 3)
    End If
    
End Sub

'*************************************************
'MSComm事件處理
'響應(yīng)MSComm事件作出相關(guān)處理
'*************************************************

Private Sub ctrMSComm_OnComm()

    
    Select Case frmMain.ctrMSComm.CommEvent
      
        Case comEvReceive
            
            If intCommFlag = 1 Then
                
                Call InputManager
                intCommFlag = 1
            End If
            
    End Select
    
End Sub

'*************************************************
'選擇接收
'準(zhǔn)備接收文件
'*************************************************

Private Sub optReceive_Click()
    optReceive.Value = True
    blnFileTransFlag = False
End Sub

'*************************************************
'選擇發(fā)送
'準(zhǔn)備發(fā)送文件
'*************************************************

Private Sub optSend_Click()
    optSend.Value = True
    blnFileTransFlag = True
End Sub


'************************************************
'響應(yīng)按鍵
'實(shí)現(xiàn)利用回車鍵即可發(fā)送消息的功能
'************************************************

Private Sub txtSend_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
      Call frmMain.cmdSendText_Click
      
    End If
End Sub


'************************************************
'信息顯示處理
'記錄發(fā)送接收及串口設(shè)置信息，保存顯示格式（顏色）
'************************************************

Public Sub ReceiveDisplay(strAdd As String, intColor As Long)
    
    intArrayCount = intArrayCount + 2               '收到新信息,信息記錄計(jì)數(shù)增加
    
    ReDim Preserve intColorSet(intArrayCount)       '重定義紀(jì)錄數(shù)組,保留原有數(shù)據(jù)
    
    intColorSet(intArrayCount - 1) = Len(rtfReceive.Text)   '添加新數(shù)據(jù)(格式位置)
    intColorSet(intArrayCount) = intColor                   '格式類型
    
    rtfReceive.Text = rtfReceive.Text + strAdd + Chr(13)    '加入新信息并設(shè)置換行
    
    For n = 1 To intArrayCount - 1 Step 2                   '顯示
        rtfReceive.SelStart = intColorSet(n)
        If n < intArrayCount - 1 Then
            rtfReceive.SelLength = intColorSet(n + 2) - intColorSet(n)
        Else
            rtfReceive.SelLength = Len(rtfReceive.Text) - intColorSet(n)
        End If
        
        Select Case intColorSet(n + 1)
            Case 1
                rtfReceive.SelColor = RGB(0, 255, 0)
            Case 2
                rtfReceive.SelColor = RGB(255, 0, 0)
            Case 3
                rtfReceive.SelColor = RGB(0, 0, 255)
        End Select
        
   Next n
    
End Sub