View Single Post
Old 10-09-2010, 08:20 PM   #59
hongson06d61132
Nhập môn đệ tử
 
Tham gia ngày: Oct 2009
Bài gửi: 2
:
nhờ các bác giải thích giùm đoạn lệnh này với.
Option Explicit

Private Sub btnClear_Click(Index As Integer)
Dim i As Integer

Select Case Index
Case 0:
For i = 0 To 11
txtHEX(i) = ""
Next i
Case 1:
txtTextOut = ""
Case 2:
txtResponse = ""
End Select

End Sub

Private Sub btnSend_Click(Index As Integer)
Dim i As Integer
Dim j As Integer
Dim Temp As Long
Dim OutString As String

OutString = ""
Select Case Index
Case 0 ' Send Hex character string
For i = 0 To 11
Temp = 0
If (Len(txtHEX(i)) > 0) Then
For j = 1 To Len(Left(txtHEX(i), 2))
Temp = Temp * 16 + HexChar(Mid(txtHEX(i), j, 1))
Next j
OutString = OutString & Chr(Temp)
End If
Next i
send (OutString)
Case 1 ' Send ascii string
send txtTextOut.Text
End Select

End Sub
Sub send(txtin As String)
If MSComm1.PortOpen = True Then
MSComm1.Output = txtin
End If
End Sub

Function HexChar(strData As String) As Integer

Select Case strData
Case "0" To "9"
HexChar = Val(strData) - Val("0")
Case "a", "A"
HexChar = 10
Case "b", "B"
HexChar = 11
Case "c", "C"
HexChar = 12
Case "d", "D"
HexChar = 13
Case "e", "E"
HexChar = 14
Case "f", "F"
HexChar = 15
Case Else
HexChar = 0
End Select

End Function

Private Sub Form_Load()
Dim i As Integer

For i = 0 To 2 ' Clear all input/output fields
btnClear_Click (i)
Next i
If Not ValidatePort Then
MsgBox "There are no available comm ports on this computer.", , "Commx"
End
End If
UpdateStatus
End Sub

Private Sub Form_Unload(Cancel As Integer)

If (MSComm1.PortOpen) Then
MSComm1.PortOpen = False
End If

End Sub

Private Sub mnuCom_Click(Index As Integer)
Dim i As Integer
Dim OldPort As Long

On Error Resume Next
With MSComm1
OldPort = .CommPort
If MSComm1.PortOpen Then
.PortOpen = False
.CommPort = Index
.PortOpen = True
If Err.Number <> 0 Then ' This should not happen...
MsgBox "Com" & Index & " is not available." & _
vbCrLf & Err.Description
Err.Clear
.CommPort = OldPort
Else
For i = 1 To 4
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 what you see is what you get." _
, 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 MSComm1_OnComm()
Dim txtBuf As String
Dim i As Integer
Dim c As Integer

With MSComm1
Select Case .CommEvent
Case comEvReceive
txtBuf = .Input
For i = 1 To Len(txtBuf)
c = Asc(Mid(txtBuf, i, 1))
If (c < 32 Or c > 126) Then
txtResponse = txtResponse & "<" & Hex(c) & ">"
Else
txtResponse = txtResponse & Chr(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(0).Enabled = True
btnSend(1).Enabled = True
Else
StatusBar1.Panels(1).Text = "Disconnected"
mnuConnect.Caption = "&Connect"
btnSend(0).Enabled = False
btnSend(1).Enabled = False
End If
StatusBar1.Panels(2).Text = "COM" & MSComm1.CommPort
StatusBar1.Panels(3).Text = MSComm1.Settings

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 Sub txtHEX_GotFocus(Index As Integer)

txtHEX(Index).SelStart = 0
txtHEX(Index).SelLength = Len(txtHEX(Index))

End Sub

Private Sub txtHEX_LostFocus(Index As Integer)
Dim Temp As String

Temp = txtHEX(Index)
Select Case Len(txtHEX(Index))
Case 0
txtHEX(Index) = ""
Case 1
txtHEX(Index) = "0" & LegalHex(Mid(txtHEX(Index), 1, 1))
Case Else
txtHEX(Index) = LegalHex(Mid(txtHEX(Index), 1, 1)) & _
LegalHex(Mid(txtHEX(Index), 2, 1))
End Select
If (Len(txtHEX(Index)) > 0) Then
Do While (Len(txtHEX(Index)) < 2)
txtHEX(Index) = "0" & txtHEX(Index)
Loop
End If
End Sub
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
hongson06d61132 vẫn chưa có mặt trong diễn đàn   Trả Lời Với Trích Dẫn