vcd.frm

一个用vb和usb通信的一个实例,大家可以下载看看!

        .Max = MyVolume.prMicMinVolume
        .Min = MyVolume.prMicMaxVolume \ 2
        .SmallChange = 1000
        .LargeChange = 1000
        .Enabled = True
    End With
End If
Dim j, ls, i, oldx, oldy, coloury
DoEvents
    Randomize
    Amounty = 325
    For j = 1 To Amounty
    Snow(j, 0) = Int(Rnd * Me.Width)
    Snow(j, 1) = Int(Rnd * Me.Height)
    Snow(j, 2) = 10 + (Rnd * 20)
    Next j
    Do While Not (DoEvents = 0)
    For ls = 1 To 10
    For i = 1 To Amounty
    oldx = Snow(i, 0): oldy = Snow(i, 1)
    Snow(i, 1) = Snow(i, 1) + Snow(i, 2)
    If Snow(i, 1) > Me.Height Then
     Snow(i, 1) = 0: Snow(i, 2) = 5 + (Rnd * 30)
     Snow(i, 0) = Int(Rnd * Me.Width)
     oldx = 0: oldy = 0
    End If
    coloury = 8 * (Snow(i, 2) - 10): coloury = 60 + coloury
    PSet (oldx, oldy), QBColor(0)
    PSet (Snow(i, 0), Snow(i, 1)), RGB(coloury, coloury, coloury)
    Next i
    Next ls
    Loop
vsVolume.Value = 16000
vsmic.Value = 16000
ooooo.Checked = False

jhjhuoyuiy.Checked = True
痒痒.Checked = True
End Sub


Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Static bBusy As Boolean
If bBusy = False Then
    bBusy = True
        Select Case CLng(X)
            Case WM_LBUTTONDBLCLK
              
                
            Case WM_LBUTTONDOWN
             
                Select Case mnCard
                    Case 0: mnCard = 1
                    Case 1: mnCard = 2
                    Case 2: mnCard = 3
                    Case 3: mnCard = 0
                End Select
                With mtIconData
                    .hIcon = ImgTrayIcon(mnCard).Picture
                    .szTip = ImgTrayIcon(mnCard).Tag & Chr$(0)
                End With
                If Shell_NotifyIcon(NIM_MODIFY, mtIconData) = 0 Then
                    MsgBox "不能改变图标!"
                End If
            Case WM_LBUTTONUP       '处理左键释放消息。
            Case WM_RBUTTONDBLCLK   '处理右键双击消息。
                 
            Case WM_RBUTTONDOWN     '处理右键按下消息。
            Case WM_RBUTTONUP
                '处理右键释放消息，显示弹出菜单。
                PopupMenu f2, 2, , , f2
        End Select
        bBusy = False
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
DeleteIconFromTray

MMControl1.Command = "close"
Unload Me
Unload Form2
Unload frmAbout
Unload frmAbout1

Form3.Show

End Sub






Private Sub io_Click()

 

End Sub


Private Sub gh_Click()
MMControl1.Command = "seek"
'MMControl1.Command = "play"
MMControl1.To = 0
MMControl1.Command = "play"
MMControl1.Command = "play"
End Sub



Private Sub hjhjhjhjh_Click()
vsmic.Value = 32767
hjhjhjhjh.Checked = True
jhjhuoyuiy.Checked = False
yuyuyiy.Checked = False
klhkljhjk.Checked = False
End Sub

Private Sub jfsfhjhhl_Click()
mciSendString "Set CDAudio Door Closed Wait", 0&, 0&, 0&
eeret.Enabled = True
jfsfhjhhl.Enabled = False

End Sub




Private Sub jhjhuoyuiy_Click()
vsmic.Value = 32767 / 2
hjhjhjhjh.Checked = False
jhjhuoyuiy.Checked = True
yuyuyiy.Checked = False
klhkljhjk.Checked = False
End Sub

Private Sub jjjjhg_Click()
Form4.Timer1 = False
End Sub

