vcd.frm

一个简单的数据库程

MMControl1.Command = "play"
 MMControl1.Command = "play"
'mmcontrol1.FileName =
Slider2.Min = 0
Slider2.Max = MMControl1.Length
Picture3.BackColor = &HFF&
Form4.Caption = "正在播放  " + MMControl1.FileName
 
Label9.Caption = "状态:播放..."
f12.Enabled = True
f11.Enabled = False
f32.Enabled = True
'.Enabled = True
f22.Enabled = True
f23.Enabled = True
f25.Enabled = True
f26.Enabled = True
f28.Enabled = True
f27.Enabled = True
f29.Enabled = True
f31.Enabled = True
gh.Enabled = True
Check1.Enabled = True
Check2.Enabled = True
  Exit Sub
ErrHandle:



End Sub

Private Sub f12_Click()
     On Error Resume Next
 MMControl1.Command = "stop"
   MMControl1.Command = "close"
   MMControl1.FileName = ""
   Form4.Hide
   Picture3.BackColor = &H0&
Form2.Caption = "蓝霞家庭音乐视听"
Label9.Caption = "状态:停止..."
Picture4.Visible = True
Unload Form4
f11.Enabled = True
f12.Enabled = False
f21.Enabled = False
f22.Enabled = False
f23.Enabled = False
f25.Enabled = False
f26.Enabled = False
f28.Enabled = False
f29.Enabled = False
gh.Enabled = False
Check1.Enabled = False
Check2.Enabled = False
Label18.Caption = ""
Label12.Caption = ""
Label13.Caption = ""
Label17.Visible = False
  
End Sub








Private Sub f14_Click()

  Form2.Caption = "蓝霞家庭音乐视听  V5.0"
    MMControl1.Command = "close"
    MMControl1.Command = "open"
     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\"

Dim iii

       iii = 0
   For iii = 0 To 20
       'myFile(i) = ""
      ' Mnu001(iii).Visible = False
       Mnu001(iii).Caption = ""
   Next
      '光盘驱动器号 FirstCdDrive ,上面清空文件名
      iii = 0
      On Error GoTo NoDisk
      MyFile(iii) = Dir(c & "\*.DAT")
   If MyFile(iii) = "" Then
NoDisk:
      MsgBox " 光 盘 没 有 准 备 好 !       ", vbInformation, "不能找到VCD文件"
      Exit Sub
   End If
    
Form2.List2.Clear
   Do Until MyFile(iii) = ""
         Form2.List2.AddItem c & MyFile(iii)
iii = iii + 1
  MyFile(iii) = Dir
   Loop
  
 Form2.List2.Selected(0) = True
  MMControl1.TimeFormat = 2
  MMControl1.DeviceType = "MpegVideo"
   MMControl1.Command = "play"
  MMControl1.FileName = Form2.List2.List(Form2.List2.ListIndex)
   On Error Resume Next
MMControl1.Command = "close"
MMControl1.DeviceType = "MpegVideo"
'MMControl1.FileName = List1.List(List1.Selected)
Form4.Show
MMControl1.hWndDisplay = Form4.Picture1.hWnd

MMControl1.Command = "open"
MMControl1.Command = "play"
 MMControl1.Command = "play"
'mmcontrol1.FileName =
Slider2.Min = 0
Slider2.Max = MMControl1.Length
Picture3.BackColor = &HFF&
Form4.Caption = "正在播放  " + MMControl1.FileName
 
Label9.Caption = "状态:播放..."
f12.Enabled = True
f11.Enabled = False
f32.Enabled = True
'.Enabled = True
f22.Enabled = True
f23.Enabled = True
f25.Enabled = True
f26.Enabled = True
f28.Enabled = True
f27.Enabled = True
f29.Enabled = True
f31.Enabled = True
gh.Enabled = True
Check1.Enabled = True
Check2.Enabled = True
 
   ' Mnu001(i).Checked = True
   ' CloseT = False
    '保存路径
    'SaveSetting App.EXEName, "Config", "Path", FirstCDDrive & ":\Mpegav\" & MyFile(i)

   ' frmVcd.PlayMethod
    


End Sub
Sub plyy()
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 = Form2.List2.List(Form2.List2.ListIndex)
Form2.MMControl1.Command = "open"
Form2.MMControl1.Command = "play"
 Form2.MMControl1.Command = "play"
'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
Function FileExists(FileName$) As Boolean
    Dim f As Integer

    On Error Resume Next
    If FileLen(FileName$) > 0 Then
        FileExists = True
        Exit Function
    End If
    
    f = FreeFile
    Open FileName$ For Input As #f
    Close #f
    FileExists = Not (Err <> 0)
End Function



Private Sub f17_Click()
MMControl1.Command = "stop"
MMControl1.Command = "close"

   Set Form2 = Nothing
    Set Form4 = Nothing
  MMControl1.Command = "close"
Unload Me
Unload Form2
Unload frmAbout
Unload frmAbout1

Form3.Show
  
   
End Sub

Private Sub f21_Click()
MMControl1.Command = "play"
f21.Enabled = False
f22.Enabled = True

End Sub

Private Sub f22_Click()
        On Error Resume Next
MMControl1.Command = "pause"
Label9.Caption = "状态:暂停..."
 f21.Enabled = True
 f22.Enabled = False
 
End Sub

Private Sub f23_Click()
  On Error Resume Next
 MMControl1.Command = "stop"
   MMControl1.Command = "close"
   MMControl1.FileName = ""
   Form4.Hide
   Picture3.BackColor = &H0&
Form2.Caption = "蓝霞家庭音乐视听"
Label9.Caption = "状态:停止..."
Picture4.Visible = True
Unload Form4
f11.Enabled = True
f12.Enabled = False
f21.Enabled = False
f22.Enabled = False
f23.Enabled = False
f25.Enabled = False
f26.Enabled = False
f28.Enabled = False
f29.Enabled = False
gh.Enabled = False
Check1.Enabled = False
Check2.Enabled = False
Label18.Caption = ""
Label12.Caption = ""
Label13.Caption = ""
Label17.Visible = False

Form2.Show
End Sub

Private Sub f25_Click()
   
Slider2.Value = Slider2.Value + 150
MMControl1.To = Slider2.Value
MMControl1.Command = "seek"
MMControl1.Command = "play"
End Sub

Private Sub f26_Click()
   
       Slider2.Value = Slider2.Value - 150
MMControl1.To = Slider2.Value
MMControl1.Command = "seek"
MMControl1.Command = "play"
End Sub

Private Sub f28_Click()
On Error Resume Next
If f28.Checked = False Then
   f28.Checked = True
   Check2.Value = 1
   Timer1.Enabled = True
'   eeeee.Checked = True
   ElseIf f28.Checked = True Then
  f28.Checked = False
  Timer1.Enabled = False
 ' eeeee.Checked = False
  
End If
End Sub

Private Sub f29_Click()
If f29.Checked = True Then
             f29.Checked = False
             Check1.Value = 0
          Else
             f29.Checked = True
             Check1.Value = 1
          End If
End Sub

Private Sub f31_Click()
 Form2.Hide
         
End Sub

Private Sub f32_Click()
List1.Clear
'df.Enabled = False
f32.Enabled = False

End Sub

Private Sub f33_Click()
CommonDialog1.ShowColor
'Picture7.BackColor = CommonDialog1.Color
End Sub

Private Sub f41_Click()
frmAbout1.Show
End Sub



Private Sub f42_Click()
frmAbout.Show
End Sub

Private Sub fgh_Click()
CommonDialog1.ShowColor

Frame1.BackColor = CommonDialog1.Color
Frame3.BackColor = CommonDialog1.Color
List1.BackColor = CommonDialog1.Color
Label1.BackColor = CommonDialog1.Color
Label2.BackColor = CommonDialog1.Color
Label3.BackColor = CommonDialog1.Color
Label4.BackColor = CommonDialog1.Color
Label5.BackColor = CommonDialog1.Color
Label9.BackColor = CommonDialog1.Color
Label1.BackColor = CommonDialog1.Color

Label1.BackColor = CommonDialog1.Color

Check1.BackColor = CommonDialog1.Color
Label11.BackColor = CommonDialog1.Color
Check2.BackColor = CommonDialog1.Color
Frame4.BackColor = CommonDialog1.Color
Label12.BackColor = CommonDialog1.Color
Label13.BackColor = CommonDialog1.Color
Frame6.BackColor = CommonDialog1.Color
'Frame5.BackColor = CommonDialog1.Color
Picture2.BackColor = CommonDialog1.Color


End Sub

Private Sub first_Click()
   SetWindowPos Me.hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE + SWP_NOMOVE
  SetWindowPos Form4.hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE + SWP_NOMOVE
 
 doiu.Enabled = True
 first.Enabled = False
        
      
End Sub

Private Sub Form_Activate()
 Label11.Caption = ""
  Label12.Caption = ""
   Label13.Caption = ""
Timer2.Interval = 1000
 MMControl1.TimeFormat = 2
f29.Checked = False
f28.Checked = False
f31.Checked = False


End Sub
Private Sub DeleteIconFromTray()
    If Shell_NotifyIcon(NIM_DELETE, mtIconData) = 0 Then
        MsgBox "不能删除图标!"
    End If
End Sub
Private Sub AddIconToTray()
    With mtIconData
        .cbSize = Len(mtIconData)
        .hWnd = Me.hWnd
        .uCallbackMessage = WM_MOUSEMOVE
                    
        .uID = 1&
        .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
        .hIcon = ImgTrayIcon.Picture
                
        .szTip = ImgTrayIcon.Tag & Chr$(0)
                   
        If Shell_NotifyIcon(NIM_ADD, mtIconData) = 0 Then
                
            MsgBox "不能创建图标!"
        End If
    End With
End Sub


Private Sub Form_Load()
 If App.PrevInstance Then
 MsgBox "蓝霞家庭音乐视听系统 已经打开了"
 Unload Me
 End If
 
 AddIconToTray
 
  A_Name = "Demo"
  S_Name = "RFile"
  ReadRecentFiles
 Dim mhandle As Long, iret As Long, shandle As Long, shandle4 As Long
mhandle = GetMenu(hWnd)
shandle = GetSubMenu(mhandle, 0)
iret = SetMenuItemBitmaps(shandle, 0, MF_BYPOSITION, Picture5.Picture, Picture5.Picture)
shandle4 = GetSubMenu(mhandle, 3)
iret = SetMenuItemBitmaps(shandle4, 1, MF_BYPOSITION, Picture6.Picture, Picture6.Picture)
 
 Call ExplodeForm(Me, 500)
Set MyVolume = New clsVolume

MyVolume.meOpenMixer

If MyVolume.prMixerErr = MMSYSERR_NOERROR Then
    With vsVolume
        .Max = MyVolume.prSpeakerMinVolume
        .Min = MyVolume.prSpeakerMaxVolume \ 2
        .SmallChange = 1000
        .LargeChange = 1000
    End With
    With vsmic