?? 通訊.frm
字號:
Loop Until InStr(Buffer$, 結束符)
Print #3, Buffer$
Text2.Text = Buffer$
Cls
Msg = "數據接收完畢，單擊確定完成操作，單擊取消退出程序。" ' 定義信息。
Style = vbYesNo + vbCritical + vbDefaultButton2 ' 定義按鈕。
Title = "中國大劍測繪系統提示" ' 定義標題。
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then ' 用戶按下“是”。
'Unload Me ' 完成某操作。
Else ' 用戶按下“否”。
End ' 完成某操作。
End If
Close
End Sub
Private Sub MSComm_OnComm()
Select Case MSComm1.CommEvent
' 錯誤
Case comEventBreak ' 收到 Break。
Msg = "應用程序出錯，系統接收到 Break 字符，單擊確定完成操作，單擊取消退出程序。" ' 定義信息。
Style = vbYesNo + vbCritical + vbDefaultButton2 ' 定義按鈕。
Title = "中國大劍測繪系統提示" ' 定義標題。
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then ' 用戶按下“是”。
Unload Me ' 完成某操作。
Else ' 用戶按下“否”。
End ' 完成某操作。
End If
Case comEventCDTO ' CD (RLSD) 超時。
Msg = "載波檢測超時。在系統規定時間內傳輸一個字符時，Carrier Detect 線為低電平，單擊確定完成操作，單擊取消退出程序。" ' 定義信息。
Style = vbYesNo + vbCritical + vbDefaultButton2 ' 定義按鈕。
Title = "中國大劍測繪系統提示" ' 定義標題。
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then ' 用戶按下“是”。
Unload Me ' 完成某操作。
Else ' 用戶按下“否”。
End ' 完成某操作。
End If
Case comEventCTSTO ' CTS Timeout。
Msg = "Clear To Send 超時。在系統規定時間內傳輸一個字符時，Clear To Send 線為低電平，單擊確定完成操作，單擊取消退出程序。" ' 定義信息。
Style = vbYesNo + vbCritical + vbDefaultButton2 ' 定義按鈕。
Title = "中國大劍測繪系統提示" ' 定義標題。
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then ' 用戶按下“是”。
Unload Me ' 完成某操作。
Else ' 用戶按下“否”。
End ' 完成某操作。
End If
Case comEventDSRTO ' DSR Timeout。
Msg = "數據準備超時，單擊確定完成操作，單擊取消退出程序。" ' 定義信息。
Style = vbYesNo + vbCritical + vbDefaultButton2 ' 定義按鈕。
Title = "中國大劍測繪系統提示" ' 定義標題。
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then ' 用戶按下“是”。
Unload Me ' 完成某操作。
Else ' 用戶按下“否”。
End ' 完成某操作。
End If
Case comEventFrame ' Framing Error
Msg = "幀錯誤。硬件檢測到幀錯誤，單擊確定完成操作，單擊取消退出程序。" ' 定義信息。
Style = vbYesNo + vbCritical + vbDefaultButton2 ' 定義按鈕。
Title = "中國大劍測繪系統提示" ' 定義標題。
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then ' 用戶按下“是”。
Unload Me ' 完成某操作。
Else ' 用戶按下“否”。
End ' 完成某操作。
End If
Case comEventOverrun '數據丟失。
Msg = "端口超限。在下一個字符到達端口之前，前一字符還沒有從硬件中讀走，因而丟失，單擊確定完成操作，單擊取消退出程序。" ' 定義信息。
Style = vbYesNo + vbCritical + vbDefaultButton2 ' 定義按鈕。
Title = "中國大劍測繪系統提示" ' 定義標題。
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then ' 用戶按下“是”。
Unload Me ' 完成某操作。
Else ' 用戶按下“否”。
End ' 完成某操作。
End If
Case comEventRxOver '接收緩沖區溢出。
Msg = "接收緩沖區溢出。接收緩沖區已沒有空間，單擊確定完成操作，單擊取消退出程序。" ' 定義信息。
Style = vbYesNo + vbCritical + vbDefaultButton2 ' 定義按鈕。
Title = "中國大劍測繪系統提示" ' 定義標題。
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then ' 用戶按下“是”。
Unload Me ' 完成某操作。
Else ' 用戶按下“否”。
End ' 完成某操作。
End If
Case comEventRxParity ' Parity 錯誤。
Msg = "奇偶校驗錯誤。硬件檢測到奇偶校驗錯誤，單擊確定完成操作，單擊取消退出程序。" ' 定義信息。
Style = vbYesNo + vbCritical + vbDefaultButton2 ' 定義按鈕。
Title = "中國大劍測繪系統提示" ' 定義標題。
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then ' 用戶按下“是”。
Unload Me ' 完成某操作。
Else ' 用戶按下“否”。
End ' 完成某操作。
End If
Case comEventTxFull '傳輸緩沖區已滿。
Msg = "發送緩沖區滿。在試圖將字符傳入發送緩沖區時，該緩沖區已滿，單擊確定完成操作，單擊取消退出程序。" ' 定義信息。
Style = vbYesNo + vbCritical + vbDefaultButton2 ' 定義按鈕。
Title = "中國大劍測繪系統提示" ' 定義標題。
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then ' 用戶按下“是”。
Unload Me ' 完成某操作。
Else ' 用戶按下“否”。
End ' 完成某操作。
End If
Case comEventDCB '獲取 DCB] 時意外錯誤
Msg = "在為端口獲取設備控制塊 (DCB) 時，發生不可預料的錯誤，單擊確定完成操作，單擊取消退出程序。" ' 定義信息。
Style = vbYesNo + vbCritical + vbDefaultButton2 ' 定義按鈕。
Title = "中國大劍測繪系統提示" ' 定義標題。
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then ' 用戶按下“是”。
Unload Me ' 完成某操作。
Else ' 用戶按下“否”。
End ' 完成某操作。
End If
' 事件
Case comEvCD ' CD 線狀態變化。
Msg = "Carrier Detect 線的狀態發生變化，單擊確定完成操作，單擊取消退出程序。" ' 定義信息。
Style = vbYesNo + vbCritical + vbDefaultButton2 ' 定義按鈕。
Title = "中國大劍測繪系統提示" ' 定義標題。
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then ' 用戶按下“是”。
Unload Me ' 完成某操作。
Else ' 用戶按下“否”。
End ' 完成某操作。
End If
Case comEvCTS ' CTS 線狀態變化。
Msg = "Clear To Send 線的狀態發生變化，單擊確定完成操作，單擊取消退出程序。" ' 定義信息。
Style = vbYesNo + vbCritical + vbDefaultButton2 ' 定義按鈕。
Title = "中國大劍測繪系統提示" ' 定義標題。
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then ' 用戶按下“是”。
Unload Me ' 完成某操作。
Else ' 用戶按下“否”。
End ' 完成某操作。
End If
Case comEvDSR ' DSR 線狀態變化。
Msg = "Data Set Ready 線的狀態發生變化，單擊確定完成操作，單擊取消退出程序。" ' 定義信息。
Style = vbYesNo + vbCritical + vbDefaultButton2 ' 定義按鈕。
Title = "中國大劍測繪系統提示" ' 定義標題。
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then ' 用戶按下“是”。
Unload Me ' 完成某操作。
Else ' 用戶按下“否”。
End ' 完成某操作。
End If
Case comEvRing ' Ring Indicator 變化。
Msg = "檢測到振鈴信號,不支持該事件，單擊確定完成操作，單擊取消退出程序。" ' 定義信息。
Style = vbYesNo + vbCritical + vbDefaultButton2 ' 定義按鈕。
Title = "中國大劍測繪系統提示" ' 定義標題。
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then ' 用戶按下“是”。
Unload Me ' 完成某操作。
Else ' 用戶按下“否”。
End ' 完成某操作。
End If
Case comEvReceive ' 收到 RThreshold # of
Msg = "收到 Rthreshold 個字符，單擊確定完成操作，單擊取消退出程序。" ' 定義信息。
Style = vbYesNo + vbCritical + vbDefaultButton2 ' 定義按鈕。
Title = "中國大劍測繪系統提示" ' 定義標題。
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then ' 用戶按下“是”。
Unload Me ' 完成某操作。
Else ' 用戶按下“否”。
End ' 完成某操作。
End If
'chars.
Case comEvSend ' 傳輸緩沖區有 Sthreshold 個字符 '
Msg = "在傳輸緩沖區中有比 Sthreshold 數少的字符，單擊確定完成操作，單擊取消退出程序。" ' 定義信息。
Style = vbYesNo + vbCritical + vbDefaultButton2 ' 定義按鈕。
Title = "中國大劍測繪系統提示" ' 定義標題。
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then ' 用戶按下“是”。
Unload Me ' 完成某操作。
Else ' 用戶按下“否”。
End ' 完成某操作。
End If
Case comEvEOF ' 輸入數據流中發現 EOF 字符
Msg = "收到文件結束（ASCII 字符為 26）字符，單擊確定完成操作，單擊取消退出程序。" ' 定義信息。
Style = vbYesNo + vbCritical + vbDefaultButton2 ' 定義按鈕。
Title = "中國大劍測繪系統提示" ' 定義標題。
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then ' 用戶按下“是”。
Unload Me ' 完成某操作。
Else ' 用戶按下“否”。
End ' 完成某操作。
End If
'
End Select
End Sub
Private Sub Command2_Click()
Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Dim Message, Default, MyValue
Dim Buffer As String
Dim Ls1 As Integer
Dim ls2 As Long
Dim Ls3 As String
'Open "COM1:" For Input As #2
Ls1 = "1"
通訊參數
MSComm1.PortOpen = True
'MSComm1.InputLen = 0
Text2.FontSize = 20
Text2.Text = " 計算機的COM" & 串行口 & "已準備好！"
Cls
Msg = "單擊確定開始發送，單擊取消返回程序。" ' 定義信息。
Style = vbYesNo + vbCritical + vbDefaultButton2 ' 定義按鈕。
Title = "中國大劍測繪系統提示" ' 定義標題。
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then ' 用戶按下“是”。
'Unload Me ' 完成某操作。
'=============================================================
Open Text1.Text For Input As #3
Do Until EOF(3)
Line Input #3, Ls3
Text2.Text = Ls3
Cls
MSComm1.Output = Ls3
Loop
Msg = "數據接收完畢，單擊確定完成操作，單擊取消退出程序。" ' 定義信息。
Style = vbYesNo + vbCritical + vbDefaultButton2 ' 定義按鈕。
Title = "中國大劍測繪系統提示" ' 定義標題。
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then ' 用戶按下“是”。
'Unload Me ' 完成某操作。
Else ' 用戶按下“否”。
End ' 完成某操作。
End If
'===============================================
Else ' 用戶按下“否”。
Text2.Text = "" ' 完成某操作。
Cls
End If
Close
End Sub
Private Sub Command3_Click()
With CommonDialog1
.FileName = "中國大劍測繪.txt"
.Filter = "所有數據文件|*.TXT;*.DAT|數據文件(*.)|*.dat|數據文本文件(*.TXT)|*.TXT|所有文件(*.*)|*.*|"
.DialogTitle = "請選擇傳出或傳出文件名"
.ShowOpen
Text1.Text = .FileName
End With
Text1.Text = Trim(Text1.Text)
End Sub
Private Sub Form_Load()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
End Sub
Private Sub Text3_Change()
On Error GoTo aac
Dim Message, Title, Default, MyValue
串行口1 = CInt(Text3.Text)
If 串行口1 = 0 Then
aac:
Message = "請輸入端口號" ' 設置提示信息。
Title = "中國大劍測繪系統提示" ' 設置標題
Default = "8" ' 設置缺省值。
串行口1 = InputBox(Message, Title, Default)
Text3.Text = 串行口1
Option22.Value = False
Option23.Value = False
Option24.Value = False
Else
Text3.Text = 串行口1
Option22.Value = False
Option23.Value = False
Option24.Value = False
End If
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -