Playing with windows mediaplayer
this is a custom windows mediaplayer embed as olecontrol on a vfp form.
Its always difficult to maintain the position and the size ratio for WMP.
On a visual form i made the property read/write Uimode="none" : it worked fine and dont show controls as menubar.On a prg with same code 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 great olecontrol.All the codes are without any skin, can make cosmetics as wanting.
Its an universal tool and can work on disc and on the web, for all known medias.
Below 9 codes around the windows mediaplayer & medias
*1*
*Begin code
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 ()
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
*2*
*This code implement a web browser windows mediaplayer.
*It can be drived from foxpro by automation with 2 methods:
*by buttons or by contextuel menu.
*the vfp browser emulated as IE11 for ex can play the html5 videos.
*this is a demo how to code this tool in visual foxpro.
*Begin code
Set Safe Off
Publi m.yrep
m.yrep=Addbs(Justpath(Sys(16,1)))
Set Defa To (yrep)
Local m.myv &&create the contextuel menu
TEXT to m.myv noshow
Define Popup raccourci SHORTCUT Relative From Mrow(),Mcol()
Define Bar 1 Of raccourci Prompt "Play" ;
FONT "Courier New", 8 Style "BI" Color G/W*, B/W*,,,,W+/GR
Define Bar 2 Of raccourci Prompt "Pause" ;
FONT "Courier New", 8 Style "BI" Color G/W*, B/W*,,,,W+/GR
Define Bar 3 Of raccourci Prompt "Stop" ;
FONT "Courier New", 8 Style "BI" Color G/W*, B/W*,,,,W+/GR
Define Bar 4 Of raccourci Prompt "Fullscreen" ;
FONT "Courier New", 8 Style "BI" Color G/W*, B/W*,,,,W+/GR
Define Bar 5 Of raccourci Prompt "WMP Contextuelmenu" ;
FONT "Courier New", 8 Style "BI" Color G/W*, B/W*,,,,W+/GR
Define Bar 6 Of raccourci Prompt "WMP loop" ;
FONT "Courier New", 8 Style "BI" Color G/W*, B/W*,,,,W+/GR
Define Bar 7 Of raccourci Prompt "Rate" ;
FONT "Courier New", 8 Style "BI" Color G/W*, B/W*,,,,W+/GR
Define Bar 8 Of raccourci Prompt "WMp UImode" ;
FONT "Courier New", 8 Style "BI" Color G/W*, B/W*,,,,W+/GR
Define Bar 9 Of raccourci Prompt "Mute sound" ;
FONT "Courier New", 8 Style "BI" Color G/W*, B/W*,,,,W+/GR
Define Bar 10 Of raccourci Prompt "Volume" ;
FONT "Courier New", 8 Style "BI" Color G/W*, B/W*,,,,W+/GR
Define Bar 11 Of raccourci Prompt "Duration" ;
FONT "Courier New", 8 Style "BI" Color G/W*, B/W*,,,,W+/GR
Define Bar 12 Of raccourci Prompt "Fastreverse" ;
FONT "Courier New", 8 Style "BI" Color G/W*, B/W*,,,,W+/GR
Define Bar 13 Of raccourci Prompt "FastForward" ;
FONT "Courier New", 8 Style "BI" Color G/W*, B/W*,,,,W+/GR
On Selection Bar 1 Of raccourci ;
DO _4bf16z47j ;
IN Locfile("YWMP\YWMP2" ,"MPX;MPR|FXP;PRG" ,"WHERE is YWMP2?")
On Selection Bar 2 Of raccourci ;
DO _4bf16z47k ;
IN Locfile("YWMP\YWMP2" ,"MPX;MPR|FXP;PRG" ,"WHERE is YWMP2?")
On Selection Bar 3 Of raccourci ;
DO _4bf16z47z ;
IN Locfile("YWMP\YWMP2" ,"MPX;MPR|FXP;PRG" ,"WHERE is YWMP2?")
On Selection Bar 4 Of raccourci ;
DO _4bf16z480 ;
IN Locfile("YWMP\YWMP2" ,"MPX;MPR|FXP;PRG" ,"WHERE is YWMP2?")
On Selection Bar 5 Of raccourci ;
DO _4bf16z481 ;
IN Locfile("YWMP\YWMP2" ,"MPX;MPR|FXP;PRG" ,"WHERE is YWMP2?")
On Selection Bar 6 Of raccourci ;
DO _4bf16z482 ;
IN Locfile("YWMP\YWMP2" ,"MPX;MPR|FXP;PRG" ,"WHERE is YWMP2?")
On Selection Bar 7 Of raccourci ;
DO _4bf16z483 ;
IN Locfile("YWMP\YWMP2" ,"MPX;MPR|FXP;PRG" ,"WHERE is YWMP2?")
On Selection Bar 8 Of raccourci ;
DO _4bf16z484 ;
IN Locfile("YWMP\YWMP2" ,"MPX;MPR|FXP;PRG" ,"WHERE is YWMP2?")
On Selection Bar 9 Of raccourci ;
DO _4bf16z485 ;
IN Locfile("YWMP\YWMP2" ,"MPX;MPR|FXP;PRG" ,"WHERE is YWMP2?")
On Selection Bar 10 Of raccourci ;
DO _4bf16z486 ;
IN Locfile("YWMP\YWMP2" ,"MPX;MPR|FXP;PRG" ,"WHERE is YWMP2?")
On Selection Bar 11 Of raccourci ;
DO _4bf16z48e ;
IN Locfile("YWMP\YWMP2" ,"MPX;MPR|FXP;PRG" ,"WHERE is YWMP2?")
On Selection Bar 12 Of raccourci ;
DO _4bf16z48f ;
IN Locfile("YWMP\YWMP2" ,"MPX;MPR|FXP;PRG" ,"WHERE is YWMP2?")
On Selection Bar 13 Of raccourci ;
DO _4bf16z48g ;
IN Locfile("YWMP\YWMP2" ,"MPX;MPR|FXP;PRG" ,"WHERE is YWMP2?")
Activate Popup raccourci
*
Procedure _4bf16z47j
*bouton play
Try
_Screen.ActiveForm.olecontrol1.Document.getElementbyID("MediaPlayer").Controls.Play
Catch
Endtry
*
Procedure _4bf16z47k
* pause
Try
_Screen.ActiveForm.olecontrol1.Document.getElementbyID("MediaPlayer").Controls.Pause
Catch
Endtry
*
Procedure _4bf16z47z
*bouton stop
Try
_Screen.ActiveForm.olecontrol1.Document.getElementbyID("MediaPlayer").Controls.stop
Catch
Endtry
*
Procedure _4bf16z480
*bouton fullscreen
Try
_Screen.ActiveForm.olecontrol1.Document.getElementbyID("MediaPlayer").fullscreen=.T.
Catch
Endtry
*
Procedure _4bf16z481
*check contextmenu
Try
With _Screen.ActiveForm.olecontrol1.Document.getElementbyID("MediaPlayer")
.enablecontextmenu=!.enablecontextmenu
Messagebox( Trans( .enablecontextmenu),0+32+4096,"EnableContextmenu",600)
Endwith
Catch
Endtry
*
Procedure _4bf16z482
*check loop
Try
With _Screen.ActiveForm.olecontrol1.Document.getElementbyID("MediaPlayer").settings
If _Screen.ActiveForm.oloop=.F.
_Screen.ActiveForm.oloop=.T.
.setMode("loop",.T.)
Else
_Screen.ActiveForm.oloop=.F.
.setMode("loop",.F.)
Endi
Messagebox(Trans(_Screen.ActiveForm.oloop),0+32+4096,'Loop',600)
Endwith
Catch
Endtry
*
Procedure _4bf16z483
Try
Local m.xrate
m.xrate=Val(Inputbox("Rate:1=normal - 2 slow - 3 fast","","1"))
If !Inlist(m.xrate,1,2,3)
m.xrate=1
Endi
local m.al
do case
case m.xrate=1
m.xval=1
case m.xrate=2
m.xval=0.5
case m.xrate=3
m.xval=3
endcase
With _Screen.ActiveForm.olecontrol1.Document.getElementbyID("MediaPlayer").settings
.rate=m.xval
Messagebox(Trans(.rate),0+32+4096,'Rate',600)
Endwith
Catch
Endtry
*https://msdn.microsoft.com/en-us/library/windows/desktop/dd564340%28v=vs.85%29.aspx
*The rate property specifies or retrieves the current playback rate of video media.
*=normal speed 0.5 half speed 3 speed
*
Procedure _4bf16z484
Local xiumODE
m.xUIMode=Inputbox("1-none 2-mini 3-Full","UIMODE","none")
If !Inlist(Lower(m.xUIMode),"none","mini","full")
xUIMode="none"
Endi
Try
_Screen.ActiveForm.olecontrol1.Document.getElementbyID("MediaPlayer").uimode=m.xUIMode
Catch
Endtry
*
Procedure _4bf16z485
Try
With _Screen.ActiveForm.olecontrol1.Document.getElementbyID("MediaPlayer").settings
.mute=!.mute
Messagebox( Trans( .mute),0+32+4096,"Mute sound",600)
Endwith
Catch
Endtry
*
Procedure _4bf16z486
* xvolume
Local m.xvolume
m.xvolume=Int(Val(Inputbox("volume 0-100%","volume","80")))
Try
With _Screen.ActiveForm.olecontrol1.Document.getElementbyID("MediaPlayer").settings
.Volume=m.xvolume
Endwith
Catch
Endtry
*
Procedure _4bf16z48e
* duration
Try
Messagebox("Current Media duration="+_Screen.ActiveForm.olecontrol1.Document.getElementbyID("MediaPlayer").currentMedia.DurationString)
Catch
Endtry
*Player.currentMedia.DurationString (HH:MM:SS):
*
Procedure _4bf16z48f
*fastrevers
Try
_Screen.ActiveForm.olecontrol1.Document.getElementbyID("MediaPlayer").Controls.fastreverse
Catch
Endtry
*
Procedure _4bf16z48g
*fastforward
Try
_Screen.ActiveForm.olecontrol1.Document.getElementbyID("MediaPlayer").Controls.fastforward
Catch
Endtry
ENDTEXT
Strtofile(m.myv, m.yrep+"ywmp2.mpr")
Publi yform
yform=Newobject("asup")
yform.Show
Read Events
Retu
*
Define Class asup As Form
Top = 0
Left = 54
Height = 493
Width = 910
ShowWindow = 2
ShowTips = .T.
Caption = "Window mediaplayer "
oloop = .F.
Name = "Form1"
Add Object olecontrol1 As OleControl With ;
oleclass="shell.explorer.2",;
Top = 3, ;
Left = 264, ;
Height = 480, ;
Width = 640, ;
Anchor = 15, ;
Name = "Olecontrol1"
Add Object combo1 As ComboBox With ;
Anchor = 768, ;
Height = 34, ;
Left = 5, ;
Top = 50, ;
Width = 223, ;
Name = "Combo1"
Add Object command1 As CommandButton With ;
Top = 87, ;
Left = 50, ;
Height = 37, ;
Width = 121, ;
Anchor = 768, ;
Caption = "PlayList", ;
BackColor = Rgb(0,255,0), ;
Name = "Command1"
Add Object command10 As CommandButton With ;
Top = 156,;
Left = 24,;
Height = 37,;
Width = 193,;
FontBold = .T.,;
FontSize = 12,;
Caption = "Menu",;
Anchor=15,;
MousePointer = 15,;
ForeColor = Rgb(0,0,255),;
BackColor = Rgb(128,0,128),;
Name = "Command10"
Add Object command2 As CommandButton With ;
Top = 10, ;
Left = 72, ;
Height = 36, ;
Width = 72, ;
Anchor = 768, ;
Picture = Home(1)+"graphics\icons\win95\openfold.ico", ;
Caption = "", ;
MousePointer = 15, ;
ToolTipText = "A folder of videos", ;
Name = "Command2"
Add Object command3 As CommandButton With ;
Top = 444, ;
Left = 114, ;
Height = 25, ;
Width = 85, ;
FontBold = .T., ;
Anchor = 768, ;
Caption = "Fullscreen", ;
MousePointer = 15, ;
ToolTipText = "ESC to clear fullscreen mode.", ;
BackColor = Rgb(255,128,0), ;
Name = "Command3"
Add Object yhelp As CommandButton With ;
Top = 444, ;
Left = 114+86, ;
Height = 25, ;
Width = 22, ;
FontBold = .T., ;
Anchor = 768, ;
Caption = "?", ;
forecolor=255,;
fontbold=.F.,;
fontsize=16,;
MousePointer = 15, ;
BackColor = Rgb(255,128,0), ;
Name = "yhelp"
Add Object command5 As CommandButton With ;
Top = 444, ;
Left = 78, ;
Height = 25, ;
Width = 37, ;
FontName = "Webdings", ;
FontSize = 12, ;
Anchor = 768, ;
Caption = "1", ;
ToolTipText = "Stop", ;
BackColor = Rgb(255,128,0), ;
Name = "Command5"
Add Object command4 As CommandButton With ;
Top = 443, ;
Left = 42, ;
Height = 25, ;
Width = 37, ;
FontName = "Webdings", ;
FontSize = 12, ;
Anchor = 768, ;
Caption = ";", ;
ToolTipText = "pause", ;
BackColor = Rgb(255,128,64), ;
Name = "Command4"
Add Object command6 As CommandButton With ;
Top = 444, ;
Left = 6, ;
Height = 25, ;
Width = 37, ;
FontName = "Webdings", ;
FontSize = 12, ;
Anchor = 768, ;
Caption = "4", ;
ToolTipText = "Play/Resume", ;
BackColor = Rgb(255,128,0), ;
Name = "Command6"
Add Object check1 As Checkbox With ;
Top = 420, ;
Left = 7, ;
Height = 17, ;
Width = 91, ;
Anchor = 768, ;
AutoSize = .T., ;
Alignment = 0, ;
BackStyle = 0, ;
Caption = "Contextmenu", ;
Name = "Check1"
Add Object check2 As Checkbox With ;
Top = 420, ;
Left = 105, ;
Height = 17, ;
Width = 46, ;
Anchor = 768, ;
AutoSize = .T., ;
Alignment = 0, ;
BackStyle = 0, ;
Caption = "Loop", ;
Name = "Check2"
Add Object combo2 As ComboBox With ;
Anchor = 768, ;
Height = 25, ;
Left = 24, ;
ToolTipText = "UIMode", ;
Top = 377, ;
Width = 84, ;
Name = "Combo2"
Add Object check3 As Checkbox With ;
Top = 381, ;
Left = 121, ;
Height = 17, ;
Width = 44, ;
Anchor = 768, ;
AutoSize = .T., ;
Alignment = 0, ;
BackStyle = 0, ;
Caption = "Mute", ;
Name = "Check3"
Add Object spinner1 As Spinner With ;
Anchor = 768, ;
Height = 25, ;
KeyboardHighValue = 100, ;
KeyboardLowValue = 0, ;
Left = 168, ;
SpinnerHighValue = 100.00, ;
SpinnerLowValue = 0.00, ;
ToolTipText = "Volume 0-100%", ;
Top = 376, ;
Width = 61, ;
Value = 80, ;
Name = "Spinner1"
Add Object optiongroup1 As OptionGroup With ;
AutoSize = .T., ;
ButtonCount = 3, ;
Anchor = 768, ;
BackStyle = 0, ;
Value = 1, ;
Height = 29, ;
Left = 156, ;
Top = 413, ;
Width = 100, ;
ToolTipText = "Rate", ;
Name = "Optiongroup1", ;
Option1.BackStyle = 0, ;
Option1.Caption = "1", ;
Option1.Value = 1, ;
Option1.Height = 17, ;
Option1.Left = 5, ;
Option1.MousePointer = 15, ;
Option1.Top = 5, ;
Option1.Width = 25, ;
Option1.AutoSize = .T., ;
Option1.Name = "Option1", ;
Option2.BackStyle = 0, ;
Option2.Caption = "0.5", ;
Option2.Height = 17, ;
Option2.Left = 32, ;
Option2.MousePointer = 15, ;
Option2.Top = 6, ;
Option2.Width = 35, ;
Option2.AutoSize = .T., ;
Option2.Name = "Option2", ;
Option3.BackStyle = 0, ;
Option3.Caption = "3", ;
Option3.Height = 17, ;
Option3.Left = 70, ;
Option3.MousePointer = 15, ;
Option3.Top = 7, ;
Option3.Width = 25, ;
Option3.AutoSize = .T., ;
Option3.Name = "Option3"
Add Object text1 As TextBox With ;
Anchor = 768, ;
Height = 25, ;
Left = 74, ;
ReadOnly = .T., ;
ToolTipText = "CurrentMedia duration (HH:MM:SS)", ;
Top = 336, ;
Width = 94, ;
Name = "Text1"
Add Object command7 As CommandButton With ;
Top = 336, ;
Left = 12, ;
Height = 25, ;
Width = 60, ;
Anchor = 768, ;
Caption = "Duration", ;
ToolTipText = "", ;
Name = "Command7"
Add Object command8 As CommandButton With ;
Top = 288, ;
Left = 132, ;
Height = 37, ;
Width = 49, ;
FontName = "Webdings", ;
FontSize = 14, ;
Anchor = 768, ;
Caption = "8", ;
Name = "Command8"
Add Object command9 As CommandButton With ;
Top = 290, ;
Left = 42, ;
Height = 37, ;
Width = 49, ;
FontName = "Webdings", ;
FontSize = 14, ;
Anchor = 768, ;
Caption = "7", ;
Name = "Command9"
Procedure ybuild
Lparameters ymedia
Local m.myvar
TEXT to m.myvar textmerge noshow
<object
id="MediaPlayer" width="<<thisform.olecontrol1.width>>" height="<<thisform.olecontrol1.height>>"
classid="CLSID:6BF52A52-394A-11D3-B153-00C04F79FAA6"
standby="Loading Microsoft Windows Media Player components..."
type="application/x-oleobject">
<param name="Url" value="<<allt(ymedia)>>">
<param name="AutoSize" value="true">
<param name="AutoStart" value="true">
<param name="Balance" value="0">
<param name="DisplaySize" value="0">
<param name="Mute" value="false">
<param name="PlayCount" value="0">
<param name="Rate" value="1.0">
<param name="ShowAudioControls" value="true">
<param name="ShowControls" value="true">
<param name="ShowDisplay" value="true">
<param name="ShowStatusBar" value="true">
<param name="ShowTracker" value="true">
<param name="StretchToFit" value="true">
<param name="TransparentAtStart" value="false">
<param name="Volume" value="100">
<param name="EnableContextMenu" value="false">
<param name="loop=" value="false">
<embed type="application/x-mplayer2"
name="mediaplayer"
pluginspage="http://www.microsoft.com/Windows/MediaPlayer"
src="<<allt(ymedia)>>"
Height="<<thisform.olecontrol1.width>>"
Width="<<thisform.olecontrol1.height>>"
AutoSize="1"
AutoStart="1"
Balance="0"
DisplaySize="0"
Mute="0"
PlayCount="0"
Rate="1.0"
ShowAudioControls="1"
ShowControls="1"
ShowDisplay="1"
ShowStatusBar="1"
ShowTracker="1"
StretchToFit="1"
TransparentAtStart="0"
EnableContextmenu="0"
loop="0"
Volume="80">
</embed>
</object>
ENDTEXT
Local m.lcdest
m.lcdest=Addbs(Sys(2023))+"ywmp.html"
Strtofile(m.myvar,m.lcdest)
*modi comm (m.lcdest)
Thisform.olecontrol1.Navigate(m.lcdest)
Thisform.olecontrol1.Refresh
Endproc
Procedure Init
Set Safe Off
Publi m.yrep
Thisform.oloop=.F.
Thisform.SetAll("mousepointer",15,"commandbutton")
Endproc
Procedure Destroy
Clea Events
Endproc
Procedure combo1.Click
Thisform.ybuild(This.Value)
Endproc
Procedure command1.Click
Sele ycurs
Local m.lcdest
m.lcdest=Addbs(Sys(2023))+"yplaylist.m3u"
Copy To (m.lcdest) Sdf
Thisform.ybuild(m.lcdest)
Endproc
Procedure command2.Click
m.yrep=Getdir()
If Empty(m.yrep)
Return .F.
Endi
m.yrep=Addbs(m.yrep)
Try
Use In ycurs
Catch
Endtry
Create Cursor ycurs (ysound c(140))
gnbre =Adir (gabase,m.yrep+"*.*")
For i=1 To gnbre
If Inlist( Lower(Justext(gabase(i,1))),"wmv","mp4","avi") &&ect....
Insert Into ycurs Values( m.yrep+gabase(i,1))
Endi
Endfor
Thisform.Caption=Thisform.Caption+" -"+Trans(Reccount())+" medias."
*brow
With Thisform.combo1
.RowSource="ycurs.ysound"
.RowSourceType=6
.ListIndex=1
.Style=2
Endwith
Endproc
Procedure command3.Click
Try
Thisform.olecontrol1.Document.getElementbyID("MediaPlayer").fullscreen=.T.
Catch
Endtry
Endproc
Procedure command5.Click
Try
Thisform.olecontrol1.Document.getElementbyID("MediaPlayer").Controls.stop
Catch
Endtry
Endproc
Procedure yhelp.Click
Local m.myvar
TEXT to m.myvar noshow
This code implement a web browser windows mediaplayer.
It can be drived from foxpro by automation with 2 methods:
by buttons or by contextuel menu.
the vfp browser emulated as IE11 for ex can play the html5 videos.
this is a demo how to code this tool in visual foxpro.
ENDTEXT
Messagebox(m.myvar,0+32+4096,"Summary help")
Endproc
Procedure command4.Click
Try
Thisform.olecontrol1.Document.getElementbyID("MediaPlayer").Controls.Pause
Catch
Endtry
Endproc
Procedure command6.Click
Try
Thisform.olecontrol1.Document.getElementbyID("MediaPlayer").Controls.Play
Catch
Endtry
Endproc
Procedure check1.InteractiveChange
Try
With Thisform.olecontrol1.Document.getElementbyID("MediaPlayer")
.enablecontextmenu=!.enablecontextmenu
Messagebox( Trans( .enablecontextmenu),0+32+4096,"EnableContextmenu",1000)
Endwith
Catch
Endtry
Endproc
Procedure check2.InteractiveChange
Try
With Thisform.olecontrol1.Document.getElementbyID("MediaPlayer").settings
If Thisform.oloop=.F.
Thisform.oloop=.T.
.setMode("loop",.T.)
Else
Thisform.oloop=.F.
.setMode("loop",.F.)
Endi
Messagebox(Trans(Thisform.oloop),0+32+4096,'Loop',1000)
Endwith
Catch
Endtry
Endproc
Procedure combo2.Click
Try
Thisform.olecontrol1.Document.getElementbyID("MediaPlayer").uimode=This.Value
Catch
Endtry
Endproc
Procedure combo2.Init
With This
.AddItem("none")
.AddItem("mini")
.AddItem("full")
.ListIndex=1
.Style=2
Endwith
Endproc
Procedure check3.InteractiveChange
Try
With Thisform.olecontrol1.Document.getElementbyID("MediaPlayer").settings
.mute=!.mute
Messagebox( Trans( .mute),0+32+4096,"Mute sound",1000)
Endwith
Catch
Endtry
Endproc
Procedure spinner1.InteractiveChange
Try
With Thisform.olecontrol1.Document.getElementbyID("MediaPlayer").settings
.Volume=This.Value
Endwith
Catch
Endtry
Endproc
Procedure optiongroup1.InteractiveChange
Try
With Thisform.olecontrol1.Document.getElementbyID("MediaPlayer").settings
Messagebox(Trans(.rate),0+32+4096,'Rate',1000)
.rate=This.Value
Endwith
Catch
Endtry
*https://msdn.microsoft.com/en-us/library/windows/desktop/dd564340%28v=vs.85%29.aspx
*The rate property specifies or retrieves the current playback rate of video media.
*=normal speed 0.5 half speed 3 speed
Endproc
Procedure command7.Click
Try
Thisform.text1.Value=Thisform.olecontrol1.Document.getElementbyID("MediaPlayer").currentMedia.DurationString
Catch
Endtry
*Player.currentMedia.DurationString (HH:MM:SS):
Endproc
Procedure command8.Click
Try
Thisform.olecontrol1.Document.getElementbyID("MediaPlayer").Controls.fastforward
Catch
Endtry
Endproc
Procedure command9.Click
Try
Thisform.olecontrol1.Document.getElementbyID("MediaPlayer").Controls.fastreverse
Catch
Endtry
Endproc
Procedure command10.Click
Do ywmp2.mpr
Endproc
Procedure command10.RightClick
Do ywmp2.mpr
Endproc
Enddefine
*
*-- EndDefine: asup
*End code
*3*
*This is a vfp browser embedding a windows mediaplayer oriented on
*playings music only.can extend the extensions of filename in code.
*
*Begin code
Publi yform
yform=Newobject("ySoundplayer")
yform.Show
Read Events
Return
*
Define Class ysoundplayer As Form
BorderStyle = 2
autocenter=.t.
Top = -1
Left = 44
Height = 172
Width = 635
ShowWindow = 2
Caption = "Windows media sounds player and VFP"
MaxButton = .F.
Name = "Form1"
Add Object combo1 As ComboBox With ;
Height = 37, ;
Left = 8, ;
Top = 48, ;
Width = 253, ;
Name = "Combo1"
Add Object olecontrol1 As OleControl With ;
OLECLASS="shell.explorer.2",;
Top = -36, ;
Left = 264, ;
Height = 204, ;
Width = 409, ;
Name = "Olecontrol1"
Add Object command1 As CommandButton With ;
Top = 96, ;
Left = 60, ;
Height = 37, ;
Width = 121, ;
Caption = "PlayList", ;
BackColor = Rgb(0,255,0), ;
Name = "Command1"
Add Object command2 As CommandButton With ;
Top = 8, ;
Left = 75, ;
Height = 36, ;
Width = 72, ;
Picture = (Home(1)+"graphics\icons\win95\openfold.ico"), ;
Caption = "", ;
MousePointer = 15, ;
ToolTipText = "A folder of sounds", ;
Name = "Command2"
Procedure ybuild
Lparameters ymedia
Local m.myvar
TEXT to m.myvar textmerge noshow
<div align="center">
<table id="table1" style="BORDER-COLLAPSE: collapse" bordercolor="#000000" height="180" cellpadding="5" width="310" border="0">
<tbody>
<tr><td bordercolor="#000000">
<table id="table2" cellspacing="0" cellpadding="0" width="100%" border="0">
<tbody>
<tr><td></td>
<td width="120">
<p align="center"> <br></td></tr></tbody></table>
<p align="center">
<embed Id="yMediaPlayer" name="MediaPlayer" pluginspage="http://www.microsoft.com/Windows/MediaPlayer/" src=" file:///<<m.ymedia>>"; width="300" height="50" type="application/x-mplayer2" autostart="1" showstatusbar="1" volume="-1" EnableContextMenu="0"></embed></embed /> <br></td></tr>
</tbody>
</table>
</div>
ENDTEXT
Local m.lcdest
m.lcdest=Addbs(Sys(2023))+"ywmp.html"
Strtofile(m.myvar,m.lcdest)
Thisform.olecontrol1.Navigate(m.lcdest)
Endproc
Procedure Init
Set Safe Off
Publi m.yrep
Endproc
Procedure combo1.Click
Thisform.ybuild(This.Value)
Endproc
Procedure command1.Click
Sele ycurs
Local m.lcdest
m.lcdest=Addbs(Sys(2023))+"yplaylist.m3u"
Copy To (m.lcdest) Sdf
*modi comm (m.lcdest)
Thisform.ybuild(m.lcdest)
Endproc
Procedure command2.Click
m.yrep=Getdir()
If Empty(m.yrep)
Return .F.
Endi
m.yrep=Addbs(m.yrep)
Try
Use In ycurs
Catch
Endtry
Create Cursor ycurs (ysound c(140))
gnbre =Adir (gabase,m.yrep+"*.*")
For i=1 To gnbre
If Inlist( Lower(Justext(gabase(i,1))),"mp3","wav") &&ect....
Insert Into ycurs Values( m.yrep+gabase(i,1))
Endi
Endfor
Thisform.Caption=Thisform.Caption+" -"+Trans(Reccount())+" medias."
*brow
With Thisform.combo1
.RowSource="ycurs.ysound"
.RowSourceType=6
.ListIndex=1
.Style=2
Endwith
Endproc
Procedure Destroy
erase (Addbs(Sys(2023))+"ywmp.html")
erase ()
Clea Events
Endproc
Enddefine
*
*-- EndDefine: asup
*End code
*with native class ffc\_multimedia.vcx class can build a player(soundplayer
*and even video player).
*This is an example of a basic soundplayer.
*Begin code
clea all
local m.afile
m.afile=getfile('wav|mp3') && any media because using mci strings API
if empty (m.afile)
return .f.
endi
messagebox("issue [clea all] to stop the player",0+32+4296,"",1000)
with _screen
.newObject("soundplayer1","_soundplayer",home()+"ffc\_multimedia.vcx")
with _screen.soundplayer1
.autoplay=.t.
.autoopen=.t.
.cfilename=m.afile
.mcialias=m.afile
.autorepeat=.f.
.playsound()
endwith
endwith
mplayer=null
*End code
*4*
*using the mcistring API (who is originally the base of all windows multimedia).
*it desserves also the _multimedia.vcx class,the windows mediaplayer...(sounds and video).
*its old codes shipped from vfp5/6
*Begin code
Local m.afile
m.afile=Getfile("wav|mp3")
If Empty(m.afile)
Return
Endi
Wait Window ("type any key to stop the media play or wait to end the media length") At Srows()/2,Scols()/2 Nowait
*!* This is the primary Windows API function that is used to send MCI commands
Declare Integer mciSendString ;
IN WinMM.Dll ;
STRING cMCIString,;
STRING @cRetString,;
INTEGER nRetLength,;
INTEGER hInstance
*!* This function allows us to retrieve the last MCI error that occured can be added to the code...
Declare Integer mciGetErrorString ;
IN WINMM.Dll ;
INTEGER nErrorno, ;
STRING @cBuffer, ;
INTEGER nBufSize
*load audio and (in short) name it 'myFile' as alias
mciSendString("open "+m.afile +" type mpegvideo alias myFile", Null, 0, 0)
*play audio
mciSendString("play myFile", Null, 0, 0)
nMediaLength = Val(doMCI("STATUS myFile length"))/1000 &&media length in seconds
Inkey(nMediaLength) &&ant key to stop or the length time of media
*close media
=ystop()
Return
Procedure doMCI()
Lparameters cMCIcmd
*!* This method takes a MCI command string and executes it using
*!* the Windows API function mciSendString
*!* If the function executes successfully, the result is returned.
*!* Otherwise, the error string is returned.
cRetString = Space(80)
nRetValue = mciSendString(cMCIcmd,@cRetString,Len(cRetString),0)
*can add a procedure to show error (if error)....
Return Trim(Strtran(cRetString,Chr(0),""))
Endproc
Procedure ystop()
*close media
mciSendString("close myFile", Null, 0, 0)
Endproc
*Endcode
*5*
*-using the shellexecute API but executed with the associated file (WMP or other).
*this lauch he windows mediaplayer (if its the associated application) and plays the file wanted (even a playlist)
*Begin code
DECLARE INTEGER ShellExecute IN shell32.dll ;
INTEGER hndWin, STRING cAction, STRING cFileName, ;
STRING cParams, STRING cDir, INTEGER nShowWin
local m.afile
afile=getfile('wav|mp3|au|wmv|mpg|avi') &&any media
ShellExecute(0,"play",m.afile,"","",1)
*end code
*6*
*-can play musics using with a hidden olecontrol WMP windows mediaplayer.press any key to stop
*Begin code
clea all
local WMP As WindowsMediaPlayer
Wmp = CreateObject("WMPlayer.OCX.7")
with Wmp
.URL = getfile("wav|mp3") &&any media
.Controls.Play()
endwith
inkey(0)
Wmp=null
*end code
*7*
*this code showing that wmp (version 11+) read mp4 files and even web urls.
*in this case internet must be connected.
*Begin code
messagebox("this code opens a visible instance of the complet window mediaplayer-use the mediabar to access fullscreen.",0+32+4096,"",1000)
local Wmp As WindowsMediaPlayer
Wmp = CreateObject("WMPlayer.OCX.7")
try
Wmp.openPlayer("http://content.bitsontherun.com/videos/bkaovAYt-364766.mp4")
catch
endtry
*End code
*its also equivalent to this native vfp code for a mp3 music:
*! "myfile.mp3"
*8*
*This gathers any folder of images with any format in a playlist.
*the mediaplayer can play this playlist as a diaporama (interval here is the deafult set in wmp options)
*Begin code
Set Safe Off
Local m.yrep
m.yrep=Getdir()
If Empty(m.yrep)
Return .F.
Endi
m.yrep=Addbs(m.yrep)
Try
Use In ycurs
Catch
Endtry
Create Cursor ycurs (ysound c(140))
gnbre =Adir (gabase,m.yrep+"*.*")
For i=1 To gnbre
If Inlist( Lower(Justext(gabase(i,1))),"png","jpg","bmp","gif") &&ect....
Insert Into ycurs Values( m.yrep+gabase(i,1))
Endi
Endfor
*brow
Sele ycurs
Local m.lcdest
m.lcdest=Addbs(Sys(2023))+"yplaylist.m3u"
Copy To (m.lcdest) Sdf
*modi comm (m.lcdest)
Declare Integer ShellExecute In shell32.Dll ;
INTEGER hndWin, String cAction, String cFileName, ;
STRING cParams, String cDir, Integer nShowWin
ShellExecute(0,"play",m.lcdest,"","",3)
*end code
ts also equivalent to this vfp code
*9*
*This code is similar to the preview (2) but build a listbox with somes icons
*ths playlist is also some difrent to build with the cursor.
*Begin code
Set Safe Off
Publi m.yrep
m.yrep=Addbs(Justpath(Sys(16,1)))
Set Defa To (yrep)
Local m.myv
TEXT to m.myv noshow
Define Popup raccourci SHORTCUT Relative From Mrow(),Mcol()
Define Bar 1 Of raccourci Prompt "Play" ;
FONT "Courier New", 8 Style "BI" Color G/W*, B/W*,,,,W+/GR
Define Bar 2 Of raccourci Prompt "Pause" ;
FONT "Courier New", 8 Style "BI" Color G/W*, B/W*,,,,W+/GR
Define Bar 3 Of raccourci Prompt "Stop" ;
FONT "Courier New", 8 Style "BI" Color G/W*, B/W*,,,,W+/GR
Define Bar 4 Of raccourci Prompt "Fullscreen" ;
FONT "Courier New", 8 Style "BI" Color G/W*, B/W*,,,,W+/GR
Define Bar 5 Of raccourci Prompt "WMP Contextuelmenu" ;
FONT "Courier New", 8 Style "BI" Color G/W*, B/W*,,,,W+/GR
Define Bar 6 Of raccourci Prompt "WMP loop" ;
FONT "Courier New", 8 Style "BI" Color G/W*, B/W*,,,,W+/GR
Define Bar 7 Of raccourci Prompt "Rate" ;
FONT "Courier New", 8 Style "BI" Color G/W*, B/W*,,,,W+/GR
Define Bar 8 Of raccourci Prompt "WMp UImode" ;
FONT "Courier New", 8 Style "BI" Color G/W*, B/W*,,,,W+/GR
Define Bar 9 Of raccourci Prompt "Mute sound" ;
FONT "Courier New", 8 Style "BI" Color G/W*, B/W*,,,,W+/GR
Define Bar 10 Of raccourci Prompt "Volume" ;
FONT "Courier New", 8 Style "BI" Color G/W*, B/W*,,,,W+/GR
Define Bar 11 Of raccourci Prompt "Duration" ;
FONT "Courier New", 8 Style "BI" Color G/W*, B/W*,,,,W+/GR
Define Bar 12 Of raccourci Prompt "Fastreverse" ;
FONT "Courier New", 8 Style "BI" Color G/W*, B/W*,,,,W+/GR
Define Bar 13 Of raccourci Prompt "FastForward" ;
FONT "Courier New", 8 Style "BI" Color G/W*, B/W*,,,,W+/GR
On Selection Bar 1 Of raccourci ;
DO _4bf16z47j ;
IN Locfile("YWMP\YWMP2" ,"MPX;MPR|FXP;PRG" ,"WHERE is YWMP2?")
On Selection Bar 2 Of raccourci ;
DO _4bf16z47k ;
IN Locfile("YWMP\YWMP2" ,"MPX;MPR|FXP;PRG" ,"WHERE is YWMP2?")
On Selection Bar 3 Of raccourci ;
DO _4bf16z47z ;
IN Locfile("YWMP\YWMP2" ,"MPX;MPR|FXP;PRG" ,"WHERE is YWMP2?")
On Selection Bar 4 Of raccourci ;
DO _4bf16z480 ;
IN Locfile("YWMP\YWMP2" ,"MPX;MPR|FXP;PRG" ,"WHERE is YWMP2?")
On Selection Bar 5 Of raccourci ;
DO _4bf16z481 ;
IN Locfile("YWMP\YWMP2" ,"MPX;MPR|FXP;PRG" ,"WHERE is YWMP2?")
On Selection Bar 6 Of raccourci ;
DO _4bf16z482 ;
IN Locfile("YWMP\YWMP2" ,"MPX;MPR|FXP;PRG" ,"WHERE is YWMP2?")
On Selection Bar 7 Of raccourci ;
DO _4bf16z483 ;
IN Locfile("YWMP\YWMP2" ,"MPX;MPR|FXP;PRG" ,"WHERE is YWMP2?")
On Selection Bar 8 Of raccourci ;
DO _4bf16z484 ;
IN Locfile("YWMP\YWMP2" ,"MPX;MPR|FXP;PRG" ,"WHERE is YWMP2?")
On Selection Bar 9 Of raccourci ;
DO _4bf16z485 ;
IN Locfile("YWMP\YWMP2" ,"MPX;MPR|FXP;PRG" ,"WHERE is YWMP2?")
On Selection Bar 10 Of raccourci ;
DO _4bf16z486 ;
IN Locfile("YWMP\YWMP2" ,"MPX;MPR|FXP;PRG" ,"WHERE is YWMP2?")
On Selection Bar 11 Of raccourci ;
DO _4bf16z48e ;
IN Locfile("YWMP\YWMP2" ,"MPX;MPR|FXP;PRG" ,"WHERE is YWMP2?")
On Selection Bar 12 Of raccourci ;
DO _4bf16z48f ;
IN Locfile("YWMP\YWMP2" ,"MPX;MPR|FXP;PRG" ,"WHERE is YWMP2?")
On Selection Bar 13 Of raccourci ;
DO _4bf16z48g ;
IN Locfile("YWMP\YWMP2" ,"MPX;MPR|FXP;PRG" ,"WHERE is YWMP2?")
Activate Popup raccourci
*
Procedure _4bf16z47j
*bouton play
Try
_Screen.ActiveForm.olecontrol1.Document.getElementbyID("MediaPlayer").Controls.Play
Catch
Endtry
*
Procedure _4bf16z47k
* pause
Try
_Screen.ActiveForm.olecontrol1.Document.getElementbyID("MediaPlayer").Controls.Pause
Catch
Endtry
*
Procedure _4bf16z47z
*bouton stop
Try
_Screen.ActiveForm.olecontrol1.Document.getElementbyID("MediaPlayer").Controls.stop
Catch
Endtry
*
Procedure _4bf16z480
*bouton fullscreen
Try
_Screen.ActiveForm.olecontrol1.Document.getElementbyID("MediaPlayer").fullscreen=.T.
Catch
Endtry
*
Procedure _4bf16z481
*check contextmenu
Try
With _Screen.ActiveForm.olecontrol1.Document.getElementbyID("MediaPlayer")
.enablecontextmenu=!.enablecontextmenu
Messagebox( Trans( .enablecontextmenu),0+32+4096,"EnableContextmenu",600)
Endwith
Catch
Endtry
*
Procedure _4bf16z482
*check loop
Try
With _Screen.ActiveForm.olecontrol1.Document.getElementbyID("MediaPlayer").settings
If _Screen.ActiveForm.oloop=.F.
_Screen.ActiveForm.oloop=.T.
.setMode("loop",.T.)
Else
_Screen.ActiveForm.oloop=.F.
.setMode("loop",.F.)
Endi
Messagebox(Trans(_Screen.ActiveForm.oloop),0+32+4096,'Loop',600)
Endwith
Catch
Endtry
*
Procedure _4bf16z483
Try
Local m.xrate
m.xrate=Val(Inputbox("Rate:1=normal - 2 slow - 3 fast","","1"))
If !Inlist(m.xrate,1,2,3)
m.xrate=1
Endi
local m.al
do case
case m.xrate=1
m.xval=1
case m.xrate=2
m.xval=0.5
case m.xrate=3
m.xval=3
endcase
With _Screen.ActiveForm.olecontrol1.Document.getElementbyID("MediaPlayer").settings
.rate=m.xval
Messagebox(Trans(.rate),0+32+4096,'Rate',600)
Endwith
Catch
Endtry
*https://msdn.microsoft.com/en-us/library/windows/desktop/dd564340%28v=vs.85%29.aspx
*The rate property specifies or retrieves the current playback rate of video media.
*=normal speed 0.5 half speed 3 speed
*
Procedure _4bf16z484
Local xiumODE
m.xUIMode=Inputbox("1-none 2-mini 3-Full","UIMODE","none")
If !Inlist(Lower(m.xUIMode),"none","mini","full")
xUIMode="none"
Endi
Try
_Screen.ActiveForm.olecontrol1.Document.getElementbyID("MediaPlayer").uimode=m.xUIMode
Catch
Endtry
*
Procedure _4bf16z485
Try
With _Screen.ActiveForm.olecontrol1.Document.getElementbyID("MediaPlayer").settings
.mute=!.mute
Messagebox( Trans( .mute),0+32+4096,"Mute sound",600)
Endwith
Catch
Endtry
*
Procedure _4bf16z486
* xvolume
Local m.xvolume
m.xvolume=Int(Val(Inputbox("volume 0-100%","volume","80")))
Try
With _Screen.ActiveForm.olecontrol1.Document.getElementbyID("MediaPlayer").settings
.Volume=m.xvolume
Endwith
Catch
Endtry
*
Procedure _4bf16z48e
* duration
Try
Messagebox("Current Media duration="+_Screen.ActiveForm.olecontrol1.Document.getElementbyID("MediaPlayer").currentMedia.DurationString)
Catch
Endtry
*Player.currentMedia.DurationString (HH:MM:SS):
*
Procedure _4bf16z48f
*fastrevers
Try
_Screen.ActiveForm.olecontrol1.Document.getElementbyID("MediaPlayer").Controls.fastreverse
Catch
Endtry
*
Procedure _4bf16z48g
*fastforward
Try
_Screen.ActiveForm.olecontrol1.Document.getElementbyID("MediaPlayer").Controls.fastforward
Catch
Endtry
ENDTEXT
Strtofile(m.myv, m.yrep+"ywmp2.mpr")
Publi yform
yform=Newobject("asup")
yform.Show
Read Events
Return
*
Define Class asup As Form
Height = 616
Width = 910
ShowWindow = 2
ShowTips = .T.
AutoCenter = .T.
Caption = "Window mediaplayer "
oloop = .F.
Name = "Form1"
Add Object olecontrol1 As OleControl With ;
oleclass="shell.explorer.2",;
Top = 3, ;
Left = 252, ;
Height = 597, ;
Width = 652, ;
Anchor = 15, ;
Name = "Olecontrol1"
Add Object command1 As CommandButton With ;
Top = 46, ;
Left = 36, ;
Height = 25, ;
Width = 121, ;
FontBold = .T., ;
Anchor = 768, ;
Caption = "PlayList", ;
MousePointer = 15, ;
BackColor = Rgb(0,255,0), ;
Name = "Command1"
Add Object command2 As CommandButton With ;
Top = 5, ;
Left = 60, ;
Height = 36, ;
Width = 60, ;
Anchor = 768, ;
Picture = "c:\program files\microsoft visual foxpro 9\graphics\icons\win95\openfold.ico", ;
Caption = "", ;
MousePointer = 15, ;
ToolTipText = "A folder of videos", ;
Name = "Command2"
Add Object command10 As CommandButton With ;
Top = 91, ;
Left = 14, ;
Height = 24, ;
Width = 193, ;
FontBold = .T., ;
FontSize = 12, ;
Caption = "Menu", ;
MousePointer = 15, ;
ForeColor = Rgb(0,0,255), ;
BackColor = Rgb(128,0,128), ;
Name = "Command10"
Add Object list1 As ListBox With ;
FontBold = .T., ;
FontSize = 8, ;
Anchor = 768, ;
RowSourceType = 6, ;
Height = 481, ;
Left = -1, ;
MousePointer = 15, ;
Top = 119, ;
Width = 250, ;
ItemForeColor = Rgb(255,255,255), ;
ItemBackColor = Rgb(0,0,0), ;
ItemTips = .T., ;
AutoHideScrollbar = 1, ;
Name = "List1"
Procedure ybuild
Lparameters ymedia
Local m.myvar
TEXT to m.myvar textmerge noshow
<object
id="MediaPlayer" width="<<thisform.olecontrol1.width>>" height="<<thisform.olecontrol1.height>>"
classid="CLSID:6BF52A52-394A-11D3-B153-00C04F79FAA6"
standby="Loading Microsoft Windows Media Player components..."
type="application/x-oleobject">
<param name="Url" value="<<allt(ymedia)>>">
<param name="AutoSize" value="true">
<param name="AutoStart" value="true">
<param name="Balance" value="0">
<param name="DisplaySize" value="0">
<param name="Mute" value="false">
<param name="PlayCount" value="0">
<param name="Rate" value="1.0">
<param name="ShowAudioControls" value="true">
<param name="ShowControls" value="true">
<param name="ShowDisplay" value="true">
<param name="ShowStatusBar" value="true">
<param name="ShowTracker" value="true">
<param name="StretchToFit" value="true">
<param name="TransparentAtStart" value="false">
<param name="Volume" value="100">
<param name="EnableContextMenu" value="false">
<param name="loop=" value="false">
<embed type="application/x-mplayer2"
name="mediaplayer"
pluginspage="http://www.microsoft.com/Windows/MediaPlayer"
src="<<allt(ymedia)>>"
Height="<<thisform.olecontrol1.width>>"
Width="<<thisform.olecontrol1.height>>"
AutoSize="1"
AutoStart="1"
Balance="0"
DisplaySize="0"
Mute="0"
PlayCount="0"
Rate="1.0"
ShowAudioControls="1"
ShowControls="1"
ShowDisplay="1"
ShowStatusBar="1"
ShowTracker="1"
StretchToFit="1"
TransparentAtStart="0"
EnableContextmenu="0"
loop="0"
Volume="80">
</embed>
</object>
ENDTEXT
Local m.lcdest
m.lcdest=Addbs(Sys(2023))+"ywmp.html"
Strtofile(m.myvar,m.lcdest)
*modi comm (m.lcdest)
Thisform.olecontrol1.Navigate(m.lcdest)
Thisform.olecontrol1.Refresh
Endproc
Procedure ylist1
Sele ycurs
Locate
With Thisform.list1
.RowSource="ycurs.ysound"
.RowSourceType=6
.Picture[0] = Pict
i=1
Scan
.AddItem(ysound)
If File(Pict)
.Picture[m.i] = Pict
Endi
i=i+1
Endscan
.ListIndex=1
Endwith
Endproc
Procedure Destroy
Clea Events
Endproc
Procedure Init
Set Safe Off
Publi m.yrep
Thisform.oloop=.F.
Thisform.SetAll("mousepointer",15,"commandbutton")
Endproc
Procedure command1.Click
Sele ycurs
Local m.lcdest
m.lcdest=Addbs(Sys(2023))+"yplaylist.m3u"
Local m.x
m.x=""
Scan
m.x=m.x+ Addbs(ydir)+Allt(ysound) +Chr(13)
Endscan
=Strtofile(m.x,m.lcdest)
*modi comm (m.lcdest)
Thisform.ybuild(m.lcdest)
Endproc
Procedure command2.Click
m.yrep=Getdir()
If Empty(m.yrep)
Return .F.
Endi
m.yrep=Addbs(m.yrep)
Try
Use In ycurs
Catch
Endtry
Create Cursor ycurs (ysound c(80),ydir c(100),Pict c(140))
gnbre =Adir (gabase,m.yrep+"*.*")
For i=1 To gnbre
If Inlist( Lower(Justext(gabase(i,1))),"wav","mp3","mp4","wmv","webm","ogg","avi" ) && etc....all supported formats
Insert Into ycurs Values( gabase(i,1),m.yrep,"")
Endi
Endfor
Local m.oo
m.oo=Home(1)+"GRAPHICS\BITMAPS\OUTLINE\NOMASK\"
*m.oo=home(1)+"GRAPHICS\icons\misc\" &&&&any folder with icons 32x32 or 16x16
gnbre1=Adir(gobase,m.oo+"*.bmp") &&home(1)+"GRAPHICS\BITMAPS\ASSORTED\*.bmp")
i=1
Scan
Try
Repl Pict With m.oo+gobase(i,1)
Catch
Endtry
i=i+1
Endscan
Thisform.Caption=Thisform.Caption+" -"+Trans(Reccount())+" medias."
*brow
*listbox
Thisform.ylist1()
Endproc
Procedure command10.RightClick
Do ywmp2.mpr
Endproc
Procedure command10.Click
Do ywmp2.mpr
Endproc
Procedure list1.Click
Thisform.ybuild(Addbs(ydir)+This.Value)
Thisform.ylist1()
Endproc
Enddefine
*
*-- EndDefine: asup
*end code
As you can see in test,the listbox with pictures dont refresh correctly ! i added a code to make it right !
*10*
You can see all PEM (properties\methods\events) of the mediaplayer if you embed it in the vfp object browser
do (_objectBrowser) to lauch the tool (or vfp/
windows mediaplayer is a com object .search it in the com panel, check it and its embed on the object browser as seen in the photo below.
-Can drag constants to the command window to see all WMP constants
-Can drag any of the 4 interfaces to the command window to see the olepublic class (can build eventHandler)
Click on code to select [then copy] -click outside to deselect
*11* created on saturday 14 of october 2017
*THIS IS A POCKET MEDIAPLAYER WITH :
*-4 builtin playlists.can select each one in the combobox
*-a set of command buttons as play-pause-stop-volume-mute
*-2 buttons for playlist( (next current media or previous)
*-a checkbox to select the shuffle (paly randomly the songs into one playlist or no)
*-a builtin clock (mouse over to see fateTime or Click on)
*-an animated gif (selected randomly from 2 ones).
*-2 system buttons (minimize-close)
*-form is top level and movable by mousedown on desktop.a small transparency is applied.
*build an exe and pin it to taskbar
*all links are personnal, can customize them.
If !_vfp.StartMode=0
On Shutdown Quit
Endi
Set Safe Off
local m.yrep
m.yrep=Addbs(Justpath(Sys(16,1)))
Set Defa To (yrep)
*download 2 animated gifs from my blog .one time (can jump code below if downloaded)
Declare Integer URLDownloadToFile In urlmon.Dll Integer pCaller, String szURL, String szFileName, Integer dwReserved, Integer lpfnCB
Declare Integer DeleteUrlCacheEntry In wininet String lpszUrlName
local lcDownloadURL,lcDownloadLoc
lcDownloadURL = "http://img.over-blog-kiwi.com/1/43/54/07/20171019/ob_753dba_gif007.gif"
lcDownloadLoc ="gif007.gif"
lnResult = DeleteUrlCacheEntry(lcDownloadURL)
lnResult = URLDownloadToFile(0, lcDownloadURL, lcDownloadLoc , 0,0)
If lnResult = 0
Wait Window "Download "+lcDownloadLoc +" Complete" Nowait
*Else
*!* Messagebox("Download fails")
Endi
lcDownloadURL = "http://img.over-blog-kiwi.com/1/43/54/07/20171019/ob_20b74f_gif017small.gif"
lcDownloadLoc ="gif017small.gif"
lnResult = DeleteUrlCacheEntry(lcDownloadURL)
lnResult = URLDownloadToFile(0, lcDownloadURL, lcDownloadLoc , 0,0)
If lnResult = 0
Wait Window "Download "+lcDownloadLoc +" Complete" Nowait
*Else
*!* Messagebox("Download fails")
Endi
**********
*begin code
Close Data All
Declare Integer GetWindowLong In user32;
INTEGER HWnd, Integer nIndex
Declare Integer SetWindowLong In user32;
INTEGER HWnd, Integer nIndex, Integer dwNewLong
Declare Integer SetLayeredWindowAttributes In user32;
INTEGER HWnd, Integer crKey,;
SHORT bAlpha, Integer dwFlags
Publi yform
yform=Newobject("ywmp2017")
yform.Show
Read Events
Retu
Define Class ywmp2017 As Form
AutoCenter=.T.
Width=245
Height=75
ShowWindow=2
BorderStyle=0
TitleBar=1
BackColor=0
ShowTips=.T.
Name="form1"
Add Object yshb As Shape With;
top=3,;
left=3,;
width=245-8,;
height=71-12,;
curvature=15,;
backcolor=0,;
bordercolor=Rgb(255,255,255),;
borderWidth=1,;
name="yshb"
Add Object ywmp1 As ywmp With Left=0
Add Object yim As Image With;
stretch=0,;
picture="gif017small.gif",;
left=30,;
top=50,;
name="yim"
Add Object combo1 As ComboBox With;
left=6,;
top=50+25,;
width=75,;
height=20,;
fontsize=8,;
borderstyle=0,;
itemtips=.T.,;
value=1,;
ItemBackColor =RGB(0,255,0),;
Selectedbackcolor=255,;
name="combo1"
Add Object ynext As Label With ;
AutoSize = .T., ;
FontName = "Webdings", ;
FontSize = 16, ;
BackStyle = 0, ;
Caption = "8", ;
Left = 160+10+20, ;
MousePointer = 15, ;
Top = 70, ;
ForeColor = Rgb(255,0,255), ;
ToolTipText = "Next", ;
Name = "ynext"
Add Object yprev As Label With ;
AutoSize = .T., ;
FontName = "Webdings", ;
FontSize = 16, ;
BackStyle = 0, ;
Caption = "7", ;
Left = 160+10, ;
MousePointer = 15, ;
Top = 70, ;
ForeColor = Rgb(255,0,255), ;
ToolTipText = "Previous", ;
Name = "yprev"
Add Object yshuffle As Checkbox With;
autosize=.T.,;
caption="",;
tooltiptext="shuffle on/off",;
left=220,;
top=70+30,;
backstyle=0,;
value=1,;
name="yshuffle"
Add Object ysh As Shape With;
left=163,;
width=10,;
height=10,;
curvature=99,;
backcolor=rgb(0,255,0),;
mousepointer=15,;
tooltiptext="mute on/off",;
name="ysh"
Add Object ymin As Label With ;
autosize=.T.,;
left=220-5,;
top=10,;
caption="-",;
fontbold=.T.,;
fontsize=9,;
mousepointer=15,;
backstyle=0,;
forecolor=Rgb(0,255,0),;
name="ymin"
Add Object yclose As Label With ;
autosize=.T.,;
left=230-5,;
top=70,;
caption="X",;
fontbold=.T.,;
fontsize=9,;
mousepointer=15,;
backstyle=0,;
forecolor=Rgb(0,255,0),;
name="yclose"
Procedure yshb.MouseDown
Lparameters nButton, nShift, nXCoord, nYCoord
Thisform.MouseDown(1)
Endproc
Procedure ynext.Click
Try
wmp.Controls.Next
Catch
Endtry
Endproc
Procedure yprev.Click
Try
wmp.Controls.Previous
Catch
Endtry
Endproc
Procedure ymin.Click
Thisform.WindowState=1
Endproc
Procedure yclose.Click
Thisform.Release
Endproc
Procedure yshuffle.InteractiveChange
If This.Value=1
wmp.settings.setMode("shuffle", .T.) &&random play items in playlist
Else
wmp.settings.setMode("shuffle", .F.) &&random play items in playlist
Endi
Endproc
Procedure ysh.Click
wmp.settings.mute=!wmp.settings.mute
if wmp.settings.mute=.f.
this.backcolor=rgb(0,255,0)
else
this.backcolor=255
endi
Endproc
Procedure MouseDown
Lparameters nButton, nShift, nXCoord, nYCoord
Declare Integer GetFocus In WIN32API
lnHandle = Thisform.HWnd
Thisform.MousePointer=15
param1 = 274
param2 = 0xF012
Declare Integer ReleaseCapture In WIN32API
Declare Integer SendMessage In WIN32API Integer, Integer, Integer, Integer
bb=ReleaseCapture()
bb=SendMessage(lnHandle, param1, param2,0)
Thisform.MousePointer=0
Endproc
Procedure Init
With This
.TitleBar=0
.BorderStyle=2 &&0
For i=1 To This.ControlCount
.Controls(i).Top=10
Endfor
.Left=Sysmetric(1)-.Width-10
.Top =.Height+10
.yim.Top=.ywmp1.Top+.ywmp1.Height+2
.yim.Left=(.Width-.yim.Width)/2
Bindevent(.yclose,"mouseEnter",Thisform,"my")
Bindevent(.ymin,"mouseEnter",Thisform,"my")
Bindevent(.yclose,"mouseLeave",Thisform,"my1")
Bindevent(.ymin,"mouseLeave",Thisform,"my1")
Local m.te
m.te=Int(Val(Substr(Time(),7,2)))
If Between(m.te,0,30)
.yim.Picture="gif017small.gif"
Else
.yim.Picture="gif007.gif"
Endi
.ynext.Top=.ynext.Top+.ynext.Height+5
.yprev.Top=.yprev.Top+.yprev.Height+5
.combo1.Top=.yim.Top+5
.yshuffle.Top=.yim.Top+5
*.yshp.Top=.yshuffle.Top+.yshuffle.Height
*.yshp.Left=.yshuffle.Left+2
.ysh.Top=.yim.Top+5
Endwith
#Define LWA_COLORKEY 1
#Define LWA_ALPHA 2
#Define GWL_EXSTYLE -20
#Define WS_EX_LAYERED 0x80000
Local nExStyle, nRgb, nAlpha, nFlags
nExStyle = GetWindowLong(Thisform.HWnd, GWL_EXSTYLE)
nExStyle = Bitor(nExStyle, WS_EX_LAYERED)
= SetWindowLong(Thisform.HWnd, GWL_EXSTYLE, nExStyle)
= SetLayeredWindowAttributes(Thisform.HWnd, Thisform.BackColor, 205,LWA_ALPHA) &&LWA_COLORKEY+LWA_ALPHA)
Thisform.yplaylist()
Endproc
Procedure combo1.Init
With This
.AddItem("Oum Kalthoum")
.AddItem("Abdelwahab")
.AddItem("Bajdoub")
.AddItem("Fairouz")
.ListIndex=1
.Style=2
.Value=1
Endwith
Procedure combo1.Click
Thisform.yplaylist()
Do Case
Case Thisform.combo1.Value=1
wmp.url="oumKaltoum.m3u"
Case Thisform.combo1.Value=2
wmp.url="Abdelwahab.m3u"
Case Thisform.combo1.Value=3
wmp.url="Bajdoub.m3u"
Case Thisform.combo1.Value=4
wmp.url="Fairouz.m3u"
Endcase
Thisform.ywmp1.ylab.Caption=Thisform.combo1.List(Thisform.combo1.Value)
Local m.te
m.te=Int(Val(Substr(Time(),7,2)))
If mod(m.te,2)=0
thisform.yim.Picture="gif017small.gif"
Else
thisform.yim.Picture="gif007.gif"
Endi
Endproc
Procedure my
Lparameters nButton, nShift, nXCoord, nYCoord
*--- aevent create an array laEvents
Aevents( myArray, 0)
*--- reference the calling object
loObject = myArray[1]
loObject.ForeColor=255
Endproc
Procedure my1
Lparameters nButton, nShift, nXCoord, nYCoord
*--- aevent create an array laEvents
Aevents( myArray, 0)
*--- reference the calling object
loObject = myArray[1]
loObject.ForeColor=Rgb(0,255,0)
Endproc
Procedure Destroy
Try
wmp=Null
wmp.Release
Catch
Endtry
Clea Events
Endproc
Procedure yplaylist()
Do Case
Case Thisform.combo1.Value=1
Local m.myv
TEXT to m.myv noshow && web links can be customized here
http://srv88.maghrebspace.net/62234/0e4050d05a763865bf9c03e3e231022d/___www_maghrebspace_net__31032010062030Oum kalthoum.mp3
http://srv62.maghrebspace.net/62234/0e4050d05a763865bf9c03e3e231022d/___www_maghrebspace_net__31032010062336Oum kalthoum.mp3
http://srv72.maghrebspace.net/62234/0e4050d05a763865bf9c03e3e231022d/___www_maghrebspace_net__27062012161428913Oum kalthoum.mp3
http://srv88.maghrebspace.net/62234/0e4050d05a763865bf9c03e3e231022d/___www_maghrebspace_net__18012013123333454Oum kalthoum.mp3
http://srv88.maghrebspace.net/62234/0e4050d05a763865bf9c03e3e231022d/___www_maghrebspace_net__agharmennesmataljanoob.mp3
http://srv88.maghrebspace.net/62234/0e4050d05a763865bf9c03e3e231022d/___www_maghrebspace_net__27062012174025249Oum kalthoum.mp3
http://srv72.maghrebspace.net/62234/0e4050d05a763865bf9c03e3e231022d/___www_maghrebspace_net__27062012123744907Oum kalthoum.mp3
http://srv62.maghrebspace.net/62234/0e4050d05a763865bf9c03e3e231022d/___www_maghrebspace_net__18012013110824173Oum kalthoum.mp3
http://srv88.maghrebspace.net/62234/0e4050d05a763865bf9c03e3e231022d/___www_maghrebspace_net__18012013122726595Oum kalthoum.mp3
http://srv88.maghrebspace.net/62234/0e4050d05a763865bf9c03e3e231022d/___www_maghrebspace_net__18012013110300667Oum kalthoum.mp3
http://srv72.maghrebspace.net/62234/0e4050d05a763865bf9c03e3e231022d/___www_maghrebspace_net__18012012153250Oum kalthoum.mp3
http://srv62.maghrebspace.net/62234/0e4050d05a763865bf9c03e3e231022d/___www_maghrebspace_net__18012013110700316Oum kalthoum.mp3
http://srv88.maghrebspace.net/62234/0e4050d05a763865bf9c03e3e231022d/___www_maghrebspace_net__18012012122328Oum kalthoum.mp3
http://srv88.maghrebspace.net/62234/0e4050d05a763865bf9c03e3e231022d/___www_maghrebspace_net__17012012164251Oum kalthoum.mp3
http://srv72.maghrebspace.net/62234/0e4050d05a763865bf9c03e3e231022d/___www_maghrebspace_net__18012012161642Oum kalthoum.mp3
http://srv62.maghrebspace.net/62234/0e4050d05a763865bf9c03e3e231022d/___www_maghrebspace_net__18012013120651173Oum kalthoum.mp3
http://srv88.maghrebspace.net/62234/0e4050d05a763865bf9c03e3e231022d/___www_maghrebspace_net__27062012124300183Oum kalthoum.mp3
http://srv88.maghrebspace.net/62234/0e4050d05a763865bf9c03e3e231022d/___www_maghrebspace_net__27062012123756131Oum kalthoum.mp3
http://srv72.maghrebspace.net/62234/0e4050d05a763865bf9c03e3e231022d/___www_maghrebspace_net__18012012121955Oum kalthoum.mp3
http://srv62.maghrebspace.net/62234/0e4050d05a763865bf9c03e3e231022d/___www_maghrebspace_net__18012013111747789Oum kalthoum.mp3
http://srv88.maghrebspace.net/62234/0e4050d05a763865bf9c03e3e231022d/___www_maghrebspace_net__18012013104712656Oum kalthoum.mp3
http://srv88.maghrebspace.net/62234/0e4050d05a763865bf9c03e3e231022d/___www_maghrebspace_net__18012013111806715Oum kalthoum.mp3
http://srv72.maghrebspace.net/62234/0e4050d05a763865bf9c03e3e231022d/___www_maghrebspace_net__27062012111948246Oum kalthoum.mp3
http://srv62.maghrebspace.net/62234/0e4050d05a763865bf9c03e3e231022d/___www_maghrebspace_net__18022012123224390Oum kalthoum.mp3
ENDTEXT
Strtofile(m.myv,"oumKaltoum.m3u")
Case Thisform.combo1.Value=2
Local m.myv
TEXT to m.myv noshow
http://maghrebspace.net/62234/03979e85026d8a0155a7c29635511811/___www_maghrebspace_net__31082015093544619Mohamed abdelwahab.mp3
http://maghrebspace.net/62234/03979e85026d8a0155a7c29635511811/___www_maghrebspace_net__29112016104221664Mohamed abdelwahab.mp3
http://maghrebspace.net/62234/03979e85026d8a0155a7c29635511811/___www_maghrebspace_net__29112016104221664Mohamed abdelwahab.mp3
http://maghrebspace.net/62234/03979e85026d8a0155a7c29635511811/___www_maghrebspace_net__17112016211816492Mohamed abdelwahab.mp3
http://srv88.maghrebspace.net/62234/03979e85026d8a0155a7c29635511811/___www_maghrebspace_net__12042012170105926Mohamed abdelwahab.mp3
http://maghrebspace.net/62234/03979e85026d8a0155a7c29635511811/___www_maghrebspace_net__29112016104605872Mohamed abdelwahab.mp3
http://maghrebspace.net/62234/03979e85026d8a0155a7c29635511811/___www_maghrebspace_net__12022015183404826Mohamed abdelwahab.mp3
http://maghrebspace.net/62234/03979e85026d8a0155a7c29635511811/___www_maghrebspace_net__31082015092715311Mohamed abdelwahab.mp3
http://srv72.maghrebspace.net/62234/03979e85026d8a0155a7c29635511811/___www_maghrebspace_net__12042012170050223Mohamed abdelwahab.mp3
http://srv62.maghrebspace.net/62234/03979e85026d8a0155a7c29635511811/___www_maghrebspace_net__12042012164941738Mohamed abdelwahab.mp3
http://maghrebspace.net/62234/03979e85026d8a0155a7c29635511811/___www_maghrebspace_net__31082015092853377Mohamed abdelwahab.mp3
http://maghrebspace.net/62234/03979e85026d8a0155a7c29635511811/___www_maghrebspace_net__31082015093733241Mohamed abdelwahab.mp3
http://srv88.maghrebspace.net/62234/03979e85026d8a0155a7c29635511811/___www_maghrebspace_net__12042012170244118Mohamed abdelwahab.mp3
http://srv88.maghrebspace.net/62234/03979e85026d8a0155a7c29635511811/___www_maghrebspace_net__12042012165122417Mohamed abdelwahab.mp3
http://maghrebspace.net/62234/03979e85026d8a0155a7c29635511811/___www_maghrebspace_net__31082015093817115Mohamed abdelwahab.mp3
http://maghrebspace.net/62234/03979e85026d8a0155a7c29635511811/___www_maghrebspace_net__31082015092454646Mohamed abdelwahab.mp3
http://srv72.maghrebspace.net/62234/03979e85026d8a0155a7c29635511811/___www_maghrebspace_net__12042012171500306Mohamed abdelwahab.mp3
http://srv62.maghrebspace.net/62234/03979e85026d8a0155a7c29635511811/___www_maghrebspace_net__12042012172341603Mohamed abdelwahab.mp3
http://maghrebspace.net/62234/03979e85026d8a0155a7c29635511811/___www_maghrebspace_net__17112016211816492Mohamed abdelwahab.mp3
http://maghrebspace.net/62234/03979e85026d8a0155a7c29635511811/___www_maghrebspace_net__29112016104605872Mohamed abdelwahab.mp3
ENDTEXT
Strtofile(m.myv,"Abdelwahab.m3u")
Case Thisform.combo1.Value=3
Local m.myv
TEXT to m.myv noshow
http://maghrebspace.net/62234/fb54ae8bd4cb4c78d920ffa8eed4dec3/___www_maghrebspace_net__04012016115805248Bajdoub.mp3
http://maghrebspace.net/62234/fb54ae8bd4cb4c78d920ffa8eed4dec3/___www_maghrebspace_net__19122014185810571Bajdoub.mp3
http://maghrebspace.net/62234/fb54ae8bd4cb4c78d920ffa8eed4dec3/___www_maghrebspace_net__19122014185727559Bajdoub.mp3
http://maghrebspace.net/62234/fb54ae8bd4cb4c78d920ffa8eed4dec3/___www_maghrebspace_net__19122014185652332Bajdoub.mp3
http://srv62.maghrebspace.net/62234/fb54ae8bd4cb4c78d920ffa8eed4dec3/___www_maghrebspace_net__121220073sb.mp3
http://maghrebspace.net/62234/fb54ae8bd4cb4c78d920ffa8eed4dec3/___www_maghrebspace_net__07032014152153296Bajdoub.mp3
http://maghrebspace.net/62234/fb54ae8bd4cb4c78d920ffa8eed4dec3/___www_maghrebspace_net__07032014124438799Bajdoub.mp3
http://srv88.maghrebspace.net/62234/fb54ae8bd4cb4c78d920ffa8eed4dec3/___www_maghrebspace_net__25032011140001Bajdoub.mp3
http://srv88.maghrebspace.net/62234/fb54ae8bd4cb4c78d920ffa8eed4dec3/___www_maghrebspace_net__05032012191416111Bajdoub.mp3
http://maghrebspace.net/62234/fb54ae8bd4cb4c78d920ffa8eed4dec3/___www_maghrebspace_net__07032014123521473Bajdoub.mp3
http://srv72.maghrebspace.net/62234/fb54ae8bd4cb4c78d920ffa8eed4dec3/___www_maghrebspace_net__06012009224035Bajdoub.mp3
ENDTEXT
Strtofile(m.myv,"Bajdoub.m3u")
Case Thisform.combo1.Value=4
Local m.myv
TEXT to m.myv noshow
http://maghrebspace.net/62234/3ca64eb420cda6cfda447bb9458b82b3/___www_maghrebspace_net__28092017095940876Fairouz.mp3
http://maghrebspace.net/62234/3ca64eb420cda6cfda447bb9458b82b3/___www_maghrebspace_net__22062017133043791Fairouz.mp3
http://maghrebspace.net/62234/3ca64eb420cda6cfda447bb9458b82b3/___www_maghrebspace_net__14112014151855654Fairouz.mp3
http://maghrebspace.net/62234/3ca64eb420cda6cfda447bb9458b82b3/___www_maghrebspace_net__14082015152311763Fairouz.mp3
http://srv88.maghrebspace.net/62234/3ca64eb420cda6cfda447bb9458b82b3/___www_maghrebspace_net__25082009182107Fairouz.mp3
http://srv72.maghrebspace.net/62234/3ca64eb420cda6cfda447bb9458b82b3/___www_maghrebspace_net__25082009182252Fairouz.mp3
http://srv62.maghrebspace.net/62234/3ca64eb420cda6cfda447bb9458b82b3/___www_maghrebspace_net__25082009182416Fairouz.mp3
http://srv88.maghrebspace.net/62234/3ca64eb420cda6cfda447bb9458b82b3/___www_maghrebspace_net__25082009181244Fairouz.mp3
http://srv88.maghrebspace.net/62234/3ca64eb420cda6cfda447bb9458b82b3/___www_maghrebspace_net__25082009181315Fairouz.mp3
http://srv72.maghrebspace.net/62234/3ca64eb420cda6cfda447bb9458b82b3/___www_maghrebspace_net__25082009181400Fairouz.mp3
ENDTEXT
Strtofile(m.myv,"Fairouz.m3u")
Endcase
Thisform.ywmp1.ylab.Caption=Thisform.combo1.List(Thisform.combo1.Value)
Thisform.combo1.Click()
Endproc
Enddefine
*enddefine ywmp2017
Define Class yclock As Container
Anchor = 256
Width = 48
Height = 23
BackStyle=0
BorderWidth=0
Name = "yclock"
Add Object label1 As Label With ;
AutoSize = .T., ;
FontBold = .T., ;
Anchor = 256, ;
Caption = "", ;
Height = 17, ;
Left = 0, ;
MousePointer = 15, ;
Top = 0, ;
Width = 2, ;
ForeColor = Rgb(0,255,0), ;
BackColor = Rgb(0,0,0), ;
Name = "Label1"
Add Object timer2 As Timer With ;
Top = 0, ;
Left = 25, ;
Height = 23, ;
Width = 23, ;
Interval = 30000, ;
Name = "Timer2"
Procedure label1.Click
Messagebox(Cdow(Date())+" "+Ttoc(Datetime()),0+32+4096,'')
Endproc
Procedure label1.Init
This.Caption=Substr(Time(),1,5)
This.ToolTipText=Cdow(Date())+" "+Ttoc(Datetime())
Endproc
Procedure timer2.Timer
This.Parent.label1.Caption=Substr(Time(),1,5)
Endproc
Enddefine
*
*-- EndDefine: yclock
Define Class ywmp As Container
Anchor=0
Top = 0
Left = 40
Width = 178+40-10
Height = 23
BackStyle = 0
BorderWidth = 0
Name = "ywmp"
Add Object ylab As Label With ;
AutoSize = .T., ;
FontBold = .T., ;
FontName = "calibri", ;
FontSize = 9, ;
BackStyle = 0, ;
Caption ="Oum Kalthoum", ;
Height = 26, ;
Left =5, ;
MousePointer = 15, ;
Top = 5, ;
Width = 22, ;
ForeColor = Rgb(0,255,0), ;
ToolTipText = "Playlist", ;
Name = "ylab"
Add Object label1 As Label With ;
AutoSize = .T., ;
FontBold = .T., ;
FontName = "Webdings", ;
FontSize = 14, ;
BackStyle = 0, ;
Caption = "4", ;
Height = 26, ;
Left = 100-20, ;
MousePointer = 15, ;
Top = -1, ;
Width = 22, ;
ForeColor = Rgb(0,255,0), ;
ToolTipText = "Play", ;
Name = "Label1"
Add Object label2 As Label With ;
AutoSize = .T., ;
FontName = "Webdings", ;
FontSize = 9, ;
BackStyle = 0, ;
Caption = "g", ;
Height = 21, ;
Left = 143-20, ;
MousePointer = 15, ;
Top = 3, ;
Width = 14, ;
ForeColor = Rgb(255,0,0), ;
ToolTipText = "Stop", ;
Name = "Label2"
Add Object label3 As Label With ;
AutoSize = .T., ;
FontName = "Webdings", ;
FontSize = 9, ;
BackStyle = 0, ;
Caption = "n", ;
Height = 21, ;
Left = 125-20, ;
MousePointer = 15, ;
Top = 3, ;
Width = 14, ;
ForeColor = Rgb(0,0,255), ;
ToolTipText = "Pause", ;
Name = "Label3"
Add Object image1 As Image With ;
Picture = Home(1)+"graphics\icons\misc\volume01.ico", ;
Stretch = 2, ;
BackStyle = 0, ;
Height = 20, ;
Left = 160-20, ;
MousePointer = 15, ;
Top = 1, ;
Width = 20, ;
ToolTipText = "Volume", ;
Name = "Image1"
Add Object yclock1 As yclock With Left=160,Top=5
Procedure Init
Publi wmp As WindowsMediaPlayer
wmp = Createobject("WMPlayer.OCX.7")
With wmp
.settings.autoStart = .T.
.settings.Volume=50
.settings.setMode('loop',.T.)
.settings.setMode("shuffle", .T.) &&random play items in playlist
.url=""
Endwith
Endproc
Procedure label1.Click
Try
wmp.Controls.Play
Catch
Endtry
Endproc
Procedure label2.Click
Try
wmp.Controls.stop
Catch
Endtry
Endproc
Procedure label3.Click
Try
wmp.Controls.Pause
Catch
Endtry
Endproc
Procedure image1.Click
#Define APPCOMMAND_VOLUME_MUTE 0x80000
#Define APPCOMMAND_VOLUME_UP 0xA0000
#Define APPCOMMAND_VOLUME_DOWN 0x90000
#Define WM_APPCOMMAND 0x319
Declare Integer SendMessage In user32;
INTEGER HWnd,;
INTEGER Msg,;
INTEGER wParam,;
INTEGER Lparam
SendMessage(_vfp.HWnd, WM_APPCOMMAND, _vfp.HWnd, APPCOMMAND_VOLUME_UP)
Endproc
Enddefine
*
*-- EndDefine: ywmp
*make visualisation effect if selected
*it can be integraded on the form as container object (non set here).
Define Class yvisu As Container
Top = 76
Left = 0
Width = 245
Height = 193
Name = "yvisu"
Add Object olecontrol1 As OleControl With ;
oleclass="WMPlayer.OCX.7",;
Top = 2, ;
Left = 1, ;
Height = 241, ;
Width = 253, ;
Anchor = 15, ;
Name = "Olecontrol1"
Procedure olecontrol1.Init
With This
.uimode="full" &&mandatory to see visualisations
.settings.autoStart = .T.
.settings.Volume=50
.settings.setMode('loop',.T.)
.settings.mute=.T.
.enableContextMenu=.F.
.url="http://srv88.maghrebspace.net/62234/0e4050d05a763865bf9c03e3e231022d/___www_maghrebspace_net__31032010062030Oum kalthoum.mp3" && a fake url only
Endwith
Endproc
Enddefine
*
*-- EndDefine: yvisu
can discover all power in code above.mouse over controls to see explained tooltips.
Click on code to select [then copy] -click outside to deselect
*12*
*created on monday 01 of january 2018
*recurse on disc folders and search for a filter on extension files for ex.
*List all "fxpbakerr" files and gather in a cursor .list all supported graphics on vfp: "bmpdibcuraniicojpgjpegjpejfifgifgfatifexifpngwmfemf" ....
*this recurse on folders and subfolders.returns the count and the ellpased calculation time and informations requested.
*this code can be applied to extract any extension file as this prototype shows.
*can read http://yousfi.over-blog.com/2015/01/clean-vfp-indesirable-files-as-bak-fxp-err.html
*or http://yousfi.over-blog.com/2015/02/the-windows-special-folders.html code *6*vfp can crash for very big folders with message "too do imriqued..." as limit vfp capacity.
*that why i added a structuren try/catch/endtry in code.
*this below returns all media information in a given folder (as WMPlayer supportted medias)
Clea All
Close Data All
Local m.yrep
m.yrep=Addbs(Getdir("c:\", "Select a folder", "Directories",16384 ))
If Empty(m.yrep)
Return .F.
Endi
Publi m.nrep,m.searched
m.searched="asfasxaviwavwaxwmawmm3ump2vmpgmpegm1vmp2mp3m3umpampempv2vobmidmidirmaifaifcaiffausndivfmovqtausndswf" && all media files extensions supported for WMPlayer here.
*m.searched="bmpdibcuraniicojpgjpegjpejfifgifgfatifexifpngwmfemf" &&can be for all graphics supported by vfp
m.nrep=0
Local m.ltStart
m.ltStart = Datetime()
Create Cursor tempfiles ( cFilename c(80), cDir c(150),nSize N(10), dMod d ,Info m)
=RecurseFolder( yrep )
Messagebox(Trans(Reccount())+" files found- "+Trans( Datetime() - ltStart)+" sec - folders="+Trans(nrep),0+32+4096,'',5000)
_Screen.Visible=.T.
*browse nowait
Locate
Browse Name ybrow Title Trans(Reccount())+" found. Ellapsed time=" +Trans( Datetime() - ltStart)+" sec - folders="+Trans(nrep)+" " Nowait &&window as oop object
With ybrow
.DeleteMark=.F.
.GridLines=0
.RecordMark=.F.
.SetAll("DynamicBackColor","IIF(MOD(RECNO( ), 2)=0, RGB(255,228,196) , RGB(144,238,140))", "Column")
Endwith
*clean public variables
m.nrep=Null
m.searched=Null
Release m.nrep
Release m.searched
Retu
Function RecurseFolder( lcDir )
Local i,N, laFiles[1]
m.nrep=m.nrep+1
N = Adir( laFiles, lcDir + "*.*", "shd" )
For i = 1 To N
If ( Left( laFiles[i,1], 1 ) != '.' )
If ( "D" $ laFiles[i,5] )
Try &&pb error "to avoid error :trop de do imbriqués...." -can raise with a very big folder.
RecurseFolder( lcDir + laFiles[i,1] + "\" )
Catch
Endtry
Else
If Lower(Justext(laFiles[i,1])) $ m.searched
Insert Into tempfiles Values( laFiles[i,1],lcDir , laFiles[i,2], laFiles[i,3],ydetailOf(lcDir +laFiles[i,1]) )
Endi
Endif
Endif
Endfor
Return
Function ydetailOf()
Lparameters lcfilename
Local m.x
m.x="detail of "+lcfilename+Chr(13)+Chr(13)
Dimension arrHeaders(35)
Local objShell,oBjFolder As Object
objShell = Createobject("Shell.Application")
oBjFolder = objShell.Namespace(Justpath(lcfilename))
For i = 1 To 35
arrHeaders(i) = oBjFolder.GetDetailsOf(oBjFolder.Items, i)
Next
For Each strFileName In oBjFolder.Items
If Lower(strFileName.Name)=Juststem(Allt(Lower(lcfilename)))
For i = 1 To 35
If !Empty(oBjFolder.GetDetailsOf(strFileName, i))
m.x=m.x+Trans(i)+" "+ arrHeaders(i) +" "+": " + oBjFolder.GetDetailsOf(strFileName, i)+Chr(13)
Endi
Next
Endi
Next
oBjFolder=Null
objShell=Null
Return m.x
Endfunc
Click on code to select [then copy] -click outside to deselect
*13* created on 01 of january 2018
*determine the duration,durationString of any media
On Key Label F2 wmp=Null &&press F2 to quit wmp
Local m.lcfile
m.lcfile=Getfile("mp3|wav|mp4")
If Empty(m.lcfile)
Return .F.
Endi
Local wmp As WindowsMediaPlayer
wmp = Createobject("WMPlayer.OCX.7")
With wmp
.url=m.lcfile
.settings.autoStart = .T. &&start immediatly
.settings.Volume=80 &&adjust soundvolume
.settings.setMode('loop',.F.) &&.t. for loop
.Controls.Play()
Local m.xdur
Do While !.currentmedia.duration >0 &&the wmp must pass the transitionnings to work as expected(as IE)
Inkey(0.1)
Enddo
m.xdur=.currentmedia.duration
_Cliptext=Trans(m.xdur,"999999.99")+" or "+.currentmedia.DurationString
Messagebox("Duration="+Trans(m.xdur,"999999.99")+" sec DurationString="+.currentmedia.DurationString,0+32+4096,'in the clipboard',5000)
Endwith
Inke(m.xdur+0.5) &&wait until the media is done.can press F2 to exit.note WMP is invisible here.
wmp=Null
Release wmp