?? frmmain.frm
字號:
'************************************************
'打開
'打開標(biāo)準(zhǔn)對話框,選擇待發(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)對話框,選擇保存文件的路徑
'************************************************
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
'************************************************
'主窗體初始化
'加載主窗體,并對串口、標(biāo)準(zhǔn)對話框及進(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)對話框
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)前串口號
'
'**************************************************
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è)置串行口號
If ctrMSComm.PortOpen = True Then
ctrMSComm.PortOpen = False
End If
ctrMSComm.Settings = strCommSettings '設(shè)置波特率.奇偶校驗位.數(shù)據(jù)位和停止位
ctrMSComm.InBufferSize = intInBufferSize '設(shè)置接收緩沖區(qū)的字節(jié)長度
ctrMSComm.InBufferCount = 0 '清除接收緩沖區(qū)數(shù)據(jù)
ctrMSComm.OutBufferSize = intOutBufferSize '設(shè)置發(fā)送緩沖區(qū)字節(jié)長度
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)被占用,請換其它串口!")
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)按鍵
'實現(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 '收到新信息,信息記錄計數(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
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -