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

📄 buttonslights.frm

📁 PC端的USB主机源代码
💻 FRM
📖 第 1 页 / 共 2 页
字号:
   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

⌨️ 快捷键说明

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