Playing with splitters
The splitter is a control (here a shape) can divide a screen or form or container into two or many (more splitters) resizable parts.
it can be horizontal or vertical.
i used the sps splitter class (with light modifications) to make it in use with this top level form as demo.
the class is as a flat text in the end of the code below.can reverse to make it as (vcx+vct) and drop it on a form.
sps link:http://www.sweetpotatosoftware.com/spsblog/2005/08/13/SplitterClassForVisualFoxPro.aspx
there is 3 containers with some advanced complexity with some controls as treeview,listbox,grid,editbox,label,image....
the sps class is the best splitter i found in vfp namespace because its light and performent.
preferably use containers to split complex configuration controls.
in the demo there is 4 splitters (1 vertical and 3 horizontal).mousedown on the splitter to move the adjacent controls.this can split as well the form or screen into economic areas.
see the images below.
first image is downloaded from web to beautify an image control in container.can replace it with local image (name it as yimage.jpg) and cut the relative code at begin.
Click on code to select [then copy] -click outside to deselect
*1*
Publi m.yrep
m.yrep=Addbs(Justpath(Sys(16,1)))
Set Defa To (yrep)
*download the picture used in code.if dont have internet connect , replace by a local image named yimage.jpg
Declare Integer URLDownloadToFile In urlmon.Dll Integer pCaller, String szURL, String szFileName, Integer dwReserved, Integer lpfnCB
Declare Integer DeleteUrlCacheEntry In wininet String lpszUrlName
Local lcDownloadURL,lcDownloadLoc,lnResult
lcDownloadURL = "http://img.over-blog-kiwi.com/1/43/54/07/20160217/ob_d8f409_sam-2259-resized.JPG"
lcDownloadLoc = "yImage.jpg"
lnResult = DeleteUrlCacheEntry(lcDownloadURL)
lnResult = URLDownloadToFile(0, lcDownloadURL, lcDownloadLoc , 0,0)
If lnResult = 0
Wait Window "Download yimage.jpg Complete" nowait
*Else
*!* Messagebox("Download fails")
Endi
Publi yform
yform=Newobject("ysplitters")
yform.Show
Read Events
Retu
*
Define Class ysplitters As Form
Height = 570
Width = 881
ShowWindow = 2
ShowTips = .T.
AutoCenter = .T.
Caption = "Splitters Demo"
BackColor = Rgb(212,208,200)
Name = "Form1"
Add Object splitter1 As splitter With ;
Top = 54, ;
Left = 223, ;
Height = 521, ;
Width = 6, ;
Anchor = 7, ;
Name = "Splitter1"
Add Object ycont As ycont With ;
Anchor = 7, ;
Top = 48, ;
Left = 0, ;
Width = 224, ;
Height = 527, ;
Name = "ycont"
Add Object ycont1 As ycont1 With ;
Anchor = 15, ;
Top = 48, ;
Left = 232, ;
Width = 644, ;
Height = 527, ;
Name = "ycont1"
Add Object ycont0 As ycont0 With ;
Anchor = 10, ;
Top = 3, ;
Left = -1, ;
Width = 877, ;
Height = 36, ;
BorderWidth = 0, ;
BackColor = Rgb(0,0,0), ;
Name = "ycont0"
Add Object splitter2 As splitter With ;
Top = 36, ;
Left = 2, ;
Height = 11, ;
Width = 874, ;
Anchor = 10, ;
vertical = .F., ;
minimumsize = 29, ;
Name = "Splitter2"
Procedure filltree
Parameters m.path, m.nlevel, m.nCount
Local DirArr,i,nTotDir,lvl,pkey
m.path = Alltrim(m.path)
If Parameters()<2 Or Type("m.nlevel") #"N"
lvl = 0
Else
lvl = m.nlevel
Endif
If Parameters()<2 Or Type("m.nCount") #"N"
Cnt = 0
Else
Cnt = m.nCount
Endif
lvl = lvl + 1
Cnt = Cnt + 1
pkey = Lower(Substr(m.path,1,Rat("\",m.path,2)))+"_"
* Add items to treeview control
o = This.ycont.oleTreeview
If Cnt = 1
oNode = o.nodes.Add(,1,Lower(m.path)+"_",Lower(m.path),,)
oNode.Image = "world"
Else
oNode = o.nodes.Add(m.pkey,4,Lower(m.path)+"_",Strtran( Strtran(Lower(m.path),"c:\program files\microsoft visual foxpro 9\samples\solution\",""),"\",""),,)
oNode.Image="open"
Endif
Dimension DirArr[1,1]
nTotDir=Adir(DirArr,m.path+"*.","D")
Asort(DirArr)
For i = 1 To m.nTotDir
If DirArr[m.i,1] != '.' And Atc('D',DirArr[m.i,5])#0
This.filltree(m.path+DirArr[m.i,1]+'\', m.lvl, m.cnt)
Endif
Endfor
Endproc
Procedure Load
Close Data All
Sele company From Home(1)+"samples\data\customer" Into Cursor ycurs
Endproc
Procedure Destroy
Clea Events
Endproc
Enddefine
*
*-- EndDefine:ysplitters
Define Class ycont As Container
Anchor = 7
Top = 48
Left = 0
Width = 224
Height = 527
lexpanded=.F.
Name = "ycont"
Add Object splitter2 As splitter With ;
Top = 311, ;
Left = 8, ;
Height = 6, ;
Width = 206, ;
Anchor = 90, ;
vertical = .F., ;
minimumsize = 29, ;
Name = "Splitter2"
Add Object list1 As ListBox With ;
FontBold = .T., ;
FontName = "Segoe Script", ;
FontSize = 10, ;
Anchor = 80, ;
Height = 212, ;
ColumnLines = .T., ;
Left = 4, ;
MousePointer = 15, ;
Top = 324, ;
Width = 212, ;
ItemForeColor = Rgb(0,255,255), ;
ItemBackColor = Rgb(0,0,0), ;
ItemTips = .T., ;
Name = "List1"
Add Object oleTreeview As OleControl With ;
oleclass="MSComctlLib.TreeCtrl.2", ;
Top = 5, ;
Left = 7, ;
Height = 295, ;
Width = 209, ;
Anchor = 75, ;
Name = "oleTreeview"
Add Object oleimageslist As OleControl With ;
oleclass="MSComctlLib.ImageListCtrl.2" , ;
Top = 165, ;
Left = 183, ;
Height = 100, ;
Width = 100, ;
Name = "oleImageslist"
Procedure Init
If Fontmetric(1, 'MS Sans Serif', 8, '') # 13 Or ;
fontmetric(4, 'MS Sans Serif', 8, '') # 2 Or ;
fontmetric(6, 'MS Sans Serif', 8, '') # 5 Or ;
fontmetric(7, 'MS Sans Serif', 8, '') # 11
This.SetAll('fontname', 'Tahoma')
Else
This.SetAll('fontname','MS Sans Serif')
Endif
This.SetAll('fontsize',8)
********
Procedure Init
* Check to see if OCX installed and loaded.
If Type("THIS.oleTreeview") # "O" Or Isnull(This.oleTreeview)
Return .F.
Endif
* Check to see if OCX installed and loaded.
If Type("THIS.oleImagesList") # "O" Or Isnull(This.oleimageslist)
Return .F.
Endif
With This.oleimageslist
xpic1=Home(1)+"GRAPHICS\ICONS\WIN95\MYCOMP.ICO"
xpic2=Home(1)+"graphics\bitmaps\outline\closed.bmp"
xpic3=Home(1)+"GRAPHICS\BITMAPS\TLBR_W95\OPEN.BMP"
.ImageHeight = 16
.ImageWidth = 16
.usemaskcolor=.T.
.ListImages.Add(,"world",LoadPicture(m.xpic1))
.ListImages.Add(,"open",LoadPicture(m.xpic2))
.ListImages.Add(,"openo",LoadPicture(m.xpic3))
Endwith
This.oleTreeview.ImageList =This.oleimageslist.Object
Local cDir
cDir = Home(1)+"samples\solution\"
If Empty(m.cDir)
Return .F.
Endif
This.oleTreeview.nodes.Clear
Thisform.filltree(m.cDir)
********
*expand all nodes
If This.oleTreeview.nodes.Count > 0
* only do this if we have nodes in the treeview
For Each loNode In This.oleTreeview.nodes
If loNode.Children > 0
* only do this if this node has child nodes
loNode.Expanded = !This.lexpanded
Endif
Endfor
* set form's Expanded property to new value
This.lexpanded = !This.lexpanded
Endif
Endproc
Procedure list1.Init
With This
.ColumnCount = 1
.RowSourceType = 6
.RowSource = "ycurs.company"
Endwith
Endproc
Procedure oleTreeview.NodeClick
*** Événement de contrôle ActiveX ***
Lparameters Node
*repaint all nodes with icon "open"
i=1
For Each loNode In This.nodes
If i=1
loNode.Image="world"
Else
loNode.Image= "open"
Endi
i=i+1
Endfor
*change only icon node clicked only to "openo"
Node.Image="openo"
Endproc
Enddefine
*
*-- EndDefine: ycont
Define Class ycont1 As Container
Anchor = 15
Top = 48
Left = 232
Width = 644
Height = 527
Name = "ycont1"
Add Object grid1 As Grid With ;
Anchor=15, ;
Height = 247, ;
Left = 5, ;
Top = 5, ;
Width = 639, ;
Name = "Grid1"
Add Object splitter2 As splitter With ;
Top = 253, ;
Left = 3, ;
Height = 11, ;
Width = 641, ;
Anchor = 10, ;
vertical = .F., ;
minimumsize = 29, ;
Name = "Splitter2"
Add Object image1 As Image With ;
Anchor = 15, ;
Picture =m.yrep+ "yimage.jpg", ;
Stretch = 2, ;
Height = 268, ;
Left = 1, ;
Top = 260, ;
Width = 643, ;
Name = "Image1"
Procedure grid1.Init
Sele * From Home(1)+"samples\data\customer" Into Cursor ycurs
With This
.RecordSource="ycurs"
.DeleteMark=.F.
.GridLines=0
.Themes=.F.
.SetAll("backcolor",Rgb(212,208,200),"header")
.SetAll("forecolor",Rgb(255,0,0),"header")
.SetAll("fontbold",.T.,"header")
.SetAll("DynamicBackColor","IIF(MOD(RECNO( ), 2)=0, RGB(225,205,235) , RGB(208,215,212))", "Column")
Locate
.Refresh
Endwith
Enddefine
*
*-- EndDefine:ycont1
Define Class ycont0 As Container
Anchor = 10
Top = 3
Left = -1
Width = 877
Height = 36
BorderWidth = 0
BackColor = Rgb(0,0,0)
Name = "ycont0"
Add Object label1 As Label With ;
FontName = "Segoe Script", ;
FontSize = 22, ;
Anchor = 10, ;
Alignment = 2, ;
Caption = "This is a splitter demo", ;
Height = 37, ;
Left = 1, ;
Top = -4, ;
Width = 800, ;
ForeColor = Rgb(255,0,0), ;
BackColor =0, ;
Name = "Label1"
Add Object yhelp As Label With ;
FontName = "Arial", ;
FontSize = 20, ;
fontbold=.T.,;
mousepointer=15,;
Anchor = 10, ;
Alignment = 2, ;
Caption = "?", ;
autosize=.T.,;
Left = 820, ;
Top = 0, ;
ForeColor = Rgb(0,255,0), ;
BackColor =0, ;
Name = "yHelp"
Add Object edit1 As EditBox With ;
Anchor = 15, ;
Height = 200, ;
Left =119, ;
Top = 38, ;
Width = 639, ;
fontsize=12,;
backcolor=0,;
ForeColor = Rgb(255,255,255), ;
Name = "Edit1"
Procedure Init
TEXT to this.edit1.value noshow
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.
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.
ENDTEXT
This.edit1.Left=(This.Width-This.edit1.Width)/2
This.Refresh
Endproc
Procedure yhelp.Click
local m.myvar
text to m.myvar noshow
The splitter is a control can divide a screen or form or container into two or many resizable parts.
it can be horizontal or vertical.
i used the sps splitter class (with light modifications) to make it in use with this demo.
the class is as a flat text in the end of the code below.can reverse to make it as (vcx+vct)
sps link:http://www.sweetpotatosoftware.com/spsblog/2005/08/13/SplitterClassForVisualFoxPro.aspx
there is 3 containers with some advanced complexity with some controls as treeview,listbox,grid,editbox,label,image....
the sps class is the best splitter i found in vfp namespace because its light and performent.
preferably use containers to split complex configuration controls.
in the demo there is 4 splitters (1 vertical and 3 horizontal).mousedown on the splitter to move the adjacent
controls.this can split as well the form or screen into economic areas.
see the images below.
first image is downloaded from web to beautify an image control in container.
endtext
Messagebox(m.myvar,0+32+4096,"summary help")
endproc
Enddefine
*
*-- EndDefine: ycont0
*this class is from SPS website translated to flat text
Define Class splitter As Shape
Height = 182
Width = 8
MousePointer = 9
SpecialEffect = 0
Style = 0
BackColor=Rgb(192,192,192)
mousedownat = 0 && Tracks mouse and allows class to ignore moves caused by resizing form
vertical = .T. && Set to .F. for horizontal splitter
minimumsize = 40 && This is how small (in pixels) the panels can get when moving the splitter
Name = "splitter"
Procedure MouseLeave
Lparameters nButton, nShift, nXCoord, nYCoord
This.mousedownat = 0
Endproc
Procedure Move
Lparameters nLeft, nTop, nWidth, nHeight
*!* If you want to move the splitter during runtime and have it move the other controls
*!* then set mousedownat != 0 and call this move method of the splitter
*!* remember to set mousedownat back to 0 when you are done moving the splitter
Local loControl, llLockScreenWas, lnMovement, llIsSplitter, lcUniqueTag, lnMarginOfError, lnAnchorWas
If This.mousedownat == 0
DoDefault(m.nLeft, m.nTop, m.nWidth, m.nHeight)
Return
Endif
m.loControl = Null
*!* The following tag can be placed in controls you don't want moved as well
m.lcUniqueTag = "DoN't_MoVe_SpLiT" && Just something that is pretty well guaranteed to be unique
This.Tag = m.lcUniqueTag
m.llLockScreenWas = Thisform.LockScreen && JIC the screen was already locked
Thisform.LockScreen = .T.
m.lnMovementLeft = m.nLeft - This.Left
m.lnMovementTop = m.nTop - This.Top
For Each m.loControl In This.Parent.Controls
If m.loControl.Tag = lcUniqueTag && this splitter so just loop
Loop
Endif
If Pemstatus(m.loControl,"Anchor",5)
m.lnAnchorWas = m.loControl.Anchor
m.loControl.Anchor = 0
m.llIsSplitter = m.loControl.Class = "Splitter"
If This.vertical && Vertical Splitter
lnMarginOfError = Int(This.Width/2) && JIC the developer got the splitter a little too close
If m.loControl.Left <= This.Left && Control is to the left of splitter
If (m.loControl.Left + m.loControl.Width) <= (This.Left + lnMarginOfError) And !m.llIsSplitter
m.loControl.Width = Max(m.loControl.Width + m.lnMovementLeft, 0)
Endif
Else && Control is to the right of splitter
If !m.llIsSplitter
m.loControl.Width = Max(m.loControl.Width - m.lnMovementLeft, 0)
Endif
m.loControl.Left = m.loControl.Left + m.lnMovementLeft
Endif
Else && Horizontal Splitter
lnMarginOfError = Int(This.Top/2) && JIC the developer got the splitter a little too close
If m.loControl.Top <= This.Top && Control is above the splitter
If (m.loControl.Top + m.loControl.Height) <= (This.Top + lnMarginOfError) And !m.llIsSplitter
m.loControl.Height = Max(m.loControl.Height + m.lnMovementTop, 0)
Endif
Else && Control is below the splitter
If !m.llIsSplitter
m.loControl.Height = Max(m.loControl.Height - m.lnMovementTop, 0)
Endif
m.loControl.Top = m.loControl.Top + m.lnMovementTop
Endif
Endif
m.loControl.Anchor = m.lnAnchorWas
Endif
Next
m.lnAnchorWas = This.Anchor
This.Anchor = 0
DoDefault(m.nLeft, m.nTop, m.nWidth, m.nHeight) && Finally move the splitter
This.Anchor = m.lnAnchorWas
Thisform.LockScreen = m.llLockScreenWas
This.Tag = ""
Endproc
Procedure MouseMove
Lparameters nButton, nShift, nXCoord, nYCoord
Local lnMovement
If m.nButton = 1 And !(This.mousedownat == 0)
If This.vertical
If m.nXCoord != This.mousedownat
m.lnMovement = m.nXCoord - This.mousedownat
If Between(This.Left + m.lnMovement, This.minimumsize, This.Parent.Width - This.Width - This.minimumsize)
This.Move(This.Left + m.lnMovement, This.Top, This.Width, This.Height)
This.mousedownat = m.nXCoord
Endif
Endif
Else && Horizontal
If m.nYCoord != This.mousedownat
m.lnMovement = m.nYCoord - This.mousedownat
If Between(This.Top + m.lnMovement, This.minimumsize, This.Parent.Height - This.Height - This.minimumsize)
This.Move(This.Left, This.Top + m.lnMovement, This.Width, This.Height)
This.mousedownat = m.nYCoord
Endif
Endif
Endif
Endif
Endproc
Procedure MouseDown
Lparameters nButton, nShift, nXCoord, nYCoord
If This.vertical
This.mousedownat = nXCoord
Else
This.mousedownat = nYCoord
Endif
Endproc
Procedure Init
*IF !THIS.vertical
* THIS.MOUSEPOINTER = 7 && NS
*ENDIF
With This &&modified
If .vertical
.MouseIcon=Home(1)+"GRAPHICS\CURSORS\VE_SPLIT.CUR"
.MousePointer=99
Else
.MouseIcon=Home(1)+"GRAPHICS\CURSORS\HO_SPLIT.CUR"
.MousePointer=99
Endi
Endwith
Endproc
Procedure MouseUp
Lparameters nButton, nShift, nXCoord, nYCoord
This.mousedownat = 0
Endproc
Enddefine
*ENDDEFINE splitter
the first image is used and downloaded in code as yimage.jpg
Important:All Codes above are tested on VFP9SP2 & windows 10 pro