?? frmmain.frm
字號:
mnuCom(i).Checked = False
Next i
mnuCom(Index).Checked = True
End If
Else
.CommPort = Index
For i = 1 To 4
mnuCom(i).Checked = False
Next i
mnuCom(Index).Checked = True
End If
End With
UpdateStatus
End Sub
Private Sub mnuConnect_Click()
On Error Resume Next
With MSComm1
If .PortOpen = True Then
.PortOpen = False
Else
.PortOpen = True
If Err.Number <> 0 Then
MsgBox "Com" & .CommPort & " is not available." & vbCrLf & _
Err.Description
Err.Clear
End If
End If
End With
UpdateStatus
End Sub
Private Sub mnuDataBSel_Click(Index As Integer)
Dim i As Integer
Dim NewSettings As String
For i = 4 To 8
If (i = Index) Then
mnuDataBSel(i).Checked = True
Select Case Index
Case 4 ' 4
NewSettings = ",,4,"
Case 5 ' 5
NewSettings = ",,5,"
Case 6 ' 6
NewSettings = ",,6,"
Case 7 ' 7
NewSettings = ",,7,"
Case 8 ' 8
NewSettings = ",,8,"
End Select
Else
mnuDataBSel(i).Checked = False
End If
Next i
SetPort (NewSettings)
End Sub
Private Sub mnuHelpSel_Click(Index As Integer)
Select Case Index
Case 0 ' Basic Help
MsgBox "Basic Communications Program -- Help is in readme file." _
, vbInformation, "Help"
Case 1 ' About
MsgBox "Basic Communications Program Version 0.91", , "Help About"
End Select
End Sub
Private Sub mnuParitySel_Click(Index As Integer)
Dim i As Integer
Dim NewSettings As String
For i = 0 To 4
If (i = Index) Then
mnuParitySel(i).Checked = True
Select Case Index
Case 0 ' E
NewSettings = ",E,,"
Case 1 ' M
NewSettings = ",M,,"
Case 2 ' N
NewSettings = ",N,,"
Case 3 ' O
NewSettings = ",O,,"
Case 4 ' S
NewSettings = ",S,,"
End Select
Else
mnuParitySel(i).Checked = False
End If
Next i
SetPort (NewSettings)
End Sub
Private Sub mnuSpeedSel_Click(Index As Integer)
Dim i As Integer
Dim CurPortOpen As Boolean
Dim NewSettings As String
For i = 0 To 12
If (i = Index) Then
mnuSpeedSel(i).Checked = True
Select Case Index
Case 0 ' 110
NewSettings = "110,,,"
Case 1 ' 300
NewSettings = "300,,,"
Case 2 ' 600
NewSettings = "600,,,"
Case 3 ' 1200
NewSettings = "1200,,,"
Case 4 ' 2400
NewSettings = "2400,,,"
Case 5 ' 9600
NewSettings = "9600,,,"
Case 6 ' 14400
NewSettings = "14400,,,"
Case 7 ' 19200
NewSettings = "19200,,,"
Case 8 ' 28800
NewSettings = "28800,,,"
Case 9 ' 38400
NewSettings = "38400,,,"
Case 10 ' 56000
NewSettings = "56000,,,"
Case 11 ' 128000
NewSettings = "128000,,,"
Case 12 ' 256000
NewSettings = "256000,,,"
End Select
Else
mnuSpeedSel(i).Checked = False
End If
Next i
SetPort (NewSettings)
End Sub
Private Sub mnuStopSel_Click(Index As Integer)
Dim i As Integer
Dim NewSettings As String
For i = 0 To 2
If (i = Index) Then
mnuStopSel(i).Checked = True
Select Case Index
Case 0 ' 1
NewSettings = ",,,1"
Case 1 ' 1.5
NewSettings = ",,,1.5"
Case 2 ' 2
NewSettings = ",,,2"
End Select
Else
mnuStopSel(i).Checked = False
End If
Next i
SetPort (NewSettings)
End Sub
Private Sub mnuViewSel_Click(Index As Integer)
Dim i As Integer
Dim j As Integer
Dim c As String
txtTextOut_LostFocus
For j = 0 To 1
If (j = Index) Then
mnuViewSel(j).Checked = True
Select Case Index
Case 0 ' Ascii
OutputAscii = True
txtResponse = ""
For i = 1 To Len(InputString)
c = Mid(InputString, i, 1)
txtResponse = txtResponse & AsciiRep(c)
Next i
txtTextOut.Text = ""
For i = 1 To Len(OutputString)
c = Mid(OutputString, i, 1)
txtTextOut.Text = txtTextOut.Text & AsciiRep(c)
Next i
Case 1 ' Hex
OutputAscii = False
txtResponse = ""
For i = 1 To Len(InputString)
c = Asc(Mid(InputString, i, 1))
txtResponse = txtResponse & " " & Hex2(c)
Next i
txtTextOut.Text = ""
For i = 1 To Len(OutputString)
c = Mid(OutputString, i, 1)
txtTextOut.Text = txtTextOut.Text & " " & Hex2(Asc(c))
Next i
End Select
Else
mnuViewSel(j).Checked = False
End If
Next j
txtResponse.SelStart = Len(txtResponse)
txtTextOut.SelStart = Len(txtTextOut.Text)
UpdateStatus
End Sub
Private Sub MSComm1_OnComm()
Dim txtBuf As String
Dim i As Integer
Dim c As String
With MSComm1
Select Case .CommEvent
Case comEvReceive
txtBuf = .Input
InputString = InputString & txtBuf
For i = 1 To Len(txtBuf)
c = Mid(txtBuf, i, 1)
If OutputAscii Then
txtResponse = txtResponse & AsciiRep(c)
Else
txtResponse = txtResponse & " " & Hex2(c)
End If
Next i
End Select
End With
txtResponse.SelStart = Len(txtResponse)
End Sub
Private Sub UpdateStatus()
If MSComm1.PortOpen Then
StatusBar1.Panels(1).Text = "Connected"
mnuConnect.Caption = "Dis&connect"
btnSend(1).Enabled = True
Else
StatusBar1.Panels(1).Text = "Disconnected"
mnuConnect.Caption = "&Connect"
btnSend(1).Enabled = False
End If
StatusBar1.Panels(2).Text = "COM" & MSComm1.CommPort
StatusBar1.Panels(3).Text = MSComm1.Settings
If (OutputAscii) Then
StatusBar1.Panels(4) = "ASCII"
Else
StatusBar1.Panels(4) = "HEX"
End If
End Sub
Private Function ValidatePort() As Boolean
Dim i As Integer
On Error Resume Next
ValidatePort = False
With MSComm1
For i = 4 To 1 Step -1
.CommPort = i
Err.Clear
.PortOpen = True
If (Err.Number <> 0) Then
mnuCom(i).Enabled = False
Else
ValidatePort = True
.PortOpen = False
End If
Next i
End With
End Function
Private Function LegalHex(c As String) As String
c = UCase(c)
Select Case c
Case "0" To "9", "A" To "F"
LegalHex = c
Case Else
LegalHex = ""
End Select
End Function
Private Sub SetPort(NewSettings As String)
Dim CurPortOpen As Boolean
Dim OldIndex As Integer
Dim OldLength As Integer
Dim NewIndex As Integer
Dim NewLength As Integer
Dim i As Integer
Dim Settings(0 To 3) As String
Dim Temp As String
With MSComm1
CurPortOpen = .PortOpen
If .PortOpen Then
.PortOpen = False
End If
OldIndex = 1
NewIndex = 1
For i = 0 To 3
NewLength = InStr(NewIndex, NewSettings, ",")
If (NewLength = 0) Then
NewLength = NewIndex + Len(Mid(NewSettings, NewIndex))
End If
OldLength = InStr(OldIndex, .Settings, ",")
If (OldLength = 0) Then
OldLength = OldIndex + Len(Mid(.Settings, OldIndex))
End If
If (NewLength = NewIndex) Then
Settings(i) = Mid(.Settings, OldIndex, OldLength - OldIndex)
Else
Settings(i) = Mid(NewSettings, NewIndex, NewLength - NewIndex)
End If
OldIndex = OldLength + 1
NewIndex = NewLength + 1
Next i
.Settings = Settings(0) & "," & Settings(1) & "," & _
Settings(2) & "," & Settings(3)
If CurPortOpen Then
.PortOpen = True
End If
End With
UpdateStatus
End Sub
Private Sub txtTextOut_GotFocus()
txtTextOut.SelStart = 0
txtTextOut.SelLength = Len(txtTextOut)
End Sub
Private Function AsciiRep(c As String) As String
Select Case Asc(c)
Case 32 To 91, 93 To 126
AsciiRep = c
Case 8
AsciiRep = "\b"
Case 9
AsciiRep = "\t"
Case 10
AsciiRep = "\n"
Case 13
AsciiRep = "\r"
Case 92
AsciiRep = "\\"
Case Else
AsciiRep = "\x" & Hex2(Asc(c))
End Select
End Function
Private Function Hex2(c As String) As String
Hex2 = Hex(c)
If Len(Hex2) < 2 Then
Hex2 = "0" & Hex2
End If
End Function
Private Sub txtTextOut_LostFocus()
Dim c As String
Dim i As Long
Dim Temp As Long
OutputString = ""
If (OutputAscii) Then
For i = 1 To Len(txtTextOut.Text)
c = Mid(txtTextOut.Text, i, 1)
If (c = "\") Then
i = i + 1
c = Mid(txtTextOut.Text, i, 1)
Select Case c
Case "b"
OutputString = OutputString & Chr(8)
Case "t"
OutputString = OutputString & Chr(9)
Case "n"
OutputString = OutputString & Chr(10)
Case "r"
OutputString = OutputString & Chr(13)
Case "\"
OutputString = OutputString & "\"
Case "x"
c = HexChar(Mid(txtTextOut.Text, i + 1, 1)) * 16 _
+ HexChar(Mid(txtTextOut.Text, i + 2, 1))
OutputString = OutputString & Chr(c)
i = i + 2
End Select
Else
OutputString = OutputString & c
End If
Next i
txtTextOut.Text = ""
For i = 1 To Len(OutputString)
c = Mid(OutputString, i, 1)
txtTextOut.Text = txtTextOut.Text & AsciiRep(c)
Next i
Else
i = 1
Do While (Len(Mid(txtTextOut.Text, i)) > 0)
Temp = 0
Do While (Mid(txtTextOut.Text, i, 1)) = " "
i = i + 1
Loop
c = Mid(txtTextOut.Text, i, 1)
Do While Not (c = " " Or c = "")
Temp = (Temp * 16) + HexChar(c)
i = i + 1
c = Mid(txtTextOut.Text, i, 1)
Loop
If (Temp > 255) Then
Temp = 0
End If
OutputString = OutputString & Chr(Temp)
Loop
txtTextOut.Text = ""
For i = 1 To Len(OutputString)
c = Mid(OutputString, i, 1)
txtTextOut.Text = txtTextOut.Text & " " & AsciiRep(c)
Next i
End If
txtTextOut.SelStart = Len(txtTextOut.Text)
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -