www.pudn.com > the PC Host examples .zip > Display.frm
VERSION 5.00
Begin VB.Form Display_Descriptors
BackColor = &H00FF8080&
Caption = "USB Design By Example: Display Descriptors"
ClientHeight = 6870
ClientLeft = 165
ClientTop = 450
ClientWidth = 11610
ForeColor = &H8000000E&
LinkTopic = "Form1"
ScaleHeight = 6870
ScaleWidth = 11610
StartUpPosition = 3 'Windows Default
Begin VB.ComboBox Choice
Height = 315
Index = 5
Left = 240
TabIndex = 15
Text = "Display String Text"
Top = 6120
Width = 11175
End
Begin VB.ComboBox Choice
Height = 315
Index = 4
Left = 9360
TabIndex = 14
Text = "Display Names"
Top = 600
Width = 2000
End
Begin VB.ListBox Descriptor
Appearance = 0 'Flat
BeginProperty Font
Name = "Arial Rounded MT Bold"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 4890
Index = 4
Left = 9360
TabIndex = 13
Top = 960
Width = 1995
End
Begin VB.ComboBox Choice
Height = 315
Index = 3
Left = 7080
TabIndex = 11
Text = "Display Names"
Top = 600
Width = 2000
End
Begin VB.ComboBox Choice
Height = 315
Index = 2
Left = 4800
TabIndex = 9
Text = "Display Names"
Top = 600
Width = 2000
End
Begin VB.ComboBox Choice
Height = 315
Index = 1
ItemData = "Display.frx":0000
Left = 2520
List = "Display.frx":0007
TabIndex = 8
Text = "Display Names"
Top = 600
Width = 2000
End
Begin VB.ComboBox Choice
Height = 315
Index = 0
ItemData = "Display.frx":001A
Left = 240
List = "Display.frx":0024
TabIndex = 7
Text = "Display Names"
Top = 600
Width = 2000
End
Begin VB.ListBox Descriptor
Appearance = 0 'Flat
BeginProperty Font
Name = "Arial Rounded MT Bold"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1920
Index = 3
ItemData = "Display.frx":0047
Left = 7080
List = "Display.frx":0060
TabIndex = 3
Top = 960
Width = 2000
End
Begin VB.ListBox Descriptor
Appearance = 0 'Flat
BeginProperty Font
Name = "Arial Rounded MT Bold"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2460
Index = 2
ItemData = "Display.frx":0079
Left = 4800
List = "Display.frx":0098
TabIndex = 2
Top = 960
Width = 2000
End
Begin VB.ListBox Descriptor
Appearance = 0 'Flat
BeginProperty Font
Name = "Arial Rounded MT Bold"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2460
Index = 1
ItemData = "Display.frx":00B7
Left = 2520
List = "Display.frx":00D6
TabIndex = 1
Top = 960
Width = 2000
End
Begin VB.ListBox Descriptor
Appearance = 0 'Flat
BeginProperty Font
Name = "Arial Rounded MT Bold"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 4890
Index = 0
ItemData = "Display.frx":00F5
Left = 240
List = "Display.frx":012F
TabIndex = 0
Top = 960
Width = 2000
End
Begin VB.Label Label5
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "Class"
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 = &H00FF0000&
Height = 495
Left = 9240
TabIndex = 12
Top = 120
Width = 2055
End
Begin VB.Label Label4
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "Endpoint"
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 = &H00FF0000&
Height = 375
Left = 6840
TabIndex = 10
Top = 120
Width = 2415
End
Begin VB.Label Label3
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "Interface"
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 = &H00FF0000&
Height = 495
Left = 4680
TabIndex = 6
Top = 120
Width = 2175
End
Begin VB.Label Label2
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "Configuration"
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 = &H00FF0000&
Height = 375
Left = 2400
TabIndex = 5
Top = 120
Width = 2295
End
Begin VB.Label Label1
Alignment = 2 'Center
BackColor = &H00FFC0C0&
BackStyle = 0 'Transparent
Caption = "Device"
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 = &H00FF0000&
Height = 375
Left = 120
TabIndex = 4
Top = 120
Width = 2175
End
End
Attribute VB_Name = "Display_Descriptors"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public Sub Initialize()
' Control is passed to this module once all of the Descriptor information has been collected
' This module displays the information in a form as similar as Chapter 3 as possible
Call ClearDisplay
Call ParseDescriptors
' Determine which Class Descriptor, if any, is in Column 5
Display_Descriptors.Show
End Sub
Private Sub ClearDisplay()
For i% = 0 To 4
Call DisplayNames(i%)
Choice(i%).Clear
Choice(i%).AddItem "Display Names"
Choice(i%).ListIndex = 0
Next i%
End Sub
Private Sub ParseDescriptors()
DeviceCount = 0: ConfigurationCount = 0: InterfaceCount = 0: EndpointCount = 0: ClassCount = 0
Index& = 1
Do While DescriptorData(Index&) <> 0
Select Case DescriptorData(Index& + 1) ' What TYPE of descriptor is this?
Case 1
DeviceCount = DeviceCount + 1: Choice(0).AddItem "Display Values"
Choice(0).ItemData(Choice(0).ListCount - 1) = Index&
Case 2
ConfigurationCount = ConfigurationCount + 1: Choice(1).AddItem "Configuration " & ConfigurationCount
Choice(1).ItemData(Choice(1).ListCount - 1) = Index&
Case 3
If StringCount <> 0 Then Choice(5).AddItem "String " & TwoHexCharacters$(CByte(StringCount)) & " = " & GetString$(Index&)
StringCount = StringCount + 1
Case 4
InterfaceCount = InterfaceCount + 1
Choice(2).AddItem "Interface " & ConfigurationCount & ":" & InterfaceCount
Choice(2).ItemData(Choice(2).ListCount - 1) = Index&
Case 5
EndpointCount = EndpointCount + 1
Choice(3).AddItem "Endpoint " & ConfigurationCount & ":" & EndpointCount
Choice(3).ItemData(Choice(3).ListCount - 1) = Index&
Case Else ' Must be a Class Descriptor
ClassCount = ClassCount + 1
Choice(4).AddItem "Class(" & TwoHexCharacters$(CByte(DescriptorData(Index& + 1))) & ") " & ConfigurationCount & ":" & ClassCount
Choice(4).ItemData(Choice(4).ListCount - 1) = Index&
End Select
Index& = Index& + DescriptorData(Index&)
Loop
' Fill out the default data for the Descriptors
For i% = 0 To 4
If Choice(i%).ListCount = 1 Then ' descriptor type is not present, remove from display
Choice(i%).Visible = False: Descriptor(i%).Visible = False
Else ' fill with data
Choice(i%).ItemData(0) = Choice(i%).ItemData(1)
Call AddDescriptorData(i%, 0)
End If
Next i%
If StringCount = 0 Then Choice(5).Visible = False
End Sub
Private Function GetString$(Index&) ' Extract UNICODE string from Descriptor
Length& = DescriptorData(Index&) - 2
temp$ = "": For i& = 2 To Length& + 1 Step 2: temp$ = temp$ + Chr$(DescriptorData(Index& + i&)): Next i&
GetString$ = temp$
End Function
Private Sub Descriptor_Click(DescriptorID%)
' If a user clicks on a TEXT entry then this text is replaced with it's current VALUE
Selection& = Descriptor(DescriptorID%).ListIndex
Descriptor(DescriptorID%).List(Selection&) = TwoHexCharacters(Descriptor(DescriptorID%).ItemData(Selection&))
End Sub
Private Sub Choice_Click(DescriptorID%)
' If a user changes the SELECTION then the corresponding Descriptor DISPLAY must be updated
If DescriptorID% <> 5 Then
Selection& = Choice(DescriptorID%).ListIndex
If Selection& = 0 Then
Call DisplayNames(DescriptorID%)
Call AddDescriptorData(DesciptorID%, 0)
Else
Call AddDescriptorData(DescriptorID%, Selection&)
Call DisplayDescriptor(DescriptorID%, Selection&)
End If 'Selection& = 0
End If 'DescriptorID% <> 5
End Sub
Public Sub AddDescriptorData(DescriptorID%, Selection&)
' This subroutine updates the ITEMDATA of DISPLAY with the corresponding VALUES
Index& = Choice(DescriptorID%).ItemData(Selection&)
Length& = Descriptor(DescriptorID%).ListCount
For i& = 0 To Length& - 1
Descriptor(DescriptorID%).ItemData(i&) = DescriptorData(Index& + i&)
Next i&
End Sub
Public Sub DisplayDescriptor(DescriptorID%, Selection&)
' This subroutine replaces Descriptor TEXT with Descriptor VALUES
Length& = Descriptor(DescriptorID%).ListCount
For i& = 0 To Length& - 1
Descriptor(DescriptorID%).List(i&) = TwoHexCharacters$(Descriptor(DescriptorID%).ItemData(i&))
Next i&
End Sub
Public Sub DisplayNames(DescriptorID%)
' This subroutine clears the Descriptor then copies TEXT to the DISPLAY
Descriptor(DescriptorID%).Clear
Descriptor(DescriptorID%).AddItem " Length"
Descriptor(DescriptorID%).AddItem " Type"
Select Case DescriptorID%
Case 0 'Device
Descriptor(0).AddItem " USB"
Descriptor(0).AddItem " Version"
Descriptor(0).AddItem " Class"
Descriptor(0).AddItem " SubClass"
Descriptor(0).AddItem " Protocol"
Descriptor(0).AddItem " EP0_Size"
Descriptor(0).AddItem " Vendor"
Descriptor(0).AddItem " ID"
Descriptor(0).AddItem " Product"
Descriptor(0).AddItem " ID"
Descriptor(0).AddItem " Version"
Descriptor(0).AddItem " Number"
Descriptor(0).AddItem " iManufacturer"
Descriptor(0).AddItem " iProductName"
Descriptor(0).AddItem " iSerial#"
Descriptor(0).AddItem " Configurations"
Case 1 'Configuration
Descriptor(1).AddItem " Total"
Descriptor(1).AddItem " Length"
Descriptor(1).AddItem " Interfaces"
Descriptor(1).AddItem " ThisConfig."
Descriptor(1).AddItem " ConfigName"
Descriptor(1).AddItem " Attributes"
Descriptor(1).AddItem " Max.Power"
Case 2 'Interface
Descriptor(2).AddItem " ThisInterface"
Descriptor(2).AddItem " Alternate"
Descriptor(2).AddItem " Endpoints"
Descriptor(2).AddItem " Class"
Descriptor(2).AddItem " SubClass"
Descriptor(2).AddItem " Protocol"
Descriptor(2).AddItem " InterfaceName"
Case 3 'Endpoint
Descriptor(3).AddItem " ThisEndpoint"
Descriptor(3).AddItem " Attributes"
Descriptor(3).AddItem " Max. Packet"
Descriptor(3).AddItem " Size"
Descriptor(3).AddItem " Polling Interval"
Case 4 ' Class. Display will depend upon which Class
' x = Descriptor(4).ItemData(1) 'Type
' Select Case x
' Case 33 'HID
Descriptor(4).AddItem "Param3"
Descriptor(4).AddItem "Param4"
Descriptor(4).AddItem "Param5"
Descriptor(4).AddItem "Param6"
Descriptor(4).AddItem "Param7"
Descriptor(4).AddItem "Param8"
Descriptor(4).AddItem "Param9"
' End Select
End Select
End Sub