 |
VFP 愛用者社區
本討論區為 Visual Foxpro 愛用者經驗交流的地方, 請多多利用"搜尋"的功能, 先查看看有無前例可循, 如果還有不懂的再發問. 部份主題有附加檔案, 須先註冊成為社區居民才可以下載.
|
| 上一篇主題 :: 下一篇主題 |
| 發表人 |
內容 |
garfield
Site Admin
註冊時間: 2003-01-30
文章: 2160
第 1 樓
|
 發表於: 星期一 三月 21, 2016 6:29 pm 文章主題: VFP播放影片程式( 控制 WMPlayer.OCX ) |
 |
|
程式原始碼來源:
http://yousfi.over-blog.com/2015/03/playing-with-windows-mediaplayer.html
| 代碼: |
Clea All
Sys(2002) &&hide the cursor
Publi yform
yform=Newobject("asup")
yform.Show
Read Events
Return
*
Define Class asup As Form
BorderStyle = 2
Height = 600
Width = 630
ShowWindow = 2
AutoCenter = .T.
Caption = "yMediaplayer"
MaxButton = .F.
BackColor = Rgb(0,0,0)
ymedia = .F.
Name = "Form1"
Add Object timer1 As Timer With ;
Top = 500, ;
Left = 396, ;
Height = 23, ;
Width = 23, ;
Enabled = .F., ;
Interval = 1000, ;
Name = "Timer1"
Add Object ycont1 As ycont1 With ;
Top = 508, ;
Left = 48, ;
Width = 336, ;
Height = 18, ;
BackStyle = 0, ;
BorderWidth = 0, ;
Name = "ycont1"
Add Object container1 As container1 With ;
Top = 536, ;
Left = 48, ;
Width = 432, ;
Height = 22, ;
BackStyle = 1, ;
BorderWidth = 2, ;
BackColor = Rgb(0,0,0), ;
BorderColor = Rgb(255,255,255), ;
Name = "Container1"
Add Object wmp As OleControl With ;
oleclass="WMPlayer.OCX.7",;
Top = 3, ;
Left = -21, ;
Height = 480, ;
Width = 640, ;
UiMode="none",;
Stretchtofit=.T.,;
enableContextMenu=.F.,;
Name = "WMP"
Add Object text1 As TextBox With ;
BackStyle = 1, ;
Value = "Info", ;
Height = 25, ;
Left = 48, ;
MousePointer = 15, ;
Top = 564, ;
Width = 36, ;
ForeColor = Rgb(255,255,255), ;
BackColor = Rgb(0,0,0), ;
Name = "Text1"
Add Object yvol As yvol With ;
Top = 504, ;
Left = 554, ;
Width = 56, ;
Height = 30, ;
BackStyle = 0, ;
BorderWidth = 0, ;
ToolTipText = "Volume", ;
Name = "yvol"
Add Object container2 As container2 With ;
Top = 564, ;
Left = 201, ;
Width = 220, ;
Height = 28, ;
BackStyle = 0, ;
Name = "Container2"
Procedure my
Lparameters nButton, nShift, nXCoord, nYCoord
*--- aevent create an array laEvents
Aevents( myArray, 0)
*--- reference the calling object
loObject = myArray[1]
aa=Allt(loObject.Name)
x=Val(Substr(aa,6,1))
For i=1 To x
aa="this.yvol.shape"+;
Trans(i)+".backcolor"
&aa=255
Endfor
If x<6
For i=x+1 To 7
aa="this.yvol.shape"+;
Trans(i)+ ".backcolor"
&aa=Rgb(128,128,128)
Endfor
Endi
vol=0
Do Case
Case x=1
Thisform.wmp.settings.Volume=0
Case x=2
Thisform.wmp.settings.Volume=10
Case x=3
Thisform.wmp.settings.Volume=40
Case x=4
Thisform.wmp.settings.Volume=60
Case x=5
Thisform.wmp.settings.Volume=80
Case x=6
Thisform.wmp.settings.Volume=90
Case x=7
Thisform.wmp.settings.Volume=100
Endcase
Endproc
Procedure Destroy
erase (Addbs(Sys(2023))+"ywmp.html")
Clea Events
Endproc
Procedure Init
Thisform.ShowTips=.T.
For i=1 To 7
aa="this.yvol.shape"+;
Trans(i)
Bindevent(&aa,"mousedown",This,"my")
Endfor
Thisform.timer1.Enabled=.F.
Endproc
Procedure timer1.Timer
yevent=""
Try
x=Thisform.wmp.playstate
Do Case
Case x=0
yevent= "Undefined"
Case x=1
yevent= "Stopped"
Case x=2
yevent= "Paused"
Case x=3
yevent= "Playing"
Case x=4
yevent= "ScanForward" &&Avance rapide
Case x=5
yevent= "ScanReverse" &&Retour rapide
Case x=6
yevent= "Buffering"
Case x=7
yevent= "Waiting"
Case x=8
yevent= "MediaEnded"
Case x=9
yevent= "Transitioning" &&Préparation nouvelle séquence
Case x=10
yevent= "Ready"
Case x=11
yevent= "Reconnecting"
Endcase
Catch
Endtry
Try
t1=Thisform.wmp.Controls.currentpositionString
t2=Thisform.wmp.currentmedia.durationString
Thisform.container1.ylab.Caption=yevent+"..."+Allt(Thisform.ymedia)+" "+t1+" - Duration: "+t2
Thisform.container1.ylab.Left=Thisform.container1.ylab.Left-20
Catch
Endtry
If Thisform.container1.ylab.Left<=-Thisform.container1.ylab.Width/2
Thisform.container1.ylab.Left=0.9*Thisform.container1.Width
Endi
dur=Thisform.wmp.currentmedia.duration
dur1=Thisform.wmp.Controls.currentposition
With Thisform.ycont1
If dur1>0
.label1.Width=(dur1/dur)*Thisform.ycont1.Width
Endi
.shape1.Left=.label1.Width -.shape1.Width/2
.shape1.Top=.label1.Top+.label1.Height/2-.shape1.Height/2
If .label1.Width=.Width
This.Enabled=.F.
Endi
Endwith
*msdn
*Value State Description
*0 Undefined Windows Media Player is in an undefined state.
*1 Stopped Playback of the current media item is stopped.
*2 Paused Playback of the current media item is paused. When a media item is paused, resuming playback begins from the same location.
*3 Playing The current media item is playing.
*4 ScanForward The current media item is fast forwarding.
*5 ScanReverse The current media item is fast rewinding.
*6 Buffering The current media item is getting additional data from the server.
*7 Waiting Connection is established, but the server is not sending data. Waiting for session to begin.*
*8 MediaEnded Media item has completed playback.
*9 Transitioning Preparing new media item.
*10 Ready Ready to begin playing.
*11 Reconnecting Reconnecting to stream.
Endproc
Procedure wmp.OPENSTATECHANGE
Lparameters newstate
Try
This.Resize()
Catch
Endtry
Endproc
Procedure wmp.PLAYSTATECHANGE
Lparameters newstate
Try
This.Resize()
Catch
Endtry
Endproc
Procedure wmp.STATUSCHANGE
Try
This.Resize()
Catch
Endtry
Endproc
Procedure wmp.PLAYLISTCHANGE
Lparameters playlist, Change
Try
This.Resize()
Catch
Endtry
Endproc
Procedure wmp.MEDIACHANGE
Lparameters Item &&object
*messagebox(item.sourceUrl)
Try
This.Resize()
Catch
Endtry
If Vartype(Item)="O"
Thisform.ymedia=Item.Name
Else
Thisform.ymedia=""
Endi
x=""
cr=Chr(13)
With Item
x=x+"Name:"+.getItemInfo("Name")+cr
x=x+"Author:"+.getItemInfo("author")+cr
x=x+"Tile:"+.getItemInfo("Title")+cr
x=x+"Album:"+.getItemInfo("Album")+cr
x=x+"CopyRight:"+.getItemInfo("copyright")+cr
x=x+"Artist:"+.getItemInfo("Artist")+cr
x=x+"Genre:"+.getItemInfo("Genre")+cr
*x=x+trans(.getItemInfo("Bitrate") / 1000)+ " kbps"+cr
x=x+"Abstract:"+.getItemInfo("Abstract")+cr
x=x+"Bitrate:"+Trans(.getItemInfo("bitRate"))+cr
*x=x+"Duration:"+trans(.getItemInfo("duration"))+" sec."+cr
x=x+"Duration hh-mm-ss:"+(Thisform.wmp.currentmedia.durationString)+cr
Endwith
Thisform.text1.ToolTipText=x
Endproc
Procedure wmp.MODECHANGE
Lparameters modename, newvalue
Try
This.Resize()
Catch
Endtry
Endproc
Procedure wmp.Resize
Try
Thisform.LockScreen=.T.
With This
.Top=0
.Left=0
.Width=640
.Height=480
.UiMode="none"
Endwith
Thisform.LockScreen=.F.
Catch
Endtry
Endproc
Procedure wmp.Init
With This
.settings.autoStart = .F.
.settings.Volume=100
.settings.mute=.F.
.Stretchtofit=.T.
.enableContextMenu=.F.
.settings.setMode('shuffle',.F.) &&random reading playlist
.settings.setMode('loop',.T.) &&loop
.UiMode="none"
DoEvents
.Visible=.T.
Endwith
This.Resize()
Endproc
Procedure wmp.Moved
Try
This.Resize()
Catch
Endtry
Endproc
Procedure yvol.Init
This.SetAll("mousepointer",15,"shape")
Endproc
Enddefine
*
*-- EndDefine: asup
*container1
Define Class container1 As Container
Top = 536
Left = 48
Width = 432
Height = 22
BackStyle = 1
BorderWidth = 2
BackColor = Rgb(0,0,0)
BorderColor = Rgb(255,255,255)
Name = "Container1"
Add Object ylab As Label With ;
AutoSize = .T., ;
FontSize = 8, ;
BackStyle = 0, ;
Caption = "", ;
Height = 16, ;
Left = 345, ;
Top = 2, ;
Width = 2, ;
ForeColor = Rgb(255,255,255), ;
BackColor = Rgb(0,0,0), ;
Name = "ylab"
Enddefine
*
*-- EndDefine: container1
*yvol
Define Class yvol As Container
Top = 504
Left = 554
Width = 56
Height = 30
BackStyle = 0
BorderWidth = 0
ToolTipText = "Volume"
Name = "yvol"
Add Object shape1 As Shape With ;
Top = 28, ;
Left = 3, ;
Height = 15, ;
Width = 5, ;
Curvature = 8, ;
BackColor = Rgb(0,0,255), ;
Name = "Shape1"
Add Object shape2 As Shape With ;
Top = 23, ;
Left = 9, ;
Height = 20, ;
Width = 5, ;
Curvature = 8, ;
BackColor = Rgb(0,0,255), ;
Name = "Shape2"
Add Object shape3 As Shape With ;
Top = 18, ;
Left = 16, ;
Height = 25, ;
Width = 5, ;
Curvature = 8, ;
BackColor = Rgb(0,0,255), ;
Name = "Shape3"
Add Object shape4 As Shape With ;
Top = 13, ;
Left = 23, ;
Height = 30, ;
Width = 5, ;
Curvature = 8, ;
BackColor = Rgb(0,0,255), ;
Name = "Shape4"
Add Object shape5 As Shape With ;
Top = 9, ;
Left = 30, ;
Height = 35, ;
Width = 5, ;
Curvature = 8, ;
BackColor = Rgb(0,0,255), ;
Name = "Shape5"
Add Object shape6 As Shape With ;
Top = 4, ;
Left = 37, ;
Height = 40, ;
Width = 5, ;
Curvature = 8, ;
BackColor = Rgb(0,0,255), ;
Name = "Shape6"
Add Object shape7 As Shape With ;
Top = 0, ;
Left = 44, ;
Height = 40, ;
Width = 5, ;
Curvature = 8, ;
BackColor = Rgb(0,0,255), ;
Name = "Shape7"
Procedure Init
This.SetAll("mousepointer",15,"shape")
Endproc
Enddefine
*
*-- EndDefine: yvol
*ycont1
Define Class ycont1 As Container
Top = 508
Left = 48
Width = 336
Height = 18
BackStyle = 0
BorderWidth = 0
Name = "ycont1"
Add Object label2 As Label With ;
Caption = "", ;
Height = 5, ;
Left = 0, ;
Top = 7, ;
Width = 336, ;
BackColor = Rgb(192,192,192), ;
Name = "Label2"
Add Object label1 As Label With ;
Caption = "", ;
Height = 6, ;
Left = 0, ;
Top = 7, ;
Width = 0, ;
BackColor = Rgb(255,0,0), ;
Name = "Label1"
Add Object shape1 As Shape With ;
Top = 3, ;
Left = -8, ;
Height = 15, ;
Width = 15, ;
Curvature = 99, ;
MousePointer = 15, ;
BackColor = Rgb(255,0,0), ;
Name = "Shape1"
Procedure Init
With This
.label1.Left=0
.label1.Width=0
.shape1.Left=-This.shape1.Width
Endwith
Endproc
Procedure shape1.MouseEnter
Lparameters nButton, nShift, nXCoord, nYCoord
Try
This.ToolTipText=Thisform.wmp.Controls.currentpositionString
Catch
Endtry
Endproc
Enddefine
*
*-- EndDefine: ycont1
*CONTAINER2
Define Class container2 As Container
Top = 564
Left = 201
Width = 350
Height = 28
BackStyle = 0
ToolTipText="container2"
Name = "Container2"
Add Object command1 As CommandButton With ;
Top = 2, ;
Left = 1, ;
Height = 25, ;
Width = 25, ;
Caption = "...", ;
Name = "Command1"
Add Object command2 As CommandButton With ;
Top = 2, ;
Left = 28, ;
Height = 25, ;
Width = 25, ;
FontBold = .T., ;
fontname="webdings",;
Caption = "4", ;
Name = "Command2"
Add Object command3 As CommandButton With ;
Top = 2, ;
Left = 55, ;
Height = 25, ;
Width = 41, ;
Caption = "Stop", ;
Name = "Command3"
Add Object command4 As CommandButton With ;
Top = 2, ;
Left = 98, ;
Height = 25, ;
Width = 65, ;
Caption = "Fullscreen", ;
Name = "Command4"
Add Object command5 As CommandButton With ;
Top = 2, ;
Left = 162, ;
Height = 25, ;
Width = 35, ;
Caption = "Mute", ;
Name = "Command5"
Add Object command6 As CommandButton With ;
Top = 2, ;
Left = 198, ;
Height = 25, ;
Width = 22, ;
Caption = "?", ;
fontsize=16,;
forecolor=255,;
fontbold=.T.,;
Name = "Command6"
Procedure Init
This.SetAll("backcolor",Rgb(0,255,0),"commandbutton")
This.SetAll("mousepointer",15,"commandbutton")
This.SetAll("backcolor",Rgb(0,255,0),"commandbutton")
Endproc
Procedure command1.Click
With Thisform.wmp
.url=Getfile("wmv|mpg|mpeg|avi|mp4|flv|wav|mp3")
If !Lower(Justext(.url)) $ "wmvmpgmpegavimp4flvwavmp3"
.url=""
Return .F.
Endi
Endwith
Thisform.ycont1.Init()
Thisform.timer1.Enabled=.T.
This.Parent.command2.Caption="4"
Thisform.container1.ylab.Caption=""
Endproc
Procedure command2.Click
If ! Empty(Thisform.wmp.url)
Do Case
Case This.Caption="4"
Thisform.wmp.Controls.Play
Thisform.timer1.Enabled=.T.
This.Caption=";"
Case This.Caption=";"
Thisform.wmp.Controls.Pause
Thisform.timer1.Enabled=.F.
This.Caption="4"
Endcase
Thisform.wmp.Resize()
Endi
Endproc
Procedure command3.Click
With Thisform
.wmp.Controls.stop
.container2.command2.Caption="4"
.timer1.Enabled=.F.
.ycont1.Init()
.wmp.Resize()
Endwith
Endproc
Procedure command4.Click
Try
Thisform.wmp.fullscreen=.T.
Catch
Endtry
Endproc
Procedure command5.Click
Thisform.wmp.settings.mute=!Thisform.wmp.settings.mute
Endproc
Procedure command6.Click
Local m.myvar
TEXT to m.myvar noshow
this is a custom windows mediaplayer embed as olecontrol on a vfp form.
Its always difficult to maintain the position and the size ration for WMP.
On a form i made the uimode="none" : it worked and not shows the menubar.On a
prg that dont work (as you can test).
i made some custom controls as (trackbar,sound,...)
It allows to vfp developper o see how to play with this olecontrol.
Its an universal tool and can work on disc and on the web, for all medias.
ENDTEXT
Messagebox(m.myvar,0+32+4096,"Summary help")
Endproc
Enddefine
*
*-- EndDefine: container2
*End code
|
_________________
利用>>搜尋<<的功能會比問的還要快得到答案. |
|
| 回頂端 |
|
 |
