midi播放 2.frm

Windows API函数,希望大伙有用哦

VERSION 5.00
Begin VB.Form MIDI播放 
   Appearance      =   0  'Flat
   BackColor       =   &H80000004&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "MIDI 播放"
   ClientHeight    =   1965
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4650
   ForeColor       =   &H8000000A&
   Icon            =   "MIDI播放 2.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   Moveable        =   0   'False
   ScaleHeight     =   131
   ScaleMode       =   0  'User
   ScaleWidth      =   306.508
End
Attribute VB_Name = "MIDI播放"
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 MidiFile As String
Private Sub Form_Load()
  Const Alias = "tune1"
  MidiFile = App.Path + "\" + "SONG03.mid"
  PlayMidiFile MidiFile, Alias
End Sub
Private Sub Form_Click()
  Const Alias = "tune1"
  StopMidiFile Alias
End Sub
Private Function PlayMidiFile(ByVal filename As String, Optional ByVal Alias As String = "tune") As Boolean
   Dim nRet As Long
   StopMidiFile Alias
   If mciSendString("open " & filename & " alias " & Alias, vbNullString, 0, 0) = 0 Then
      nRet = mciSendString("play " & Alias & " from 0", vbNullString, 0, 0)
      PlayMidiFile = (nRet = 0)
   End If
End Function
Private Sub StopMidiFile(Optional ByVal Alias As String = "tune")
   mciSendString "stop " & Alias, vbNullString, 0, 0
   mciSendString "close " & Alias, vbNullString, 0, 0
End Sub

Sub PlaySound(filename)
Dim cmd As String
Call mciSendString("close MyFlc", 0, 0, 0)
cmd = "open " & filename & " alias MyFlc"
Call mciSendString(cmd, 0, 0, 0)
Call mciSendString("play MyFlc", 0, 0, 0)
End Sub