Web desktop based applications & transparency
Web technology can be used usefully on vfp form inside olecontrols (oleclass="shell.explorer.2").
the olecontrol must mandatory be emulated to work with latest web technologies (as IE11).
can build modern vfp apps with web ingredients.
in vfp ,transparency is natively blocked because windows gives automatically an unique numero to each
window( named handle HWND).
windows can set transparency only if the object have an HWND (in vfp its only the form natively).
And then transparency applied concerns all objects on the form at once.its not good result.
Web with CSS,CSS3 styles can apply to each element a transparency because each object have a property
Opacity(not defined in vfp).
Web can render as well transparency in a div ,image,element,...for ex.
if we give to each web element an unique Id,vfp can interact dynamically with the web code with the syntax:
(vfp_form).olecontrol.document.getElementById("x").property ...
that is suffisent to build a desktop vfp app decorated with web things.the menu is native vfp.
*Code rendered on 32 inches screen (if less that add form.scrollbar=1)
*Css used here is adapted from the web().
Warning: if you project to run here forms (because the olecontrol is alwaysonTop) ,must have modal forms mandatory with 2 properies:
ShowWindow = 1
Desktop=.T.
[Post 241]
Click on code to select [then copy] -click outside to deselect
*1* created on monday 06 of november 2017
*!* this code builds a main form as desktop application stylised with web ingredients.
*!* it uses transparency for creating a main text and a big image as background (2048x365)
*!* 2 images are used as titles & link to my website
*!* a menu grouped in a commandgroup object have 10 items.
*:* the form is a top level one and resizable (borderstyle=3).titlebar can be on/off.
*!* each button mousedown is binded to a personal method as demo only.
*!* this demonstrate how with vfp can create a desktop with modern look.
*!* it can be used as a basic template to build more complex application.can customize all images.
*!* 3 images are on my web site.can use local disk images.
*!*See at the form left the element div transparency applied.here no hwnd recquired and it renders the element concerned only (not all page
*!* issue ESC on visible form area or click button exit to cancel application.
*!* the code (+config.fpw) can build a project and compile to an exe desktop app.
*!* internet must be connected to access to web images (otherwise make local images instead).
Publi oform
oform=Newobject("ymain")
oform.Show
Read Events
Retu
*
Define Class ymain As Form
Top = 0
Left = 0
Height = 538
Width = 1058
ShowWindow = 2
Caption = "A web desktop application & transparency"
WindowState = 2
KeyPreview=.T.
BackColor = Rgb(212,210,208)
Name = "Form1"
Add Object olecontrol1 As OleControl With ;
oleclass="shell.explorer.2", ;
Top = 0, ;
Left = 0, ;
Height = 481, ;
Width = 1069, ;
Anchor = 15, ;
Name = "Olecontrol1"
Add Object commandgroup1 As CommandGroup With ;
AutoSize = .T., ;
ButtonCount = 10, ;
Anchor = 768, ;
BackStyle = 1, ;
BorderStyle = 1, ;
Value = 1, ;
Height = 37, ;
Left = 60, ;
MousePointer = 15, ;
Top = 502, ;
Width = 875, ;
BackColor = Rgb(255,255,255), ;
BorderColor = Rgb(255,255,255), ;
Name = "Commandgroup1", ;
Command1.AutoSize = .F., ;
Command1.Top = 5, ;
Command1.Left = 5, ;
Command1.Height = 27, ;
Command1.Width = 84, ;
Command1.Caption = "Command1", ;
Command1.Name = "Command1", ;
Command2.AutoSize = .F., ;
Command2.Top = 5, ;
Command2.Left = 91, ;
Command2.Height = 27, ;
Command2.Width = 84, ;
Command2.Caption = "Command2", ;
Command2.Name = "Command2", ;
Command3.AutoSize = .F., ;
Command3.Top = 5, ;
Command3.Left = 177, ;
Command3.Height = 27, ;
Command3.Width = 84, ;
Command3.Caption = "Command3", ;
Command3.Name = "Command3", ;
Command4.AutoSize = .F., ;
Command4.Top = 5, ;
Command4.Left = 263, ;
Command4.Height = 27, ;
Command4.Width = 84, ;
Command4.Caption = "Command4", ;
Command4.Name = "Command4", ;
Command5.AutoSize = .F., ;
Command5.Top = 5, ;
Command5.Left = 349, ;
Command5.Height = 27, ;
Command5.Width = 84, ;
Command5.Caption = "Command5", ;
Command5.Name = "Command5", ;
Command6.AutoSize = .F., ;
Command6.Top = 5, ;
Command6.Left = 435, ;
Command6.Height = 27, ;
Command6.Width = 84, ;
Command6.Caption = "Command6", ;
Command6.Name = "Command6", ;
Command7.AutoSize = .F., ;
Command7.Top = 5, ;
Command7.Left = 521, ;
Command7.Height = 27, ;
Command7.Width = 84, ;
Command7.Caption = "Command7", ;
Command7.Name = "Command7", ;
Command8.AutoSize = .F., ;
Command8.Top = 5, ;
Command8.Left = 607, ;
Command8.Height = 27, ;
Command8.Width = 84, ;
Command8.Caption = "Help", ;
Command8.Name = "Command8", ;
Command9.AutoSize = .F., ;
Command9.Top = 5, ;
Command9.Left = 693, ;
Command9.Height = 27, ;
Command9.Width = 84, ;
Command9.Caption = "Titlebar", ;
Command9.Name = "Command9", ;
Command10.AutoSize = .F., ;
Command10.Top = 5, ;
Command10.Left = 779, ;
Command10.Height = 27, ;
Command10.Width = 91, ;
Command10.Caption = "Exit", ;
Command10.Name = "Command10"
Procedure KeyPress
Lparameters nKeyCode, nShiftAltCtrl
If nKeyCode=27
Thisform.Release &&give focus on form area out of olecontrol
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.BackColor=Rgb(0,0,64)
N=Int(Val(Substr(loObject.Name,8)))
If Inlist(N,1,2,3,4,5,6,7)
Messagebox(loObject.Name+" clicked! can write some code from here!",0+32+4096,'',1500) &&only for not used buttons
Endi
Do Case
Case N=1
*
Case N=2
*
Case N=3
*
Case N=4
*
Case N=5
*
Case N=6
*
Case N=7
Case N=8
local m.myvar
text to m.myvar pretext 7 noshow
this code builds a main form as desktop application stylised with web ingredients.
it uses transparency for creating a main text and a big image as background (2048x365)
2 images are used as titles & link to my website
a menu grouped in a commandgroup object have 10 items.
the form is a top level one and resizable (borderstyle=3).titlebar can be on/off.
each button mousedown is binded to a personal method as demo only.
this demonstrate how with vfp can create a desktop with modern look.
it can be used as a basic template to build more complex application.can customize all images.
3 images are on my web site.can use local disk images.
See at the form left the element div transparency applied.here no hwnd recquired and it renders the element concerned only (not all page)!
issue ESC on visible form area or click button exit to cancel application.
the code (+config.fpw) can build a project and compile to an exe desktop app.
internet must be connected to access to web images (otherwise make local images instead).
Warning: if you project to run here forms (because the olecontrol is alwaysonTop) ,must have modal forms mandatory with 2 properies:
ShowWindow = 1 and Desktop=. T.
endtext
Local oshell
oshell = Createobject('WScript.Shell')
oshell.Popup(m.myvar,0, 'Summary help', 0+32+4096) &&4,16,48,64...
oshell=Null
Case N=9
Thisform.TitleBar=Iif(Thisform.TitleBar=1,0,1)
If Thisform.TitleBar=0
Thisform.Height=Thisform.Height+31
Else
Thisform.Height=Thisform.Height-31
Endi
Case N=10
Thisform.Release
Endcase
loObject.BackColor=Rgb(0,255,0)
Endproc
Procedure my1
Lparameters nButton, nShift, nXCoord, nYCoord
*--- aevent create an array laEvents
Aevents( myArray, 0)
*--- reference the calling object
loObject = myArray[1]
loObject.BackColor=255
Endproc
Procedure my2
Lparameters nButton, nShift, nXCoord, nYCoord
*--- aevent create an array laEvents
Aevents( myArray, 0)
*--- reference the calling object
loObject = myArray[1]
loObject.BackColor=Rgb(0,255,0)
Endproc
Procedure Destroy
oform=null
release oform
Clea Events
Endproc
Procedure olecontrol1.Init
This.silent=.T.
Local m.yrep
m.yrep=Addbs(Justpath(Sys(16,1)))
This.Navigate("about:blank")
Inke(0.5)
Local m.myvar
TEXT to m.myvar textmerge noshow
<!DOCTYPE html><html class=''>
<head>
<link rel='stylesheet prefetch' href='https://cdnjs.cloudflare.com/ajax/libs/normalize/5.0.0/normalize.min.css'>
<style >
body {
background: url('http://img.over-blog-kiwi.com/1/43/54/07/20171106/ob_6a64c7_taghit.jpg');
background-size: cover;
background-position: center;
}
.ytranspa {
height: 520px;
width: 600px;
background: rgba(0, 0, 0, 0.6);
margin: 20px;
}
.ytranspa h2 {
text-align: center;
padding: 10px;
color: #fff;
text-shadow: 1px 1px 1px #000;
}
.ytranspa p {
padding: 10px;
}
</style>
</head>
<body>
<img src='http://img.over-blog-kiwi.com/1/43/54/07/20171108/ob_4b1b52_ylogorup.png' style="display: block" width="1109px; " height="80px; ">
<div class="ytranspa">
<h2>This is my Title</h2><p style="color: #e2e2e2;">Fill with any text you want. Can type a long text,with tags < p > in the box </p>
<p style="color:lime;">
Lorem ipsum dolor sit amet, consectetur adipiscing elit. Proin vel risus eget lorem feugiat
fermentum nec a turpis. Phasellus purus sem, mollis ac posuere eget, ornare vel orci. Sed ac rutrum
nulla. Aenean ultrices eget lectus eu efficitur. In hac habitasse platea dictumst. Nulla in iaculis nisi.
Nullam et pulvinar tellus. Donec arcu dui, efficitur a odio non, porta congue dolor. Aenean viverra
auctor sagittis. Integer lobortis dignissim auctor. Proin et volutpat massa.
</p>
<p style="color:gold;font:bold;">
Cras vitae felis venenatis, egestas sem quis, sodales neque. Donec venenatis hendrerit odio, non
pellentesque metus scelerisque ac. Suspendisse aliquet rhoncus odio id viverra. Vestibulum feugiat
lectus a nisl pulvinar, in tempor metus eleifend. Nunc id odio quam. Praesent egestas lorem ut
sollicitudin consectetur. Vestibulum id bibendum est. Ut vel lacus sapien. Quisque eget molestie
sem. Integer eget purus eu orci molestie aliquam quis in ante. Integer a magna eget lectus finibus
porttitor. Donec fringilla sapien a quam aliquet, pellentesque blandit nisl placerat. Nam hendrerit
velit vel ex aliquam, eget convallis ante mollis.
</p>
<p style="color:bisque;font-family: Segoe UI,Frutiger,Frutiger Linotype,Dejavu Sans,Helvetica Neue,Arial,sans-serif;font-size: 24px;font-style: italic;font-variant:normal;font-weight:500;line-height:26.4px;font-bold:bold;float:right;">
Looking forward to seeing you and seeing you again !
<p><br><BR>
</div>
<div ><a href="http://www.yousfi.over-blog.com" target="_blank"><img src='http://img.over-blog-kiwi.com/1/43/54/07/20171106/ob_457211_ylogo.png' style="display: block;float:right;"></a></div>
</body></html>
ENDTEXT
With This.Document
.Open()
.Write(m.myvar)
.Close()
Endwith
Endproc
Procedure MouseMove
Lparameters nButton, nShift, nXCoord, nYCoord
Thisform.commandgroup1.Command1.SetFocus &&to give focus in form menu out of olecontrol
Endproc
Procedure commandgroup1.Init
With This
.Left=(.Parent.Width-.Width)/2
.SetAll("mousepointer",15,"commandbutton")
.SetAll("backcolor",Rgb (0,255,0),"commandbutton")
.SetAll("fontbold",.T.,"commandbutton")
.SetAll("specialeffect",2,"commandbutton")
For i=1 To .ButtonCount
If i<=7
.Buttons(i).Caption="My Menu"+Trans(i)
Endi
Bindevent(.Buttons(i),"mousedown",Thisform,"my")
Bindevent(.Buttons(i),"mouseEnter",Thisform,"my1")
Bindevent(.Buttons(i),"mouseLeave",Thisform,"my2")
Endfor
Endwith
Endproc
Enddefine
*
*-- EndDefine: ymain
see the web transparency at the form left.no hwnd required and it render an element concerned only.
Click on code to select [then copy] -click outside to deselect
*2* created on monday 06 of november 2017
Publi yform
yform=Newobject("ytransparency")
yform.Show
Read Events
Retu
*
Define Class ytransparency As Form
BorderStyle = 3
Height = 668
Width = 1367
ShowWindow = 2
AutoCenter = .T.
Caption = "Around Web transparencies"
alpha = 0
Name = "Form1"
Add Object olecontrol1 As OleControl With ;
oleclass="shell.explorer.2", ;
Top = 12, ;
Left = 58, ;
Height = 290, ;
Width = 520, ;
Anchor = 0, ;
Name = "Olecontrol1"
Add Object timer1 As Timer With ;
Top = 24, ;
Left = 60, ;
Height = 23, ;
Width = 23, ;
Enabled = .F., ;
Interval = 400, ;
Name = "Timer1"
Add Object olecontrol2 As OleControl With ;
oleclass="shell.explorer.2", ;
Top = 2, ;
Left = 612, ;
Height = 611, ;
Width = 756, ;
Anchor = 0, ;
Name = "Olecontrol2"
Add Object olecontrol3 As OleControl With ;
oleclass="shell.explorer.2", ;
Top = 345, ;
Left = 59, ;
Height = 290, ;
Width = 520, ;
Anchor = 0, ;
Name = "Olecontrol3"
Add Object spinner1 As Spinner With ;
Height = 24, ;
Increment = 0.10, ;
InputMask = "999.99", ;
KeyboardHighValue = 1, ;
KeyboardLowValue = 0, ;
Left = 264, ;
MousePointer = 15, ;
SpinnerHighValue = 1.00, ;
SpinnerLowValue = 0.00, ;
Top = 639, ;
Width = 84, ;
Value = 0.6, ;
Name = "Spinner1"
Add Object spinner2 As Spinner With ;
Height = 24, ;
Increment = 0.10, ;
InputMask = "999.99", ;
KeyboardHighValue = 1, ;
KeyboardLowValue = 0, ;
Left = 756, ;
MousePointer = 15, ;
SpinnerHighValue = 1.00, ;
SpinnerLowValue = 0.00, ;
Top = 624, ;
Width = 79, ;
Value = 0.6, ;
Name = "Spinner2"
Add Object label1 As Label With ;
AutoSize = .T., ;
BackStyle = 0, ;
Caption = "Change transparency", ;
Height = 17, ;
Left = 631, ;
Top = 631, ;
Width = 120, ;
Name = "Label1"
Add Object label2 As Label With ;
AutoSize = .T., ;
BackStyle = 0, ;
Caption = "Change transparency", ;
Height = 17, ;
Left = 138, ;
Top = 645, ;
Width = 120, ;
Name = "Label2"
Add Object label3 As Label With ;
AutoSize = .T., ;
WordWrap = .T., ;
BackStyle = 0, ;
Caption = "VFP can traverse the web opacity property with a timer and rebuild the html contents as well.", ;
Height = 32, ;
Left = 65, ;
Top = 306, ;
Width = 324, ;
Name = "Label3"
Add Object check1 As Checkbox With ;
Top = 625, ;
Left = 871, ;
Height = 17, ;
Width = 58, ;
AutoSize = .T., ;
Alignment = 0, ;
Caption = "Radius", ;
Value = 1, ;
MousePointer = 15, ;
Name = "Check1"
Add Object command1 As CommandButton With ;
AutoSize = .T., ;
Top = 619, ;
Left = 939, ;
Height = 27, ;
Width = 65, ;
FontBold = .T., ;
Caption = "BgColor", ;
MousePointer = 15, ;
BackColor = Rgb(0,255,0), ;
Name = "Command1"
Add Object command2 As CommandButton With ;
AutoSize = .T., ;
Top = 618, ;
Left = 1006, ;
Height = 27, ;
Width = 50, ;
FontBold = .T., ;
Caption = "Color", ;
MousePointer = 15, ;
BackColor = Rgb(0,255,0), ;
Name = "Command2"
Add Object command3 As CommandButton With ;
AutoSize = .T., ;
Top = 620, ;
Left = 1067, ;
Height = 27, ;
Width = 102, ;
FontBold = .T., ;
Caption = "Image random", ;
MousePointer = 15, ;
BackColor = Rgb(0,255,0), ;
Name = "Command3"
Procedure yhtmlcolor
*a shortest to convert RGB color to HTML color used in web (now can use rgb and even RGBA color in web !)
Lparameters xcol
xhtml_color=Chrtran("123456","563412",Right(Trans(m.xcol ,"@0"),6))
Return "#"+xhtml_color
Endproc
Procedure Init
#Define xbg Rgb(212,210,208)
This.BackColor=xbg
Thisform.timer1.Enabled=.T.
Thisform.WindowState=2
Endproc
Procedure Activate
With This &&avoid the vfp bug titlebar caption in form.windowstate=2
.WindowState=0
Inkey(0.3)
.WindowState=2
Endwith
Endproc
Procedure Destroy
yform=null
release yform
Clea Events
Endproc
Procedure olecontrol1.Init
This.silent=.T.
This.Navigate("about:blank")
Inke(0.2)
nAlpha=0.5
Local m.myvar
TEXT to m.myvar textmerge noshow
<!DOCTYPE html>
<html>
<head>
<style>
div {
background:rgb(0,0,0);
background:url(http://p2.storage.canalblog.com/20/24/763987/55549657.jpg) no-repeat;
width:100%;
height:<<this.height-20>>px;
background-size:cover;
padding:0px 0px 5px 5px;
}
</style>
</head>
<body background=black scroll="no">
<div id="yb" style="opacity:<<nAlpha>>";"></div>
</body>
</html>
ENDTEXT
With This
.Document.Open()
.Document.Write(m.myvar)
.Document.Close()
Endwith
Endproc
Procedure timer1.Timer
Thisform.alpha=Thisform.alpha+0.1
If Thisform.alpha>1
Thisform.alpha=0
Endi
Thisform.olecontrol1.Document.GetElementById("yb").Style.opacity=Thisform.alpha
Endproc
Procedure olecontrol2.Init
This.silent=.T.
This.Navigate("about:blank")
Inke(0.2)
Local m.myvar
TEXT to m.myvar textmerge noshow
<!DOCTYPE html>
<html>
<head>
<style>
div.background {
background: url(http://www.floornature.eu/media/photos/34/5034/01_dubai_popup.jpg) repeat;
border: 2px solid black;
width:100%;
height:<<this.height-20>>px;
background-size:cover;
padding:0px 0px 5px 0px;
}
div.transbox {
margin: 30px;
background-color: #ffffff;
border: 1px solid black;
border-radius: 25px;
opacity: 0.6;
filter: alpha(opacity=60); /* For IE8 and earlier */
}
div.transbox p {
margin: 5%;
font-weight: bold;
color: red; //#000000;
}
</style>
</head>
<body scroll="no">
<div class="background" id="ybg">
<div id="yb" class="transbox">
<p id="yb1" >This is some text that is placed in the transparent box.(div.transbox CSS class)<br>
can adjust interactively with the spinner the value of opacity( 0- 100%).<br>
the image is stretched to exact area div with CSS3 attribute :[ background-size:cover;]<br>
Lorem ipsum dolor sit amet, consectetur adipiscing elit. Proin vel risus eget lorem feugiat<br>
fermentum nec a turpis. Phasellus purus sem, mollis ac posuere eget, ornare vel orci. Sed ac rutrum<br>
nulla. Aenean ultrices eget lectus eu efficitur. In hac habitasse platea dictumst. Nulla in iaculis nisi.<br>
Nullam et pulvinar tellus. Donec arcu dui, efficitur a odio non, porta congue dolor. Aenean viverra<br>
auctor sagittis. Integer lobortis dignissim auctor. Proin et volutpat massa.
<br>
</p>
</div>
</div>
</body>
</html>
ENDTEXT
With This
.Document.Open()
.Document.Write(m.myvar)
.Document.Close()
Endwith
Endproc
Procedure olecontrol3.Init
This.silent=.T.
This.Navigate("about:blank")
Inke(0.2)
nAlpha=0.5
Local m.myvar
TEXT to m.myvar textmerge noshow
<!DOCTYPE html>
<html>
<head>
<style>
div {
background:rgb(0,0,0);
background:url(https://thumbnails.trvl-media.com/_E1uxhsTUuSQFMmCIHK6nonh7vE=/768x432/images.trvl-media.com/media/content/shared/images/travelguides/destination/1079/Dubai-56828.jpg) repeat;
width:100%;
height:<<thisform.olecontrol1.height-40>>px;
background-size:cover;
padding:0px 0px 0px 0px;
}
h2 {color:maroon;}
</style>
</head>
<body background=black scroll="no">
<div id="yb" style="opacity:<<nAlpha>>";">
<center><h2> this is an opacity test</h2> </center>
</div>
</body>
</html>
ENDTEXT
With This
.Document.Open()
.Document.Write(m.myvar)
.Document.Close()
Endwith
Endproc
Procedure spinner1.InteractiveChange
Thisform.olecontrol3.Document.GetElementById("yb").Style.opacity=This.Value
Endproc
Procedure spinner2.InteractiveChange
Thisform.olecontrol2.Document.GetElementById("yb").Style.opacity=This.Value
Endproc
Procedure check1.Click
Thisform.olecontrol2.Document.GetElementById("yb").Style.borderRadius=Iif(This.Value=0,"0","25px")
Endproc
Procedure command1.Click
Local m.xcolor
m.xcolor=Getcolor()
If !m.xcolor=-1
Thisform.olecontrol2.Document.GetElementById("yb").Style.backgroundColor=Thisform.yhtmlcolor(m.xcolor)
Endi
Endproc
Procedure command2.Click
Local m.xcolor
m.xcolor=Getcolor()
If !m.xcolor=-1
Thisform.olecontrol2.Document.GetElementById("yb1").Style.Color=Thisform.yhtmlcolor(m.xcolor)
Endi
Endproc
Procedure command3.Click
Set Memowidth To 8192
Local m.myvar
TEXT to m.myvar noshow
https://encrypted-tbn0.gstatic.com/images?q=tbn:ANd9GcQCfyM-lV49RlNugpel9I0ml6P0tln021NMHyt8EZp1WQOawNFecQ
http://images.all-free-download.com/images/graphicthumb/dubai_marina_516235.jpg
https://s-ec.bstatic.com/images/hotel/max1024x768/705/70555770.jpg
https://encrypted-tbn0.gstatic.com/images?q=tbn:ANd9GcTUPFCraDXMj1zhHbUWVn8ssUlLXuFOxylevo0Iq0pKGF0jwZ9B
ENDTEXT
Local N,yimage,m.uu
N=Int((Memlines(m.myvar))*Rand( ) + 1)
m.yimage=Allt(Mline(m.myvar,N))
m.uu=["url(]+m.yimage+')"'
Thisform.olecontrol2.Document.GetElementById("ybg").Style.backgroundimage=Eval(m.uu)
Endproc
Enddefine
*
*-- EndDefine: ytransparency
Of course can integrate all web subjects as animations,transitions,videos,voice,widgets,....
Click on code to select [then copy] -click outside to deselect
*3* this code plays any youtube video.
*the function below receives a youtube video url (embed-can the integration code [<iframe>......</iframe>]obtain by rightclick on any youtube playing video )
*the internet application is used here (emulation IE11 recquired).can resize the window or ven make the youtbe inbuilt fullscreen....
*i set for the fun a custom icon and titlebar title.
*internet must be connected.
_screen.windowstate=1
Do ydeclare
Local m.lcUrl
m.lcUrl="https://www.youtube.com/embed/fA_dBVxcPCo" &&integration youtube url to put here
yview(m.lcUrl)
Function yview()
Lparameters url
Declare Integer BringWindowToTop In user32 Integer
Local m.myvar
TEXT to m.myvar textmerge noshow
<iframe width=100% height=100% src="<<url>>" frameborder="0" gesture="media" allowfullscreen></iframe>
ENDTEXT
Local apie
apie=Newobject("internetexplorer.application")
With apie
.Navigate("about:blank")
.menubar=0
.Toolbar=0
.StatusBar=0
.Resizable=1
Inke(1)
.Document.Open()
.Document.Write(m.myvar)
.Document.Close()
.Document.body.Style.background="#000000" && black
BringWindowToTop(.HWnd)
.Width=1100
.Height=700
.Visible=.T.
Inke(1.5)
SetWindowText(.HWnd, "Playing video: "+url)
**changing ie icon
*Constants for SendMessage second parameter
#Define WM_GETICON 0x7F
#Define WM_SETICON 0x80
*Constants for SendMessage third parameter
#Define ICON_SMALL 0
#Define ICON_BIG 1
lnHWND=apie.HWnd
lnIcon = ExtractIcon (0,Home(1)+"GRAPHICS\ICONS\misc\camera.ICO",0)
SendMessage(lnHWND, WM_SETICON, ICON_SMALL, lnIcon)
Endwith
Endfunc
Procedure ydeclare
Declare Integer BringWindowToTop In user32 Integer
Declare Integer SetWindowText In user32 Integer HWnd, String lpString
Declare Integer ExtractIcon In shell32 Integer hInst, String lpszExeFileName, Integer lpiIcon
Declare Integer SendMessage In user32 Integer HWnd, Integer Msg, Integer wParam, Integer Lparam
Endproc
Click on code to select [then copy] -click outside to deselect
*4* created on tuesday 08 of november 2017
*another desktop application template
*a web collapsible menu with css (can adapt many from web searches).
*read the help in the running code below.
*internet connection recquired.
*designed for 32 pouces screen (can set form.minWidth property if resizing)
*Note:2 classes based container can be used out of this application
publi yform
yform=newObject("yapp")
yform.show
read events
retu
*
DEFINE CLASS yApp AS form
Top = 0
Left = 0
Height = 603
Width = 1382
ShowWindow = 2
Caption = "Another desktop application template"
BackColor = RGB(212,210,208)
*minWidth=1400
*minHeight=750
*scrollbars=1 && if you have a screen<32 inches (adapt)
Name = "Form1"
ADD OBJECT olecontrol1 AS olecontrol WITH ;
oleclass="shell.explorer.2", ;
Top = 45, ;
Left = 0, ;
Height = 552, ;
Width = 1405, ;
Anchor = 15, ;
Name = "Olecontrol1"
PROCEDURE Destroy
clea events
ENDPROC
PROCEDURE KeyPress
LPARAMETERS nKeyCode, nShiftAltCtrl
if nkeycode=27
thisform.release
endi
ENDPROC
PROCEDURE Init
_screen.windowstate=1
sys(2002)
with this
.AddObject("ycnt_shapes1","ycnt_shapes") &&class below
with .ycnt_shapes1
.borderwidth=0
.left=2
.top=-10
.anchor=768
.visible=.t.
endwith
.AddObject("ycnt_options1","ycnt_options") &&class below
with .ycnt_options1
.borderwidth=0
.left=thisform.ycnt_shapes1.left+thisform.ycnt_shapes1.width-40
.width=thisform.width-.left-10
.top=1
.ylab.top=2
.anchor=768
.visible=.t.
endwith
.windowstate=2
endwith
ENDPROC
PROCEDURE olecontrol1.Init
this.silent=.t.
local m.myvar
text to m.myvar textmerge noshow
<!DOCTYPE html>
<html lang="en">
<head>
<meta charset="utf-8">
<meta name="viewport" content="width=device-width, initial-scale=1">
<meta http-equiv="x-ua-compatible" content="ie=edge" />
<title></title>
<link rel="stylesheet prefetch" href="https://preview.codepad.co/css/normalize.min.css"/>
<style>
body, html {
margin: 0;
padding: 0;
}
@import url('https://preview.codepad.co/redirect?url=http://fonts.googleapis.com/css?family=Open+Sans+Condensed:300');
@import url('https://preview.codepad.co/redirect?url=http://fonts.googleapis.com/css?family=Handlee');
html,
body {
margin: 0;
padding: 0;
border: 0;
width: 100%;
height: 100%;
overflow: hidden;
background-color:#212121;
font-family: 'Open Sans Condensed', sans-serif;
color: gold; //#F5F5F5;
background: url('http://img.over-blog-kiwi.com/1/43/54/07/20171108/ob_f5e0e6_rup.jpg');
background-size: cover;
background-position: center;
}
.menu .menu-content {
-webkit-transition-duration: 1s;
-moz-transition-duration: 1s;
-ms-transition-duration: 1s;
-o-transition-duration: 1s;
transition-duration: 1s;
float: left;
width: 12em;
background: rgba(0, 0, 0, 0.6); //rgba(72,72,72,0.8);
}
.menu .menu-content h2 {
font-family: 'Handlee', cursive;
font-weight: normal;
margin-left: 1em;
}
.menu .menu-content ul {
list-style: none;
}
.menu li,
.menu label {
color: #BDBDBD;
cursor: pointer;
-webkit-transition-duration: 1.0s;
-moz-transition-duration: 1.0s;
-ms-transition-duration: 1.0s;
-o-transition-duration: 1.0s;
transition-duration: 1.0s;
}
.menu li:hover,
.menu label:hover {
-webkit-transition-duration: 0.3s;
-moz-transition-duration: 0.3s;
-ms-transition-duration: 0.3s;
-o-transition-duration: 0.3s;
transition-duration: 0.3s;
color: lime; //rgba(255,255,0,1); //rgba(252, 251, 250, 0.9);
}
.menu .menu-switch {
padding-top: 0.em;
}
.menu .menu-switch label {
font-size: 3em;
font-family: 'Open Sans Condensed', sans-serif;
color:lime;
}
.menu input {
display: none;
}
.menu #menu-collapsed:checked ~ .menu-content {
margin-left: -12em;
}
.menu #menu-collapsed:checked ~ .menu-switch .rise {
display: block;
}
.menu #menu-collapsed:checked ~ .menu-switch .collapse {
display: none;
}
.menu #menu-collapsed ~ .menu-switch .rise {
display: none;
}
a {text-decoration: none;color:inherit;}
</style>
</head>
<body>
<img src='http://img.over-blog-kiwi.com/1/43/54/07/20171108/ob_4b1b52_ylogorup.png' style="display: block" width="1109px; " height="80px;">
<div class="menu">
<input type="checkbox" id="menu-collapsed" name="menu-collapsed" />
<div class="menu-content">
<h2>Collapsible menu</h2>
<ul>
<li><a href="http://www.yousfi.over-blog.com" TARGET="_BLANK" >1.my blog</a></li>
<li><a href="#" TARGET="_BLANK" >2. Proin vel</a></li>
<li><a href="#" TARGET="_BLANK" >3. risus eget</a></li>
<li><a href="#" TARGET="_BLANK" >4. lorem feugiat</a></li>
<li><a href="#" TARGET="_BLANK" >5. fermentum nec</a></li>
<li><a href="#" TARGET="_BLANK" >6. a turpis</a></li>
<li><a href="#" TARGET="_BLANK" >7. Phasellus purus</a></li>
<li><a href="#" TARGET="_BLANK" >8. sem mollis</a></li>
<li><a href="http://www.yousfi.over-blog.com" TARGET="_BLANK" >9. my blog</a></li>
<li><a href="#" TARGET="_BLANK" >10. ac posuere</a></li>
<li><a href="#" TARGET="_BLANK" >11. eget ornare</a></li>
<li><a href="#" TARGET="_BLANK" >12. vel orci</li>
<li><a href="#" TARGET="_BLANK" >13. Sed ac rutrum</a></li>
<li><a href="#" TARGET="_BLANK" >14. Aenean ultrices</a></li>
<li><a href="#" TARGET="_BLANK" >15. eget lectus</a></li>
<li><a href="#" TARGET="_BLANK" >16. Any link</li>
<li><a href="http://www.yousfi.over-blog.com" TARGET="_BLANK" >17. my blog</a></li>
<li><a href="#" TARGET="_BLANK" >18. eu efficitur</a></li>
<li><a href="#"TARGET="_BLANK" >19. In hac habitasse</a></li>
<li><a href="#" TARGET="_BLANK" >20. platea dictumst</a></li>
<li><a href="#" TARGET="_BLANK" >21. Nulla in iaculis</a></li>
<li><a href="#" TARGET="_BLANK" >22. Nullam et pulvinar</a></li>
<li><a href="#" TARGET="_BLANK" >23. Donec arcu dui</a></li>
<li><a href="#" TARGET="_BLANK" >24. Aenean viverra</a></li>
</ul>
</div>
<div class="menu-switch">
<label Id="ych" class="collapse" for="menu-collapsed">«</label>
<label class="rise" for="menu-collapsed">»</label>
</div>
</div>
<div ><a href="http://www.yousfi.over-blog.com" target="_blank"><img src='http://img.over-blog-kiwi.com/1/43/54/07/20171106/ob_457211_ylogo.png' style="display: block;float:right;margin-top:<<thisform.height-50>>px;margin-right:30px;"></a></div>
</body>
</html>
</body>
</html>
endtext
this.navigate('about:blank')
inke(1)
with this.document
.open()
.write(m.myvar)
.close()
endwith
ENDPROC
ENDDEFINE
*
*-- EndDefine: yApp
DEFINE CLASS ycnt_shapes AS container
Top = 9
Left = 37
Width = 396
Height = 48
BackStyle = 0
BorderWidth = 1
Name = "yCnt_Shapes"
ADD OBJECT shape1 AS shape WITH ;
Top = 12, ;
Left = 12, ;
Height = 20, ;
Width = 27, ;
BorderWidth = 2, ;
Curvature = 15, ;
MousePointer = 15, ;
SpecialEffect = 0, ;
BackColor = RGB(0,255,0), ;
Name = "Shape1"
ADD OBJECT shape2 AS shape WITH ;
Top = 12, ;
Left = 49, ;
Height = 20, ;
Width = 27, ;
BorderWidth = 2, ;
Curvature = 15, ;
MousePointer = 15, ;
SpecialEffect = 0, ;
BackColor = RGB(0,255,0), ;
Name = "Shape2"
ADD OBJECT shape3 AS shape WITH ;
Top = 12, ;
Left = 89, ;
Height = 20, ;
Width = 27, ;
BorderWidth = 2, ;
Curvature = 15, ;
MousePointer = 15, ;
SpecialEffect = 0, ;
BackColor = RGB(0,255,0), ;
Name = "Shape3"
ADD OBJECT shape4 AS shape WITH ;
Top = 12, ;
Left = 128, ;
Height = 20, ;
Width = 27, ;
BorderWidth = 2, ;
Curvature = 30, ;
MousePointer = 15, ;
SpecialEffect = 0, ;
BackColor = RGB(0,255,0), ;
Name = "Shape4"
ADD OBJECT shape5 AS shape WITH ;
Top = 12, ;
Left = 166, ;
Height = 20, ;
Width = 27, ;
BorderWidth = 2, ;
Curvature = 15, ;
MousePointer = 15, ;
SpecialEffect = 0, ;
BackColor = RGB(0,255,0), ;
Name = "Shape5"
ADD OBJECT shape6 AS shape WITH ;
Top = 12, ;
Left = 205, ;
Height = 20, ;
Width = 27, ;
BorderWidth = 2, ;
Curvature = 15, ;
MousePointer = 15, ;
SpecialEffect = 0, ;
BackColor = RGB(0,255,0), ;
Name = "Shape6"
ADD OBJECT shape7 AS shape WITH ;
Top = 12, ;
Left = 245, ;
Height = 20, ;
Width = 27, ;
BorderWidth = 2, ;
Curvature = 15, ;
MousePointer = 15, ;
SpecialEffect = 0, ;
BackColor = RGB(0,255,0), ;
Name = "Shape7"
ADD OBJECT shape8 AS shape WITH ;
Top = 12, ;
Left = 280, ;
Height = 20, ;
Width = 27, ;
BorderWidth = 2, ;
Curvature = 15, ;
MousePointer = 15, ;
SpecialEffect = 0, ;
BackColor = RGB(0,255,0), ;
Name = "Shape8"
ADD OBJECT shape9 AS shape WITH ;
Top = 12, ;
Left = 316, ;
Height = 20, ;
Width = 27, ;
BorderWidth = 2, ;
Curvature = 15, ;
MousePointer = 15, ;
SpecialEffect = 0, ;
BackColor = RGB(0,255,0), ;
tooltiptext="Change backcolor"
Name = "Shape9"
ADD OBJECT shape10 AS shape WITH ;
Top = 12, ;
Left = 357, ;
Height = 20, ;
Width = 27, ;
BorderWidth = 2, ;
Curvature = 15, ;
MousePointer = 15, ;
SpecialEffect = 0, ;
BackColor = RGB(0,255,0), ;
Name = "Shape10"
PROCEDURE Init
with this
.parent.showtips=.t.
.backstyle=0
.borderwidth=0
.setall("width",25,"shape")
.setall("height",25,"shape")
.setall("curvature",99,"shape") &&circles
*.setall("borderstyle",0,"shape")
rand(-1)
for i=1 to .controlcount
with .controls(i)
.backcolor=rgb(255*rand(),255*rand(),255*rand())
.mousepointer=15
do case
case i<=8
.tooltiptext="Menu"+trans(i)
case i=9
.tooltiptext="Change backcolor"
case i=10
.tooltiptext="Collapse/expand menu"
endcase
endwith
endfor
endwith
for i=1 to this.controlcount
bindevent(this.controls(i),"mousedown",this,"mys")
bindevent(this.controls(i),"mouseENTER",this,"mys1")
bindevent(this.controls(i),"mouseLeave",this,"mys2")
endfor
ENDPROC
Procedure mys1
Lparameters nButton, nShift, nXCoord, nYCoord
*--- aevent create an array laEvents
Aevents( myArray, 0)
*--- reference the calling object
loObject = myArray[1]
thisform.ycnt_options1.ylab.caption=LoObject.tooltiptext
endproc
Procedure mys2
Lparameters nButton, nShift, nXCoord, nYCoord
*--- aevent create an array laEvents
Aevents( myArray, 0)
*--- reference the calling object
loObject = myArray[1]
thisform.ycnt_options1.ylab.caption=""
endproc
Procedure mys
Lparameters nButton, nShift, nXCoord, nYCoord
*--- aevent create an array laEvents
Aevents( myArray, 0)
*--- reference the calling object
loObject = myArray[1]
loObject.BackColor=Rgb(0,0,64)
thisform.ycnt_options1.ylab.caption=LoObject.tooltiptext
inkey(1)
thisform.ycnt_options1.ylab.caption=""
N=Int(Val(Substr(loObject.Name,6))) &&"shapeXX"
If Inlist(N,1,2,3,4,5,6,7,8)
Messagebox(loObject.Name+" clicked! can write some code from here!",0+32+4096,'',1500) &&only for not used buttons
Endi
Do Case
Case N=1
Case N=2
Case N=3
Case N=4
Case N=5
Case N=6
Case N=7
Case N=8
Case N=9
local m.xcolor
m.xcolor=getcolor()
if !m.xcolor=-1
thisform.backcolor=m.xcolor
endi
Case N=10
thisform.olecontrol1.document.getElementById("ych").click(.t.)
Endcase
loObject.BackColor=Rgb(0,255,0)
endproc
ENDDEFINE
*
*-- EndDefine: ycnt_shapes
*
DEFINE CLASS ycnt_options AS container
Width = 722+100
Height = 27
top=35
backstyle=0
borderwidth=0
Name = "ycnt_options"
ADD OBJECT optiongroup1 AS optiongroup WITH ;
AutoSize = .T., ;
ButtonCount = 10, ;
Anchor = 768, ;
BackStyle = 1, ;
Value = 1, ;
Height = 27, ;
Left = 0, ;
Top = 1, ;
Width = 708, ;
Name = "Optiongroup1", ;
Option1.Caption = "Option1", ;
Option1.Value = 1, ;
Option1.Height = 17, ;
Option1.Left = 5, ;
Option1.Style = 0, ;
Option1.Top = 5, ;
Option1.Width = 68, ;
Option1.AutoSize = .F., ;
Option1.Name = "Option1", ;
Option2.Caption = "Option2", ;
Option2.Height = 17, ;
Option2.Left = 75, ;
Option2.Style = 0, ;
Option2.Top = 5, ;
Option2.Width = 68, ;
Option2.AutoSize = .F., ;
Option2.Name = "Option2", ;
Option3.Caption = "Option3", ;
Option3.Height = 17, ;
Option3.Left = 145, ;
Option3.Style = 0, ;
Option3.Top = 5, ;
Option3.Width = 68, ;
Option3.AutoSize = .F., ;
Option3.Name = "Option3", ;
Option4.Caption = "Option4", ;
Option4.Height = 17, ;
Option4.Left = 215, ;
Option4.Style = 0, ;
Option4.Top = 5, ;
Option4.Width = 68, ;
Option4.AutoSize = .F., ;
Option4.Name = "Option4", ;
Option5.Caption = "Option5", ;
Option5.Height = 17, ;
Option5.Left = 285, ;
Option5.Style = 0, ;
Option5.Top = 5, ;
Option5.Width = 68, ;
Option5.AutoSize = .F., ;
Option5.Name = "Option5", ;
Option6.Caption = "Option6", ;
Option6.Height = 17, ;
Option6.Left = 355, ;
Option6.Style = 0, ;
Option6.Top = 5, ;
Option6.Width = 68, ;
Option6.AutoSize = .F., ;
Option6.Name = "Option6", ;
Option7.Caption = "Option7", ;
Option7.Height = 17, ;
Option7.Left = 425, ;
Option7.Style = 0, ;
Option7.Top = 5, ;
Option7.Width = 68, ;
Option7.AutoSize = .F., ;
Option7.Name = "Option7", ;
Option8.Caption = "Option8", ;
Option8.Height = 17, ;
Option8.Left = 495, ;
Option8.Style = 0, ;
Option8.Top = 5, ;
Option8.Width = 68, ;
Option8.AutoSize = .F., ;
Option8.Name = "Option8", ;
Option9.Caption = "Option9", ;
Option9.Height = 17, ;
Option9.Left = 565, ;
Option9.Style = 0, ;
Option9.Top = 5, ;
Option9.Width = 68, ;
Option9.AutoSize = .F., ;
Option9.Name = "Option9", ;
Option10.Caption = "Option10", ;
Option10.Height = 17, ;
Option10.Left = 635, ;
Option10.Style = 0, ;
Option10.Top = 5, ;
Option10.Width = 68, ;
Option10.AutoSize = .F., ;
Option10.Name = "Option10"
ADD OBJECT ylab AS label WITH ;
AutoSize = .T., ;
FontBold = .T., ;
FontSize = 12, ;
Anchor = 768, ;
BackStyle = 0, ;
Caption = "", ;
Height = 22, ;
Left = 660, ;
Top = 20, ;
Width = 2, ;
ForeColor = RGB(255,0,0), ;
Name = "ylab"
PROCEDURE optiongroup1.Init
with this
.backstyle=0
.autosize=.t.
for i=1 to .buttoncount
with .buttons(i)
.backstyle=0
.autosize=.t.
.mousepointer=15
if i<=7
.caption="Menu"+trans(i)
endi
endwith
endfor
.buttons(8).caption="Help"
.buttons(9).caption="Titlebar"
.buttons(10).caption="Exit"
endwith
for i=1 to this.buttoncount
bindevent(this.buttons(i),"Mousedown",this.parent,"my")
endfor
ENDPROC
Procedure my
Lparameters nButton, nShift, nXCoord, nYCoord
*--- aevent create an array laEvents
Aevents( myArray, 0)
*--- reference the calling object
loObject = myArray[1]
loObject.BackColor=Rgb(0,0,64)
this.ylab.caption=LoObject.name
inkey(1)
this.ylab.caption=""
N=Int(Val(Substr(loObject.Name,7)))
If Inlist(N,1,2,3,4,5,6,7)
Messagebox(loObject.Name+" clicked! can write some code from here!",0+32+4096,'',1500) &&only for not used buttons
Endi
Do Case
Case N=1
*
Case N=2
*
Case N=3
*
Case N=4
*
Case N=5
*
Case N=6
*
Case N=7
Case N=8
local m.myvar
text to m.myvar pretext 7 noshow
this code builds a main form as desktop application stylised with web ingredients.
it uses transparency for creating a collapsible menu and uses a big image as background
2 images are used as titles & link to my website
a menu grouped in 2 containers classes object have each one 10 clickable items .
the form is a top level one and resizable (borderstyle=3).titlebar can be on/off.
each button mousedown is binded to a personal method as demo only (for each container there is 2 methods my & mys).
this demonstrate how with vfp can create a desktop with modern look.
can change the backcolor dynamically (shape9).
it can be used as a basic template to build more complex application.can customize all images.
3 images are on my web site.can use local disk images or link to web ones.
See at the form left the transparency applied to the collapsible menu.
can customize menu items (20) in the <a> element.
here no hwnd recquired and it renders the element concerned only (not all page)!
issue ESC on visible form area or click button exit to cancel application.
-note the collapsible menu commanded by a vfp button(axpand/collapse).
-can use the collapsible menu to direct web urls or to redirect to vfp programs.
the code (+config.fpw) can build a project and compile to an exe desktop app.
internet must be connected to access to web images (otherwise make local images instead).
Warning: if you project to run here forms (because the olecontrol is alwaysonTop) ,must have modal forms mandatory with 2 properies:
ShowWindow = 1 and Desktop=.T.
endtext
Local oshell
oshell = Createobject('WScript.Shell')
oshell.Popup(m.myvar,0, 'Summary help', 0+32+4096) &&4,16,48,64...
oshell=Null
Case N=9
Thisform.TitleBar=Iif(Thisform.TitleBar=1,0,1)
If Thisform.TitleBar=0
Thisform.Height=Thisform.Height+31
Else
Thisform.Height=Thisform.Height-31
Endi
Case N=10
Thisform.Release
Endcase
loObject.BackColor=Rgb(0,255,0)
endproc
ENDDEFINE
*
*-- EndDefine: ycnt_options
Click on code to select [then copy] -click outside to deselect
*5* created on wednesday 08 of november 2017
*another desktop application template
*a web collapsible menu with css (can adapt many from web searches).
*read the help in the running code below.
*internet connection recquired.
*in this new version ,i dont want to tweak the previous code *4* and added a new container toolbar at the form bottom with 20 menu items.
**Note:3 classes based container can be used out of this application
publi yform
yform=newObject("yapp")
yform.show
read events
retu
*
DEFINE CLASS yApp AS form
Top = 0
Left = 0
Height = 603
Width = 1382
ShowWindow = 2
*ShowTips=.t.
Caption = "Another desktop application template"
BackColor = RGB(212,210,208)
*minWidth=1400
*minHeight=750
*scrollbars=1 && if you have a screen<32 inches (to adapt)
Name = "Form1"
ADD OBJECT olecontrol1 AS olecontrol WITH ;
oleclass="shell.explorer.2", ;
Top = 45, ;
Left = 0, ;
Height = 552-40, ;
Width = 1405, ;
Anchor = 15, ;
Name = "Olecontrol1"
PROCEDURE Destroy
clea events
ENDPROC
PROCEDURE KeyPress
LPARAMETERS nKeyCode, nShiftAltCtrl
if nkeycode=27
thisform.release
endi
ENDPROC
PROCEDURE Init
_screen.windowstate=1
sys(2002)
with this
.AddObject("ycnt_shapes1","ycnt_shapes") &&class below
with .ycnt_shapes1
.borderwidth=0
.left=2
.top=-10
.anchor=768
.visible=.t.
endwith
.AddObject("ycnt_options1","ycnt_options") &&class below
with .ycnt_options1
.borderwidth=0
.left=thisform.ycnt_shapes1.left+thisform.ycnt_shapes1.width+20
.width=900 &&thisform.width-.left-10
.top=1
.optiongroup1.left=0
.ylab.top=3
.ylab.left=.optionGroup1.left+.optiongroup1.width+4
.visible=.t.
endwith
.AddObject("ycnt_imgs1","ycnt_imgs") &&class below
with .ycnt_imgs1
.left=(thisform.width-.width)/2
*.width=thisform.width-.left-10
.top=thisform.height-.height
.anchor=768
.visible=.t.
endwith
.windowstate=2
endwith
ENDPROC
PROCEDURE olecontrol1.Init
this.silent=.t.
local m.myvar
text to m.myvar textmerge noshow
<!DOCTYPE html>
<html lang="en">
<head>
<meta charset="utf-8">
<meta name="viewport" content="width=device-width, initial-scale=1">
<meta http-equiv="x-ua-compatible" content="ie=edge" />
<title></title>
<link rel="stylesheet prefetch" href="https://preview.codepad.co/css/normalize.min.css"/>
<style>
body, html {
margin: 0;
padding: 0;
}
@import url('https://preview.codepad.co/redirect?url=http://fonts.googleapis.com/css?family=Open+Sans+Condensed:300');
@import url('https://preview.codepad.co/redirect?url=http://fonts.googleapis.com/css?family=Handlee');
html,
body {
margin: 0;
padding: 0;
border: 0;
width: 100%;
height: 100%;
overflow: hidden;
background-color:#212121;
font-family: 'Open Sans Condensed', sans-serif;
color: gold; //#F5F5F5;
background: url('http://img.over-blog-kiwi.com/1/43/54/07/20171108/ob_e97688_rup1.jpg');
background-size: cover;
background-position: center;
}
.menu .menu-content {
-webkit-transition-duration: 1s;
-moz-transition-duration: 1s;
-ms-transition-duration: 1s;
-o-transition-duration: 1s;
transition-duration: 1s;
float: left;
width: 12em;
background: rgba(0, 0, 0, 0.6); //rgba(72,72,72,0.8);
}
.menu .menu-content h2 {
font-family: 'Handlee', cursive;
font-weight: normal;
margin-left: 1em;
}
.menu .menu-content ul {
list-style: none;
}
.menu li,
.menu label {
color: #BDBDBD;
cursor: pointer;
-webkit-transition-duration: 1.0s;
-moz-transition-duration: 1.0s;
-ms-transition-duration: 1.0s;
-o-transition-duration: 1.0s;
transition-duration: 1.0s;
}
.menu li:hover,
.menu label:hover {
-webkit-transition-duration: 0.3s;
-moz-transition-duration: 0.3s;
-ms-transition-duration: 0.3s;
-o-transition-duration: 0.3s;
transition-duration: 0.3s;
color: lime; //rgba(255,255,0,1); //rgba(252, 251, 250, 0.9);
}
.menu .menu-switch {
padding-top: 0.em;
}
.menu .menu-switch label {
font-size: 3em;
font-family: 'Open Sans Condensed', sans-serif;
color:lime;
}
.menu input {
display: none;
}
.menu #menu-collapsed:checked ~ .menu-content {
margin-left: -12em;
}
.menu #menu-collapsed:checked ~ .menu-switch .rise {
display: block;
}
.menu #menu-collapsed:checked ~ .menu-switch .collapse {
display: none;
}
.menu #menu-collapsed ~ .menu-switch .rise {
display: none;
}
a {text-decoration: none;color:inherit;}
</style>
</head>
<body>
<img src='http://img.over-blog-kiwi.com/1/43/54/07/20171108/ob_4b1b52_ylogorup.png' style="display: block" width="1109px; " height="80px;">
<div class="menu">
<input type="checkbox" id="menu-collapsed" name="menu-collapsed" />
<div class="menu-content">
<h2>Collapsible menu</h2>
<ul>
<li><a href="http://www.yousfi.over-blog.com" TARGET="_BLANK" >1.my blog</a></li>
<li><a href="#" TARGET="_BLANK" >2. Proin vel</a></li>
<li><a href="#" TARGET="_BLANK" >3. risus eget</a></li>
<li><a href="#" TARGET="_BLANK" >4. lorem feugiat</a></li>
<li><a href="#" TARGET="_BLANK" >5. fermentum nec</a></li>
<li><a href="#" TARGET="_BLANK" >6. a turpis</a></li>
<li><a href="#" TARGET="_BLANK" >7. Phasellus purus</a></li>
<li><a href="#" TARGET="_BLANK" >8. sem mollis</a></li>
<li><a href="http://www.yousfi.over-blog.com" TARGET="_BLANK" >9. my blog</a></li>
<li><a href="#" TARGET="_BLANK" >10. ac posuere</a></li>
<li><a href="#" TARGET="_BLANK" >11. eget ornare</a></li>
<li><a href="#" TARGET="_BLANK" >12. vel orci</li>
<li><a href="#" TARGET="_BLANK" >13. Sed ac rutrum</a></li>
<li><a href="#" TARGET="_BLANK" >14. Aenean ultrices</a></li>
<li><a href="#" TARGET="_BLANK" >15. eget lectus</a></li>
<li><a href="#" TARGET="_BLANK" >16. Any link</li>
<li><a href="http://www.yousfi.over-blog.com" TARGET="_BLANK" >17. my blog</a></li>
<li><a href="#" TARGET="_BLANK" >18. eu efficitur</a></li>
<li><a href="#"TARGET="_BLANK" >19. In hac habitasse</a></li>
<li><a href="#" TARGET="_BLANK" >20. platea dictumst</a></li>
<li><a href="#" TARGET="_BLANK" >21. Nulla in iaculis</a></li>
<li><a href="#" TARGET="_BLANK" >22. Nullam et pulvinar</a></li>
<li><a href="#" TARGET="_BLANK" >23. Donec arcu dui</a></li>
<li><a href="#" TARGET="_BLANK" >24. Aenean viverra</a></li>
</ul>
</div>
<div class="menu-switch">
<label Id="ych" class="collapse" for="menu-collapsed">«</label>
<label class="rise" for="menu-collapsed">»</label>
</div>
</div>
<div ><a href="http://www.yousfi.over-blog.com" target="_blank"><img src='http://img.over-blog-kiwi.com/1/43/54/07/20171106/ob_457211_ylogo.png' style="display: block;float:right;margin-top:<<thisform.height-50>>px;margin-right:30px;"></a></div>
</body>
</html>
</body>
</html>
endtext
this.navigate('about:blank')
inke(1)
with this.document
.open()
.write(m.myvar)
.close()
endwith
ENDPROC
ENDDEFINE
*
*-- EndDefine: yApp
DEFINE CLASS ycnt_shapes AS container
Top = 9
Left = 37
Width = 396
Height = 48
BackStyle = 0
BorderWidth = 0
Name = "yCnt_Shapes"
ADD OBJECT shape1 AS shape WITH ;
Top = 12, ;
Left = 12-12, ;
Height = 20, ;
Width = 27, ;
BorderWidth = 2, ;
Curvature = 15, ;
MousePointer = 15, ;
SpecialEffect = 0, ;
BackColor = RGB(0,255,0), ;
tooltiptext="AlwaysonTop on/off"
Name = "Shape1"
ADD OBJECT shape2 AS shape WITH ;
Top = 12, ;
Left = 49-12, ;
Height = 20, ;
Width = 27, ;
BorderWidth = 2, ;
Curvature = 15, ;
MousePointer = 15, ;
SpecialEffect = 0, ;
BackColor = RGB(0,255,0), ;
Name = "Shape2"
ADD OBJECT shape3 AS shape WITH ;
Top = 12, ;
Left = 89-12, ;
Height = 20, ;
Width = 27, ;
BorderWidth = 2, ;
Curvature = 15, ;
MousePointer = 15, ;
SpecialEffect = 0, ;
BackColor = RGB(0,255,0), ;
Name = "Shape3"
ADD OBJECT shape4 AS shape WITH ;
Top = 12, ;
Left = 128-12, ;
Height = 20, ;
Width = 27, ;
BorderWidth = 2, ;
Curvature = 30, ;
MousePointer = 15, ;
SpecialEffect = 0, ;
BackColor = RGB(0,255,0), ;
Name = "Shape4"
ADD OBJECT shape5 AS shape WITH ;
Top = 12, ;
Left = 166-12, ;
Height = 20, ;
Width = 27, ;
BorderWidth = 2, ;
Curvature = 15, ;
MousePointer = 15, ;
SpecialEffect = 0, ;
BackColor = RGB(0,255,0), ;
Name = "Shape5"
ADD OBJECT shape6 AS shape WITH ;
Top = 12, ;
Left = 205-12, ;
Height = 20, ;
Width = 27, ;
BorderWidth = 2, ;
Curvature = 15, ;
MousePointer = 15, ;
SpecialEffect = 0, ;
BackColor = RGB(0,255,0), ;
Name = "Shape6"
ADD OBJECT shape7 AS shape WITH ;
Top = 12, ;
Left = 245-12, ;
Height = 20, ;
Width = 27, ;
BorderWidth = 2, ;
Curvature = 15, ;
MousePointer = 15, ;
SpecialEffect = 0, ;
BackColor = RGB(0,255,0), ;
Name = "Shape7"
ADD OBJECT shape8 AS shape WITH ;
Top = 12, ;
Left = 280-12, ;
Height = 20, ;
Width = 27, ;
BorderWidth = 2, ;
Curvature = 15, ;
MousePointer = 15, ;
SpecialEffect = 0, ;
BackColor = RGB(0,255,0), ;
Name = "Shape8"
ADD OBJECT shape9 AS shape WITH ;
Top = 12, ;
Left = 316-12, ;
Height = 20, ;
Width = 27, ;
BorderWidth = 2, ;
Curvature = 15, ;
MousePointer = 15, ;
SpecialEffect = 0, ;
BackColor = RGB(0,255,0), ;
tooltiptext="Change backcolor"
Name = "Shape9"
ADD OBJECT shape10 AS shape WITH ;
Top = 12, ;
Left = 357-12, ;
Height = 20, ;
Width = 27, ;
BorderWidth = 2, ;
Curvature = 15, ;
MousePointer = 15, ;
SpecialEffect = 0, ;
BackColor = RGB(0,255,0), ;
Name = "Shape10"
PROCEDURE Init
with this
*.parent.showtips=.t.
.backstyle=0
.borderwidth=0
.setall("width",25,"shape")
.setall("height",25,"shape")
.setall("curvature",99,"shape") &&circles 30 round rectangle
*.setall("borderstyle",0,"shape")
rand(-1)
for i=1 to .controlcount
with .controls(i)
.backcolor=rgb(255*rand(),255*rand(),255*rand())
.mousepointer=15
do case
case i=1
.tooltiptext="AlwaysOnTop on/off"
case between(i,2,8)
.tooltiptext="Menu"+trans(i)
case i=9
.tooltiptext="Change backcolor"
case i=10
.tooltiptext="Collapse/expand menu"
endcase
endwith
endfor
endwith
for i=1 to this.controlcount
bindevent(this.controls(i),"mousedown",this,"mys")
bindevent(this.controls(i),"mouseENTER",this,"mys1")
bindevent(this.controls(i),"mouseLeave",this,"mys2")
endfor
ENDPROC
Procedure mys1
Lparameters nButton, nShift, nXCoord, nYCoord
*--- aevent create an array laEvents
Aevents( myArray, 0)
*--- reference the calling object
loObject = myArray[1]
thisform.ycnt_options1.ylab.caption=LoObject.tooltiptext
endproc
Procedure mys2
Lparameters nButton, nShift, nXCoord, nYCoord
*--- aevent create an array laEvents
Aevents( myArray, 0)
*--- reference the calling object
loObject = myArray[1]
thisform.ycnt_options1.ylab.caption=""
endproc
Procedure mys
Lparameters nButton, nShift, nXCoord, nYCoord
*--- aevent create an array laEvents
Aevents( myArray, 0)
*--- reference the calling object
loObject = myArray[1]
loObject.BackColor=Rgb(0,0,64)
thisform.ycnt_options1.ylab.caption=LoObject.tooltiptext
inkey(1)
thisform.ycnt_options1.ylab.caption=""
N=Int(Val(Substr(loObject.Name,6))) &&"shapeXX"
If Inlist(N,2,3,4,5,6,7,8)
Messagebox(loObject.Name+" clicked! can write some code from here!",0+32+4096,'',1500) &&only for not used buttons
Endi
Do Case
Case N=1
thisform.alwaysonTop=iif(thisform.alwaysontop=.f.,.t.,.f.)
Case N=2
Case N=3
Case N=4
Case N=5
Case N=6
Case N=7
Case N=8
Case N=9
local m.xcolor
m.xcolor=getcolor()
if !m.xcolor=-1
thisform.backcolor=m.xcolor
endi
Case N=10
thisform.olecontrol1.document.getElementById("ych").click(.t.)
Endcase
endproc
ENDDEFINE
*
*-- EndDefine: ycnt_shapes
*
DEFINE CLASS ycnt_options AS container
Width = 722+100
Height = 27
top=35
backstyle=0
borderwidth=0
Name = "ycnt_options"
ADD OBJECT optiongroup1 AS optiongroup WITH ;
AutoSize = .T., ;
ButtonCount = 10, ;
Anchor = 768, ;
BackStyle = 1, ;
Value = 1, ;
Height = 27, ;
Left = 0, ;
Top = 1, ;
Width = 708, ;
Name = "Optiongroup1", ;
Option1.Caption = "Option1", ;
Option1.Value = 1, ;
Option1.Height = 17, ;
Option1.Left = 5, ;
Option1.Style = 0, ;
Option1.Top = 5, ;
Option1.Width = 68, ;
Option1.AutoSize = .F., ;
Option1.Name = "Option1", ;
Option2.Caption = "Option2", ;
Option2.Height = 17, ;
Option2.Left = 75, ;
Option2.Style = 0, ;
Option2.Top = 5, ;
Option2.Width = 68, ;
Option2.AutoSize = .F., ;
Option2.Name = "Option2", ;
Option3.Caption = "Option3", ;
Option3.Height = 17, ;
Option3.Left = 145, ;
Option3.Style = 0, ;
Option3.Top = 5, ;
Option3.Width = 68, ;
Option3.AutoSize = .F., ;
Option3.Name = "Option3", ;
Option4.Caption = "Option4", ;
Option4.Height = 17, ;
Option4.Left = 215, ;
Option4.Style = 0, ;
Option4.Top = 5, ;
Option4.Width = 68, ;
Option4.AutoSize = .F., ;
Option4.Name = "Option4", ;
Option5.Caption = "Option5", ;
Option5.Height = 17, ;
Option5.Left = 285, ;
Option5.Style = 0, ;
Option5.Top = 5, ;
Option5.Width = 68, ;
Option5.AutoSize = .F., ;
Option5.Name = "Option5", ;
Option6.Caption = "Option6", ;
Option6.Height = 17, ;
Option6.Left = 355, ;
Option6.Style = 0, ;
Option6.Top = 5, ;
Option6.Width = 68, ;
Option6.AutoSize = .F., ;
Option6.Name = "Option6", ;
Option7.Caption = "Option7", ;
Option7.Height = 17, ;
Option7.Left = 425, ;
Option7.Style = 0, ;
Option7.Top = 5, ;
Option7.Width = 68, ;
Option7.AutoSize = .F., ;
Option7.Name = "Option7", ;
Option8.Caption = "Option8", ;
Option8.Height = 17, ;
Option8.Left = 495, ;
Option8.Style = 0, ;
Option8.Top = 5, ;
Option8.Width = 68, ;
Option8.AutoSize = .F., ;
Option8.Name = "Option8", ;
Option9.Caption = "Option9", ;
Option9.Height = 17, ;
Option9.Left = 565, ;
Option9.Style = 0, ;
Option9.Top = 5, ;
Option9.Width = 68, ;
Option9.AutoSize = .F., ;
Option9.Name = "Option9", ;
Option10.Caption = "Option10", ;
Option10.Height = 17, ;
Option10.Left = 635, ;
Option10.Style = 0, ;
Option10.Top = 5, ;
Option10.Width = 68, ;
Option10.AutoSize = .F., ;
Option10.Name = "Option10"
ADD OBJECT ylab AS label WITH ;
AutoSize = .T., ;
FontBold = .T., ;
FontSize = 12, ;
Anchor = 768, ;
BackStyle = 0, ;
Caption = "", ;
Height = 22, ;
Left = 660, ;
Top = 20, ;
Width = 2, ;
ForeColor = RGB(255,0,0), ;
Name = "ylab"
PROCEDURE optiongroup1.Init
with this
.backstyle=0
for i=1 to .buttoncount
with .buttons(i)
.backstyle=0
.mousepointer=15
if i<=7
.caption="Menu"+trans(i)
.tooltiptext="OPmenu"+trans(i)
endi
endwith
.autosize=.t.
endfor
.buttons(8).caption="Help"
.buttons(8).tooltiptext="Summary Help"
.buttons(9).caption="Titlebar"
.buttons(9).tooltiptext="Titlebar on/off"
.buttons(10).caption="Exit"
.buttons(10).tooltiptext="Exit application"
.autosize=.t.
endwith
for i=1 to this.buttoncount
bindevent(this.buttons(i),"Mousedown",this.parent,"my")
bindevent(this.buttons(i),"mouseENTER",this.parent,"my1")
bindevent(this.buttons(i),"mouseLeave",this.parent,"my2")
endfor
ENDPROC
Procedure my1
Lparameters nButton, nShift, nXCoord, nYCoord
*--- aevent create an array laEvents
Aevents( myArray, 0)
*--- reference the calling object
loObject = myArray[1]
thisform.ycnt_options1.ylab.caption=LoObject.TOOLTIPTEXT
endproc
Procedure my2
Lparameters nButton, nShift, nXCoord, nYCoord
*--- aevent create an array laEvents
Aevents( myArray, 0)
*--- reference the calling object
loObject = myArray[1]
thisform.ycnt_options1.ylab.caption=""
endproc
Procedure my
Lparameters nButton, nShift, nXCoord, nYCoord
*--- aevent create an array laEvents
Aevents( myArray, 0)
*--- reference the calling object
loObject = myArray[1]
loObject.BackColor=Rgb(0,0,64)
this.ylab.caption=LoObject.name
inkey(1)
this.ylab.caption=""
N=Int(Val(Substr(loObject.Name,7)))
If Inlist(N,1,2,3,4,5,6,7)
Messagebox(loObject.Name+" clicked! can write some code from here!",0+32+4096,'',1500) &&only for not used buttons
Endi
Do Case
Case N=1
*
Case N=2
*
Case N=3
*
Case N=4
*
Case N=5
*
Case N=6
*
Case N=7
Case N=8
local m.myvar
text to m.myvar pretext 7 noshow
this code builds a main form as desktop application stylised with web ingredients.
it uses transparency for creating a collapsible menu and uses a big image as background
2 images are used as titles & link to my website
a menu grouped in 2 containers classes object have each one 10 clickable items .
the form is a top level one and resizable (borderstyle=3).titlebar can be on/off.
each button mousedown is binded to a personal method as demo only (for each container there is 2 methods my & mys).
this demonstrate how with vfp can create a desktop with modern look.
can change the backcolor dynamically.
it can be used as a basic template to build more complex application.can customize all images.
3 images are on my web site.can use local disk images or link to web ones.
See at the form left the transparency applied to the collapsible menu.
can make the form.alwaysOnTop on/off (if menu recovered with taskbar down)
can customize menu items (20) in the <a> element.
here no hwnd recquired and it renders the element concerned only (not all page)!
issue ESC on visible form area or click button exit to cancel application.
-note the collapsible menu commanded by a vfp button(axpand/collapse).
-can use the collapsible menu to direct web urls or to redirect to vfp programs.
*3 classes containers are used to build this app.
the code (+config.fpw) can build a project and compile to an exe desktop app.
internet must be connected to access to web images (otherwise make local images instead).
Warning: if you project to run here forms (because the olecontrol is alwaysonTop) ,must have modal forms mandatory with 2 properies:
ShowWindow = 1 and Desktop=.T.
endtext
Local oshell
oshell = Createobject('WScript.Shell')
oshell.Popup(m.myvar,0, 'Summary help', 0+32+4096) &&4,16,48,64...
oshell=Null
Case N=9
Thisform.TitleBar=Iif(Thisform.TitleBar=1,0,1)
If Thisform.TitleBar=0
Thisform.Height=Thisform.Height+31
Else
Thisform.Height=Thisform.Height-31
Endi
Case N=10
Thisform.Release
Endcase
endproc
ENDDEFINE
*
*-- EndDefine: ycnt_options
*
Define Class yCnt_imgs As Container
Top = 144
Left = 240
Width = 720
Height = 39
BackStyle = 0
BorderWidth = 2
BackColor = RGB(0,255,0)
BorderColor = RGB(0,0,0)
Name = "yCnt_Imgs"
ADD OBJECT image1 AS image WITH ;
Stretch = 2, ;
Height = 32, ;
Left = 4, ;
MousePointer = 15, ;
Top = 4, ;
Width = 32, ;
Name = "Image1"
ADD OBJECT image2 AS image WITH ;
Stretch = 2, ;
Height = 32, ;
Left = 40, ;
MousePointer = 15, ;
Top = 4, ;
Width = 32, ;
Name = "Image2"
ADD OBJECT image3 AS image WITH ;
Stretch = 2, ;
Height = 32, ;
Left = 76, ;
MousePointer = 15, ;
Top = 4, ;
Width = 32, ;
Name = "Image3"
ADD OBJECT image4 AS image WITH ;
Stretch = 2, ;
Height = 32, ;
Left = 111, ;
MousePointer = 15, ;
Top = 4, ;
Width = 32, ;
Name = "Image4"
ADD OBJECT image5 AS image WITH ;
Stretch = 2, ;
Height = 32, ;
Left = 147, ;
MousePointer = 15, ;
Top = 4, ;
Width = 32, ;
Name = "Image5"
ADD OBJECT image6 AS image WITH ;
Stretch = 2, ;
Height = 32, ;
Left = 184, ;
MousePointer = 15, ;
Top = 4, ;
Width = 32, ;
Name = "Image6"
ADD OBJECT image7 AS image WITH ;
Stretch = 2, ;
Height = 32, ;
Left = 220, ;
MousePointer = 15, ;
Top = 4, ;
Width = 32, ;
Name = "Image7"
ADD OBJECT image8 AS image WITH ;
Stretch = 2, ;
Height = 32, ;
Left = 256, ;
MousePointer = 15, ;
Top = 4, ;
Width = 32, ;
Name = "Image8"
ADD OBJECT image9 AS image WITH ;
Stretch = 2, ;
Height = 32, ;
Left = 291, ;
MousePointer = 15, ;
Top = 4, ;
Width = 32, ;
Name = "Image9"
ADD OBJECT image10 AS image WITH ;
Stretch = 2, ;
Height = 32, ;
Left = 327, ;
MousePointer = 15, ;
Top = 4, ;
Width = 32, ;
Name = "Image10"
ADD OBJECT image11 AS image WITH ;
Stretch = 2, ;
Height = 32, ;
Left = 362, ;
MousePointer = 15, ;
Top = 4, ;
Width = 32, ;
Name = "Image11"
ADD OBJECT image12 AS image WITH ;
Stretch = 2, ;
Height = 32, ;
Left = 398, ;
MousePointer = 15, ;
Top = 4, ;
Width = 32, ;
Name = "Image12"
ADD OBJECT image13 AS image WITH ;
Stretch = 2, ;
Height = 32, ;
Left = 434, ;
MousePointer = 15, ;
Top = 4, ;
Width = 32, ;
Name = "Image13"
ADD OBJECT image14 AS image WITH ;
Stretch = 2, ;
Height = 32, ;
Left = 471, ;
MousePointer = 15, ;
Top = 4, ;
Width = 32, ;
Name = "Image14"
ADD OBJECT image15 AS image WITH ;
Stretch = 2, ;
Height = 32, ;
Left = 507, ;
MousePointer = 15, ;
Top = 4, ;
Width = 32, ;
Name = "Image15"
ADD OBJECT image16 AS image WITH ;
Stretch = 2, ;
Height = 32, ;
Left = 543, ;
MousePointer = 15, ;
Top = 4, ;
Width = 32, ;
Name = "Image16"
ADD OBJECT image17 AS image WITH ;
Stretch = 2, ;
Height = 32, ;
Left = 578, ;
MousePointer = 15, ;
Top = 4, ;
Width = 32, ;
Name = "Image17"
ADD OBJECT image18 AS image WITH ;
Stretch = 2, ;
Height = 32, ;
Left = 614, ;
MousePointer = 15, ;
Top = 4, ;
Width = 32, ;
Name = "Image18"
ADD OBJECT image19 AS image WITH ;
Stretch = 2, ;
Height = 32, ;
Left = 649, ;
MousePointer = 15, ;
Top = 4, ;
Width = 32, ;
Name = "Image19"
ADD OBJECT image20 AS image WITH ;
Stretch = 2, ;
Height = 32, ;
Left = 685, ;
MousePointer = 15, ;
Top = 4, ;
Width = 32, ;
Name = "Image20"
Procedure Init
Set Memo To 8192
Local m.myvar
TEXT to m.myvar noshow
http://img.over-blog-kiwi.com/1/43/54/07/20171108/ob_b0991a_icon1.png
http://img.over-blog-kiwi.com/1/43/54/07/20171108/ob_ca4454_icon2.png
http://img.over-blog-kiwi.com/1/43/54/07/20171108/ob_526d74_icon3.png
http://img.over-blog-kiwi.com/1/43/54/07/20171108/ob_1b83ae_icon4.png
http://img.over-blog-kiwi.com/1/43/54/07/20171108/ob_291f2c_icon5.png
http://img.over-blog-kiwi.com/1/43/54/07/20171108/ob_0e2596_icon6.png
http://img.over-blog-kiwi.com/1/43/54/07/20171108/ob_d82e5b_icon7.png
http://img.over-blog-kiwi.com/1/43/54/07/20171108/ob_251e3e_icon8.png
http://img.over-blog-kiwi.com/1/43/54/07/20171108/ob_4bda46_icon9.png
http://img.over-blog-kiwi.com/1/43/54/07/20171108/ob_056b85_icon10.png
http://img.over-blog-kiwi.com/1/43/54/07/20171108/ob_01db43_icon11.png
http://img.over-blog-kiwi.com/1/43/54/07/20171108/ob_a7a07b_icon12.png
http://img.over-blog-kiwi.com/1/43/54/07/20171108/ob_1eacea_icon13.png
http://img.over-blog-kiwi.com/1/43/54/07/20171108/ob_a2051d_icon21.png
http://img.over-blog-kiwi.com/1/43/54/07/20171108/ob_6f1ca8_icon15.gif
http://img.over-blog-kiwi.com/1/43/54/07/20171108/ob_535181_icon16.png
http://img.over-blog-kiwi.com/1/43/54/07/20171108/ob_57fd09_icon17.png
http://img.over-blog-kiwi.com/1/43/54/07/20171108/ob_8d5bb6_icon18.png
http://img.over-blog-kiwi.com/1/43/54/07/20171108/ob_92b681_icon19.png
http://img.over-blog-kiwi.com/1/43/54/07/20171108/ob_7e8ba4_icon20.png
ENDTEXT
With This
.top=0
*.Parent.ShowTips=.T.
.BackStyle=0
.BorderWidth=0
.BorderColor=0
Local m.x,m.w
For i=1 To .ControlCount
m.w= Eval(".image"+Trans(i))
With m.w
m.x=Allt(Mline(m.myvar,i))
This.yrequest(m.x,m.w)
inke(0.3)
.MousePointer=15
.ToolTipText="ImgMenu"+Trans(i)
Endwith
Endfor
Endwith
For i=1 To This.ControlCount
Bindevent(This.Controls(i),"mousedown",This,"myI")
bindevent(this.controls(i),"mouseENTER",this,"myI1")
bindevent(this.controls(i),"mouseLeave",this,"myI2")
Endfor
Endproc
Procedure myI
Lparameters nButton, nShift, nXCoord, nYCoord
*--- aevent create an array laEvents
Aevents( myArray, 0)
*--- reference the calling object
loObject = myArray[1]
N=Int(Val(Substr(loObject.Name,6))) &&"imageXX"
If Inlist(N,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20)
Messagebox(loObject.Name+" clicked! can write some code from here!",0+32+4096,'',1500) &&only for not used buttons
Endi
Do Case && to customize
Case N=1
Case N=2
Case N=3
Case N=4
Case N=5
Case N=6
Case N=7
Case N=8
Case N=9
Case N=10
Case N=11
Case N=12
Case N=13
Case N=14
Case N=15
Case N=16
Case N=17
Case N=18
Case N=19
Case N=20
Endcase
Endproc
Procedure yrequest
lparameters xurl,xobj
xurl=allt(xUrl)
try
Local loRequest
m.loRequest = Createobject('MsXml2.XmlHttp')
m.loRequest.Open("GET",xUrl,.F.)
m.loRequest.Send()
local m.oo
xobj.pictureVal= m.loRequest.ResponseBody
m.loRequest=Null
catch
endtry
endproc
Procedure myI1
Lparameters nButton, nShift, nXCoord, nYCoord
*--- aevent create an array laEvents
Aevents( myArray, 0)
*--- reference the calling object
loObject = myArray[1]
thisform.ycnt_options1.ylab.caption=LoObject.TOOLTIPTEXT
endproc
Procedure myI2
Lparameters nButton, nShift, nXCoord, nYCoord
*--- aevent create an array laEvents
Aevents( myArray, 0)
*--- reference the calling object
loObject = myArray[1]
thisform.ycnt_options1.ylab.caption=""
endproc
Enddefine
*
*-- EndDefine:ycnt_Imgs
Click on code to select [then copy] -click outside to deselect
*6* created on wednesday 09 of november 2017
*this code plays any youtube video.
*its the same code as *3* but with setting IE emulation as Edge programmatly.
*if the emulation is not set in registry,or if the code html is not editable,can set at first the emulation as the Edge one (Edge is the top emulation.there is IE11...).the code snippet is available with any IE emulation.
*the function below receives a youtube video url (embed-can the integration code [<iframe>......</iframe>]obtain by rightclick on any youtube playing video )
*the internet application is used here (emulation IE11 recquired).can resize the window or ven make the youtbe inbuilt fullscreen....
*i set for the fun a custom icon and titlebar title.
*internet must be connected.
_Screen.WindowState=1
Do ydeclare
Local m.lcUrl
m.lcUrl="https://www.youtube.com/embed/fA_dBVxcPCo" &&integration youtube url to put here
yview(m.lcUrl)
Function yview()
Lparameters url
Declare Integer BringWindowToTop In user32 Integer
Local m.myvar
TEXT to m.myvar textmerge noshow
<head>
<meta id="ym" http-equiv="x-ua-compatible" content="ie=edge" />
</head>
<iframe width=100% height=100% src="<<url>>" frameborder="0" gesture="media" allowfullscreen></iframe>
ENDTEXT
Local apie
apie=Newobject("internetexplorer.application")
With apie
.Navigate("about:blank")
.menubar=0
.Toolbar=0
.StatusBar=0
.Resizable=1
Inke(1)
.Document.Open()
.Document.Write(m.myvar)
.Document.Close()
.Document.body.Style.background="#000000" && black
BringWindowToTop(.HWnd)
.Width=1100
.Height=700
.Visible=.T.
Inke(1.5)
SetWindowText(.HWnd, "Playing video: "+url)
**changing ie icon
*Constants for SendMessage second parameter
#Define WM_GETICON 0x7F
#Define WM_SETICON 0x80
*Constants for SendMessage third parameter
#Define ICON_SMALL 0
#Define ICON_BIG 1
lnHWND=apie.HWnd
lnIcon = ExtractIcon (0,Home(1)+"GRAPHICS\ICONS\misc\camera.ICO",0)
SendMessage(lnHWND, WM_SETICON, ICON_SMALL, lnIcon)
Messagebox( .Document.getElementById("ym").outerhtml ,0+32+4096,'Edge emulation',3000)
Endwith
Endfunc
Procedure ydeclare
Declare Integer BringWindowToTop In user32 Integer
Declare Integer SetWindowText In user32 Integer HWnd, String lpString
Declare Integer ExtractIcon In shell32 Integer hInst, String lpszExeFileName, Integer lpiIcon
Declare Integer SendMessage In user32 Integer HWnd, Integer Msg, Integer wParam, Integer Lparam
Endproc
*!* *from vfp with DOM logic (OOP) can add programmatly any tag to a page web
*!* *with automation Apie above this is the code for setting IE emulation:
*!* local x
*!* with apie
*!* x =.document.createElement("META")
*!* x.setAttribute("id", "ym")
*!* x.setAttribute("name", "description")
*!* x.setAttribute("http-equiv", "x-ua-compatible")
*!* x.content="ie=edge"
*!* . document.head.appendChild(x)
*!* endwith
*!* inke(2)
Important:All Codes above are tested on VFP9SP2 , windows 10 pro 64 bits (latest version 1703) and IE11 emulation .