【VB开源代码栏目提醒】:网学会员在VB开源代码频道为大家收集整理了BGSound.Frm提供大家参考,希望对大家有所帮助!
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