Private Sub kkkll_Click()
frmSoundCard.Show

End Sub

Private Sub klhkljhjk_Click()
vsmic.Value = 0
hjhjhjhjh.Checked = False
jhjhuoyuiy.Checked = False
yuyuyiy.Checked = False
klhkljhjk.Checked = True
End Sub





Private Sub Label6_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbRightButton Then
        Me.PopupMenu f2
End If
End Sub

Private Sub Label7_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbRightButton Then
        Me.PopupMenu f2
End If
End Sub

Private Sub Label8_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbRightButton Then
        Me.PopupMenu f2
End If
End Sub




Private Sub m112_Click()
Slider2.Value = Slider2.Value - 2000
MMControl1.To = Slider2.Value
MMControl1.Command = "seek"
MMControl1.Command = "play"

End Sub



Private Sub m17_Click()
MMControl1.Command = "close"

End

End Sub

Private Sub m21_Click()


End Sub

Private Sub m213_Click()
Slider2.Value = Slider2.Value + 2000
MMControl1.To = Slider2.Value
MMControl1.Command = "seek"
MMControl1.Command = "play"


 'MMControl1.Position = MMControl1.Position + 1000
 
 
 
End Sub



Private Sub m24_Click()
MMControl1.Command = "prew"
End Sub







Private Sub List2_DblClick()
On Error Resume Next
Form2.MMControl1.Command = "close"
Form2.MMControl1.DeviceType = "MpegVideo"
'MMControl1.FileName = List1.List(List1.Selected)
Form4.Show
Form2.MMControl1.hWndDisplay = Form4.Picture1.hWnd
Form2.MMControl1.FileName = List2.List(List2.ListIndex)
Form2.MMControl1.Command = "open"
Form2.MMControl1.Command = "play"
 Form2.MMControl1.Command = "play"
 Form2.MMControl1.TimeFormat = 2
'mmcontrol1.FileName =
Form2.Slider2.Min = 0
Form2.Slider2.Max = MMControl1.Length
Form2.Picture3.BackColor = &HFF&
Form4.Caption = "正在播放  " + MMControl1.FileName
 
Form2.Label9.Caption = "状态:播放..."
Form2.f12.Enabled = True
Form2.f11.Enabled = False
Form2.f32.Enabled = True

Form2.f22.Enabled = True
Form2.f23.Enabled = True
Form2.f25.Enabled = True
Form2.f26.Enabled = True
Form2.f28.Enabled = True
Form2.f27.Enabled = True
Form2.f29.Enabled = True
Form2.f31.Enabled = True
Form2.gh.Enabled = True
Form2.Check1.Enabled = True
Form2.Check2.Enabled = True

End Sub




Private Sub List2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbRightButton Then
    Me.PopupMenu Form1.ssuu
End If

End Sub

Private Sub MMControl1_EjectClick(Cancel As Integer)
MMControl1.UpdateInterval = 0

MMControl1.Command = "eject"
MMControl1.Command = "close"
Exit Sub

End Sub


Private Sub MMControl1_StatusUpdate()
Label11.Caption = MMControl1.FileName
Label12.Caption = MMControl1.Length

Label13.Caption = MMControl1.Position

Slider2.Value = MMControl1.Position
'Slider2.Value = Int((MMControl1.Position / MMControl1.Length) * 1000)



End Sub



Private Sub Text4_Change()
'If Val(Text4.Text) < MMControl1.Length Then
   
 '  ty = Val(Text4.Text)
  ' MMControl1.Position = ty
  ' MMControl1.Command = "play"
'ElseIf Val(Text4.Text) > MMControl1.Length Then
'   ffg = MsgBox("此值大于" + MMControl1.Length + ",无效.", 53, "提示1")
'End If

   
End Sub


   





Private Sub once_Click()
MMControl1.Command = "prev"
MMControl1.Command = "prev"
Label9.Caption = "状态:播放..."
End Sub

