Playing with windows mediaplayer

Published on by Yousfi Benameur

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  (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

 


Try to translate the code above as a visual form to obtain the uimode="none" as planed.
Try to translate the code above as a visual form to obtain the uimode="none" as planed.

Try to translate the code above as a visual form to obtain the uimode="none" as planed.


*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

 


Playing with  windows mediaplayer

*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 (Addbs(Sys(2023))+"yplaylist.m3u")
        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 !

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/menu/tools/object browser)

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)


Playing with  windows mediaplayer

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.
can discover all power in code above.mouse over controls to see explained tooltips.

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


Playing with  windows mediaplayer

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


To be informed of the latest articles, subscribe:
Comment on this post