⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 avr interface.frm

📁 Visuabaic interface with com connect to computer
💻 FRM
📖 第 1 页 / 共 2 页
字号:
         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 + -