A desktop application with subclassed pageframe and some effects
this code builds an application based on a subclassed pageframe tabs with an image.it give opportunity to write applications without digging in complex classes. the pagecount=8 here (set always pageframe.pagecount as in image in container). each page can embed any vfp control(s) or even olecontrols. the main image is covered with transparent shapes binded to 3 events (mousedown,mouseEnter and mouseLeave). the mousedown event can fire any programme,form,report or external app(notepad,MSpaint,ie,firefox...). i used the special shape effect with shape.drawmode property to have some native vfp transparency .there is a set of 23 clickable icons to fire any application ( as a similar toolbar). i added the special exit effect with also a shape and drawmode=9. 2 images are used in this code with no disc access (pictureVal property with internet connected of course) the first image is duplicated in 3 versions (same image) and at each start its rendomly set (1 of 3). the main form is movable by mousedown on image. with this artifact can build any desktop application . [post 232]
Click on code to select [then copy] -click outside to deselect
*1*created on 09 of may 2017.
*updated on 10 of may 2017 (3 background images instead one previously).
Publi yform
yform=Newobject("ypgf")
yform.Show
Read Events
Retu
*
Define Class ypgf As Form
BorderStyle = 0
Height = 604
Width = 984
ShowWindow = 2
ShowTips = .T.
AutoCenter = .T.
Caption = "Form1"
BackColor = Rgb(44,108,157)
xleft = .F.
xtop = .F.
xwidth = .F.
xheight = .F.
Name = "Form1"
Add Object container1 As ycont With ;
Top = 0, ;
Left = 0, ;
Width = 984, ;
Height = 204, ;
BackStyle = 0, ;
BorderWidth = 0, ;
BackColor = Rgb(240,240,240), ;
Name = "Container1"
Add Object pageframe1 As PageFrame With ;
ErasePage = .T., ;
PageCount = 8, ;
Anchor = 15, ;
Top = 204, ;
Left = -12, ;
Width = 996, ;
Height = 396, ;
Tabs = .F., ;
Themes = .F., ;
Name = "Pageframe1", ;
Page1.Caption = "Page1", ;
Page1.Name = "Page1", ;
Page2.Caption = "Page2", ;
Page2.Name = "Page2", ;
Page3.Caption = "Page3", ;
Page3.Name = "Page3", ;
Page4.Caption = "Page4", ;
Page4.Name = "Page4", ;
Page5.Caption = "Page5", ;
Page5.Name = "Page5", ;
Page6.Caption = "Page6", ;
Page6.Name = "Page6", ;
Page7.Caption = "Page7", ;
Page7.Name = "Page7", ;
Page8.Caption = "Page8", ;
Page8.Name = "Page8"
Procedure my
Lparameters nButton, nShift, nXCoord, nYCoord
*--- aevent create an array laEvents
Aevents( myArray, 0)
*--- reference the calling object
loObject = myArray[1]
x= Int(Val( Substr(loObject.Name,6)))
If Between(x,1,8)
Thisform.pageframe1.ActivePage=x
Else
Thisform.yactions(m.x)
Endi
Endproc
Procedure my1
Lparameters nButton, nShift, nXCoord, nYCoord
*--- aevent create an array laEvents
Aevents( myArray, 0)
*--- reference the calling object
loObject = myArray[1]
Local m.x
m.x=Int(Val(Substr(loObject.Name,6)))
With loObject
.ToolTipText=.Name
.DrawMode=9
.BackStyle=1
If m.x<=8
.BackColor=Rgb(0,255,0)
Else
.BackColor=255
Endi
.Curvature=15
*.fillcolor=rgb(0,255,0)
Endwith
Endproc
Procedure my2
Lparameters nButton, nShift, nXCoord, nYCoord
*--- aevent create an array laEvents
Aevents( myArray, 0)
*--- reference the calling object
loObject = myArray[1]
loObject.BackStyle=0
Endproc
Procedure yactions
Lparameters x
Messagebox("Shape"+Trans(x)+" clicked ...do some code from thisform.yactions() !",0+32+4096,'',1000)
*write code actions to run here
* do case
*!* case x= 9
*!* case x= 10
*!* case x= 11
*!* case x= 12
*!* case x= 13
*!* case x= 14
*!* case x= 15
*!* case x= 16
*!* case x= 17
*!* case x= 18
*!* case x= 19
*!* case x= 20
*!* case x= 21
*!* case x= 22
*!* case x= 23
*!* case x= 24
*!* case x= 25
*!* case x= 26
*!* case x= 27
*!* case x= 28
*!* case x= 29
*!* case x= 30
*!* case x= 31
*!* endcase
Endproc
Procedure Init
Thisform.TitleBar=0
_Screen.WindowState=1
Endproc
Procedure QueryUnload
With Thisform
If .pageframe1.ActivePage=1
.pageframe1.ActivePage=2 &&to avoid olecontrol in page1 always on top
Endi
Try
.AddObject("zshape","shape")
Catch
Endtry
With .zshape
.Left=0
.Top=0
.Width=.Parent.Width
.Height=.Parent.Height
.DrawMode=9
.BackColor=Rgb(46,46,46)
.ZOrder(0)
.Visible=.T.
Endwith
Endwith
If Messagebox("Want indeed to exit ?",4+64)=6
DoDefault()
Thisform.Release
Else
Thisform.RemoveObject("zshape")
Nodefault
Return .F.
Endi
Endproc
Procedure Activate
Thisform.WindowState=2
Endproc
Procedure Destroy
Clea Events
Endproc
Procedure pageframe1.Init
With This
For i=1 To .PageCount
.Pages(i).BackColor=Rgb(255*Rand(),255*Rand(),255*Rand())
Endfor
With .Page1
.AddObject("olecontrol1","olecontrol", "shell.explorer.2")
With .olecontrol1
.Top = 0
.Left = 0
.Height = 397
.Width = 997
.Anchor = 15
.Name = "Olecontrol1"
Thisform.ybuild()
.Visible=.T.
Endwith
Endwith
With .Page2
.AddObject("image1","image")
With .image1
.Picture =Home(1)+ "samples\tastrade\bitmaps\buchstev.bmp"
.Height = 223
.Left = 58
.Top = 46
.Width = 192
.Name = "Image1"
.Visible=.T.
Endwith
.AddObject("image2","image")
With .image2
.Picture = Home(1)+"samples\tastrade\bitmaps\calllaur.bmp"
.Height = 223
.Left = 593
.Top = 107
.Width = 192
.Name = "Image2"
.Visible=.T.
Endwith
Endwith
With .Page3
.AddObject("image1","image")
With .image1
.Picture =Home(1)+ "samples\tastrade\bitmaps\bridjust.bmp"
.Height = 223
.Left = 58
.Top = 46
.Width = 192
.Name = "Image1"
.Visible=.T.
Endwith
.AddObject("image2","image")
With .image2
.Picture = Home(1)+"samples\tastrade\bitmaps\davonanc.bmp"
.Height = 223
.Left = 593
.Top = 107
.Width = 192
.Name = "Image2"
.Visible=.T.
Endwith
Endwith
With .Page4
.AddObject("image1","image")
With .image1
.Picture =Home(1)+ "samples\tastrade\bitmaps\kingrobe.bmp"
.Height = 223
.Left = 58
.Top = 46
.Width = 192
.Name = "Image1"
.Visible=.T.
Endwith
.AddObject("image2","image")
With .image2
.Picture = Home(1)+"samples\tastrade\bitmaps\dodsanne.bmp"
.Height = 223
.Left = 593
.Top = 107
.Width = 192
.Name = "Image2"
.Visible=.T.
Endwith
Endwith
With .Page5
.AddObject("image1","image")
With .image1
.Picture =Home(1)+ "samples\tastrade\bitmaps\fullandr.bmp"
.Height = 223
.Left = 58
.Top = 46
.Width = 192
.Name = "Image1"
.Visible=.T.
Endwith
.AddObject("image2","image")
With .image2
.Picture = Home(1)+"samples\tastrade\bitmaps\levejane.bmp"
.Height = 223
.Left = 593
.Top = 107
.Width = 192
.Name = "Image2"
.Visible=.T.
Endwith
Endwith
With .Page6
.AddObject("image1","image")
With .image1
.Picture =Home(1)+ "samples\tastrade\bitmaps\martxavi.bmp"
.Height = 223
.Left = 58
.Top = 46
.Width = 192
.Name = "Image1"
.Visible=.T.
Endwith
.AddObject("image2","image")
With .image2
.Picture = Home(1)+"samples\tastrade\bitmaps\pattcaro.bmp"
.Height = 223
.Left = 593
.Top = 107
.Width = 192
.Name = "Image2"
.Visible=.T.
Endwith
Endwith
With .Page7
.AddObject("image1","image")
With .image1
.Picture =Home(1)+ "samples\tastrade\bitmaps\calllaur.bmp"
.Height = 223
.Left = 58
.Top = 46
.Width = 192
.Name = "Image1"
.Visible=.T.
Endwith
.AddObject("image2","image")
With .image2
.Picture = Home(1)+"samples\tastrade\bitmaps\peacmarg.bmp"
.Height = 223
.Left = 593
.Top = 107
.Width = 192
.Name = "Image2"
.Visible=.T.
Endwith
Endwith
With .Page8
.AddObject("image1","image")
With .image1
.Picture =Home(1)+ "samples\tastrade\bitmaps\pattcaro.bmp"
.Height = 223
.Left = 58
.Top = 46
.Width = 192
.Name = "Image1"
.Visible=.T.
Endwith
.AddObject("image2","image")
With .image2
.Picture = Home(1)+"samples\tastrade\bitmaps\peacmarg.bmp"
.Height = 223
.Left = 593
.Top = 107
.Width = 192
.Name = "Image2"
.Visible=.T.
Endwith
Endwith
Endwith
Endproc
Procedure ybuild
With Thisform.pageframe1.Page1.olecontrol1
.silent=.T.
.Left=0
.Top=0
.Width =.Parent.Parent.Width
.Height=.Parent.Parent.Height
Local m.myvar
TEXT to m.myvar noshow
<!DOCTYPE html>
<html>
<head>
<meta http-equiv="content-type" content="text/html; charset=UTF-8">
<meta name="robots" content="noindex, nofollow">
<meta name="googlebot" content="noindex, nofollow">
<script type="text/javascript" src="http://code.jquery.com/jquery-1.5.2.js"></script>
<link rel="stylesheet" type="text/css" href="http://fiddle.jshell.net/css/normalize.css">
<link rel="stylesheet" type="text/css" href="http://fiddle.jshell.net/css/result-light.css">
<style type="text/css">
.image {
position:relative;
}
.image img {
width:100%;
vertical-align:top;
}
.image:after {
content:'\A';
position:absolute;
width:100%; height:100%;
top:0; left:0;
background:rgba(0,0,0,0.6);
opacity:0;
transition: all 0.5s;
-webkit-transition: all 0.5s;
}
.image:hover:after {
opacity:1;
}
</style>
<title></title>
<script type='text/javascript'>//<![CDATA[
$(window).load(function(){
});//]]>
</script>
</head>
<body>
<div class="image">
<img src="http://i.stack.imgur.com/Sjsbh.jpg" alt="" />
</div>
<script>
// tell the embed parent frame the height of the content
if (window.parent && window.parent.parent){
window.parent.parent.postMessage(["resultsFrame", {
height: document.body.getBoundingClientRect().height,
slug: "s6q288sw"
}], "*")
}
</script>
</body>
</html>
ENDTEXT
.Navigate("about:blank")
.Document.Open()
.Document.Write(m.myvar)
.Document.Close()
Endwith
* .parent.refresh
Endproc
Enddefine
*
*-- EndDefine: ypgf
*
Define Class ycont As Container
Top = 0
Left = 0
Width = 984
Height = 204
BackStyle = 0
BorderWidth = 0
BackColor = Rgb(240,240,240)
Name = "Container1"
Add Object image1 As Image With ;
Picture = "_template_pgf1.png", ;
Height = 204, ;
Left = 0, ;
Top = 0, ;
Width = 984, ;
Name = "Image1"
Add Object shape1 As Shape With ;
Top = 90, ;
Left = 12, ;
Height = 44, ;
Width = 84, ;
Name = "Shape1"
Add Object shape2 As Shape With ;
Top = 91, ;
Left = 108, ;
Height = 39, ;
Width = 97, ;
Name = "Shape2"
Add Object shape3 As Shape With ;
Top = 86, ;
Left = 224, ;
Height = 49, ;
Width = 112, ;
Name = "Shape3"
Add Object shape4 As Shape With ;
Top = 84, ;
Left = 346, ;
Height = 49, ;
Width = 170, ;
Name = "Shape4"
Add Object shape5 As Shape With ;
Top = 84, ;
Left = 527, ;
Height = 50, ;
Width = 104, ;
Name = "Shape5"
Add Object shape6 As Shape With ;
Top = 84, ;
Left = 641, ;
Height = 51, ;
Width = 139, ;
Name = "Shape6"
Add Object shape7 As Shape With ;
Top = 84, ;
Left = 785, ;
Height = 49, ;
Width = 67, ;
Name = "Shape7"
Add Object shape8 As Shape With ;
Top = 89, ;
Left = 858, ;
Height = 43, ;
Width = 109, ;
Name = "Shape8"
Add Object label1 As Label With ;
AutoSize = .T., ;
FontBold = .T., ;
FontSize = 36, ;
Anchor = 768, ;
BackStyle = 0, ;
Caption = "Hello World!", ;
Height = 60, ;
Left = 36, ;
Top = 12, ;
Width = 282, ;
ForeColor = Rgb(255,255,0), ;
Name = "Label1"
Add Object label2 As Label With ;
AutoSize = .T., ;
FontBold = .T., ;
FontSize = 36, ;
Anchor = 768, ;
BackStyle = 0, ;
Caption = "Hello World!", ;
Height = 60, ;
Left = 32, ;
Top = 13, ;
Width = 282, ;
ForeColor = Rgb(0,255,0), ;
Name = "Label2"
Add Object image2 As Image With ;
Picture = "_applications-office.png", ;
Stretch = 2, ;
Height = 65, ;
Left = 810, ;
MousePointer = 15, ;
Top = 11, ;
Width = 65, ;
Name = "Image2"
Add Object text1 As TextBox With ;
BorderStyle = 0, ;
Height = 25, ;
Left = 658, ;
Top = 136, ;
Width = 215, ;
Name = "Text1"
Add Object shape9 As Shape With ;
Top = 168, ;
Left = 185, ;
Height = 32, ;
Width = 32, ;
BackStyle = 0, ;
Name = "Shape9"
Add Object shape10 As Shape With ;
Top = 168, ;
Left = 217, ;
Height = 32, ;
Width = 32, ;
BackStyle = 0, ;
Name = "Shape10"
Add Object shape11 As Shape With ;
Top = 168, ;
Left = 249, ;
Height = 32, ;
Width = 32, ;
BackStyle = 0, ;
Name = "Shape11"
Add Object shape12 As Shape With ;
Top = 168, ;
Left = 281, ;
Height = 32, ;
Width = 32, ;
BackStyle = 0, ;
Name = "Shape12"
Add Object shape13 As Shape With ;
Top = 168, ;
Left = 314, ;
Height = 32, ;
Width = 32, ;
BackStyle = 0, ;
Name = "Shape13"
Add Object shape14 As Shape With ;
Top = 168, ;
Left = 348, ;
Height = 32, ;
Width = 32, ;
BackStyle = 0, ;
Name = "Shape14"
Add Object shape15 As Shape With ;
Top = 168, ;
Left = 379, ;
Height = 32, ;
Width = 32, ;
BackStyle = 0, ;
Name = "Shape15"
Add Object shape16 As Shape With ;
Top = 168, ;
Left = 412, ;
Height = 32, ;
Width = 32, ;
BackStyle = 0, ;
Name = "Shape16"
Add Object shape17 As Shape With ;
Top = 168, ;
Left = 446, ;
Height = 32, ;
Width = 32, ;
BackStyle = 0, ;
Name = "Shape17"
Add Object shape18 As Shape With ;
Top = 168, ;
Left = 481, ;
Height = 32, ;
Width = 32, ;
BackStyle = 0, ;
Name = "Shape18"
Add Object shape19 As Shape With ;
Top = 168, ;
Left = 515, ;
Height = 32, ;
Width = 32, ;
BackStyle = 0, ;
Name = "Shape19"
Add Object shape20 As Shape With ;
Top = 168, ;
Left = 550, ;
Height = 32, ;
Width = 32, ;
BackStyle = 0, ;
Name = "Shape20"
Add Object shape21 As Shape With ;
Top = 168, ;
Left = 584, ;
Height = 32, ;
Width = 32, ;
BackStyle = 0, ;
Name = "Shape21"
Add Object shape22 As Shape With ;
Top = 168, ;
Left = 616, ;
Height = 32, ;
Width = 32, ;
BackStyle = 0, ;
Name = "Shape22"
Add Object shape23 As Shape With ;
Top = 168, ;
Left = 652, ;
Height = 32, ;
Width = 32, ;
BackStyle = 0, ;
Name = "Shape23"
Add Object shape24 As Shape With ;
Top = 168, ;
Left = 686, ;
Height = 32, ;
Width = 32, ;
BackStyle = 0, ;
Name = "Shape24"
Add Object shape25 As Shape With ;
Top = 168, ;
Left = 720, ;
Height = 32, ;
Width = 32, ;
BackStyle = 0, ;
Name = "Shape25"
Add Object shape26 As Shape With ;
Top = 168, ;
Left = 759, ;
Height = 32, ;
Width = 32, ;
BackStyle = 0, ;
Name = "Shape26"
Add Object shape27 As Shape With ;
Top = 168, ;
Left = 799, ;
Height = 32, ;
Width = 32, ;
BackStyle = 0, ;
Name = "Shape27"
Add Object shape28 As Shape With ;
Top = 168, ;
Left = 840, ;
Height = 32, ;
Width = 32, ;
BackStyle = 0, ;
Name = "Shape28"
Add Object shape29 As Shape With ;
Top = 168, ;
Left = 878, ;
Height = 32, ;
Width = 32, ;
BackStyle = 0, ;
Name = "Shape29"
Add Object shape30 As Shape With ;
Top = 168, ;
Left = 914, ;
Height = 32, ;
Width = 32, ;
BackStyle = 0, ;
Name = "Shape30"
Add Object shape31 As Shape With ;
Top = 168, ;
Left = 950, ;
Height = 32, ;
Width = 32, ;
BackStyle = 0, ;
Name = "Shape31"
Add Object command1 As CommandButton With ;
Top = 11, ;
Left = 958, ;
Height = 20, ;
Width = 20, ;
FontBold = .T., ;
FontSize = 12, ;
Anchor = 768, ;
Caption = "X", ;
MousePointer = 15, ;
SpecialEffect = 2, ;
ForeColor = Rgb(255,0,0), ;
BackColor = Rgb(128,255,0), ;
Name = "Command1"
Add Object command2 As CommandButton With ;
Top = 11, ;
Left = 912, ;
Height = 20, ;
Width = 20, ;
FontBold = .T., ;
FontSize = 12, ;
Anchor = 768, ;
Caption = "-", ;
MousePointer = 15, ;
SpecialEffect = 2, ;
ForeColor = Rgb(255,0,0), ;
BackColor = Rgb(128,255,0), ;
Name = "Command2"
Add Object command3 As CommandButton With ;
Top = 11, ;
Left = 935, ;
Height = 20, ;
Width = 20, ;
FontBold = .T., ;
FontName = "Webdings", ;
FontSize = 9, ;
Anchor = 768, ;
Caption = "1", ;
MousePointer = 15, ;
SpecialEffect = 2, ;
ForeColor = Rgb(255,0,0), ;
BackColor = Rgb(128,255,0), ;
Name = "Command3"
Procedure Init
With This
Rand(-1) &&set a random background picture (1 of 3)
Local rr
rr=Int((3) * Rand( ) + 1)
Try
Do Case
Case rr=1
.image1.PictureVal=yloadImg("http://img.over-blog-kiwi.com/1/43/54/07/20170509/ob_d85cdb_template-pgf1.png")
.image2.PictureVal=yloadImg("http://img.over-blog-kiwi.com/1/43/54/07/20170509/ob_cf0b09_applications-office.png")
Thisform.BackColor=Rgb(44,108,157)
Case rr=2
.image1.PictureVal=yloadImg("http://img.over-blog-kiwi.com/1/43/54/07/20170510/ob_563011_template-pgf2.png")
.image2.PictureVal=yloadImg("http://img.over-blog-kiwi.com/1/43/54/07/20170509/ob_cf0b09_applications-office.png")
Thisform.BackColor=0
Case rr=3
.image1.PictureVal=yloadImg("http://img.over-blog-kiwi.com/1/43/54/07/20170510/ob_6f63c8_template-pgf3.png")
.image2.PictureVal=yloadImg("http://img.over-blog-kiwi.com/1/43/54/07/20170509/ob_cf0b09_applications-office.png")
Thisform.BackColor=Rgb(255,242,0)
Endcase
Catch
Endtry
.Left=0
.Top=0
.SetAll("backstyle",0,"shape")
.SetAll("borderstyle",0,"shape")
.SetAll("mousepointer",15,"shape")
For i=1 To .ControlCount
If Lower(.Controls(i).Class)=="shape"
Bindevent(.Controls(i),"mousedown",Thisform,"my")
Bindevent(.Controls(i),"mouseEnter",Thisform,"my1")
Bindevent(.Controls(i),"mouseLeave",Thisform,"my2")
Endi
Endfor
Endwith
Endproc
Procedure image1.Init
With This
.Left=0
.Top=0
.Stretch=0
.ZOrder(1)
Endwith
Endproc
Procedure image2.Click
Local m.myvar
TEXT to m.myvar pretext 7 noshow
this code builds an application based on a subclassed pageframe tabs with an image.it give opportunity to write applications without digging in complex classes.
the pagecount=8 here.
each page can embed any vfp control(s) or even olecontrols.
the main image is covered with transparent shapes binded to 3 events (mousedown,mouseEnter and mouseLeave).
the mousedown event can fire any programme,form,report or external app(notepad,MSpaint,ie,firefox...).
i used the special shape effect with shape.drawmode property to have some native vfp transparency .there is a set of 23 clickable icons to fire any application ( as a similar toolbar).
i added the special exit effect with also a shape and drawmode=9.
2 images are used in this code with no disc access (pictureVal property with internet connected of course)
with this artifact can build any desktop application .
ENDTEXT
*Messagebox(m.myvar,0+32+4096)
Local oshell
oshell = Createobject('WScript.Shell')
oshell.Popup(m.myvar,0, 'Summary help', 0+32+4096) &&4,16,48,64...
oshell=Null
Endproc
Procedure command1.MouseEnter
Lparameters nButton, nShift, nXCoord, nYCoord
This.BackColor=255
Endproc
Procedure command1.MouseLeave
Lparameters nButton, nShift, nXCoord, nYCoord
This.BackColor=Rgb(0,255,0)
Endproc
Procedure command1.Click
Thisform.QueryUnload() &&release or not
Endproc
Procedure command2.MouseLeave
Lparameters nButton, nShift, nXCoord, nYCoord
This.BackColor=Rgb(0,255,0)
Endproc
Procedure command2.MouseEnter
Lparameters nButton, nShift, nXCoord, nYCoord
This.BackColor=255
Endproc
Procedure command2.Click
Try
yaerot.WindowState=1
Catch
Endtry
Thisform.WindowState=1
Endproc
Procedure command3.MouseEnter
Lparameters nButton, nShift, nXCoord, nYCoord
This.BackColor=255
Endproc
Procedure command3.MouseLeave
Lparameters nButton, nShift, nXCoord, nYCoord
This.BackColor=Rgb(0,255,0)
Endproc
Procedure command3.Click
Do Case
Case This.Caption=="1"
This.Caption="2"
With Thisform
.xleft=.Left
.xtop=.Top
.xwidth=.Width
.xheight=.Height
.Left=0
.Top=0
.Width=Sysmetric(1)
.Refresh
Endwith
Case This.Caption=="2"
This.Caption="1"
With Thisform
.Left=.xleft
.Top=.xtop
.Width=.xwidth
Endwith
Endcase
Endproc
Enddefine
*
*-- EndDefine: ycont
Function yloadImg
Lparameters lcURL
Local loRequest
m.loRequest = Createobject('MsXml2.XmlHttp')
m.loRequest.Open("GET",lcURL,.F.)
m.loRequest.Send()
local m.x
m.x=m.loRequest.ResponseBody
m.loRequest=Null
Return m.x
Endfunc
if change the shipped web images by images on disc dont omit to change pictureVal to picture !
Click on code to select [then copy] -click outside to deselect
*2* created on saturday 10 of june 2017
*this code uses only the tabs of a pageframe to align as clickable buttons to run some custom codes.it looks like a dockable toolbar.
*the themes must be set to .f. -here the pagecount=10 (10 buttons)
*the tabOrienttion tweaked with some code below, makes the buttons in 4 sides of the form (change the spinner value and click on any tab).
Publi yform
yform=Newobject("asup")
yform.Show
Read Events
Retu
*
Define Class asup As Form
BorderStyle = 3
Top = 0
Left = 0
Height = 522
Width = 1007
ShowWindow = 2
ScrollBars = 2
Caption = "Using a pageframe as buttons toolbar"
Name = "Form1"
Add Object pageframe1 As PageFrame With ;
ErasePage = .T., ;
PageCount = 10, ;
Top = 0, ;
Left = 0, ;
Width = 1009, ;
Height = 32, ;
Name = "Pageframe1", ;
Page1.Caption = "Page1", ;
Page1.Name = "Page1", ;
Page2.Caption = "Page2", ;
Page2.Name = "Page2", ;
Page3.Caption = "Page3", ;
Page3.Name = "Page3", ;
Page4.Caption = "Page4", ;
Page4.Name = "Page4", ;
Page5.Caption = "Page5", ;
Page5.Name = "Page5", ;
Page6.Caption = "Page6", ;
Page6.Name = "Page6", ;
Page7.Caption = "Page7", ;
Page7.Name = "Page7", ;
Page8.Caption = "Page8", ;
Page8.Name = "Page8", ;
Page9.Caption = "Page9", ;
Page9.Name = "Page9", ;
Page10.Caption = "Page10", ;
Page10.Name = "Page10"
Add Object spinner1 As Spinner With ;
Height = 37, ;
KeyboardHighValue = 3, ;
KeyboardLowValue = 0, ;
Left = 384, ;
SpinnerHighValue = 3.00, ;
SpinnerLowValue = 0.00, ;
Top = 144, ;
Width = 85, ;
Name = "Spinner1"
Add Object label1 As Label With ;
AutoSize = .T., ;
FontSize = 12, ;
BackStyle = 0, ;
Caption = "Taborientation (0-1-2-3)", ;
Height = 21, ;
Left = 369, ;
Top = 185, ;
Width = 167, ;
ForeColor = Rgb(255,0,0), ;
Name = "Label1"
Procedure my
*--- aevent create an array laEvents
Aevents( myArray, 0)
*--- reference the calling object
loObject = myArray[1]
Messagebox(loObject.Caption +" clicked....can run some code from here!",0+32+4096,'',1200)
Endproc
Procedure Resize
Thisform.spinner1.InteractiveChange()
Endproc
Procedure Destroy
Clea Events
Endproc
Procedure pageframe1.Init
With This
.Themes=.F.
Rand(-1)
For i=1 To .PageCount
.Pages(i).BackColor=Rgb( 255*Rand(),255*Rand(),255*Rand())
.MousePointer=15
.Height=30
.Pages(i).Caption="MyCaption"+Trans(i)
.pages(i).fontbold=.t.
Bindevent(.Pages(i),"click",Thisform,"my")
Endfor
Endwith
Endproc
Procedure spinner1.InteractiveChange
Do Case
Case This.Value=0
With Thisform.pageframe1
.Height=30
.Top=0
.Width=0.9*.Parent.Width
.Left=0
Endwith
Case This .Value=1
With Thisform.pageframe1
.Height=30
.Top=Thisform.Height-30
.Width=0.9*.Parent.Width
.Left=0
Endwith
Case This.Value=2
With Thisform.pageframe1
.Top=0
.Height=0.9*Thisform.Width
.Width=30
.Left=0
Endwith
Case This.Value=3
With Thisform.pageframe1
.Top=0
.Height=0.9*Thisform.Width
.Width=30
.Left=.Parent.Width-30
Endwith
Endcase
With Thisform.pageframe1
.TabOrientation=This.Value
.Refresh
.parent.refresh
Endwith
Endproc
Enddefine
*
*-- EndDefine: asup
Important:All Codes above are tested on VFP9SP2 , windows 10 pro & IE11 Emulation.