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