garfield
Site Admin
註冊時間: 2003-01-30
文章: 2160
第 2 樓
|
| 發表於: 星期三 三月 23, 2016 4:50 pm 文章主題: |
|
|
補充幾個會用到的功能
| 代碼: |
yform.wmp.settings.autoStart = .t.
yform.wmp.currentPlaylist.clear()
DIMENSION mplaylist[3]
mplaylist[1]='d:\dvd\movie1.mkv'
mplaylist[2]='d:\dvd\movie2.mkv'
mplaylist[3]='d:\dvd\movie3.mkv'
FOR i=1 TO ALEN(mplaylist)
IF FILE(mplaylist[i])
yform.wmp.currentplaylist.appendItem(yform.wmp.newMedia(playlist[i]))
endif
next
DO WHILE yform.wmp.currentmedia.duration >0
INKEY(0.1)
IF LASTKEY()=27
exit
endif
ENDDO
*用playlist 無法 autoplay
yform.wmp.Controls.play
INKEY(1)
yform.wmp.fullscreen=.T.
*yform.wmp.Controls.STOP
*yform.wmp.settings.mute=.T.
yform.wmp.settings.volume=100 &&--0到100
*yform.wmp.controls.currentPosition = yform.wmp.currentmedia.duration/2 &&--到影片一半�}始播放
*? '已播放秒數/總秒數:',yform.wmp.controls.currentPosition ,' / ',yform.wmp.currentmedia.duration
*? '影片長度時:分:秒 :',yform.wmp.currentmedia.durationString
|
_________________
利用>>搜尋<<的功能會比問的還要快得到答案. |
|
| 回頂端 |
|
|
ezpos
註冊時間: 2011-04-20
文章: 323
第 3 樓
|
| 發表於: 星期五 六月 03, 2016 9:07 am 文章主題: |
|
|
我照樓主的程式碼修改成以下
撥放器我設定為 360*312
播放影片的時候.竟然會變大
目前還沒找到改善的方法!!
| 代碼: |
thisform.wmp.settings.autoStart = .T.
thisform.wmp.UiMode="mini"
thisform.wmp.enableContextMenu=.F.
thisform.wmp.Height =312
thisform.wmp.Width = 360
thisform.wmp.Stretchtofit=.F.
thisform.wmp.currentPlaylist.Clear()
Dimension mplaylist[3]
mplaylist[1]='D:\download\ci\01.wmv'
mplaylist[2]=''
mplaylist[3]=''
For i=1 To Alen(mplaylist)
If File(mplaylist[i])
thisform.wmp.currentPlaylist.appendItem(thisform.wmp.newMedia(mplaylist[i]))
Endif
NEXT
Do While thisform.wmp.currentmedia.duration >0
Inkey(0.1)
If Lastkey()=27
Exit
Endif
Enddo
*用playlist 無法 autoplay
thisform.wmp.Controls.Play
thisform.wmp.Height =312
thisform.wmp.Width = 360
Inkey(1)
thisform.wmp.fullscreen=.F.
*yform.wmp.Controls.STOP
*yform.wmp.settings.mute=.T.
thisform.wmp.settings.Volume=100 &&--0到100
|
| 引言回覆: | 属性/方法名： 说明：
[基本属性]
URL:String; 指定媒体位置，本机或网络地址
uiMode:String; 播放器界面模式，可为Full, Mini, None, Invisible
playState:integer; 播放状态，1=停止，2=暂停，3=播放，6=正在缓冲，9=正在连接，10=准备就绪
enableContextMenu:Boolean; 启用/禁用右键菜单
fullScreen:boolean; 是否全屏显示
[controls] wmp.controls //播放器基本控制
controls.play; 播放
controls.pause; 暂停
controls.stop; 停止
controls.currentPosition:double; 当前进度
controls.currentPositionString:string; 当前进度，字符串格式。如“00:23”
controls.fastForward; 快进
controls.fastReverse; 快退
controls.next; 下一曲
controls.previous; 上一曲
[settings] wmp.settings //播放器基本设置
settings.volume:integer; 音量，0-100
settings.autoStart:Boolean; 是否自动播放
settings.mute:Boolean; 是否静音
settings.playCount:integer; 播放次数
[currentMedia] wmp.currentMedia //当前媒体属性
currentMedia.duration:double; 媒体总长度
currentMedia.durationString:string; 媒体总长度，字符串格式。如“03:24”
currentMedia.getItemInfo(const string); 获取当前媒体信息"Title"=媒体标题，"Author"=艺术家，"Copyright"=版权信息，"Description"=媒体内容描述， "Duration"=持续时间（秒），"FileSize"=文件大小，"FileType"=文件类型，"sourceURL"=原始地址
currentMedia.setItemInfo(const string); 通过属性名设置媒体信息
currentMedia.name:string; 同 currentMedia.getItemInfo("Title")
[currentPlaylist] wmp.currentPlaylist //当前播放列表属性
currentPlaylist.count:integer; 当前播放列表所包含媒体数
currentPlaylist.Item[integer]; 获取或设置指定项目媒体信息，其子属性同wmp.currentMedia
playState:integer; 播放状态。这个属性改变时同时引发PlayStateChange事件与StateChange事件。取值范围为枚举型：WMPLib.WMPPlayState，它的成员如下：
wmppsUndefined = 0; //未知状态
wmppsStopped = 1; //播放停止
wmppsPaused = 2; //播放暂停
wmppsPlaying = 3; //正在播放
wmppsScanForward = 4; //向前搜索
wmppsScanReverse = 5; //向后搜索
wmppsBuffering = 6; //正在缓冲
wmppsWaiting = 7; //正在等待流开始
wmppsMediaEnded = 8; //播放流已结束
wmppsTransitioning = 9; //准备新的媒体文件
wmppsReady = 10; //播放准备就绪
wmppsReconnecting = 11; //尝试重新连接流媒体数据
wmppsLast = 12; //上一次状态,状态没有改变 |
_________________
ezPos收銀機 簡單好用低成本 http://www.ezpos.info
全新美觀的POS收銀機.POS軟硬體耗材.
軟體客制化.網站規劃....能賺錢的都可以找我
http://www.twelife.com 台灣生活網 |
|
| 回頂端 |
|
|
kalok
註冊時間: 2010-08-26
文章: 284
第 4 樓
|
| 發表於: 星期三 十一月 16, 2016 9:12 am 文章主題: |
|
|
| 看來不錯 |
|
| 回頂端 |
|
|
ezpos
註冊時間: 2011-04-20
文章: 323
第 5 樓
|
|
| 回頂端 |
|
|
garfield
Site Admin
註冊時間: 2003-01-30
文章: 2160
第 6 樓
|
|
| 回頂端 |
|
|
ezpos
註冊時間: 2011-04-20
文章: 323
第 7 樓
|
|
| 回頂端 |
|
|
|
|
您 無法 在這個版面發表文章
您 無法 在這個版面回覆文章
您 無法 在這個版面編輯文章
您 無法 在這個版面刪除文章
您 無法 在這個版面進行投票
您 無法 在這個版面附加檔案
您 無法 在這個版面下載檔案
|
|
常見問題
搜尋
會員列表
會員群組
會員註冊
個人資料
登入檢查您的私人訊息
登入
