Working with IE11 fullscreen apps from vfp
[Post 279] Youtube for TV is available on PC nowadays.i find it wonderfull (no adds,configurable,..and provided with a simple url) in previous code i have designed internetexplorer.application to embed the youtube but no fullscreen because its not easy to add dynamically some controls on the youtube web page even with some created scriptings. hopefully there is a simple vfp solution to drive any fullscreen web page from VFP. a top level form (showWindow=2) and with property alwaysontop and some cosmetics des the job. the apie and form are declared as public variables to interact. The follow code can benefite user with all the screen area (fullscreen) and shows always a button to close, hide/show the youtube. this button is a vfp form and its a direct way to interact with youtube.its movable (if needed only). if a web page is built by user ,can add some button+event to interact with it (close it in particular).but if you navigate to an url its not easy to interact with. i made a semi transparency to this form with known APIs.a button can hide the youtube (green small shape or show it red shape). on PC the mouse can be used to search,navigate on videos,...to move on video use also the left/right/up/down keyboard buttons. press esc (on bottom youtube page) to return previous page...to run a custom menu of urls with navigations (back,youtube,forward). Notes: *its the only one way to see youtube for ex (not supported with ie olecontrol embed on form for security problems) Internetexplorer.application is the write way as a real navigator. *make a project+config.fpw and compile an exe as desktop application. *generalized from previous post:http://yousfi.over-blog.com/2017/09/access-youtube-tv-from-vfp.html![]()
Click on code to select [then copy] -click outside to deselect
*1*created on thursday 11 of october 2018
*!* Youtube for TV is available on PC nowadays.i find it wonderfull (no adds,configurable,..and provided with a simple url)
*!* in previous code i have designed internetexplorer.application to embed the youtube but no fullscreen because its not easy to add some controls
*!* on the youtube web page even with some created scriptings.
*!* hopefully there is a simple vfp solution to drive any fullscreen web page from VFp.
*!* a top level form (showWindow=2) and with property alwaysontop and some cosmetics do the job.
*!* the apie and form are public variables to interact.
*!* The follow code can benefite user with all the screen area (fullscreen) and shows always a button to close, hide/show the youtube.
*!* this button is a vfp form and its a direct way to interact with youtube.its movable (if needed only).
*!* if a web page is built by user ,can add some button+event to interact with it (close it in particular).but if you navigate to an url its not easy to interact with.
*!* i made a semi transparency to this form w<ith known APIs.a button can hide the youtube (green small shape or show it red shape).
*!* on PC the mouse can be used to search,navigate on videos,...to move on video use also the left/right/up/down keyboard buttons.
*!* press esc (on bottom youtube page) to return previous page...to run a custom menu of urls with navigations (back,youtube,forward).
*!* previous post:http://yousfi.over-blog.com/2017/09/access-youtube-tv-from-vfp.html
if !_vfp.startmode=0
on shutdown quit
endi
declare integer BringWindowToTop in user32 integer HWND
publi apie
apie=newObject("internetexplorer.application")
with apie
.navigate("https://www.youtube.com/tv#/browse-sets?c=default&resume")
.fullscreen=1
BringWindowToTop(.HWND)
.visible=.T.
endwith
inke(2)
*do form yexit
PUBLIC oform
oform=newObject("yexit")
oform.Show
read events
RETURN
*
DEFINE CLASS yexit AS form
BorderStyle = 0
Top = 0
Left = 0
Height = 94+14
Width = 70
ShowWindow = 2
ShowTips = .T.
Caption = ""
ControlBox = .F.
MaxButton = .F.
MinButton = .F.
MaxWidth =70
MinWidth = 20
MousePointer = 0
AlwaysOnTop = .T.
BackColor = RGB(12,12,12)
Name = "Form1"
ADD OBJECT label1 AS label with ;
AutoSize = .T., ;
FontBold = .T., ;
FontSize = 48, ;
BackStyle = 0, ;
Caption = "X", ;
Height = 79, ;
Left = 8, ;
MousePointer = 15, ;
Top = 10, ;
Width = 45, ;
ForeColor = RGB(255,128,0), ;
ToolTipText = "Close the navigator/exit", ;
Name = "Label1"
ADD OBJECT yshp AS shape with ;
Top = 2,;
Left = 1,;
Height = 10,;
Width = 10,;
Curvature = 99,;
MousePointer = 15,;
ToolTipText = "show/hide apie",;
BackColor = RGB(0,255,0),;
Name = "yshp"
ADD OBJECT yhelp AS shape with ;
Top = 2,;
Left = 1+15,;
Height = 10,;
Width = 10,;
Curvature = 99,;
MousePointer = 15,;
ToolTipText = "Help",;
BackColor = RGB(255,255,0),;
Name = "yhelp"
ADD OBJECT ymove AS shape with ;
Top = 2,;
Left = 1+15+15,;
Height = 10,;
Width = 10,;
Curvature = 99,;
MousePointer = 15,;
ToolTipText = "Move/mousedown",;
BackColor = RGB(0,255,255),;
Name = "ymove"
ADD OBJECT ymenu AS shape with ;
Top = 2,;
Left = 1+15+15+15,;
Height = 10,;
Width = 10,;
Curvature = 99,;
MousePointer = 15,;
ToolTipText = "Urls",;
BackColor = RGB(255,0,255),;
Name = "ymenu"
ADD OBJECT ybg AS shape with ;
Top = 70+7+4,;
Left = 5,;
Height = 22,;
Width = 50,;
Curvature = 0,;
BackStyle=0,;
borderwidth=2,;
bordercolor=RGB(255,255,255),;
Name = "ybg"
ADD OBJECT xlabel1 AS label with ;
AutoSize = .T., ;
FontBold = .F., ;
FontName = "Webdings", ;
FontSize = 12, ;
BackStyle = 0, ;
Caption = "3", ;
Height = 32, ;
Left = 0+5+5, ;
MousePointer = 15, ;
Top = 70+7+5, ;
Width = 30, ;
ForeColor = RGB(0,255,0), ;
ToolTipText = "Back", ;
Name = "xLabel1"
ADD OBJECT xlabel2 AS label with ;
AutoSize = .T., ;
FontBold = .F., ;
FontName = "Webdings", ;
FontSize = 12, ;
BackStyle = 0, ;
Caption = "4", ;
Height = 32, ;
Left = 29+5+5, ;
MousePointer = 15, ;
Top = 70+7+5, ;
Width = 30, ;
ForeColor = RGB(0,255,0), ;
ToolTipText = "Forward", ;
Name = "xLabel2"
ADD OBJECT xlabel3 AS label with ;
AutoSize = .T., ;
FontBold = .T., ;
FontName = "Arial Black", ;
FontSize = 12, ;
BackStyle = 0, ;
Caption = "o", ;
Height = 40, ;
Left = 17+5+5, ;
MousePointer = 15, ;
Top = 70+7+3, ;
Width = 20, ;
ForeColor = RGB(255,0,0), ;
ToolTipText = "Youtube", ;
Name = "xLabel3"
procedure label1.mouseEnter
lparameters nButton, nShift, nXCoord, nYCoord
this.forecolor=255
endproc
procedure label1.mouseLeave
lparameters nButton, nShift, nXCoord, nYCoord
this.forecolor=RGB(255,128,0)
endproc
PROCEDURE xlabel1.Click
try
apie.goback()
catch
endtry
ENDPROC
PROCEDURE xlabel2.Click
try
apie.goforward()
catch
endtry
ENDPROC
PROCEDURE xlabel3.Click
try
apie.navigate("https://www.youtube.com/tv#/browse-sets?c=default&resume")
catch
endtry
ENDPROC
PROCEDURE ymenu.Click
DEFINE POPUP raccourci SHORTCUT RELATIVE FROM MROW(),MCOL()
DEFINE BAR 1 OF raccourci PROMPT "El Khabar" FONT "Courier New", 8 style "BI" COLOR G/W*, B/W*,,,,W+/GR
DEFINE BAR 2 OF raccourci PROMPT "MSN News" FONT "Courier New", 8 style "BI" COLOR G/W*, B/W*,,,,W+/GR
DEFINE BAR 3 OF raccourci PROMPT "Spoutnik" FONT "Courier New", 8 style "BI" COLOR G/W*, B/W*,,,,W+/GR
DEFINE BAR 4 OF raccourci PROMPT "Huffington post" FONT "Courier New", 8 style "BI" COLOR G/W*, B/W*,,,,W+/GR
DEFINE BAR 5 OF raccourci PROMPT "El Heddef" FONT "Courier New", 8 style "BI" COLOR G/W*, B/W*,,,,W+/GR
DEFINE BAR 6 OF raccourci PROMPT "Algerie patriotique" FONT "Courier New", 8 style "BI" COLOR G/W*, B/W*,,,,W+/GR
DEFINE BAR 7 OF raccourci PROMPT "Youtube" FONT "Courier New", 8 style "BI" COLOR G/W*, B/W*,,,,W+/GR
DEFINE BAR 8 OF raccourci PROMPT "El Jazeera doc" FONT "Courier New", 8 style "BI" COLOR G/W*, B/W*,,,,W+/GR
DEFINE BAR 9 OF raccourci PROMPT "Animal world live" FONT "Courier New", 8 style "BI" COLOR G/W*, B/W*,,,,W+/GR
DEFINE BAR 10 OF raccourci PROMPT "Music relax" FONT "Courier New", 8 style "BI" COLOR G/W*, B/W*,,,,W+/GR
*can add another custom urls
on SELECTION BAR 1 OF raccourci _screen.activeform.ynav ("http://www.elkhabar.com/")
on SELECTION BAR 2 OF raccourci _screen.activeform.ynav ("https://www.msn.com/fr-fr/actualite/france")
on SELECTION BAR 3 OF raccourci _screen.activeform.ynav ("https://fr.sputniknews.com/")
on SELECTION BAR 4 OF raccourci _screen.activeform. ynav ("http://www.huffpostmaghreb.com/algerie/")
on SELECTION BAR 5 OF raccourci _screen.activeform. ynav ("http://www.lebuteur.com/")
on SELECTION BAR 6 OF raccourci _screen.activeform. ynav ("https://www.algeriepatriotique.com/")
on SELECTION BAR 7 OF raccourci _screen.activeform. ynav ("https://www.youtube.com/tv#/browse-sets?c=default&resume")
on SELECTION BAR 8 OF raccourci _screen.activeform. ynav ("https://www.youtube.com/tv#/watch/video/idle?v=_7cSIDJD4f8&resume")
on SELECTION BAR 9 OF raccourci _screen.activeform. ynav ("https://www.youtube.com/tv#/watch/video/control?v=FuKhZBIO0cA&resume")
on SELECTION BAR 10 OF raccourci _screen.activeform. ynav ("https://www.youtube.com/tv#/watch/video/control?v=NuIAYHVeFYs&resume")
ACTIVATE POPUP raccourci
PROCEDURE ynav()
lparameters url
try
apie.navigate(url)
catch
endtry
ENDPROC
PROCEDURE ymove.mousedown
lparameters nButton, nShift, nXCoord, nYCoord
*DECLARE INTEGER GetFocus IN WIN32API
lnHandle = THISFORM.HWND &&getFocus()
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)
ENDPROC
PROCEDURE yshp.Click
try
with this
.BackColor=iif(.BackColor=RGB(0,255,0),255,RGB(0,255,0))
if .BackColor=RGB(0,255,0)
apie.visible=.T.
else
apie.visible=.F.
endi
endwith
catch
endtry
ENDPROC
PROCEDURE yhelp.Click
local m.myvar
TEXT to m.myvar pretext 7 noshow
*created on thursday 11 of october 2018
Youtube for TV is available on PC nowadays.i find it wonderfull (no adds,configurable,..and provided with a simple url)
in previous code i have designed internetexplorer.application to embed the youtube but no fullscreen because its not easy to add some controls
on the youtube web page even with some created scriptings.
hopefully there is a simple vfp solution to drive any fullscreen web page from VFp.
a top level form (showWindow=2) and with property alwaysontop and some cosmetics do the job.
the apie and form are public variables to interact.
The follow code can benefite user with all the screen area (fullscreen) and shows always a button to close, hide/show the youtube.
this button is a vfp form and its a direct way to interact with youtube.its movable (if needed only).
if a web page is built by user ,can add some button+event to interact with it (close it in particular).but if you navigate to an url its not easy to interact with.
i made a semi transparency to this form w<ith known APIs.a button can hide the youtube (green small shape or show it red shape).
on PC the mouse can be used to search,navigate on videos,...to move on video use also the left/right/up/down keyboard buttons.
press esc (on bottom youtube page) to return previous page...to run a custom menu of urls with navigations (back,youtube,forward).
previous post:http://yousfi.over-blog.com/2017/09/access-youtube-tv-from-vfp.html
ENDTEXT
local oshell
oshell = Createobject('WScript.Shell')
oshell.POPUP(m.myvar,0, 'Summary help', 0+32+4096) &&4,16,48,64...
oshell=Null
ENDPROC
PROCEDURE Destroy
clea events
ENDPROC
PROCEDURE Click
this.AlwaysOnTop=.T.
ENDPROC
PROCEDURE rightclick
this.AlwaysOnTop=.T.
ENDPROC
PROCEDURE load
DECLARE SetWindowLong In Win32Api Integer, Integer, Integer
DECLARE SetLayeredWindowAttributes In Win32Api Integer, String, Integer, Integer
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
ENDPROC
PROCEDURE Init
with this
.titlebar=0
.Width=60
.Left=sysmetric(1)-.Width-17
.Top=4
endwith
#DEFINE GWL_EXSTYLE -20
#DEFINE WS_EX_LAYERED 0x80000
#DEFINE LWA_COLORKEY 1
#DEFINE LWA_ALPHA 2
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, 190,LWA_ALPHA)
ENDPROC
PROCEDURE label1.Click
try
apie.quit
release apie
THISFORM.release
catch
THISFORM.release &&in case apie closed (alt+f4)
endtry
ENDPROC
ENDDEFINE
*
*-- EndDefine: yexit
Click on code to select [then copy] -click outside to deselect
*2*created on sunday 21 of october 2018
*IE11 without titlebar and always fullscreen resized.
*this is the same code as above *1* but with a faked fullscreen ie mode.
*in old ie versions we can install a fullscreen mode and resize it to (left,top,width,height) wanted on desktop but without any titlebar.this behavior was deprecated early with microsoft.
*and nowadays cannot with apie properties(left,top,width,height) resize the fullscreen after installed it (can do it with ie and titlebar visible only programmatly or with apie.resizable=1 property).
*this is a method i found to do this job (ie11 here is always fullscreen without any titlebar).it uses the setWindowpos Api.
_screen.windowstate=1
if !_vfp.startmode=0
on shutdown quit
endi
declare integer BringWindowToTop in user32 integer HWND
Declare Long SetWindowPos In user32 Long HWnd, Long hWndInsertAfter, Long x, Long Y, Long cx, Long cy, Long wFlags
publi apie
apie=newObject("internetexplorer.application")
with apie
.navigate("https://www.youtube.com/tv#/browse-sets?c=default&resume")
.fullscreen=1
BringWindowToTop(.HWND)
inkey(2)
publi m.x,m.y,m.w,m.h
m.x=0 &&left
m.y=0 &&top
m.w=900 &&width
m.h=650 &&height
SetWindowPos(.HWND,0,m.x,m.y,m.w,m.h,64)
apie.resizable=.T.
.visible=.T.
endwith
inke(2)
PUBLIC oform
oform=newObject("yexit")
oform.Show
read events
RETURN
*
DEFINE CLASS yexit AS form
BorderStyle = 0
Top = 0
Left = 0
Height = 199
Width = 120
ShowWindow = 2
ShowTips = .T.
Caption = ""
ControlBox = .F.
MaxButton = .F.
MinButton = .F.
MinWidth = 20
MousePointer = 0
AlwaysOnTop = .T.
BackColor = RGB(12,12,12)
Name = "Form1"
delta=20 &&property for positionning apie
Add object label1 AS label with ;
AutoSize = .T., ;
FontBold = .T., ;
FontSize = 48, ;
BackStyle = 0, ;
Caption = "X", ;
Height = 79, ;
Left = 8, ;
MousePointer = 15, ;
Top = 10, ;
Width = 45, ;
ForeColor = RGB(255,128,0), ;
ToolTipText = "Close the navigator/exit", ;
Name = "Label1"
Add object yshp AS shape with ;
Top = 2,;
Left = 1,;
Height = 10,;
Width = 10,;
Curvature = 99,;
MousePointer = 15,;
ToolTipText = "show/hide apie",;
BackColor = RGB(0,255,0),;
Name = "yshp"
Add object yhelp AS shape with ;
Top = 2,;
Left = 16,;
Height = 10,;
Width = 10,;
Curvature = 99,;
MousePointer = 15,;
ToolTipText = "Help",;
BackColor = RGB(255,255,0),;
Name = "yhelp"
Add object ymove AS shape with ;
Top = 2,;
Left = 31,;
Height = 10,;
Width = 10,;
Curvature = 99,;
MousePointer = 15,;
ToolTipText = "Move/mousedown",;
BackColor = RGB(0,255,255),;
Name = "ymove"
Add object ymenu AS shape with ;
Top = 2,;
Left = 46,;
Height = 10,;
Width = 10,;
Curvature = 99,;
MousePointer = 15,;
ToolTipText = "Urls",;
BackColor = RGB(255,0,255),;
Name = "ymenu"
Add object ybg AS shape with ;
Top =81,;
Left = 5,;
Height = 22,;
Width = 50,;
Curvature = 0,;
BackStyle=0,;
borderwidth=2,;
bordercolor=RGB(255,255,255),;
Name = "ybg"
Add object xlabel1 AS label with ;
AutoSize = .T., ;
FontBold = .F., ;
FontName = "Webdings", ;
FontSize = 12, ;
BackStyle = 0, ;
Caption = "3", ;
Height = 32, ;
Left = 0+5+5, ;
MousePointer = 15, ;
Top = 82, ;
Width = 30, ;
ForeColor = RGB(0,255,0), ;
ToolTipText = "Back", ;
Name = "xLabel1"
Add object xlabel2 AS label with ;
AutoSize = .T., ;
FontBold = .F., ;
FontName = "Webdings", ;
FontSize = 12, ;
BackStyle = 0, ;
Caption = "4", ;
Height = 32, ;
Left = 39, ;
MousePointer = 15, ;
Top = 82, ;
Width = 30, ;
ForeColor = RGB(0,255,0), ;
ToolTipText = "Forward", ;
Name = "xLabel2"
Add object xlabel3 AS label with ;
AutoSize = .T., ;
FontBold = .T., ;
FontName = "Arial Black", ;
FontSize = 12, ;
BackStyle = 0, ;
Caption = "o", ;
Height = 40, ;
Left = 27, ;
MousePointer = 15, ;
Top = 80, ;
Width = 20, ;
ForeColor = RGB(255,0,0), ;
ToolTipText = "Youtube", ;
Name = "xLabel3"
Add object ycont AS ycont with;
Top=111,;
Left=0,;
Name="ycont"
procedure label1.mouseEnter
lparameters nButton, nShift, nXCoord, nYCoord
this.ForeColor=255
endproc
procedure label1.mouseLeave
lparameters nButton, nShift, nXCoord, nYCoord
this.ForeColor=RGB(255,128,0)
endproc
procedure xlabel1.Click
try
apie.goback()
catch
endtry
endproc
procedure xlabel2.Click
try
apie.goforward()
catch
endtry
endproc
procedure xlabel3.Click
try
apie.navigate("https://www.youtube.com/tv#/browse-sets?c=default&resume")
catch
endtry
endproc
procedure ymenu.Click
DEFINE POPUP raccourci SHORTCUT RELATIVE FROM MROW(),MCOL()
DEFINE BAR 1 OF raccourci PROMPT "El Khabar" FONT "Courier New", 8 style "BI" COLOR G/w*, B/w*,,,,w+/GR
DEFINE BAR 2 OF raccourci PROMPT "MSN News" FONT "Courier New", 8 style "BI" COLOR G/w*, B/w*,,,,w+/GR
DEFINE BAR 3 OF raccourci PROMPT "Spoutnik" FONT "Courier New", 8 style "BI" COLOR G/w*, B/w*,,,,w+/GR
DEFINE BAR 4 OF raccourci PROMPT "Huffington post" FONT "Courier New", 8 style "BI" COLOR G/w*, B/w*,,,,w+/GR
DEFINE BAR 5 OF raccourci PROMPT "El Heddef" FONT "Courier New", 8 style "BI" COLOR G/w*, B/w*,,,,w+/GR
DEFINE BAR 6 OF raccourci PROMPT "Algerie patriotique" FONT "Courier New", 8 style "BI" COLOR G/w*, B/w*,,,,w+/GR
DEFINE BAR 7 OF raccourci PROMPT "Youtube" FONT "Courier New", 8 style "BI" COLOR G/w*, B/w*,,,,w+/GR
DEFINE BAR 8 OF raccourci PROMPT "El Jazeera doc" FONT "Courier New", 8 style "BI" COLOR G/w*, B/w*,,,,w+/GR
DEFINE BAR 9 OF raccourci PROMPT "Animal world live" FONT "Courier New", 8 style "BI" COLOR G/w*, B/w*,,,,w+/GR
DEFINE BAR 10 OF raccourci PROMPT "Music relax" FONT "Courier New", 8 style "BI" COLOR G/w*, B/w*,,,,w+/GR
*can add another custom urls
on SELECTION BAR 1 OF raccourci _screen.activeform.ynav ("http://www.elkhabar.com/")
on SELECTION BAR 2 OF raccourci _screen.activeform.ynav ("https://www.msn.com/fr-fr/actualite/france")
on SELECTION BAR 3 OF raccourci _screen.activeform.ynav ("https://fr.sputniknews.com/")
on SELECTION BAR 4 OF raccourci _screen.activeform. ynav ("http://www.huffpostmaghreb.com/algerie/")
on SELECTION BAR 5 OF raccourci _screen.activeform. ynav ("http://www.lebuteur.com/")
on SELECTION BAR 6 OF raccourci _screen.activeform. ynav ("https://www.algeriepatriotique.com/")
on SELECTION BAR 7 OF raccourci _screen.activeform. ynav ("https://www.youtube.com/tv#/browse-sets?c=default&resume")
on SELECTION BAR 8 OF raccourci _screen.activeform. ynav ("https://www.youtube.com/tv#/watch/video/idle?v=_7cSIDJD4f8&resume")
on SELECTION BAR 9 OF raccourci _screen.activeform. ynav ("https://www.youtube.com/tv#/watch/video/control?v=FuKhZBIO0cA&resume")
on SELECTION BAR 10 OF raccourci _screen.activeform. ynav ("https://www.youtube.com/tv#/watch/video/control?v=NuIAYHVeFYs&resume")
ACTIVATE POPUP raccourci
procedure ynav()
lparameters url
try
apie.navigate(url)
catch
endtry
endproc
procedure ymove.mousedown &&move the form
lparameters nButton, nShift, nXCoord, nYCoord
*DECLARE INTEGER GetFocus IN WIN32API
lnHandle = THISFORM.HWND &&getFocus()
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)
endproc
procedure yshp.Click
try
with this
.BackColor=iif(.BackColor=RGB(0,255,0),255,RGB(0,255,0))
if .BackColor=RGB(0,255,0)
apie.visible=.T.
else
apie.visible=.F.
endi
endwith
catch
endtry
endproc
procedure yhelp.Click
local m.myvar
TEXT to m.myvar pretext 7 noshow
*created on thursday 11 of october 2018
Youtube for TV is available on PC nowadays.i find it wonderfull (no adds,configurable,..and provided with a simple url)
in previous code i have designed internetexplorer.application to embed the youtube but no fullscreen because its not easy to add some controls
on the youtube web page even with some created scriptings.
hopefully there is a simple vfp solution to drive any fullscreen web page from VFp.
a top level form (showWindow=2) and with property alwaysontop and some cosmetics do the job.
the apie and form are public variables to interact.
The follow code can benefite user with all the screen area (fullscreen) and shows always a button to close, hide/show the youtube.
this button is a vfp form and its a direct way to interact with youtube.its movable (if needed only).
if a web page is built by user ,can add some button+event to interact with it (close it in particular).but if you navigate to an url its not easy to interact with.
i made a semi transparency to this form w<ith known APIs.a button can hide the youtube (green small shape or show it red shape).
on PC the mouse can be used to search,navigate on videos,...to move on video use also the left/right/up/down keyboard buttons.
press esc (on bottom youtube page) to return previous page...to run a custom menu of urls with navigations (back,youtube,forward).
previous post:http://yousfi.over-blog.com/2017/09/access-youtube-tv-from-vfp.html
ENDTEXT
local oshell
oshell = Createobject('WScript.Shell')
oshell.POPUP(m.myvar,0, 'Summary help', 0+32+4096) &&4,16,48,64...
oshell=Null
endproc
procedure Destroy
apie=Null
release apie
release m.x,m.y,m.w,m.h
clea events
endproc
procedure Click
this.AlwaysOnTop=.T.
endproc
procedure rightclick
this.AlwaysOnTop=.T.
endproc
procedure load
DECLARE SetWindowLong In Win32Api Integer, Integer, Integer
DECLARE SetLayeredWindowAttributes In Win32Api Integer, String, Integer, Integer
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
endproc
procedure Init
with this
.titlebar=0
.Width=60
.Left=sysmetric(1)-.Width-17
.Top=4
endwith
#DEFINE GWL_EXSTYLE -20
#DEFINE WS_EX_LAYERED 0x80000
#DEFINE LWA_COLORKEY 1
#DEFINE LWA_ALPHA 2
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, 190,LWA_ALPHA)
endproc
procedure label1.Click
try
apie.quit
release apie
THISFORM.release
catch
THISFORM.release &&in case apie closed (alt+f4)
endtry
endproc
ENDDEFINE
*
*-- EndDefine: yexit
DEFINE CLASS ycont AS container &&positioning apie on 4 directions
Width = 60
Height = 86
BackStyle=0
borderwidth=1
bordercolor=RGB(255,255,0)
Name = "ycont"
*delta=10 && IE window positioning increment
Add object image1 AS image with ;
Picture = home(1)+"graphics\icons\arrows\arw08up.ico", ;
Stretch = 2, ;
BackStyle = 1, ;
Height = 15, ;
Left = 22, ;
MousePointer = 15, ;
Top = 0, ;
Width = 15, ;
Name = "Image1"
Add object image2 AS image with ;
Picture = home(1)+"graphics\icons\arrows\arw08dn.ico", ;
Stretch = 2, ;
BackStyle = 1, ;
Height = 15, ;
Left = 22, ;
MousePointer = 15, ;
Top = 31, ;
Width = 15, ;
Name = "Image2"
Add object image3 AS image with ;
Picture = home(1)+"graphics\icons\arrows\arw08rt.ico", ;
Stretch = 2, ;
BackStyle = 1, ;
Height = 15, ;
Left = 39, ;
MousePointer = 15, ;
Top = 15, ;
Width = 15, ;
Name = "Image3"
Add object image4 AS image with ;
Picture =home(1)+"graphics\icons\arrows\arw08lt.ico", ;
Stretch = 2, ;
BackStyle = 1, ;
Height = 15, ;
Left = 0+5, ;
MousePointer = 15, ;
Top = 17, ;
Width = 15, ;
Name = "Image4"
Add object spinnerW AS spinner with ;
Left=3 ,;
Top=55 ,;
Width=20,;
Height=25,;
value=0,;
spinnerLowValue=-200,;
spinnerHighValue=200,;
KeyboardLowValue=-200,;
KeyboardHighValue=200,;
MousePointer=15,;
ToolTipText="Change apie width",;
increment=10,;
Name="spinnerW"
Add object yfs AS shape with ;
Top = 55,;
Left =24,;
Height = 10,;
Width = 10,;
Curvature = 99,;
MousePointer = 15,;
ToolTipText = "apie fullscreen",;
BackColor = RGB(0,255,0),;
Name = "yfs"
Add object spinnerH AS spinner with ;
Left=35 ,;
Top=55 ,;
Width=20,;
Height=25,;
value=0,;
spinnerLowValue=-200,;
spinnerHighValue=200,;
KeyboardLowValue=-200,;
KeyboardHighValue=200,;
MousePointer=15,;
ToolTipText="Change apie height",;
ToolTipText="Change apie height",;
Name="spinnerH"
procedure Init
dodefault()
endproc
procedure yfs.Click
if !vartype(apie)="O"
RETURN .F.
endi
apie.fullscreen=1
m.x=0
m.y=0
m.w=sysmetric(1)
m.h=sysmetric(2)
endproc
procedure image1.Click
if !vartype(apie)="O"
RETURN .F.
endi
SetWindowPos(apie.HWND,0,m.x,m.y-THISFORM.delta,m.w,m.h,64)
m.y=m.y-10
endproc
procedure image2.Click
if !vartype(apie)="O"
RETURN .F.
endi
SetWindowPos(apie.HWND,0,m.x,m.y+THISFORM.delta,m.w,m.h,64)
m.y=m.y+10
endproc
procedure image3.Click
if !vartype(apie)="O"
RETURN .F.
endi
SetWindowPos(apie.HWND,0,m.x+THISFORM.delta,m.y,m.w,m.h,64)
m.x=m.x+10
endproc
procedure image4.Click
if !vartype(apie)="O"
RETURN .F.
endi
SetWindowPos(apie.HWND,0,m.x-THISFORM.delta,m.y,m.w,m.h,64)
m.x=m.x-10
endproc
procedure spinnerW.interactiveChange
if !vartype(apie)="O"
RETURN .F.
endi
m.w=m.w+this.value
SetWindowPos(apie.HWND,0,m.x,m.y,m.w,m.h,64)
endproc
procedure spinnerH.interactiveChange
if !vartype(apie)="O"
RETURN .F.
endi
m.h=m.h+this.value
SetWindowPos(apie.HWND,0,m.x,m.y,m.w,m.h,64)
endproc
ENDDEFINE
*
*-- EndDefine: ycont
Click on code to select [then copy] -click outside to deselect
*3*created on monday 22of october 2018
*Another solution to use ie11 as viewer without titlebar is to use windows APIs
*this is the same code as above *1* but the titlebar is cut with windows APIs.
*this is a method i found to do this job (ie11 here is always without any titlebar on a normal windows desserving viewing urls (or local html files).
*it uses also the setWindowpos Api to be controlled from VFP.
*can also cretae a project and add a config.fpw and compile an exe.
*Note: use ALT+F4 to close any window in problem occurs
_screen.windowstate=1
if !_vfp.startmode=0
on shutdown quit
endi
do ydeclare
publi apie
apie=newObject("internetexplorer.application")
with apie
.navigate("https://www.youtube.com/tv#/browse-sets?c=default&resume")
.toolbar=0
.menubar=0
.statusbar=0
.width=1024
.height=650
*center apie
.left=(sysmetric(1)-.width)/2
.top=(sysmetric(2)-.height)/2
.resizable=0 && no resize for borders=0 (1 for resizable but with a top border appearing)
bringWindowtoTop(.hwnd)
publi m.x,m.y,m.w,m.h &&public variables to modify dynamically in code.
m.x=0 &&left
m.y=0 &&top
m.w=1024 &&width
m.h=650 &&height
SetWindowPos(.hwnd,0,m.x,m.y,m.w,m.h,64)
.resizable=1 &&here window resizable manually by mousedown
.visible=.T.
endwith
*cut the IE titlebar
#DEFINE GWL_STYLE -16
#DEFINE WS_CAPTION 0x00C00000
#DEFINE WS_THICKFRAME 0x00040000
#DEFINE WS_DLGFRAME 0x00400000
LOCAL lnStyle, lnNewStyle
* Get the current style of the window
lnStyle = GetWindowLong(apie.hwnd, GWL_STYLE)
* Remove the border of the window
lnNewStyle = BITXOR(lnStyle, WS_CAPTION)
* Set the new style for the window
SetWindowLong(apie.hwnd, GWL_STYLE, lnNewStyle)
* This is to refresh the form (so the form re-draws itself)
apie.height = apie.height - 1
*create the top level form (alwaysonTop) to control apie.
PUBLIC oform
oform=newObject("yexit")
oform.Show
read events
RETURN
*
DEFINE CLASS yexit AS form
BorderStyle = 0
top = 0
left = 0
height = 199
width = 120
ShowWindow = 2
ShowTips = .T.
Caption = ""
ControlBox = .F.
MaxButton = .F.
MinButton = .F.
MinWidth = 20
MousePointer = 0
AlwaysOnTop = .T.
BackColor = RGB(12,12,12)
Name = "Form1"
delta=20 &&property for positionning apie
Add object label1 AS label with ;
AutoSize = .T., ;
FontBold = .T., ;
FontSize = 48, ;
BackStyle = 0, ;
Caption = "X", ;
height = 79, ;
left = 8, ;
MousePointer = 15, ;
top = 10, ;
width = 45, ;
ForeColor = RGB(255,128,0), ;
ToolTipText = "Close the navigator/exit", ;
Name = "Label1"
Add object yshp AS shape with ;
top = 2,;
left = 1,;
height = 10,;
width = 10,;
Curvature = 99,;
MousePointer = 15,;
ToolTipText = "show/hide apie",;
BackColor = RGB(0,255,0),;
Name = "yshp"
Add object yhelp AS shape with ;
top = 2,;
left = 16,;
height = 10,;
width = 10,;
Curvature = 99,;
MousePointer = 15,;
ToolTipText = "Help",;
BackColor = RGB(255,255,0),;
Name = "yhelp"
Add object ymove AS shape with ;
top = 2,;
left = 31,;
height = 10,;
width = 10,;
Curvature = 99,;
MousePointer = 15,;
ToolTipText = "Move/mousedown",;
BackColor = RGB(0,255,255),;
Name = "ymove"
Add object ymenu AS shape with ;
top = 2,;
left = 46,;
height = 10,;
width = 10,;
Curvature = 99,;
MousePointer = 15,;
ToolTipText = "Urls",;
BackColor = RGB(255,0,255),;
Name = "ymenu"
Add object ybg AS shape with ;
top =81,;
left = 5,;
height = 22,;
width = 50,;
Curvature = 0,;
BackStyle=0,;
borderwidth=2,;
bordercolor=RGB(255,255,255),;
Name = "ybg"
Add object xlabel1 AS label with ;
AutoSize = .T., ;
FontBold = .F., ;
FontName = "Webdings", ;
FontSize = 12, ;
BackStyle = 0, ;
Caption = "3", ;
height = 32, ;
left = 0+5+5, ;
MousePointer = 15, ;
top = 82, ;
width = 30, ;
ForeColor = RGB(0,255,0), ;
ToolTipText = "Back", ;
Name = "xLabel1"
Add object xlabel2 AS label with ;
AutoSize = .T., ;
FontBold = .F., ;
FontName = "Webdings", ;
FontSize = 12, ;
BackStyle = 0, ;
Caption = "4", ;
height = 32, ;
left = 39, ;
MousePointer = 15, ;
top = 82, ;
width = 30, ;
ForeColor = RGB(0,255,0), ;
ToolTipText = "Forward", ;
Name = "xLabel2"
Add object xlabel3 AS label with ;
AutoSize = .T., ;
FontBold = .T., ;
FontName = "Arial Black", ;
FontSize = 12, ;
BackStyle = 0, ;
Caption = "o", ;
height = 40, ;
left = 27, ;
MousePointer = 15, ;
top = 80, ;
width = 20, ;
ForeColor = RGB(255,0,0), ;
ToolTipText = "Youtube", ;
Name = "xLabel3"
Add object ycont AS ycont with;
top=111,;
left=0,;
Name="ycont"
procedure label1.mouseEnter
lparameters nButton, nShift, nXCoord, nYCoord
this.ForeColor=255
endproc
procedure label1.mouseLeave
lparameters nButton, nShift, nXCoord, nYCoord
this.ForeColor=RGB(255,128,0)
endproc
procedure xlabel1.Click
try
apie.goback()
catch
endtry
endproc
procedure xlabel2.Click
try
apie.goforward()
catch
endtry
endproc
procedure xlabel3.Click
try
apie.navigate("https://www.youtube.com/tv#/browse-sets?c=default&resume")
catch
endtry
endproc
procedure ymenu.Click
DEFINE POPUP raccourci SHORTCUT RELATIVE FROM MROW(),MCOL()
DEFINE BAR 1 OF raccourci PROMPT "El Khabar" FONT "Courier New", 8 style "BI" COLOR G/w*, B/w*,,,,w+/GR
DEFINE BAR 2 OF raccourci PROMPT "MSN News" FONT "Courier New", 8 style "BI" COLOR G/w*, B/w*,,,,w+/GR
DEFINE BAR 3 OF raccourci PROMPT "Spoutnik" FONT "Courier New", 8 style "BI" COLOR G/w*, B/w*,,,,w+/GR
DEFINE BAR 4 OF raccourci PROMPT "Huffington post" FONT "Courier New", 8 style "BI" COLOR G/w*, B/w*,,,,w+/GR
DEFINE BAR 5 OF raccourci PROMPT "El Heddef" FONT "Courier New", 8 style "BI" COLOR G/w*, B/w*,,,,w+/GR
DEFINE BAR 6 OF raccourci PROMPT "Algerie patriotique" FONT "Courier New", 8 style "BI" COLOR G/w*, B/w*,,,,w+/GR
DEFINE BAR 7 OF raccourci PROMPT "Youtube" FONT "Courier New", 8 style "BI" COLOR G/w*, B/w*,,,,w+/GR
DEFINE BAR 8 OF raccourci PROMPT "El Jazeera doc" FONT "Courier New", 8 style "BI" COLOR G/w*, B/w*,,,,w+/GR
DEFINE BAR 9 OF raccourci PROMPT "Animal world live" FONT "Courier New", 8 style "BI" COLOR G/w*, B/w*,,,,w+/GR
DEFINE BAR 10 OF raccourci PROMPT "Music relax" FONT "Courier New", 8 style "BI" COLOR G/w*, B/w*,,,,w+/GR
*can add another custom urls
on SELECTION BAR 1 OF raccourci _screen.activeform.ynav ("http://www.elkhabar.com/")
on SELECTION BAR 2 OF raccourci _screen.activeform.ynav ("https://www.msn.com/fr-fr/actualite/france")
on SELECTION BAR 3 OF raccourci _screen.activeform.ynav ("https://fr.sputniknews.com/")
on SELECTION BAR 4 OF raccourci _screen.activeform. ynav ("http://www.huffpostmaghreb.com/algerie/")
on SELECTION BAR 5 OF raccourci _screen.activeform. ynav ("http://www.lebuteur.com/")
on SELECTION BAR 6 OF raccourci _screen.activeform. ynav ("https://www.algeriepatriotique.com/")
on SELECTION BAR 7 OF raccourci _screen.activeform. ynav ("https://www.youtube.com/tv#/browse-sets?c=default&resume")
on SELECTION BAR 8 OF raccourci _screen.activeform. ynav ("https://www.youtube.com/tv#/watch/video/idle?v=_7cSIDJD4f8&resume")
on SELECTION BAR 9 OF raccourci _screen.activeform. ynav ("https://www.youtube.com/tv#/watch/video/control?v=FuKhZBIO0cA&resume")
on SELECTION BAR 10 OF raccourci _screen.activeform. ynav ("https://www.youtube.com/tv#/watch/video/control?v=NuIAYHVeFYs&resume")
ACTIVATE POPUP raccourci
procedure ynav()
lparameters url
try
apie.navigate(url)
catch
endtry
endproc
procedure ymove.mousedown &&move the form
lparameters nButton, nShift, nXCoord, nYCoord
*DECLARE INTEGER GetFocus IN WIN32API
lnHandle = THISFORM.hwnd &&getFocus()
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)
endproc
procedure yshp.Click
try
with this
.BackColor=iif(.BackColor=RGB(0,255,0),255,RGB(0,255,0))
if .BackColor=RGB(0,255,0)
apie.visible=.T.
else
apie.visible=.F.
endi
endwith
catch
endtry
endproc
procedure yhelp.Click
LOCAL m.myvar
TEXT to m.myvar pretext 7 noshow
*3*created on monday 22of october 2018
IE11 without titlebar with windows APIs
this is the same code as above *1* but the titlebar is cut with windows APIs.
this is a method i found to do this job (ie11 here is always without any titlebar on a normal windows desserving viewing urls (or local html files) ).
it uses also the setWindowpos Api to be controlled from VFP.
can also cretae a project and add a config.fpw and compile an exe.
ENDTEXT
LOCAL oshell
oshell = Createobject('WScript.Shell')
oshell.POPUP(m.myvar,0, 'Summary help', 0+32+4096) &&4,16,48,64...
oshell=Null
endproc
procedure Destroy
apie=Null
release apie
release m.x,m.y,m.w,m.h
clea events
endproc
procedure Click
this.AlwaysOnTop=.T.
endproc
procedure rightclick
this.AlwaysOnTop=.T.
endproc
procedure Init
with this
.titlebar=0
.width=60
.left=sysmetric(1)-.width-17
.top=4
endwith
#DEFINE GWL_EXSTYLE -20
#DEFINE WS_EX_LAYERED 0x80000
#DEFINE LWA_COLORKEY 1
#DEFINE LWA_ALPHA 2
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, 190,LWA_ALPHA)
endproc
procedure label1.Click
try
apie.quit
release apie
THISFORM.release
catch
THISFORM.release &&in case apie closed (alt+f4)
endtry
endproc
ENDDEFINE
*
*-- EndDefine: yexit
DEFINE CLASS ycont AS container &&positioning apie on 4 directions
width = 60
height = 86
BackStyle=0
borderwidth=1
bordercolor=RGB(255,255,0)
Name = "ycont"
*delta=10 && IE window positioning increment
Add object image1 AS image with ;
Picture = home(1)+"graphics\icons\arrows\arw08up.ico", ;
Stretch = 2, ;
BackStyle = 1, ;
height = 15, ;
left = 22, ;
MousePointer = 15, ;
top = 0, ;
width = 15, ;
Name = "Image1"
Add object image2 AS image with ;
Picture = home(1)+"graphics\icons\arrows\arw08dn.ico", ;
Stretch = 2, ;
BackStyle = 1, ;
height = 15, ;
left = 22, ;
MousePointer = 15, ;
top = 31, ;
width = 15, ;
Name = "Image2"
Add object image3 AS image with ;
Picture = home(1)+"graphics\icons\arrows\arw08rt.ico", ;
Stretch = 2, ;
BackStyle = 1, ;
height = 15, ;
left = 39, ;
MousePointer = 15, ;
top = 15, ;
width = 15, ;
Name = "Image3"
Add object image4 AS image with ;
Picture =home(1)+"graphics\icons\arrows\arw08lt.ico", ;
Stretch = 2, ;
BackStyle = 1, ;
height = 15, ;
left = 0+5, ;
MousePointer = 15, ;
top = 17, ;
width = 15, ;
Name = "Image4"
Add object spinnerW AS spinner with ;
left=3 ,;
top=55 ,;
width=20,;
height=25,;
value=0,;
spinnerLowValue=-200,;
spinnerHighValue=200,;
KeyboardLowValue=-200,;
KeyboardHighValue=200,;
MousePointer=15,;
ToolTipText="Change apie width",;
increment=10,;
Name="spinnerW"
Add object yfs AS shape with ;
top = 55,;
left =24,;
height = 10,;
width = 10,;
Curvature = 99,;
MousePointer = 15,;
ToolTipText = "apie fullscreen",;
BackColor = RGB(0,255,0),;
Name = "yfs"
Add object spinnerH AS spinner with ;
left=35 ,;
top=55 ,;
width=20,;
height=25,;
value=0,;
spinnerLowValue=-200,;
spinnerHighValue=200,;
KeyboardLowValue=-200,;
KeyboardHighValue=200,;
MousePointer=15,;
ToolTipText="Change apie height",;
ToolTipText="Change apie height",;
Name="spinnerH"
procedure Init
dodefault()
endproc
procedure yfs.Click
if !vartype(apie)="O"
RETURN .F.
endi
apie.fullscreen=1
m.x=0
m.y=0
m.w=sysmetric(1)
m.h=sysmetric(2)
endproc
procedure image1.Click
if !vartype(apie)="O"
RETURN .F.
endi
SetWindowPos(apie.hwnd,0,m.x,m.y-THISFORM.delta,m.w,m.h,64)
m.y=m.y-10
endproc
procedure image2.Click
if !vartype(apie)="O"
RETURN .F.
endi
SetWindowPos(apie.hwnd,0,m.x,m.y+THISFORM.delta,m.w,m.h,64)
m.y=m.y+10
endproc
procedure image3.Click
if !vartype(apie)="O"
RETURN .F.
endi
SetWindowPos(apie.hwnd,0,m.x+THISFORM.delta,m.y,m.w,m.h,64)
m.x=m.x+10
endproc
procedure image4.Click
if !vartype(apie)="O"
RETURN .F.
endi
SetWindowPos(apie.hwnd,0,m.x-THISFORM.delta,m.y,m.w,m.h,64)
m.x=m.x-10
endproc
procedure spinnerW.interactiveChange
if !vartype(apie)="O"
RETURN .F.
endi
m.w=m.w+this.value
SetWindowPos(apie.hwnd,0,m.x,m.y,m.w,m.h,64)
endproc
procedure spinnerH.interactiveChange
if !vartype(apie)="O"
RETURN .F.
endi
m.h=m.h+this.value
SetWindowPos(apie.hwnd,0,m.x,m.y,m.w,m.h,64)
endproc
ENDDEFINE
*
*-- EndDefine: ycont
procedure ydeclare
declare integer BringWindowToTop in user32 integer HWND
Declare Long SetWindowPos In user32 Long HWnd, Long hWndInsertAfter, Long x, Long Y, Long cx, Long cy, Long wFlags
DECLARE SetWindowLong In Win32Api Integer, Integer, Integer
DECLARE SetLayeredWindowAttributes In Win32Api Integer, String, Integer, Integer
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
endproc
here can resize ie window manually (mousedown)
|
|
|
|
Yousfi |
Important:All Codes above are tested on VFP9SP2 & windows 10 pro 64 bits version 1803 & IE11 emulation Navigator: firefox 62.0.2 64 bits - screen:32 pouces.