A custom Youtube video audio part II
this is a continuation of the previous post relative to THE VERY ATTRACTIVE youtube video/audio players.
this code builds a youtube player drived from a vfp form and using internet.explorer.application.
the form is set with horizontal scrollbar as a scrollable container.the form viewPort is reset when choosing a video.
i avoided some issues security by working on "about:blank" (some dialogs appear when navigating to a temp file).
the form is a top level (alwaysonTop=.t.) one and have these capabilities as follow
-create a cursor to gather the custom videoIds and titles
-grab the videos jpg posters from the web with pictureVal image control property (no disc used) the memo in the cursor is fill with blobs image and restored as pictureval
-adjust the form and apie to fill entier screen.Remark that the fullscreen of each video can be fired now (iframe tag updated)
-in each thumb can see in tooltip the videoId and the title of video (needs form.focus).
-can show/hide the apie,customize the bakcolor of the form
-can see the videos list in a form view (modal with desktop=.t.)
-see the date+video playing videoId+ttle+videos count and the time()
-bindevent function permit to change video after clicking on any thumb.
-mouseWheel at the bottom of apie to raise the youtube commandbar.its autohide.can acess to its commands (play,pause,stop,progressbar,fullscreen,...)
-can make a playlist with a great number of videos as coded below.
-give the focus to the form (By a click) to see tooltips.
[Post 227]
Click on code to select [then copy] -click outside to deselect
![]()
*1* Publi yform yform=Newobject("youtube") yform.Show Read Events Retu * Define Class youtube As Form BorderStyle = 0 Top = 508 Left = 1 Height = 130 Width = 1014 ShowWindow = 2 ScrollBars = 1 ShowTips = .T. Caption = "Form1" TitleBar = 1 AlwaysOnTop = .T. BackColor = Rgb(0,0,0) ycl = .F. Name = "form1" Add Object shape1 As Shape With ; Top = -1, ; Left = 984, ; Height = 13, ; Width = 13, ; Anchor = 768, ; BorderWidth = 2, ; Curvature = 99, ; MousePointer = 15, ; ToolTipText = "Exit", ; BackColor = Rgb(0,255,0), ; Name = "Shape1" Add Object shape2 As Shape With ; Top = -1, ; Left = 966, ; Height = 13, ; Width = 13, ; Anchor = 768, ; BorderWidth = 2, ; Curvature = 99, ; MousePointer = 15, ; ToolTipText = "SHow/Hide viewer", ; BackColor = Rgb(255,0,0), ; Name = "Shape2" Add Object shape3 As Shape With ; Top = -1, ; Left = 946, ; Height = 13, ; Width = 13, ; Anchor = 768, ; BorderWidth = 2, ; Curvature = 99, ; MousePointer = 15, ; ToolTipText = "Backcolor", ; BackColor = Rgb(255,255,0), ; Name = "Shape3" Add Object label1 As Label With ; AutoSize = .T., ; BackStyle = 0, ; Caption = "", ; Height = 17, ; Left = 2, ; Top = 2, ; Width = 2, ; ForeColor = Rgb(0,255,0), ; Name = "Label1" Add Object shape4 As Shape With ; Top = -1, ; Left = 929, ; Height = 13, ; Width = 13, ; Anchor = 768, ; BorderWidth = 2, ; Curvature = 99, ; MousePointer = 15, ; ToolTipText = "Video list", ; BackColor = Rgb(0,255,255), ; Name = "Shape4" Add Object shape5 As Shape With ; Top = -1, ; Left = 913, ; Height = 13, ; Width = 13, ; Anchor = 768, ; BorderWidth = 2, ; Curvature = 99, ; MousePointer = 15, ; ToolTipText = "Help", ; BackColor = Rgb(255,128,0), ; Name = "Shape5" Add Object timer1 As Timer With ; Top = 0, ; Left = 888, ; Height = 23, ; Width = 23, ; Enabled = .F., ; Interval = 60000, ; Name = "Timer1" Add Object label2 As Label With ; AutoSize = .T., ; FontBold = .T., ; FontSize = 11, ; Anchor = 768, ; BackStyle = 0, ; Caption = "", ; Height = 20, ; Left = 835, ; Top = 2, ; Width = 2, ; ForeColor = Rgb(255,0,0), ; BackColor = Rgb(128,255,0), ; Name = "Label2" Procedure my Lparameters nButton, nShift, nXCoord, nYCoord *--- aevent create an array laEvents Aevents( myArray, 0) *--- reference the calling object loObject = myArray[1] Local N m.n=Substr(loObject.Name,4) N=Int(Val(m.n)) Sele ycurs Go N Thisform.label1.Caption=" "+Dtoc(Date())+"-"+Time()+" Playing :"+videoID+" ["+Allt(xtitle)+"] - video count="+Trans(Recno())+"/"+Trans(Reccount()) With Thisform &&reset the form viewPort area inke(1) .SetViewPort(0, .ViewPortTop ) Endwith Local m.ww,m.hh,xvideoID m.xvideoID=Allt(videoID) m.ww=apie.Width m.hh=apie.Height Local m.myvar TEXT to m.myvar textmerge noshow <meta http-equiv="X-UA-Compatible" content="IE=EDGE" /> <body scroll="no"> <iframe width='<<m.ww>>' height='<<m.hh>>' src='http://youtube.com/embed/<<m.xvideoID>>?autoplay=1&rel=0&showinfo=0&autohide=1' frameborder="0" allowfullscreen></iframe> </body> ENDTEXT With apie .document.open() .document.write(m.myvar) .document.close() .refresh .Visible=.T. Endwith Endproc Procedure Destroy Try apie.Quit Catch Endtry Erase Addbs(Sys(2023))+"ytemp.html" Clea Events Endproc Procedure Init _Screen.WindowState=1 With This .TitleBar=0 .Left=0 .Height=140 .Top=Sysmetric(2)-.Height .Width=Sysmetric(1)-5 .ycl=.T. Endwith Sele ycurs nn=Reccount() Local m.delta m.delta=5 With Thisform For i=1 To nn xx="img"+Trans(i) .AddObject(m.xx,"image") With Eval("."+m.xx) .Width=100 .Height=80 .Stretch=2 Sele ycurs Go i .PictureVal=xPictVAl .BorderStyle=1 .MousePointer=15 .Top=24 .ToolTipText=xtitle+Chr(13)+"VideoId="+videoID .Visible=.T. If i=1 .Left=0 Else .Left=Eval("thisform.img"+Trans(i-1)+".left")+Eval("thisform.img"+Trans(i-1)+".width")+m.delta Endi Endwith Bindevent(Eval("."+m.xx),"mousedown",Thisform,"my") Endfor Endwith Publi apie apie=Newobject("internetexplorer.application") With apie .Navigate("about:blank") .menubar=0 .Toolbar=0 .StatusBar=0 .Resizable=0 .Top=-Sysmetric(9)-Sysmetric(4)-Sysmetric(3) .Left=-16 .Width=Sysmetric(1)+2*19+2*sysmetric(3) .Height=Sysmetric(2)-Thisform.Height+Sysmetric(9)+Sysmetric(4)+Sysmetric(3)+6 bringWindowToTop(.HWnd) ***make apie topmost to dont be covered by any other window #define SWP_NOSIZE 0x0001 #define SWP_NOMOVE 0x0002 #define SWP_SHOWWINDOW 0x0040 #define HWND_TOPMOSt -1 SetWindowPos(.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZE + SWP_SHOWWINDOW) *** Endwith Sele ycurs Locate Thisform.img1.MouseDown(1) Endproc Procedure Load Declare BringWindowToTop In user32 Integer DECLARE INTEGER SetWindowPos IN user32; INTEGER hwnd,; INTEGER hWndInsertAfter,; INTEGER x,; INTEGER y,; INTEGER cx,; INTEGER cy,; INTEGER wFlags Close Data All Set Date Long Create Cursor ycurs (videoID c(20),xtitle c(50),xPictVAl m) Insert Into ycurs Values ("jx0-YMuz8M4","Astronomie - Mars La Planète Rouge","") Insert Into ycurs Values("J6RGi2nLy6Y","Astronomie - Mars La Planète Rouge ","") Insert Into ycurs Values("KoZl-2fOpfQ","Vivre dans l'espace","") Insert Into ycurs Values("nhnOc5K61f8","Coloniser l'espace","") Insert Into ycurs Values("Uk07YuS-3KY","Le Problème du Voyage Interstellaire","") Insert Into ycurs Values("K1QiRzcgpVs","Mars Tech Anomalies, Curiosity Rover 2017","") Insert Into ycurs Values("sWuUSX8639o","this is mars2017","") Insert Into ycurs Values("pWumSTGBMAs","10 DÉCOUVERTES INEXPLICABLES SUR TERRE ","") Insert Into ycurs Values("d7ENdwFyhWc","LES MENSONGES DE LA NASA SUR LA PLANÈTE MARS ","") Insert Into ycurs Values("ZXz3wKeJNSA","7 MARS Mysteries ","") Insert Into ycurs Values("SYqfAmISM0Q","5 Strangest & Mysterious Things Caught By NASA On Mars! ","") Insert Into ycurs Values("jDM05tm8xEs","O.V.N.I - Vimana - Humain ","") Insert Into ycurs Values("U-8KBJfEa5Y","NASA top secret video/pictures about mars 2017 ","") Insert Into ycurs Values("GiIoBpIDogw","NASA UFO - Leaked Moon images and video! ","") Insert Into ycurs Values("IJHPrPCAEXA","5 Mysteries Of Mars Unexplained By Nasa","") Insert Into ycurs Values("_RbUydzAMSo","The Best Mars Discoveries Of 2016 ","") Insert Into ycurs Values("We2KncJ-tMA","Mars 2017, Curiosity Rover","") Insert Into ycurs Values("Xe5LVKCVttg","Mars Nouvelles - Février 2017 [I] - Curiosité","") Insert Into ycurs Values("xOFeXzo5WP0","Les Enigmes De La Lune ","") Insert Into ycurs Values("8uzAtoDxTm0","Le mystère de la face cachée de la lune","") Insert Into ycurs Values("DcYiH5jPVds","AUX MYSTÉRIEUSES ORIGINES DE LA LUNE","") Insert Into ycurs Values("OqGqkXUUrjw","ÉQUATION DE DRAKE & VIE EXTRATERRESTRE INTELLIGENTE ","") Locate Local m.lcURLnloRequest Scan m.lcUrl='https://img.youtube.com/vi/'+Allt(videoID)+'/1.jpg' Try m.loRequest = Createobject('MsXml2.XmlHttp') m.loRequest.Open("GET",lcUrl,.F.) m.loRequest.Send() Repl xPictVAl With m.loRequest.ResponseBody m.loRequest=Null Catch Endtry Endscan *Brow Endproc Procedure shape1.Click Thisform.Release Endproc Procedure shape2.Click Thisform.ycl=Iif(Thisform.ycl=.T.,.F.,.T.) Try apie.Visible=Thisform.ycl Catch Endtry Endproc Procedure shape3.Click Local m.xcolor m.xcolor=Getcolor() If !m.xcolor=-1 Thisform.BackColor=m.xcolor Endi Endproc Procedure shape4.Click * form ylist Local yview yview=Newobject("ylist") yview.Show(1) Endproc Procedure shape5.Click Local m.myvar TEXT to m.myvar pretext 7noshow this is a continuation of the previous post relative to youtube video/audio players. this code builds a youtube player drived from a vfp form and using internet.explorer.application. the form is set with horizontal scrollbar as a scrollable container.the form viewPort is reset when choosing a video. infortunatly some IE dialogs appears because an iframe is embed on (click unblock if the case). i configured the IE internet options/security insuccessfully to avoid this message.confirm it... the form is a top level (alwaysonTop=.t.) one and have these capabilities as follow -create a cursor to gather the custom videoIds and titles -grab the videos jpg posters from the web with pictureVal image control property (no disc used) the memo in the cursor is fill with blobs image and restored as pictureval -adjust the form and apie to fill entier screen.Remark that the fullscreen of each video now can be fired now (corrected with update iframe tag) -in each thum can see in tooltip the videoId and the title of video. -can show/hide the apie,customize the bakcolor orf the form -can see the videos list in a form view (modal with desktop=.t.) -see the date+video playing videoId+ttle+videos count and the time() -bindevent function permit to change video after clicking on any thumb. -mouseWheel at the bottom of apie to raise the youtube commandbar. can make a playlist with a great number of videos. - give the focus to the form (click) to see tooltips. ENDTEXT *messagebox(m.myvar,0+32+4096,"Summary help") _Cliptext=m.myvar #Define MB_ICONINFORMATION 0x00000040 #Define MB_OK 0x00000000 #Define MB_APPLMODAL 0x00000000 #Define MB_DEFBUTTON1 0x00000000 Declare Integer MessageBox In user32 As MessageBoxA ; INTEGER HWnd,; STRING lpText,; STRING lpCaption,; INTEGER wType *buttons #Define MB_ABORTRETRYIGNORE 0x00000002 #Define MB_CANCELTRYCONTINUE 0x00000006 #Define MB_HELP 0x00004000 #Define MB_OKCANCEL 0x00000001 #Define MB_RETRYCANCEL 0x00000005 #Define MB_YESNO 0x00000004 #Define MB_YESNOCANCEL 0x00000003 *Icons #Define MB_ICONEXCLAMATION 0x00000030 #Define MB_ICONWARNING 0x00000030 #Define MB_ICONASTERISK 0x00000040 #Define MB_ICONQUESTION 0x00000020 #Define MB_ICONSTOP 0x00000010 #Define MB_ICONERROR 0x00000010 #Define MB_ICONHAND 0x00000010 *To indicate the default button, specify one of the following values. #Define MB_DEFBUTTON2 0x00000100 #Define MB_DEFBUTTON3 0x00000200 #Define MB_DEFBUTTON4 0x00000300 *To indicate the modality of the dialog box, specify one of the following values. #Define MB_SYSTEMMODAL 0x00001000 #Define MB_TASKMODAL 0x00002000 *To specify other options, use one or more of the following values. #Define MB_DEFAULT_DESKTOP_ONLY 0x00020000 #Define MB_RIGHT 0x00080000 #Define MB_RTLREADING 0x00100000 #Define MB_SETFOREGROUND 0x00010000 #Define MB_TOPMOST 0x00040000 #Define MB_SERVICE_NOTIFICATION 0x00200000 *Return code #Define IDABORT 3 #Define IDCANCEL 2 #Define IDCONTINUE 11 #Define IDIGNORE 5 #Define IDNO 7 #Define IDOK 1 #Define IDRETRY 4 #Define IDTRYAGAIN 10 #Define IDYES 6 MessageBoxA(_vfp.HWnd,m.myvar,"Summary help (text in clipboard)",MB_TOPMOST+MB_APPLMODAL+MB_OK +MB_ICONINFORMATION +MB_DEFBUTTON1 ) Endproc Procedure timer1.Timer Thisform.label2.Caption=Substr(Time(),1,5) Endproc Procedure label2.Init Thisform.label2.Caption=Substr(Time(),1,5) Endproc Enddefine *-- EndDefine: youtube *form ylist Define Class ylist As Form BorderStyle = 0 Height = 361 Width = 491 ShowWindow = 1 AutoCenter = .T. Desktop=.T. Caption = "Videos list" MaxButton = .F. MinButton = .F. WindowType = 1 Name = "form1" Add Object grid1 As Grid With ; Anchor = 15, ; Height = 361, ; Left = 0, ; ScrollBars = 2, ; Top = 0, ; Width = 492, ; AllowCellSelection = .F., ; Name = "Grid1" Procedure Init With This .Left=(Sysmetric(1)-.Width)/2 .Top =(Sysmetric(2)-.Height)/2 Endwith Endproc Procedure grid1.Init With This .RecordSource="ycurs" .RecordSourceType=1 .Themes=.F. .GridLines=0 .DeleteMark=.F. .RecordMark=.F. .FontBold=.T. .column3.Visible=.F. Local m.x m.x='rgb('+Trans(Int(255*Rand()))+','+Trans(Int(255*Rand()))+','+Trans(Int(255*Rand()))+')' &&unique color .SetAll("BackColor",Eval(m.x),"header") tnlevel=0.65 lnRed =Int(255*Rand()) lnGreen = Int(255*Rand()) lnBlue = Int(255*Rand()) m.x='RGB('+Trans( lnRed + ((255 - lnRed ) * tnlevel))+','+; trans( lnGreen + ((255 - lnGreen) * tnlevel))+ ','+ ; trans( lnBlue + ((255 - lnBlue ) * tnlevel) )+')' .SetAll("DynamicBackColor","IIF(MOD(recno(), 2)=0, RGB(255,255,255) ,"+m.x +")" , "Column") Locate .Refresh Endwith Endproc Procedure KeyPress Lparameters nKeyCode, nShiftAltCtrl If nKeyCode=27 Thisform.Release Endi Enddefine * *-- EndDefine: ylist
can use the scrollable vfp containers classes described in my previous post instead the scrollable form (better and simple).can also use the vfp embed browser with same method (instead apie).can see each video in fullscreen (with IE message dialog).
Click on code to select [then copy] -click outside to deselect
*2*
*i remarked that the messageboxA in code *1* is too big to achieve the dialog.
*this code below use wscript.shell.popup with 4 lines of code to do the same job.
*its very usefull.it might be in previous post "messagebox API" but infortunatly i cannot modify it for provider editor reasons.it can be accessed easily with searcch engine.
*i dont find any support for unicode shell.popup
Local m.myvar
*could be m.myvar=filetostr(getfile('txt'))
TEXT to m.myvar pretext 7 noshow
Displays text in a pop-up message box.
intButton = object.Popup(strText,[nSecondsToWait],[strTitle],[nType])
Collapse imageArguments
object WshShell object.
strText String value containing the text you want to appear in the pop-up message box.
nSecondsToWait Optional. Numeric value indicating the maximum length of time (in seconds) you want the pop-up message box displayed.
strTitle Optional. String value containing the text you want to appear as the title of the pop-up message box.
nType Optional. Numeric value indicating the type of buttons and icons you want in the pop-up message box. These determine how the message box is used.
IntButton Integer value indicating the number of the button the user clicked to dismiss the message box. This is the value returned by the Popup method.
Collapse imageRemarks
The Popup method displays a message box regardless of which host executable file is running (WScript.exe or CScript.exe). If nSecondsToWaitis equals zero (the default), the pop-up message box remains visible until closed by the user. If nSecondsToWaitis is greater than zero, the pop-up message box closes after nSecondsToWait seconds. If you do not supply the argument strTitle, the title of the pop-up message box defaults to "Windows Script Host." The meaning of nType is the same as in the Microsoft Win32® application programming interface MessageBox function. The following tables show the values and their meanings. You can combine values in these tables.
NoteNote
To display text properly in RTL languages such as Hebrew or Arabic, add hex &h00100000 (decimal 1048576) to the nType parameter.
Button Types
Value Description
0 Show OK button.
1 Show OK and Cancel buttons.
2 Show Abort, Retry, and Ignore buttons.
3 Show Yes, No, and Cancel buttons.
4 Show Yes and No buttons.
5 Show Retry and Cancel buttons.
Icon Types
Value Description
16 Show "Stop Mark" icon.
32 Show "Question Mark" icon.
48 Show "Exclamation Mark" icon.
64 Show "Information Mark" icon.
The previous two tables do not cover all values for nType. For a complete list, see the Microsoft Win32 documentation.
The return value intButton denotes the number of the button that the user clicked. If the user does not click a button before nSecondsToWait seconds, intButton is set to -1.
Value Description
1 OK button
2 Cancel button
3 Abort button
4 Retry button
5 Ignore button
6 Yes button
7 No button
ENDTEXT
local oshell
oShell = Createobject('WScript.Shell')
oShell.Popup(m.myvar,0, 'a Wscript.Shell big message', 0+32+4096) &&4,16,48,64...
oshell=null
Important:All Codes above are tested on VFP9SP2 & windows 10 pro and IE11 emulation