bgsound.frm

vb源码大全

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "播放MIDI"
   ClientHeight    =   4425
   ClientLeft      =   1140
   ClientTop       =   1545
   ClientWidth     =   5535
   LinkTopic       =   "Form1"
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   4425
   ScaleWidth      =   5535
   Begin VB.FileListBox File1 
      Height          =   2790
      Left            =   2640
      TabIndex        =   2
      Top             =   360
      Width           =   2775
   End
   Begin VB.DirListBox Dir1 
      Height          =   2400
      Left            =   240
      TabIndex        =   1
      Top             =   840
      Width           =   2295
   End
   Begin VB.DriveListBox Drive1 
      Height          =   300
      Left            =   240
      TabIndex        =   0
      Top             =   360
      Width           =   2295
   End
   Begin VB.Timer Timer1 
      Interval        =   500
      Left            =   4560
      Top             =   3840
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit


Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
        
Dim IsMusicOn As Boolean
Dim RetValue As Long

Private Sub Dir1_Change()
File1.Path = Dir1


End Sub

Private Sub Drive1_Change()
Dir1.Path = Drive1

End Sub

Private Sub File1_DblClick()
Dim fName As String, S As String
fName = File1.Path
If Right(fName, 1) <> "\" Then
    fName = fName & "\"
End If
fName = fName & File1.FileName
S = String(LenB(fName), Chr(0))
GetShortPathName fName, S, Len(S)
fName = Left(S, InStr(S, Chr(0)) - 1)
mciSendString "close myMIDI", vbNullString, 0, 0
mciSendString "open " & fName & " alias myMIDI", vbNullString, 0, 0
mciSendString "play myMIDI", vbNullString, 0, 0

End Sub

Private Sub Form_Load()
    IsMusicOn = True
End Sub

Private Sub Form_Unload(Cancel As Integer)
    IsMusicOn = False
    RetValue = mciSendString("CLOSE myMIDI", "", 0, 0)
End Sub