分享
 
 
 

要用VB做多媒体程序的同志必看...

王朝vb·作者佚名  2006-01-08
窄屏简体版  字體: |||超大  

Csdn上已经有好多朋友问过诸如:

“如何播放Avi、Wave、midi文件”、:

“谁知道用api播放avi,mpg的详细方法?要可以设定将图像放置到设定的窗体中”、

“如何同时播放两个Wav文件”

的问题,

其实用一个类模块就一切搞定,不需要什么控件之类的东西

下面这个类模块(不知从哪里找来的,好象就是CSDN),我研究后将它修改得更好用了

将下面这个类模块存为Mmedia.cls

'----------------------------------------------------

Option Explicit

'--------------TrueZq 最新更新2001-01-12---------------------

'文件名: MMedia.cls

'说明: : 一个多媒体类,能播放Avi、Wave、Midi文件

'用法:

'Dim Multimedia As New Mmedia

'Multimedia.mmOpen "c:\test.wav"

'Multimedia.mmPlay

'!记住:在程序结束时,一定要用Set Multimedia=nothing释放资源!!!

'-----------------------------------------------------

' -=-=-=- 属性 -=-=-=-

' sFilename 当前的文件名

' nLength 文件长度(只读)

' nPosition 当前位置

' sStatus 当前状态(只读)

' bWait True/False.决定是否等待播放完

' -=-=-=- 方法 -=-=-=-=-

' mmOpen <Filename> 打开要播放的文件

' mmClose 关闭当前文件

' mmPause 暂停

' mmStop 停止 停止后可以跳到开始再次播放

' mmSeek <Position> Seeks to a position in the file

' mmPlay 播放

'--------------------------------------------------------------

Private sAlias As String '别名

'Private hWnd As Long

Private sFilename As String ' 当前的文件名

Private nLength As Single ' 文件长度

Private nPosition As Single ' 当前位置

Private sStatus As String ' 当前状态

Private bWait As Boolean ' 决定是否等待播放完

Const WS_CHILD = &H40000000

'------------ API 声明 -------------

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 GetActiveWindow Lib "USER32" () As Integer

'当sTheFile是一个Avi文件时,参数hWnd指定动画在哪里播放

'若hWnd=0,则新开一个窗口播放动画。

'如果听不到Midi音乐,请在Windows下用媒体播放器测试一下。

'文件名不能带空格

Public Sub mmOpen(ByVal sTheFile As String, Optional hWnd As Long = 0)

Dim nReturn As Long

Dim sType As String '文件类型

Static nNum As Integer

If sAlias <> "" Then '关闭开始打开的文件

mmClose

End If

If (Dir(sTheFile) = "") Then '判断是否是一个存在的文件

sFilename = "文件" & sTheFile & " 不存在!"

Exit Sub

Else

sFilename = sTheFile

' nNum = nNum + 1

End If

' Stop

sAlias = sFilename '用文件名作别名,避免别名冲突!

' 判断文件类型

Select Case UCase$(Right$(sTheFile, 3))

Case "WAV"

sType = "Waveaudio"

Case "AVI"

sType = "AviVideo"

Case "MID"

sType = "Sequencer"

Case Else

' 未知文件格式,退出。

Exit Sub

End Select

If sType = "AviVideo" And hWnd > 0 Then

nReturn = mciSendString("open " & sTheFile & " ALIAS " & sAlias _

& " TYPE AVIVideo parent " & hWnd & " style " & LTrim$(Str$(WS_CHILD)), 0&, 0, 0)

Else

nReturn = mciSendString("Open " & sTheFile & " ALIAS " & sAlias _

& " TYPE " & sType, "", 0, 0)

End If

End Sub

'关闭当前打开的多媒体文件

Public Sub mmClose()

Dim nReturn As Long

'如果没有文件打开,则退出

If sAlias = "" Then Exit Sub

nReturn = mciSendString("Close " & sAlias, "", 0, 0)

sAlias = ""

sFilename = ""

End Sub

'暂停

Public Sub mmPause()

Dim nReturn As Long

If sAlias = "" Then

Exit Sub

ElseIf Status = "paused" Then '如果先前已经暂停了,则解除暂停

mmPlay

Else

nReturn = mciSendString("Pause " & sAlias, "", 0, 0)

End If

'nPosition = Position

End Sub

'播放

Public Sub mmPlay()

Dim nReturn As Long

If sAlias = "" Then

Exit Sub

ElseIf Position = Length Then '如果已经到末尾

mmSeek 0 '跳到开始处

End If

If bWait Then

nReturn = mciSendString("Play " & sAlias & " wait", "", 0, 0)

