midi

开发平台：
Visual Basic

play1.frm：源码内容
							VERSION 5.00
Object = "{C1A8AF28-1257-101B-8FB0-0020AF039CA3}#1.1#0"; "MCI32.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form Form1 
   BackColor       =   &H000080FF&
   Caption         =   "MulMedia Player"
   ClientHeight    =   8595
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   11880
   FillColor       =   &H00808000&
   ForeColor       =   &H00FFFFFF&
   Icon            =   "PLAY1.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   8595
   ScaleWidth      =   11880
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   1560
      Top             =   4200
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin MCI.MMControl MC 
      Height          =   375
      Left            =   5520
      TabIndex        =   14
      Top             =   4320
      Width           =   2760
      _ExtentX        =   4868
      _ExtentY        =   661
      _Version        =   393216
      AutoEnable      =   0   'False
      RecordVisible   =   0   'False
      EjectVisible    =   0   'False
      DeviceType      =   ""
      FileName        =   ""
   End
   Begin VB.CommandButton about 
      Caption         =   "About"
      Height          =   375
      Left            =   5160
      TabIndex        =   11
      Top             =   360
      Width           =   855
   End
   Begin VB.Timer Timer1 
      Left            =   2040
      Top             =   1920
   End
   Begin VB.CommandButton dall 
      Caption         =   "DelAll"
      Height          =   375
      Left            =   8040
      TabIndex        =   10
      Top             =   6960
      Width           =   855
   End
   Begin VB.CommandButton add 
      Caption         =   "Add"
      Height          =   375
      Left            =   8040
      TabIndex        =   9
      Top             =   6000
      Width           =   855
   End
   Begin VB.CommandButton Delete 
      Caption         =   "Delete"
      Height          =   375
      Left            =   8040
      TabIndex        =   8
      Top             =   6480
      Width           =   855
   End
   Begin VB.ListBox List1 
      Height          =   1860
      ItemData        =   "PLAY1.frx":27A2
      Left            =   3240
      List            =   "PLAY1.frx":27A4
      TabIndex        =   7
      Top             =   5520
      Width           =   4455
   End
   Begin VB.ComboBox Combo1 
      Height          =   315
      ItemData        =   "PLAY1.frx":27A6
      Left            =   3000
      List            =   "PLAY1.frx":27A8
      TabIndex        =   6
      Text            =   "WAV"
      Top             =   4320
      Width           =   2055
   End
   Begin VB.FileListBox File1 
      Height          =   2790
      Left            =   5040
      TabIndex        =   5
      Top             =   1320
      Width           =   3735
   End
   Begin VB.DirListBox Dir1 
      ForeColor       =   &H00000000&
      Height          =   2790
      Left            =   3000
      TabIndex        =   4
      Top             =   1320
      Width           =   1935
   End
   Begin VB.DriveListBox Drive1 
      Height          =   315
      Left            =   3000
      TabIndex        =   3
      Top             =   840
      Width           =   5775
   End
   Begin VB.CommandButton Exitb 
      Caption         =   "Exit"
      Height          =   375
      Left            =   7800
      TabIndex        =   2
      Top             =   4800
      Width           =   615
   End
   Begin VB.CommandButton Closeb 
      Caption         =   "Close"
      Height          =   375
      Left            =   6600
      TabIndex        =   1
      Top             =   4800
      Width           =   615
   End
   Begin VB.CommandButton Openb 
      Caption         =   "Open"
      Height          =   375
      Left            =   5400
      TabIndex        =   0
      Top             =   4800
      Width           =   615
   End
   Begin VB.Image Image1 
      Height          =   345
      Left            =   480
      Picture         =   "PLAY1.frx":27AA
      Stretch         =   -1  'True
      Top             =   2640
      Visible         =   0   'False
      Width           =   345
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      BackColor       =   &H000080FF&
      Caption         =   "No File"
      BeginProperty Font 
         Name            =   "System"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   240
      Left            =   3240
      TabIndex        =   13
      Top             =   5280
      Width           =   690
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackColor       =   &H00FFFFFF&
      Caption         =   "970128"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000000&
      Height          =   300
      Left            =   3000
      TabIndex        =   12
      Top             =   2640
      Width           =   810
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim joke As Boolean
Dim filename(10) As String
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim switch As Boolean
Private Declare Function CreateEllipticRgn Lib "gdi32" _
(ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" _
(ByVal hWnd As Long, ByVal hrgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function auxSetVolume Lib "winmm.dll" _
(ByVal uDeviceID As Long, ByVal dwVolume As Long) As Long
Private Declare Function waveOutGetVolume Lib "winmm.dll" _
(ByVal uDeviceID As Long, lpdwVolume As Long) As Long
Private Declare Function waveOutSetVolume Lib "winmm.dll" _
(ByVal uDeviceID As Long, ByVal dwVolume As Long) As Long
Private Sub about_Click()
Beep
If switch Then
 add.Visible = False
 Closeb.Visible = False
 Combo1.Visible = False
 dall.Visible = False
 Delete.Visible = False
 Dir1.Visible = False
 Drive1.Visible = False
 Exitb.Visible = False
 File1.Visible = False
 Label2.Visible = False
 List1.Visible = False
 MC.Visible = False
 Openb.Visible = False
 joke = True
 Timer1.Enabled = True
 Label1.Visible = True
 about.Caption = "Ok"
  Else
   add.Visible = True
   Closeb.Visible = True
   Combo1.Visible = True
   dall.Visible = True
   Delete.Visible = True
   Dir1.Visible = True
   Drive1.Visible = True
   Exitb.Visible = True
   File1.Visible = True
   Label2.Visible = True
   List1.Visible = True
   MC.Visible = True
   Openb.Visible = True
   joke = False
  about.Caption = "About"
  Timer1.Enabled = False
  Label1.Visible = False
 End If
 If joke Then
  Form1.MousePointer = 14
 Else
  Form1.MousePointer = 0
End If
 switch = Not switch
End Sub
Private Sub Add_Click()
 CommonDialog1.Filter = "AVI|*.avi|WAV|*.wav|MID|*.mid|MPG|*.mpg|MP3|*.mp3|所有文件|*.*"
 CommonDialog1.ShowOpen
 If CommonDialog1.filename <> "" Then
    filename(i) = CommonDialog1.filename
    List1.AddItem (filename(i))
    i = i + 1
 End If
End Sub
Private Sub Closeb_Click()
MC.Command = "close"
MC.filename = ""
Label2.Caption = "No File"
MC.PlayEnabled = False
MC.PrevEnabled = False
MC.NextEnabled = False
MC.StepEnabled = False
MC.BackEnabled = False
End Sub
Private Sub Combo1_Change()
Select Case Combo1.Text
 Case "WAV"
  File1.Pattern = "*.wav"
 Case "AVI"
  File1.Pattern = "*.avi"
 Case "MID"
  File1.Pattern = "*.mid"
 Case "MPG"
  File1.Pattern = "*.mpg"
 Case "MP3"
  File1.Pattern = "*.mp3"
 End Select
End Sub
Private Sub Combo1_Click()
Select Case Combo1.Text
 Case "WAV"
  File1.Pattern = "*.wav"
 Case "AVI"
  File1.Pattern = "*.avi"
 Case "MID"
  File1.Pattern = "*.mid"
 Case "MPG"
  File1.Pattern = "*.mpg"
 Case "MP3"
  File1.Pattern = "*.mp3"
End Select
End Sub
Private Sub Command1_Click()
a = auxSetVolume(uBeviceID, 15)
End Sub
Private Sub dall_Click()
List1.Clear
MC.filename = ""
Label2.Caption = "No File"
MC.BackEnabled = False
MC.StepEnabled = False
MC.Command = "close"
MC.PlayEnabled = False
MC.PrevEnabled = False
MC.NextEnabled = False
End Sub
Private Sub Delete_Click()
If List1.ListIndex <= 9 And List1.ListIndex >= 0 Then
 k = List1.ListIndex
 List1.RemoveItem (List1.ListIndex)
 i = i - 1
End If
For k = k To 8
 filename(k) = filename(k + 1)
 If filename(k + 2) = "" Then
  Exit For
 End If
 Next k
filename(i + 1) = ""
MC.filename = ""
Label2.Caption = "No File"
If i = 0 Then
 MC.filename = ""
 Label2.Caption = "No File"
 MC.BackEnabled = False
 MC.StepEnabled = False
 MC.Command = "close"
 MC.PlayEnabled = False
 MC.PrevEnabled = False
 MC.NextEnabled = False
End If
End Sub
Private Sub Dir1_Change()
File1.filename = Dir1.Path
End Sub
Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub
Private Sub Exitb_Click()
MC.Command = "close"
Unload Form1
End Sub
Private Sub File1_DblClick()
MC.Command = "close"
Select Case Combo1.Text
 Case "AVI"
  MC.DeviceType = "AVIVideo"
 Case "WAV"
  MC.DeviceType = "waveaudio"
 Case "MID"
  MC.DeviceType = "Sequencer"
 Case "MPG"
  MC.DeviceType = "MPEGVideo"
 Case "MP3"
  MC.DeviceType = "MPEGVideo"
 End Select
MC.filename = Dir1.Path + "" + File1.filename
MC.Command = "open"
MC.PlayEnabled = True
MC.PrevEnabled = True
MC.NextEnabled = True
End Sub
Private Sub File1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Image1.Move File1.Left, File1.Top + y - 70, File1.Width, 200
Image1.Drag
End Sub
Private Sub Form_Load()
Dim lreg As Long
hrgn = CreateEllipticRgn(0, 0, 800, 600)
lres = SetWindowRgn(Me.hWnd, hrgn, True)
MC.Command = "open"
i = 0
j = 25
l = 25
joke = False
Timer1.Interval = 35
switch = True
Combo1.AddItem ("AVI")
Combo1.AddItem ("WAV")
Combo1.AddItem ("MID")
Combo1.AddItem ("MPG")
Combo1.AddItem ("MP3")
Timer1.Enabled = False
Label1.Visible = False
File1.Pattern = "*.wav"
Form1.MousePointer = 2
End Sub
Private Sub List1_DblClick()
MC.Command = "close"
MC.filename = filename(List1.ListIndex)
MC.Command = "open"
Combo1.Text = UCase(Mid(MC.filename, Len(MC.filename) - 2, 3))
MC.PlayEnabled = True
MC.PrevEnabled = True
MC.NextEnabled = True
If i >= 2 Then
 MC.StepEnabled = True
 MC.BackEnabled = True
End If
End Sub
Private Sub List1_DragDrop(Source As Control, x As Single, y As Single)
 filename(i) = Dir1.Path + "" + File1.filename
    List1.AddItem (filename(i))
    i = i + 1
End Sub
Private Sub MC_BackClick(Cancel As Integer)
MC.Command = "close"
If List1.ListIndex = 0 Then
 MC.filename = filename(i)
 List1.ListIndex = i - 1
 MC.Command = "open"
 ElseIf List1.ListIndex >= 1 Then
  MC.filename = filename(List1.ListIndex - 1)
  List1.ListIndex = List1.ListIndex - 1
  MC.Command = "open"
End If
End Sub
Private Sub MC_Done(NotifyCode As Integer)
'MC.StopEnabled = False
MC.PauseEnabled = False
End Sub
Private Sub MC_NextClick(Cancel As Integer)
MC.PlayEnabled = True
End Sub
Private Sub MC_PlayClick(Cancel As Integer)
Label2.Caption = MC.filename
MC.StopEnabled = True
MC.PauseEnabled = True
MC.PlayEnabled = False
End Sub
Private Sub MC_PrevClick(Cancel As Integer)
MC.StopEnabled = True
End Sub
Private Sub MC_StepClick(Cancel As Integer)
MC.Command = "close"
If List1.ListIndex = i - 1 Then
 MC.filename = filename(0)
 List1.ListIndex = 0
 MC.Command = "open"
 ElseIf List1.ListIndex < i - 1 Then
  MC.filename = filename(List1.ListIndex + 1)
  List1.ListIndex = List1.ListIndex + 1
  MC.PlayEnabled = True
  MC.Command = "open"
End If
End Sub
Private Sub MC_StopClick(Cancel As Integer)
MC.StopEnabled = False
MC.PauseEnabled = False
MC.PlayEnabled = True
End Sub
Private Sub Openb_Click()
 CommonDialog1.Filter = "AVI|*.avi|WAV|*.wav|MID|*.mid|MPG|*.mpg|MP3|*.mp3|所有文件|*.*"
 CommonDialog1.ShowOpen
 If CommonDialog1.filename <> "" Then
  MC.filename = CommonDialog1.filename
  MC.Command = "open"
  Combo1.Text = UCase(Mid(MC.filename, Len(MC.filename) - 2, 3))
 End If
End Sub
Private Sub Timer1_Timer()
Label1.Left = Label1.Left + j
Label1.Top = Label1.Top + l
If Label1.Left > 8000 Or Label1.Left < 3000 Then
 j = -j
End If
If Label1.Top < 1200 Or Label1.Top > 5000 Then
l = -l
End If
End Sub

						