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

📄 display.frm

📁 vb环境下usb口的数据传输
💻 FRM
📖 第 1 页 / 共 2 页
字号:
         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"
         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"
         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

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -