unknown
مدير بخش ويژوال بيسيك
Joined: 05 Dec 2004
Posts: 439
Location: Tehran
|
 Posted: Fri Jul 15, 2005 9:06 am Post subject: پخش فایل های mp3 و wave در vb با استفاده از MCI |
 |
|
تابع mcisendstring:
MCI جزئی از ویندوز است که مولد تولید صوت در آن می باشد. با استفاده از تابع mcisendstring به راحتی می توانید کارهای جالبی انجام دهید(به مثال رجوع شود)
جالبی این تابع این است که به این تابع با زبان انگلیسی و معمول روزانه دستور می دهید البته در یک چارچوب خاص و محدود!
در مثال
play,
pause,
stop,
open/close CD-ROM Door
با استفاده از این تابع آورده شده است. همچنین در این برنامه از یک slider bar برای نمایش و تغییر وضعیت فعلی آهنگ استفاده شده است.
برای اجرای این برنامه به component های زیر در vb نیازمندید:
1. Microsoft Common Dialog Control 6.0 ("comdlg32.ocx")
2. Microsoft Windows Common Controls 6.0 (SP6) ("MSCOMCTL.OCX")
کد زیر را در notepad با پسوند frmذخیره کنید. به محل ذخیره شده بروید و فایل را اجرا کنید
در vb از منوی projects گزینهء components را انتخاب کنید و در لیست باز شده دو فایل بالا را انتخاب کنید (اگر ندارید به من mail بزنید براتون می فرستم) و به برنامه اضافه کنید. در پنجرهء ToolBox در سمت چپ برنامه فایل هایی اضافه شده است. روی Common Dialog و Slider دوبار کلیک کنید تا روی فرم قرار گیرند. اگر خواستید مکان و اندازهء Slider را تغییر دهید
تمام کاری که باید انجام می دادید همین بود حالا برنامه را اجرا کنید (کلید F5) فایا صوتی را باز کنید و برنامه را تست کنید.
البته انتظار می رود برای یاد گیری برنامه را خط به خط بخوانید و trace کنید
اگر سوالی بود بپرسید!
|
VERSION 5.00
Begin VB.Form FrmMain
BorderStyle = 1 'Fixed Single
Caption = "Powered by Amir Moradabadi (amirmoradabadi@yahoo.com)"
ClientHeight = 3120
ClientLeft = 45
ClientTop = 435
ClientWidth = 9165
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 3120
ScaleWidth = 9165
StartUpPosition = 3 'Windows Default
Begin VB.Frame Frame2
Caption = "Options"
Height = 855
Left = 120
TabIndex = 4
Top = 1680
Width = 8895
Begin VB.CommandButton CmdClose
Caption = "Close CD-ROM door"
Height = 255
Left = 6600
TabIndex = 10
Top = 480
Width = 2175
End
Begin VB.CommandButton CmdOpen
Caption = "Open CD-ROM door"
Height = 255
Left = 6600
TabIndex = 9
Top = 240
Width = 2175
End
Begin VB.CheckBox CmdPause
Caption = "P&ause"
Height = 375
Left = 1440
Style = 1 'Graphical
TabIndex = 7
Top = 360
Width = 1095
End
Begin VB.CommandButton CmdStop
Caption = "&Stop"
Enabled = 0 'False
Height = 375
Left = 2640
TabIndex = 6
Top = 360
Width = 1095
End
Begin VB.CommandButton CmdPlay
Caption = "&Play"
Enabled = 0 'False
Height = 375
Left = 240
TabIndex = 5
Top = 360
Width = 1095
End
Begin VB.Label lbltime
AutoSize = -1 'True
BackStyle = 0 'Transparent
Height = 195
Left = 4080
TabIndex = 8
Top = 360
Width = 45
End
End
Begin VB.Frame Frame1
Height = 1455
Left = 120
TabIndex = 0
Top = 120
Width = 8895
Begin VB.CommandButton CmdBrowse
Caption = "&Browse"
Height = 375
Left = 7680
TabIndex = 2
Top = 840
Width = 1095
End
Begin VB.TextBox txtFileName
Height = 285
Left = 240
TabIndex = 1
Top = 480
Width = 8535
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "File name:"
Height = 195
Left = 240
TabIndex = 3
Top = 240
Width = 720
End
End
Begin VB.Timer Timer1
Interval = 1000
Left = 960
Top = 720
End
Begin VB.Timer Timer2
Interval = 1000
Left = 120
Top = 120
End
End
Attribute VB_Name = "FrmMain"
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
Private Sub playfile(Filename As String, Sl1 As Slider)
Dim Extension As String, LastFile As String
If MediaStatus = "STOPPED" Or MediaStatus = "PLAYING" Or MediaStatus = "PAUSED" Then
mciSendString "close mmfile", "", 0, 0
End If
mciSendString "open " + ShortPath(Filename) + " alias mmfile", "", 0, 0
Extension = UCase$(Right$(ShortPath(Filename), 3))
If MediaLength > 0 Then
Sl1.Max = MediaLength
Else
MsgBox "Cannot play file!", vbCritical, "Error"
Exit Sub
End If
If MediaStatus = "STOPPED" Then
mciSendString "play mmfile", "", 0, 0
ElseIf MediaStatus = "PAUSED" Then
mciSendString "resume mmfile", "", 0, 0
End If
End Sub
Private Function MediaStatus() As String
Dim lNullChar As Integer, sStatus As String * 255
mciSendString "status mmfile mode", sStatus, 255, 0
lNullChar = InStr(sStatus, Chr$(0))
MediaStatus = UCase$(Left$(sStatus, lNullChar - 1))
End Function
Private Function ShortPath(ByVal strFilename As String) As String
Dim strBuffer As String * 255
Dim lngReturnCode As Long
lngReturnCode = GetShortPathName(strFilename, strBuffer, 255)
ShortPath = Left$(strBuffer, lngReturnCode)
End Function
Private Function MediaLength() As Long
Dim sLength As String * 255, lNullChar As Long
mciSendString "status mmfile length", sLength, 255, 0
lNullChar = InStr(sLength, Chr$(0))
MediaLength = CLng(Val(Left$(sLength, lNullChar - 1)))
End Function
Private Function CurrentPos() As Long
Dim lNullChar As Long, sCurPos As String * 255
mciSendString "status mmfile position", sCurPos, 255, 0
lNullChar = InStr(sCurPos, Chr$(0))
CurrentPos = CLng(Val(Left$(sCurPos, lNullChar - 1)))
End Function
Private Sub CmdBrowse_Click()
CommonDialog1.Filter = "All supported files(mp3,wav)|*.mp3;*.wav"
CommonDialog1.ShowOpen
If CommonDialog1.Filename <> "" Then
txtFileName.Text = CommonDialog1.Filename
End If
End Sub
Private Sub CmdPause_Click()
Pause
End Sub
Private Sub CmdPlay_Click()
playfile txtFileName.Text, Slider1
End Sub
Private Sub CmdStop_Click()
mciSendString "stop mmfile", "", 0, 0
mciSendString "close mmfile", "", 0, 0
End Sub
Private Sub CmdOpen_Click()
mciSendString "set cdaudio door open", "", 0, 0
End Sub
Private Sub CmdClose_Click()
mciSendString "set cdaudio door closed", "", 0, 0
End Sub
Private Sub Form_Load()
txtFileName.Text = "D:\Persian\Afsaneh\TRACK01.MP3"
End Sub
Private Sub Slider1_Scroll()
Dim MStatus As String, lPos As Long
MStatus = MediaStatus
lPos = CLng(Slider1.Value)
If IsValidState Then
If lPos < MediaLength Then
mciSendString "seek mmfile to " & lPos, "", 0, 0
Slider1.Text = SecondsToTime(CurrentPos / 1000)
If MStatus = "PLAYING" Then
If MediaStatus = "STOPPED" Then
mciSendString "play mmfile", "", 0, 0
ElseIf MediaStatus = "PAUSED" Then
mciSendString "resume mmfile", "", 0, 0
End If
End If
End If
End If
End Sub
Private Function IsValidState() As Boolean
If MediaStatus = "PLAYING" Or MediaStatus = "PAUSED" Or MediaStatus = "STOPPED" Then
IsValidState = True
Else
IsValidState = False
End If
End Function
Public Function SecondsToTime(lSeconds As Double) As String
Dim sTime As String
Dim iSeconds As Integer
Dim iMinutes As Integer
iSeconds = Abs(Fix(lSeconds)) Mod 60
iMinutes = Fix(Abs(Fix(lSeconds)) / 60)
sTime = iMinutes & ":" & IIf(iSeconds < 10, "0", "") & iSeconds
SecondsToTime = sTime
End Function
Function File_exists(ByVal sFileName As String) As Boolean
Dim TheFileLength As Integer
On Error Resume Next
TheFileLength = Len(Dir$(sFileName))
If Err Or TheFileLength = 0 Then
File_exists = False
Else
File_exists = True
End If
End Function
Private Sub Timer1_Timer()
Slider1.Value = CurrentPos
End Sub
Private Sub Timer2_Timer()
lbltime.Caption = SecondsToTime(CurrentPos / 1000) & " / " & SecondsToTime(MediaLength / 1000)
End Sub
Private Sub txtFileName_Change()
If File_exists(txtFileName.Text) = True Then
CmdPlay.Enabled = True
CmdPause.Enabled = True
CmdStop.Enabled = True
End If
End Sub
Private Sub Pause()
If MediaStatus = "PLAYING" Then
mciSendString "pause mmfile", "", 0, 0
ElseIf MediaStatus = "PAUSED" Then
mciSendString "resume mmfile", "", 0, 0
End If
End Sub |
|
|
Profile 
Log in to check your private messages | 
FAQ 
Search 
Memberlist 
Usergroups 
Log in
Register