Private Sub Mnu001_Click(Index As Integer)

  Form2.Caption = "蓝霞家庭音乐视听  V5.0"
    MMControl1.Command = "close"
     Dim a(14) As String
Dim b As Integer
Dim c, d As String
On Error Resume Next
a(0) = "D:"
a(1) = "E:"
a(2) = "F:"
a(3) = "G:"
a(4) = "H:"
a(5) = "I:"
a(6) = "J:"
a(7) = "K:"
a(8) = "L:"
a(9) = "M:"
a(10) = "N:"
a(11) = "O:"
a(12) = "P:"
a(13) = "Q:"
a(14) = "R:"
For b = 0 To 14
ChDir (a(b))
On Error GoTo e
Next
e:

c = a(b - 1) + "\mpegav\"
MMControl1.FileName = c & Mnu001(Index).Caption
  Mnu001(Index).Checked = True
  
 ' CloseT = False
  '保存路径
  ' SaveSetting App.EXEName, "Config", "Path", FirstCDDrive & ":\Mpegav\" & Mnu001(Index).Caption
MMControl1.Command = "play"
MMControl1.Command = "play"
MMControl1.Command = "play"
 
End Sub

Private Sub ooooo_Click()
If ooooo.Checked = False Then
ooooo.Checked = True
Form2.Height = 3630

Else
ooooo.Checked = False
Form2.Height = 2355
End If
End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbRightButton Then
        Me.PopupMenu f2
End If
End Sub

Private Sub Timer2_Timer()
Label11.Caption = MMControl1.FileName
Label12.Caption = MMControl1.Length
Label13.Caption = MMControl1.Position

Dim dd As String
dd = Right$(MMControl1.FileName, 3)
If dd = "mp3" Then
 mp3
ElseIf dd = "mpg" Then
mpg
ElseIf dd = "MP3" Then
 mp3
 ElseIf dd = "MPG" Then
mpg
ElseIf dd = "wav" Then
mp3
ElseIf dd = "WAV" Then
mp3
ElseIf dd = "avi" Then
avi
ElseIf dd = "AVI" Then
avi
ElseIf dd = "MOV" Then
mpg
ElseIf dd = "mov" Then
mpg
End If
If Label1.Left < -(Label1.Width) Then
   Label1.Left = Picture2.Width
   End If
Label1.Left = Label1.Left - 200
Form2.Label17.Caption = "蓝霞家庭音乐视听系统  正在播放:" & Form2.MMControl1.FileName & "    总长:" & Form2.MMControl1.Length & "帧     当前位置:" & Form2.MMControl1.Position & "帧"
If Form2.Label17.Left <= -7880 Then
   Form2.Label17.Left = 1000
   Else
   Form2.Label17.Left = Form2.Label17.Left - 100
   End If


'If MMControl1.Position = MMControl1.Length Then
'   MMControl1.Command = "close"
'  Slider2.Value = 0
'End If


'Dim File As String
 '   File = List1.List(List1.ListIndex)
'List1.Selected(List1.ListIndex + 1) = True
  
End Sub

Private Sub Timer4_Timer()


Do While MMControl1.Position >= MMControl1.Length And MMControl1.FileName <> ""
       If List2.List(List2.ListIndex + 1) = "" Then
          MMControl1.Command = "stop"
      Else
        MMControl1.Command = "close"
          MMControl1.FileName = List2.List(List2.ListIndex + 1)
             Dim rrr
             rrr = List2.ListIndex
              List2.Selected(rrr) = False
               List2.Selected(rrr + 1) = True
     MMControl1.DeviceType = "MpegVideo"
'MMControl1.FileName = List1.List(List1.Selected)

MMControl1.hWndDisplay = Form4.Picture1.hWnd
MMControl1.FileName = List2.List(List2.ListIndex)
MMControl1.Command = "open"
MMControl1.Command = "play"
 MMControl1.Command = "play"
'mmcontrol1.FileName =
 MMControl1.TimeFormat = 2
Slider2.Min = 0
Slider2.Max = MMControl1.Length
Picture3.BackColor = &HFF&