Else

nReturn = mciSendString("Play " & sAlias, "", 0, 0)

End If

End Sub

'停止

'停止后跳到开始,以便再次播放

Public Sub mmStop()

Dim nReturn As Long

If sAlias = "" Then Exit Sub

nReturn = mciSendString("Stop " & sAlias, "", 0, 0)

mmSeek 0 '跳到开始位置

End Sub

'跳到指定的位置,并且处于暂停状态

'当nPosition的值>Length 或者nPosition<0时,将忽略这次操作

Public Sub mmSeek(ByVal nPosition As Single)

Dim nReturn As Long

nReturn = mciSendString("Seek " & sAlias & " to " & nPosition, "", 0, 0)

End Sub

'方法Filename返回当前打开的文件名

Property Get filename() As String

filename = sFilename

End Property

'指定要播放的文件名,然后将它打开

'对于需要指定容器的Avi文件,不要以这种方式打开。

Property Let filename(ByVal sTheFile As String)

mmOpen sTheFile

End Property

'读取属性Wait的值

'Msgbox Multimedia.Wait

Property Get Wait() As Boolean

Wait = bWait

End Property

'设置等待属性

'用法:Multimedia.Wait=True

Property Let Wait(bWaitValue As Boolean)

bWait = bWaitValue

End Property

'获得长度值

Property Get Length() As Single

Dim nReturn As Long, nLength As Integer

Dim sLength As String * 255

If sAlias = "" Then

Length = 0

Exit Property

End If

nReturn = mciSendString("Status " & sAlias & " length", sLength, 255, 0)

nLength = InStr(sLength, Chr$(0))

Length = Val(Left$(sLength, nLength - 1))

End Property

Property Let Position(ByVal nPosition As Single)

mmSeek nPosition

End Property

'获取当前位置

Property Get Position() As Single

Dim nReturn As Integer, nLength As Integer

Dim sPosition As String * 255

If sAlias = "" Then Exit Property

nReturn = mciSendString("Status " & sAlias & " position", sPosition, 255, 0)

nLength = InStr(sPosition, Chr$(0))

Position = Val(Left$(sPosition, nLength - 1))

End Property

'当前打开文件的状态

'有以下几种:playing paused stopped

Property Get Status() As String

Dim nReturn As Integer, nLength As Integer

Dim sStatus As String * 255

If sAlias = "" Then Exit Property

nReturn = mciSendString("Status " & sAlias & " mode", sStatus, 255, 0)

nLength = InStr(sStatus, Chr$(0))

Status = Left$(sStatus, nLength - 1)

End Property

'从头开始播放

Public Sub mmRestart()

Dim nReturn As Long

If sAlias = "" Then Exit Sub

mmSeek 0

mmPlay

End Sub

'类的初始化

Private Sub Class_Initialize()

' sAlias = "" '别名初值为空

End Sub

'关闭打开的多媒体设备

'当该类的对象所在的窗体(或模块)卸载时,自动调用该过程

Private Sub Class_Terminate()

mmClose

End Sub

'----------------------------------------------------

[用法]

1、

比如要在窗体上播放一个动画,只需3个语句就搞定。

Dim MmAvi As New Mmedia

MmAvi.mmOpen "G:\resource\Avi\Test.avi", Me.hWnd

MmAvi.mmPlay

2、循环播放

Private Sub Timer1_Timer()

Dim S As String

S = "当前文件:" & MmAvi.filename & vbCrLf & "当前位置:" & MmAvi.Position _

& "总长度:" & MmAvi.Length & "当前状态:" & MmAvi.Status

Label1.Caption = S

If MmAvi.Status = "stopped" Then MmAvi.mmRestart

End sub

3、同时播放几个文件(类型可以相同、可以不同)

在Form1中加入Private MmWave(1) As New Mmedia

在需要播放的地方加上:

MmWave(0).mmOpen "G:\resource\wave\m16.wav"

MmWave(1).mmOpen "G:\resource\wave\Welcom98.wav"

MmWave(0).mmPlay

MmWave(1).mmPlay

4、将动画放入一个圆形区域播放

Dim hr As Long

Dim usew&, useh&

Dim MmAvi As New Mmedia

usew& = Frame1.Width / Screen.TwipsPerPixelX

useh& = Frame1.Height / Screen.TwipsPerPixelY

usew = useh

hr& = CreateEllipticRgn(0, 0, usew, useh)

Call SetWindowRgn(Frame1.hWnd, hr, True)

MmAvi.mmOpen "G:\resource\Avi\start.avi", Frame1.hWnd

MmAvi.mmPlay

………………………………

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有