📄 avr interface.frm
字号:
Left = 2760
TabIndex = 19
Top = 1320
Width = 735
End
Begin VB.Label Label4
Caption = "Press the buttons, to turn-OFF the LEDs"
Height = 375
Left = 360
TabIndex = 6
Top = 1440
Width = 1575
End
End
Begin VB.Menu About
Caption = "About"
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' Title: AVR RS232 interface
' Date: 14.09.2003
' Target: AT90s2313 4MHz
' Author: Serasidis Vasilis
' Home: Http://www.serasidis.gr
' eMail: info@serasidis.gr
' Version: 1.1
'
' Description:
' This example shows how to control some AVR device via Visual Basic. The current
' example is writed in Visual Basic 6.
' The hardware constituted by AT90s2313 at 4MHz speed, MAX232 or similar,
' 8 LEDs connected to PortB and 5 switches connected to PortD.
' Alternative you can use some STK board like MCU 00100, STK200, STK500.
'
' The software:
' When you press some button from Visual Basic (VB) software you will see the LEDs
' on the board, to change there status (on-off). When you press the switches from the
' board you will see the color of the pins PD2-PD6, in the VB software, to change there color
' from green to red.
Option Explicit
Dim LEDs As Integer
Dim Switches() As Byte
Dim sData As String
Dim temp As String
Dim Button As Integer
Dim PB0 As Integer
Dim PB1 As Integer
Dim PB2 As Integer
Dim PB3 As Integer
Dim PB4 As Integer
Dim PB5 As Integer
Dim PB6 As Integer
Dim PB7 As Integer
Private Sub About_Click()
frmAbout.Show
End Sub
Private Sub Check9_Click()
If Check9.Value = 0 Then
PB0 = 0
Check9.BackColor = QBColor(10)
ElseIf Check9.Value = 1 Then PB0 = 1
Check9.BackColor = QBColor(12)
End If
Call Command1_Click
End Sub
Private Sub Check10_Click()
If Check10.Value = 0 Then
PB1 = 0
Check10.BackColor = QBColor(10)
ElseIf Check10.Value = 1 Then PB1 = 2
Check10.BackColor = QBColor(12)
End If
Call Command1_Click
End Sub
Private Sub Check11_Click()
If Check11.Value = 0 Then
PB2 = 0
Check11.BackColor = QBColor(10)
ElseIf Check11.Value = 1 Then PB2 = 4
Check11.BackColor = QBColor(12)
End If
Call Command1_Click
End Sub
Private Sub Check12_Click()
If Check12.Value = 0 Then
PB3 = 0
Check12.BackColor = QBColor(10)
ElseIf Check12.Value = 1 Then PB3 = 8
Check12.BackColor = QBColor(12)
End If
Call Command1_Click
End Sub
Private Sub Check13_Click()
If Check13.Value = 0 Then
PB4 = 0
Check13.BackColor = QBColor(10)
ElseIf Check13.Value = 1 Then PB4 = 16
Check13.BackColor = QBColor(12)
End If
Call Command1_Click
End Sub
Private Sub Check14_Click()
If Check14.Value = 0 Then
PB5 = 0
Check14.BackColor = QBColor(10)
ElseIf Check14.Value = 1 Then PB5 = 32
Check14.BackColor = QBColor(12)
End If
Call Command1_Click
End Sub
Private Sub Check15_Click()
If Check15.Value = 0 Then
PB6 = 0
Check15.BackColor = QBColor(10)
ElseIf Check15.Value = 1 Then PB6 = 64
Check15.BackColor = QBColor(12)
End If
Call Command1_Click
End Sub
Private Sub Check16_Click()
If Check16.Value = 0 Then
PB7 = 0
Check16.BackColor = QBColor(10)
ElseIf Check16.Value = 1 Then PB7 = 128
Check16.BackColor = QBColor(12)
End If
Call Command1_Click
End Sub
Private Sub Command1_Click()
Dim bytInput() As Byte
Dim bytElement As Byte
Dim iX As Long
Dim iY As Long
Dim iL As Long
Dim sResult As String
Dim sData As String
Dim i As String
LEDs = PB0 + PB1 + PB2 + PB3 + PB4 + PB5 + PB6 + PB7
MSComm1.Output = Chr$(LEDs)
Switches = MSComm1.Input
Text1.Text = LEDs
Text2.Text = Chr$(LEDs)
iX = UBound(Switches(), 1)
For iY = 0 To iX
bytElement = Switches(iY) 'Get Single Byte Element
sData = Chr$(bytElement) 'and Its Character
For iL = 1 To 8 'Iterate Each Bit of the Byte
sResult = Abs((BitOn((bytElement), iL))) & sResult
Text3.Text = sResult
i = Mid(sResult, 8, 1)
If i = "0" Then
Shape1.FillColor = QBColor(12)
Else: Shape1.FillColor = QBColor(10)
End If
i = Mid(sResult, 7, 1)
If i = "0" Then
Shape2.FillColor = QBColor(12)
Else: Shape2.FillColor = QBColor(10)
End If
i = Mid(sResult, 6, 1)
If i = "0" Then
Shape3.FillColor = QBColor(12)
Else: Shape3.FillColor = QBColor(10)
End If
i = Mid(sResult, 5, 1)
If i = "0" Then
Shape4.FillColor = QBColor(12)
Else: Shape4.FillColor = QBColor(10)
End If
i = Mid(sResult, 4, 1)
If i = "0" Then
Shape5.FillColor = QBColor(12)
Else: Shape5.FillColor = QBColor(10)
End If
Next
Next
End Sub
Function BitOn(Number As Long, Bit As Long) As Boolean
Dim iX As Long
Dim iY As Long
iY = 1
For iX = 1 To Bit - 1
iY = iY * 2
Next
If Number And iY Then BitOn = True Else BitOn = False
End Function
Private Sub com1_Click()
If MSComm1.PortOpen = True Then
MSComm1.PortOpen = False
MSComm1.CommPort = 1
MSComm1.PortOpen = True
End If
End Sub
Private Sub com2_Click()
If MSComm1.PortOpen = True Then
MSComm1.PortOpen = False
MSComm1.CommPort = 2
MSComm1.PortOpen = True
End If
End Sub
Private Sub Timer1_Timer()
Call Command1_Click
End Sub
Private Sub Form_Load()
LEDs = Hex(0)
On Error GoTo Errorhandler
If MSComm1.PortOpen = False Then 'if comport is disabled....
MSComm1.PortOpen = True ' enable it.
End If
Timer1.Interval = 100 ' Set Timer interval.
Text3.Text = "00011111"
Exit Sub
Errorhandler:
If Err = 8005 Then 'if COM1 port is open then...
com2.Value = True 'check the 2th option button
MSComm1.CommPort = 2 'change to COM2 port
Resume 'return
End If
End Sub
Private Sub Command6_Click()
If MSComm1.PortOpen = True Then
MSComm1.PortOpen = False
End If
Unload Me
Unload frmAbout
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -