www.pudn.com > the PC Host examples .zip > ButtonsLights.frm
VERSION 5.00
Begin VB.Form DisplayWindow
BackColor = &H00FF8080&
Caption = "USB Design By Example: Buttons and Lights"
ClientHeight = 5595
ClientLeft = 60
ClientTop = 345
ClientWidth = 8475
LinkTopic = "Form1"
ScaleHeight = 5595
ScaleWidth = 8475
StartUpPosition = 3 'Windows Default
Begin VB.TextBox RealLEDValue
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 600
TabIndex = 16
Text = "Text1"
Top = 1080
Width = 615
End
Begin VB.ComboBox SelectFunction
BeginProperty Font
Name = "Arial Rounded MT Bold"
Size = 20.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 600
ItemData = "ButtonsLights.frx":0000
Left = 3120
List = "ButtonsLights.frx":0013
TabIndex = 0
Text = "A only"
Top = 2280
Width = 2175
End
Begin VB.CommandButton SoftButton
Appearance = 0 'Flat
BackColor = &H00808080&
CausesValidation= 0 'False
Height = 495
Index = 1
Left = 840
MaskColor = &H00FFFFFF&
TabIndex = 9
Top = 3720
Width = 255
End
Begin VB.CommandButton SoftButton
Appearance = 0 'Flat
BackColor = &H00808080&
CausesValidation= 0 'False
Height = 495
Index = 2
Left = 1200
MaskColor = &H00FFFFFF&
TabIndex = 10
Top = 3720
Width = 255
End
Begin VB.CommandButton SoftButton
Appearance = 0 'Flat
BackColor = &H00808080&
CausesValidation= 0 'False
Height = 495
Index = 3
Left = 1560
MaskColor = &H00FFFFFF&
TabIndex = 11
Top = 3720
Width = 255
End
Begin VB.CommandButton SoftButton
Appearance = 0 'Flat
BackColor = &H00808080&
CausesValidation= 0 'False
Height = 495
Index = 4
Left = 1920
MaskColor = &H00FFFFFF&
TabIndex = 12
Top = 3720
Width = 255
End
Begin VB.CommandButton SoftButton
Appearance = 0 'Flat
BackColor = &H00808080&
CausesValidation= 0 'False
Height = 495
Index = 5
Left = 2280
MaskColor = &H00FFFFFF&
TabIndex = 13
Top = 3720
Width = 255
End
Begin VB.CommandButton SoftButton
Appearance = 0 'Flat
BackColor = &H00808080&
CausesValidation= 0 'False
Height = 495
Index = 6
Left = 2640
MaskColor = &H00FFFFFF&
TabIndex = 14
Top = 3720
Width = 255
End
Begin VB.CommandButton SoftButton
Appearance = 0 'Flat
BackColor = &H00808080&
CausesValidation= 0 'False
Height = 495
Index = 7
Left = 3000
MaskColor = &H00FFFFFF&
TabIndex = 15
Top = 3720
Width = 255
End
Begin VB.CommandButton SoftButton
Appearance = 0 'Flat
BackColor = &H00808080&
CausesValidation= 0 'False
Height = 495
Index = 0
Left = 480
MaskColor = &H00FFFFFF&
TabIndex = 8
Top = 3720
Width = 255
End
Begin VB.Timer Timer1
Interval = 200
Left = 7440
Top = 1080
End
Begin VB.Shape RealButton
FillColor = &H00C0C0C0&
FillStyle = 0 'Solid
Height = 495
Index = 6
Left = 7320
Top = 3720
Width = 255
End
Begin VB.Shape RealButton
FillColor = &H00C0C0C0&
FillStyle = 0 'Solid
Height = 495
Index = 5
Left = 6960
Top = 3720
Width = 255
End
Begin VB.Shape RealButton
FillColor = &H00C0C0C0&
FillStyle = 0 'Solid
Height = 495
Index = 4
Left = 6600
Top = 3720
Width = 255
End
Begin VB.Shape RealButton
FillColor = &H00C0C0C0&
FillStyle = 0 'Solid
Height = 495
Index = 3
Left = 6240
Top = 3720
Width = 255
End
Begin VB.Shape RealButton
FillColor = &H00C0C0C0&
FillStyle = 0 'Solid
Height = 495
Index = 2
Left = 5880
Top = 3720
Width = 255
End
Begin VB.Shape RealButton
FillColor = &H00C0C0C0&
FillStyle = 0 'Solid
Height = 495
Index = 1
Left = 5520
Top = 3720
Width = 255
End
Begin VB.Shape RealButton
FillColor = &H00C0C0C0&
FillStyle = 0 'Solid
Height = 495
Index = 0
Left = 5160
Top = 3720
Width = 255
End
Begin VB.Shape RealButton
FillColor = &H00C0C0C0&
FillStyle = 0 'Solid
Height = 495
Index = 7
Left = 7680
Top = 3720
Width = 255
End
Begin VB.Shape SoftOFF
FillStyle = 0 'Solid
Height = 735
Index = 0
Left = 480
Top = 3720
Width = 255
End
Begin VB.Label Label7
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "1"
BeginProperty Font
Name = "Arial Rounded MT Bold"
Size = 15.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 495
Left = 4560
TabIndex = 7
Top = 3600
Width = 495
End
Begin VB.Label Label6
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "0"
BeginProperty Font
Name = "Arial Rounded MT Bold"
Size = 15.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 495
Left = 4560
TabIndex = 6
Top = 4200
Width = 495
End
Begin VB.Label Label5
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "0"
BeginProperty Font
Name = "Arial Rounded MT Bold"
Size = 15.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 495
Left = 3360
TabIndex = 5
Top = 4200
Width = 495
End
Begin VB.Label Label4
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "1"
BeginProperty Font
Name = "Arial Rounded MT Bold"
Size = 15.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 495
Left = 3360
TabIndex = 4
Top = 3600
Width = 495
End
Begin VB.Label Label3
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "Lights"
BeginProperty Font
Name = "Arial Rounded MT Bold"
Size = 15.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 495
Left = 2880
TabIndex = 3
Top = 360
Width = 2895
End
Begin VB.Line Line4
X1 = 4320
X2 = 4320
Y1 = 1800
Y2 = 2280
End
Begin VB.Line Line3
X1 = 6600
X2 = 6600
Y1 = 3480
Y2 = 2640
End
Begin VB.Line Line2
X1 = 1920
X2 = 1920
Y1 = 3480
Y2 = 2640
End
Begin VB.Line Line1
X1 = 1920
X2 = 6600
Y1 = 2640
Y2 = 2640
End
Begin VB.Label Label2
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "B = ""real"" buttons"
BeginProperty Font
Name = "Arial Rounded MT Bold"
Size = 15.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 495
Left = 5040
TabIndex = 2
Top = 4920
Width = 3015
End
Begin VB.Label Label1
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "A = ""soft"" buttons"
BeginProperty Font
Name = "Arial Rounded MT Bold"
Size = 15.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 495
Left = 360
TabIndex = 1
Top = 4920
Width = 3015
End
Begin VB.Shape RealOFF
FillStyle = 0 'Solid
Height = 735
Index = 7
Left = 7680
Top = 3720
Width = 255
End
Begin VB.Shape RealOFF
FillStyle = 0 'Solid
Height = 735
Index = 6
Left = 7320
Top = 3720
Width = 255
End
Begin VB.Shape RealOFF
FillStyle = 0 'Solid
Height = 735
Index = 5
Left = 6960
Top = 3720
Width = 255
End
Begin VB.Shape RealOFF
FillStyle = 0 'Solid
Height = 735
Index = 4
Left = 6600
Top = 3720
Width = 255
End
Begin VB.Shape RealOFF
FillStyle = 0 'Solid
Height = 735
Index = 3
Left = 6240
Top = 3720
Width = 255
End
Begin VB.Shape RealOFF
FillStyle = 0 'Solid
Height = 735
Index = 2
Left = 5880
Top = 3720
Width = 255
End
Begin VB.Shape RealOFF
FillStyle = 0 'Solid
Height = 735
Index = 1
Left = 5520
Top = 3720
Width = 255
End
Begin VB.Shape RealOFF
FillStyle = 0 'Solid
Height = 735
Index = 0
Left = 5160
Top = 3720
Width = 255
End
Begin VB.Shape SoftOFF
FillStyle = 0 'Solid
Height = 735
Index = 7
Left = 3000
Top = 3720
Width = 255
End
Begin VB.Shape SoftOFF
FillStyle = 0 'Solid
Height = 735
Index = 6
Left = 2640
Top = 3720
Width = 255
End
Begin VB.Shape SoftOFF
FillStyle = 0 'Solid
Height = 735
Index = 5
Left = 2280
Top = 3720
Width = 255
End
Begin VB.Shape SoftOFF
FillStyle = 0 'Solid
Height = 735
Index = 4
Left = 1920
Top = 3720
Width = 255
End
Begin VB.Shape SoftOFF
FillStyle = 0 'Solid
Height = 735
Index = 3
Left = 1560
Top = 3720
Width = 255
End
Begin VB.Shape SoftOFF
FillStyle = 0 'Solid
Height = 735
Index = 2
Left = 1200
Top = 3720
Width = 255
End
Begin VB.Shape SoftOFF
FillStyle = 0 'Solid
Height = 735
Index = 1
Left = 840
Top = 3720
Width = 255
End
Begin VB.Shape RealButtonCase
FillColor = &H00FF0000&
FillStyle = 0 'Solid
Height = 1215
Left = 5040
Top = 3480
Width = 3015
End
Begin VB.Shape LED1
FillStyle = 0 'Solid
Height = 495
Index = 7
Left = 6120
Shape = 3 'Circle
Top = 1080
Width = 495
End
Begin VB.Shape LED1
FillStyle = 0 'Solid
Height = 495
Index = 6
Left = 5520
Shape = 3 'Circle
Top = 1080
Width = 495
End
Begin VB.Shape LED1
FillStyle = 0 'Solid
Height = 495
Index = 5
Left = 4920
Shape = 3 'Circle
Top = 1080
Width = 495
End
Begin VB.Shape LED1
FillColor = &H000000FF&
FillStyle = 0 'Solid
Height = 495
Index = 4
Left = 4320
Shape = 3 'Circle
Top = 1080
Width = 495
End
Begin VB.Shape LED1
FillStyle = 0 'Solid
Height = 495
Index = 3
Left = 3720
Shape = 3 'Circle
Top = 1080
Width = 495
End
Begin VB.Shape LED1
FillStyle = 0 'Solid
Height = 495
Index = 2
Left = 3120
Shape = 3 'Circle
Top = 1080
Width = 495
End
Begin VB.Shape LED1
FillColor = &H000000FF&
FillStyle = 0 'Solid
Height = 495
Index = 1
Left = 2520
Shape = 3 'Circle
Top = 1080
Width = 495
End
Begin VB.Shape LED1
FillStyle = 0 'Solid
Height = 495
Index = 0
Left = 1920
Shape = 3 'Circle
Top = 1080
Width = 495
End
Begin VB.Shape SoftButtonCase
FillColor = &H00FF0000&
FillStyle = 0 'Solid
Height = 1215
Left = 360
Top = 3480
Width = 3015
End
Begin VB.Shape Shape1
FillColor = &H00C0FFFF&
FillStyle = 0 'Solid
Height = 975
Left = 1680
Top = 840
Width = 5175
End
End
Attribute VB_Name = "DisplayWindow"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' Declare some variables that will make the program easier to read
Dim isON, isOFF, Red, Black As Long
Private Sub Form_Load()
' Initialize the module's variables
isON = 3720: isOFF = 3960: Red = RGB(255, 0, 0): Black = RGB(0, 0, 0)
' Put SoftButtons in their default position
For i% = 0 To 7: SoftButton(i%).Top = isOFF: Next i% ' All Soft Buttons Off
SoftButton(1).Top = isON: SoftButton(4).Top = isON ' Pattern used on Front Cover!
SelectFunction.ListIndex = 0 ' Select "A only"
RealLEDValue.Visible = False ' Turn off debug window
End Sub
Sub SoftButton_Click(index%)
' Toggle the SoftButton on a click
If SoftButton(index%).Top = isON Then
SoftButton(index%).Top = isOFF
Else: SoftButton(index%).Top = isON
End If
End Sub
Private Sub Timer1_Timer()
' Check for button changes every 200msec
' NOTE: only flip the "RealButtons" and "LED(i%)" if necessary, otherwise there is flicker
Dim RealButtons As Byte: Dim RealLEDS As Byte: Dim LEDon As Boolean
' What is the value of the Real Buttons
Call ReadUSBdevice(AddressFor(RealButtons), 1)
For i% = 0 To 7
If ((RealButtons And 1) = 1) And (RealButton(i%).Top = isOFF) Then RealButton(i%).Top = isON
If ((RealButtons And 1) = 0) And (RealButton(i%).Top = isON) Then RealButton(i%).Top = isOFF
RealButtons = ((RealButtons And &HFE) / 2) ' Clear Bit 0 before divide
Next i%
' Now update the LEDs, first the Display LEDs then the Real LEDs
RealLEDS = 0
For i% = 0 To 7
LEDon = False ' Let's assume
RealLEDS = RealLEDS * 2
Select Case SelectFunction.ListIndex
Case 0: If SoftButton(i%).Top = isON Then LEDon = True ' A only
Case 1: If ((SoftButton(i%).Top = isON) Or (RealButton(i%).Top = isON)) Then LEDon = True ' A OR B
Case 2: If ((SoftButton(i%).Top = isON) And (RealButton(i%).Top = isON)) Then LEDon = True ' A AND B
Case 3: If ((SoftButton(i%).Top = isON) Xor (RealButton(i%).Top = isON)) Then LEDon = True ' A XOR B
Case 4: If RealButton(i%).Top = isON Then LEDon = True ' B only
End Select
If LEDon Then ' Turn it on IFF it's not already on
If LED1(i%).FillColor = Black Then LED1(i%).FillColor = Red
RealLEDS = RealLEDS + 1
Else: If LED1(i%).FillColor = Red Then LED1(i%).FillColor = Black
End If
Next i%
RealLEDValue.Text = TwoHexCharacters$(RealLEDS)
End Sub