Web sidebar working with VFP application
A sidebar is a panel can collapse to free space or expand for using its contents.
it can be coded with pure vfp as collapsible container,listbox or even a form (scrollable if needed) or an olecontrol treeview on the form...
but the look infortunatly stays as vfp can give (old look).
this code builds a web page in the vfp browser (olecontrol) with:
-a transparent sidebar containing some custom links
-a changing big image from web.
All the commands can be done from vfp as:
-expand/collapse the sidebar
-Change the background picture directly from the web
-change the color of the navbar
-and all commands from the toolbar container (its a re usable, customizable class yCnt_imgs)
there is in image1 of the class the possibility to run vfp forms but as the olecontrol is always on top,the form must be with (modal windowtype=1) and desktop=.t. properties (click the ycnt_imgs class in button1)
(or can limit the olecontrol1 area (without background image) to the sidebar only to run any vfp code)
the sidebar can be as this one or an accordion sidebar menu....its very easy to pick the html/css template code from the web.there is tons.)
some command on the ycn_imgs classes are implemented as:
-run a form
-run modern UI news
-change app backcolor
-Minimise, maximize/restore app,exit.
-app titlebar on/off
- form alwaysonTop on/off (if problem with windows taskbar)
-the icons used in this class are free from web..can customize.
-mousemove on any control of the class to see its tooltip at form top-right.
can populate/customize/modify codes in yCNT_imgs class.
Good luck !
*this code rendered on 32 pouces screen (otherwise to adapt)
[post 242]
Click on code to select [then copy] -click outside to deselect
*1* created on friday 10 of november 2017
*a web sidebar working with vfp application
*can populate all controls with custom codes.
*sidebar links can be real ones (web pages open in new IE window) or redirected to vfp namespace with beforenavigate browser method.
*sidebar source is very simple:https://www.w3schools.com/howto/howto_js_sidenav.asp
publi yform
yform=newObject("ysidebar")
yform.show
read events
retu
*
DEFINE CLASS ysidebar AS form
Top = 0
Left = 0
Height = 663
Width = 1420
ShowWindow = 2
Caption = ""
WindowState = 2
AlwaysOnBottom = .T.
ycl = 0
navcolor = "rgb(17,17,17,0.8)"
Name = "Form1"
ADD OBJECT olecontrol1 AS olecontrol WITH ;
oleclass="shell.explorer.2", ;
Top = 36, ;
Left = -2, ;
Height = 600, ;
Width = 1417, ;
Anchor = 15, ;
Name = "Olecontrol1"
ADD OBJECT image1 AS image WITH ;
Anchor = 768, ;
Height = 25, ;
Left = 15, ;
MousePointer = 15, ;
Top = 4, ;
Width = 25, ;
Name = "Image1"
ADD OBJECT ylab AS label WITH ;
AutoSize = .T., ;
FontBold = .T., ;
FontSize = 12, ;
BackStyle = 0, ;
Caption = "", ;
Height = 22, ;
Left = 1140, ;
Top = 5, ;
Width = 2, ;
ForeColor = RGB(255,0,0), ;
Name = "yLab"
ADD OBJECT command1 AS commandbutton WITH ;
AutoSize = .T., ;
Top = 2, ;
Left = 72, ;
Height = 27, ;
Width = 137, ;
FontBold = .T., ;
Anchor = 768, ;
Caption = "Change background", ;
MousePointer = 15, ;
BackColor = RGB(128,0,64), ;
Name = "Command1"
ADD OBJECT command2 AS commandbutton WITH ;
Top = 4, ;
Left = 240, ;
Height = 27, ;
Width = 84, ;
FontBold = .T., ;
Caption = "Nav color", ;
MousePointer = 15, ;
SpecialEffect = 2, ;
BackColor = RGB(0,255,0), ;
Name = "Command2"
ADD OBJECT timer1 AS timer WITH ;
Top = 9, ;
Left = 333, ;
Height = 23, ;
Width = 23, ;
Enabled = .F., ;
Interval = 2000, ;
Name = "Timer1"
Procedure mousemove
Lparameters nButton, nShift, nXCoord, nYCoord
thisform.command2.setfocus()
endproc
PROCEDURE ybuild &&this rebuilds the web page interactively after making some changes in parameters.
*nav border random color
local m.xcol,m.xhtml_color
rand(-1)
m.xcol=rgb(255*rand(),255*rand(),255*rand())
m.xhtml_color="#"+Chrtran("123456","563412",Right(Trans(m.xcol ,"@0"),6))
local m.myvar
text to m.myvar textmerge noshow
<!DOCTYPE html>
<html>
<head>
<meta http-equiv="x-ua-compatible" content="ie=edge" />
<style>
body {
margin: 0;
padding: 0;
border: 0;
width :100%;
height:<<sysmetric(2)>>px; //100%;
overflow: hidden;
font-family: "Lato", sans-serif;
background:rgb(0,0,0);
background: url('http://www.algerie-focus.com/wp-content/uploads/2014/12/B%C3%A9char-Taghit_20-d%C3%A9cembre-2014.jpg') ;
background-size: cover;
background-position: center;
}
.sidenav {
height: 80%;
width: 0;
position: fixed;
z-index: 1;
top: 0;
left: 0;
background-color: <<thisform.navcolor>> ;
overflow-x: hidden;
overflow-y: hidden; //hide scrollbar here
transition: 0.5s;
padding-top: 60px;
border: solid 4px <<m.xhtml_color>> ; //can cut this line if no border wanted
}
.sidenav a {
padding: 8px 8px 8px 32px;
text-decoration: none;
font-size: 25px;
color: #818181;
display: block;
transition: 0.3s;
}
.sidenav a:hover {
color: #f1f1f1;
}
@media screen and (max-height: 450px) {
.sidenav {padding-top: 15px;}
.sidenav a {font-size: 18px;}
}
</style>
</head>
<body oncontextmenu="return true;" scroll="no">
<div id="mySidenav" class="sidenav">
<a href="http://www.yousfi.over-blog.com" target="_blank">1. My Blog</a>
<a href="#">2. Services</a>
<a href="#">3. Clients</a>
<a href="#">4. Contact</a>
<a href="#">5. Gallery</a>
<a href="#">6. Reports</a>
<a href="#">7. Travels</a>
<a href="#">8. Maps</a>
<a href="#">9. Projects</a>
<a href="#">10.Subscribers</a>
<a href="#">11.Data</a>
<a href="#">12.Sports</a>
</div>
</body >
</html>
endtext
thisform.lockscreen=.t.
With Thisform.olecontrol1
.navigate("about:blank")
inke(1)
.Document.Open()
.Document.Write(m.myvar)
.Document.Close()
Endwith
thisform.lockscreen=.f.
thisform.timer1.enabled=.t.
ENDPROC
PROCEDURE Init
*source sidebar:https://www.w3schools.com/howto/howto_js_sidenav.asp
_screen.windowstate=1
*set proc to ycnt_imgs_class addi
with thisform
.addobject ("ycnt_imgs1","ycnt_imgs")
with .ycnt_imgs1
.left=(.parent.width-.width)/2
.top=-2
.visible=.t.
endwith
endwith
*release procedure ycnt_imgs_class
thisform.ycl=1
thisform.navcolor="rgba(17,17,17,.7)"
thisform.ybuild()
ENDPROC
PROCEDURE Destroy
clea events
ENDPROC
PROCEDURE olecontrol1.Init
this.silent=.t.
ENDPROC
PROCEDURE image1.Init
local m.myvar
text to m.myvar noshow
iVBORw0KGgoAAAANSUhEUgAAABkAAAAYCAYAAAAPtVbGAAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8YQUAAAAJcEhZcwAAEnQAABJ0Ad5mH3gAAACkSURBVEhLY/z48eN/BhoCPj4+BiYom6YA4pMPpxmWzj/C8AoqSDEQs2FIjDZlEAAyQT5hAFny8da8/94MDKBgow72nvf/FshcIAYBiE9ebmEoSJrOcBuogipANZNh3gQfBnEgE+ST4RPxo5aQBOhiCV3yCV18AsknPx4yXDr9iOEjVJBiwC/HYKonz8ABZI5mRpLB8LGELqlruGVGGgI65RMGBgDN/K+s1PzsiAAAAABJRU5ErkJggg==
endtext
this.pictureVal=strconv(m.myvar,14)
ENDPROC
PROCEDURE image1.Click
with thisform
.ycl=iif(.ycl=1,0,1)
do case
case .ycl=0
.olecontrol1.document.getElementById("mySidenav").style.width = "0px"
case .ycl=1
.olecontrol1.document.getElementById("mySidenav").style.width = "250px"
endcase
endwith
ENDPROC
PROCEDURE command1.Click
Local m.myvar
TEXT to m.myvar noshow
http://www.mulierchile.com/dubai-city-images/dubai-city-images-012.jpg
http://dubaicitytours.net/wp-content/uploads/2013/12/Dubai-City-Tour.jpg
http://www.almariahtravel.com/inc_img/57421394625421.jpg
http://www.zagygroup.com/web-images/cheap-hotel-dubai-ZAGY-Group-Internet-Marketing.png
https://www.tmb.ie/wp/wp-content/uploads/2017/01/dubai-travel-tips2.jpg
https://www.dubaieveningsafari.com/files/2016/08/Burj-Khalifa.jpg
http://glamazonsblog.com/wp-content/uploads/dubai-glamazons-blog.jpg
http://www.almariahtravel.com/inc_img/57421394625505.jpg
http://www.ahstatic.com/photos/6146_hodesti_00_p_1024x768.jpg
https://www.traditours.com/sliders/jordanie_croisiere/data1/images/04dubai.jpg
https://www.oneandonlyresorts.com/fr/-/media/oneandonly/the-palm/home-page/1440x900/the_palm_dubai_pool_beach_1440x900.jpg?v2
https://d12dkjq56sjcos.cloudfront.net/pub/media/wysiwyg/dubai/06-route-detail/View-Of-Dubai-Marina-Big-Bus-Tours-01.17.jpg
ENDTEXT
Local N,m.x
N=Int((Memlines(m.myvar))*Rand( ) + 1)
m.x=["url(']+Allt(Mline(m.myvar,N))+[')"]
with Thisform.olecontrol1.Document
.body.Style.backgroundImage=Eval(m.x)
.body.Style.backgroundsize="cover"
.body.Style.backgroundposition="center"
endwith
ENDPROC
PROCEDURE command2.Click
local m.xcolor
m.xcolor=getcolor()
if m.xcolor=-1
return .f.
endi
Local RGBChr,xred,xgreen,xblue
m.RGBChr=left(BINTOC(m.xcolor,'R'),3)
xred=asc(substr(m.RGBChr,1,1)) && RED
xgreen=asc(substr(m.RGBChr,2,1)) && GREEN
xblue=asc(substr(m.RGBChr,3,1)) && BLUE
local m.x
m.x='"'+'rgba('+Trans(m.xred)+','+Trans(m.xgreen)+","+Trans(m.xblue)+',.7)"'
thisform.olecontrol1.document.getElementById("mySidenav").style.background=eval(m.x)
ENDPROC
PROCEDURE timer1.Timer
thisform.olecontrol1.document.getElementById("mySidenav").style.width = "250px"
this.enabled=.f.
ENDPROC
ENDDEFINE
*
*-- EndDefine: ysidebar
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, ;
tooltiptext="Run modal form",;
Name = "Image1"
Add Object image2 As Image With ;
Stretch = 2, ;
Height = 32, ;
Left = 40, ;
MousePointer = 15, ;
Top = 4, ;
Width = 32, ;
tooltiptext="News", ;
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, ;
tooltiptext="AlwaysOnTop on/off", ;
Name = "Image15"
Add Object image16 As Image With ;
Stretch = 2, ;
Height = 32, ;
Left = 543, ;
MousePointer = 15, ;
Top = 4, ;
Width = 32, ;
tooltiptext="Change backcolor", ;
Name = "Image16"
Add Object image17 As Image With ;
Stretch = 2, ;
Height = 32, ;
Left = 578, ;
MousePointer = 15, ;
Top = 4, ;
Width = 32, ;
tooltiptext="Minimize", ;
Name = "Image17"
Add Object image18 As Image With ;
Stretch = 2, ;
Height = 32, ;
Left = 614, ;
MousePointer = 15, ;
Top = 4, ;
Width = 32, ;
tooltiptext="Maximize/restore", ;
Name = "Image18"
Add Object image19 As Image With ;
Stretch = 2, ;
Height = 32, ;
Left = 649, ;
MousePointer = 15, ;
Top = 4, ;
Width = 32, ;
tooltiptext="Form titlebar on/off",;
Name = "Image19"
Add Object image20 As Image With ;
Stretch = 2, ;
Height = 32, ;
Left = 685, ;
MousePointer = 15, ;
Top = 4, ;
Width = 32, ;
tooltiptext="Exit",;
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
If between(i,3,14) &&adapt images with filled codes
.ToolTipText="ImgMenu"+Trans(i) && not used
Endi
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,3,4,5,6,7,8,9,10,11,12,13,14) &&if control code not empty this is not needed)
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
Local yf
yf=Newobject("oform")
yf.Show(1) &&modal (olecontrol is always on top !)
Case N=2
&&shellexecute
Declare Integer ShellExecute In SHELL32.Dll Integer nWinHandle,;
STRING cOperation,;
STRING cFileName,;
STRING cParameters,;
STRING cDirectory,;
INTEGER nShowWindow
local m.x
m.x="shell:AppsFolder\Microsoft.BingNews_8wekyb3d8bbwe!AppexNews"
try
Local m.result
m.result = ShellExecute(0, "open", "explorer.exe ",m.x,"",1)
If result<=32
Messagebox("Fail to run!",16+4096,'',1200)
Endi
Catch
Messagebox("An error was occured!",16+4096,"Error",1200)
Endtry
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
thisform.alwaysontop=iif(thisform.alwaysontop=.f.,.t.,.f.)
Case N=16
local m.xcolor
m.xcolor=getcolor()
if m.xcolor=-1
return .f.
endi
thisform.backcolor=m.xcolor
Case N=17
thisform.windowstate=1
Case N=18
thisform.windowstate=iif(thisform.windowstate=0,2,0)
Case N=18
thisform.windowstate=iif(thisform.windowstate=0,2,0)
Case N=19
with Thisform
.TitleBar=Iif(.TitleBar=1,0,1)
if .titlebar=0
.height=.height+31
else
.height=.height-31
endi
endwith
Case N=20
Thisform.Release
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.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.ylab.Caption=""
Endproc
Enddefine
*
*-- EndDefine:ycnt_Imgs
Define Class oform As Form
ShowWindow = 1
Desktop=.T.
AutoCenter = .T.
Caption = "Form1"
BackColor = Rgb(0,255,0)
width=700
height=400
caption="Form modal with desktop=.t. (pb olecontrol alwaysonTop)"
Name = "Form1"
Add Object grid1 As Grid With ;
Anchor = 15,;
Height = 217,;
Left = 5,;
Top = 16,;
Width = 372,;
Name = "Grid1"
Procedure Init
Rand(-1)
This.BackColor=Rgb(255*Rand(),255*Rand(),255*Rand())
Endproc
procedure load
sele * from home(1)+"samples\data\customer" into cursor ycurs
endproc
Procedure grid1.Init
With This
.RecordSource="ycurs"
.RecordSourceType=1
.Themes=.F.
.left=20
.top=20
.width=thisform.width-40
.height=thisform.height-40
.GridLines=0
.HeaderHeight=30
.RowHeight=25
.DeleteMark=.F.
.RecordMark=.F.
For i=1 To .ColumnCount
.Columns(i).header1.BackColor=Rgb(255*Rand(),255*Rand(),255*Rand())
Endfor
.SetAll("DynamicBackColor","IIF(MOD(RECNO( ), 2)=0,RGB(200,206,180),RGB(255,255,255))", "Column")
.SetAll("fontbold",.T.,"header")
.SetAll("fontsize",14,"header")
Endwith
sele ycurs
Locate
Endproc
Enddefine
Important:All Codes above are tested on VFP9SP2 & windows 10 pro 64 bits version 1703 ( creator update) & IE11 emulation