PIC Vietnam

Go Back   PIC Vietnam > Microchip PIC > Các ngôn ngữ lập trình khác (CCS C, HT PIC,...)

Tài trợ cho PIC Vietnam
Trang chủ Đăng Kí Hỏi/Ðáp Thành Viên Lịch Bài Trong Ngày Vi điều khiển

 
 
Ðiều Chỉnh Xếp Bài
Prev Previous Post   Next Post Next
Old 10-09-2010, 08:20 PM   #32
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
 


Quyền Sử Dụng Ở Diễn Ðàn
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is Mở
Smilies đang Mở
[IMG] đang Mở
HTML đang Tắt

Chuyển đến


Múi giờ GMT. Hiện tại là 05:22 AM.


Được sáng lập bởi Đoàn Hiệp
Powered by vBulletin®
Page copy protected against web site content infringement by Copyscape
Copyright © PIC Vietnam