1) The Resizer class
VFP9 come with the Anchor property.
A Resizer class must scan all form's objects and set the Anchor property to 16+32+64+128, for each one.
Because some objects, like grid columns or pages inside a pageframe, does not have the anchor property, or the controls property, require a special attention.
But the class isn't complicated.
At some starting point, a method must collect the original values for FontSize and, in some cases, other properties like RowHeight, HeaderHeight (for a grid) and even Width or Height (for the form itself). These values must be stored somewhere, because they would be used as basis to calculate the new values of the same properties.
Then, in the Resize() event of the form, must be called another method that scans and calculate the new values for each object.
*************************************************************
* The resizer class
*************************************************************
DEFINE CLASS MyResize as Custom
nAmount = 1 && the amount for width
nAmountH = 1 && the amount for height
ADD OBJECT myCol as Collection && stores original width, height or fontsize
* First collect the original sizes and fontsizes
* Collect data for the form
PROCEDURE DoCollect1
This.MyCol.Add(ThisForm.Width,"_orig_Width" + SYS(1272,ThisForm))
This.MyCol.Add(ThisForm.Height,"_orig_Height" + SYS(1272,ThisForm))
This.DoCollect(ThisForm)
ENDPROC
* Collect data for embeded objects
PROCEDURE DoCollect
LPARAMETERS toParent
IF m.toParent = this
RETURN
ENDIF
IF PEMSTATUS(m.toParent,'Anchor',5)
toParent.Anchor = 16+32+64+128
ENDIF
IF PEMSTATUS(m.toParent,'FontSize',5)
This.MyCol.Add(m.toParent.FontSize,"_orig_FontSize" + SYS(1272,toParent))
ENDIF
IF PEMSTATUS(m.toParent,'RowHeight',5) && for grid
This.MyCol.Add(m.toParent.RowHeight,"_orig_RowHeight" + SYS(1272,toParent))
ENDIF
IF PEMSTATUS(m.toParent,'HeaderHeight',5) && for grid
This.MyCol.Add(m.toParent.HeaderHeight,"_orig_HeaderHeight" + SYS(1272,toParent))
ENDIF
IF PEMSTATUS(m.toParent,'Controls',5)
FOR EACH loObj IN m.toParent.Controls
This.DoCollect(m.loObj)
NEXT
ENDIF
IF PEMSTATUS(m.toParent,'Pages',5) && for pageframe
FOR EACH loObj IN m.toParent.Pages
This.DoCollect(m.loObj)
NEXT
ENDIF
IF PEMSTATUS(m.toParent,'Columns',5) && for grid
FOR EACH loObj IN m.toParent.Columns
IF This.MyCol.GetKey("_orig_Width" + SYS(1272,toParent)) = 0
This.MyCol.Add(m.loObj.Width,"_orig_Width" + SYS(1272,toParent))
ENDIF
This.DoCollect(m.loObj)
NEXT
ENDIF
ENDPROC
* The resize method (change form's appearance)
PROCEDURE DoResize1
This.nAmount = ThisForm.Width / This.MyCol.Item("_orig_Width" + SYS(1272,ThisForm))
This.nAmountH = ThisForm.Height / This.MyCol.Item("_orig_Height" + SYS(1272,ThisForm))
This.DoResize(ThisForm)
TRY
ThisForm.FontSize = CEILING(This.MyCol.Item("_orig_FontSize" + SYS(1272,ThisForm)) * MIN(This.nAmount, This.nAmountH))
CATCH
ENDTRY
ENDPROC
* The magnifying method (change form's appearance)
PROCEDURE DoResize2
LPARAMETERS tnAmount
IF m.tnAmount > 0
STORE m.tnAmount TO This.nAmount, This.nAmountH
ThisForm.Width = m.tnAmount * This.MyCol.Item("_orig_Width" + SYS(1272,ThisForm))
ThisForm.Height = m.tnAmount * This.MyCol.Item("_orig_Height" + SYS(1272,ThisForm))
This.DoResize(ThisForm)
ENDIF
TRY
ThisForm.FontSize = CEILING(This.MyCol.Item("_orig_FontSize" + SYS(1272,ThisForm)) * MIN(This.nAmount, This.nAmountH))
CATCH
ENDTRY
ENDPROC
* The resize method (adjust form's objects)
PROCEDURE DoResize
LPARAMETERS toParent
LOCAL loObj
IF PEMSTATUS(m.toParent,'FontSize',5)
TRY
toParent.FontSize = FLOOR(This.MyCol.Item("_orig_FontSize" + SYS(1272,toParent)) * MIN(This.nAmount, This.nAmountH))
CATCH
ENDTRY
ENDIF
IF PEMSTATUS(m.toParent,'RowHeight',5) && for grid
toParent.RowHeight = CEILING(This.MyCol.Item("_orig_RowHeight" + SYS(1272,toParent)) * This.nAmountH)
ENDIF
IF PEMSTATUS(m.toParent,'HeaderHeight',5) && for grid
toParent.HeaderHeight = CEILING(This.MyCol.Item("_orig_HeaderHeight" + SYS(1272,toParent)) * This.nAmountH)
ENDIF
IF PEMSTATUS(m.toParent,'Controls',5)
FOR EACH loObj IN m.toParent.Controls
This.DoResize(m.loObj)
NEXT
ENDIF
IF PEMSTATUS(m.toParent,'Pages',5) && for pageframe
FOR EACH loObj IN m.toParent.Pages
This.DoResize(m.loObj)
NEXT
ENDIF
IF PEMSTATUS(m.toParent,'Columns',5) && for grid
FOR EACH loObj IN m.toParent.Columns
loObj.Width = CEILING(This.MyCol.Item("_orig_Width" + SYS(1272,toParent)) * This.nAmount)
This.DoResize(m.loObj)
NEXT
ENDIF
ENDPROC
ENDDEFINE
*************************************************************
* End of the resizer class
*************************************************************
2) The Zooming tool
Having this class, it's easy to build a combobox that provide the "zoom" facility
In the Interactivechange() and Valid() event of that class, simply must be called the appropriate method form the Resizer class.
***************************
* The magnifier combo
***************************
DEFINE CLASS MyMagnifier as ComboBox
oMyResize = Null && pointer to the Resizer object
RowSourceType = 1
RowSource = "25%,50%,75%,100%,125%,150%,200%"
Value = "100%"
Format = "KT"
PROCEDURE Interactivechange
IF TYPE("This.oMyResize") = "O" AND !ISNULL(This.oMyResize)
This.oMyResize.DoResize2(VAL(This.Value)/100)
ENDIF
This.SelStart = LEN(ALLTRIM(This.DisplayValue))
ENDPROC
PROCEDURE Valid
IF TYPE("This.oMyResize") = "O" AND !ISNULL(This.oMyResize)
This.oMyResize.DoResize2(VAL(This.DisplayValue)/100)
ENDIF
ENDPROC
ENDDEF
*******************************
* End of the magnifier combo
*******************************
3) Example
Here is a complete example, with a form that uses those two classes
As you can see, the Init() method of the form call the DoCollect1() method of the Resizer class, while the Resize() method of the form call the DoResize1() method of the Resizer class
PUBLIC ofrm
ofrm = CREATEOBJECT("MyForm")
ofrm.show()
DEFINE CLASS MyForm as Form
width = 500
height = 300
ADD OBJECT txt as textbox WITH top = 30
ADD OBJECT cmd as commandbutton WITH top = 30,left = 100
ADD OBJECT grd as grid WITH top = 70, RecordSource = 'cc'
ADD OBJECT pgf as PageFrame WITH left = 350,width = 150,height = 250,Pagecount = 2
ADD OBJECT Resizer as MyResize
ADD OBJECT Magnifier as MyMagnifier &&WITH oMyResize = ThisForm.Resizer
PROCEDURE Load
CREATE CURSOR cc (ii I DEFAULT RECNO()+6,cc C(10) DEFAULT SYS(2015))
FOR lni = 1 TO 10
APPEND BLANK
NEXT
GO TOP IN 'cc'
ENDPROC
PROCEDURE Init
This.pgf.Page1.AddObject("txt","textbox")
This.pgf.Page1.AddObject("cmd","commandbutton")
This.pgf.Page1.cmd.top = 40
This.pgf.Page1.AddObject("grd","grid")
This.pgf.Page1.grd.top = 80
This.pgf.Page1.grd.RecordSource = 'cc'
This.pgf.Page1.SetAll("Visible",.T.)
This.pgf.Page2.AddObject("pgf","pageframe")
This.pgf.Page2.pgf.Pagecount = 1
This.pgf.Page2.pgf.width = 100
This.pgf.Page2.pgf.height = 200
This.pgf.Page2.pgf.Page1.AddObject("txt","textbox")
This.pgf.Page2.pgf.Page1.AddObject("cmd","commandbutton")
This.pgf.Page2.pgf.Page1.cmd.top = 40
This.pgf.Page2.pgf.Visible = .T.
This.pgf.Page2.pgf.Page1.SetAll("Visible",.T.)
* Set the oMyResize property of the Magnifier combobox
This.Magnifier.oMyResize = ThisForm.Resizer
* Initialize the Resizer object (collect the original dimension of the form's objects)
This.Resizer.DoCollect1
ENDPROC
* When you resize the form, the objects are scaled
PROCEDURE Resize
This.Resizer.DoResize1
ENDPROC
ENDDEFINE
***************************
* The magnifier combo
***************************
DEFINE CLASS MyMagnifier as ComboBox
oMyResize = Null && pointer to the Resizer object
RowSourceType = 1
RowSource = "25%,50%,75%,100%,125%,150%,200%"
Value = "100%"
Format = "KT"
PROCEDURE Interactivechange
IF TYPE("This.oMyResize") = "O" AND !ISNULL(This.oMyResize)
This.oMyResize.DoResize2(VAL(This.Value)/100)
ENDIF
This.SelStart = LEN(ALLTRIM(This.DisplayValue))
ENDPROC
PROCEDURE Valid
IF TYPE("This.oMyResize") = "O" AND !ISNULL(This.oMyResize)
This.oMyResize.DoResize2(VAL(This.DisplayValue)/100)
ENDIF
ENDPROC
ENDDEF
*******************************
* End of the magnifier combo
*******************************
*************************************************************
* The resizer class
*************************************************************
DEFINE CLASS MyResize as Custom
nAmount = 1 && the amount for width
nAmountH = 1 && the amount for height
ADD OBJECT myCol as Collection && stores original width, height or fontsize
* First collect the original sizes and fontsizes
* Collect data for the form
PROCEDURE DoCollect1
This.MyCol.Add(ThisForm.Width,"_orig_Width" + SYS(1272,ThisForm))
This.MyCol.Add(ThisForm.Height,"_orig_Height" + SYS(1272,ThisForm))
This.DoCollect(ThisForm)
ENDPROC
* Collect data for embeded objects
PROCEDURE DoCollect
LPARAMETERS toParent
IF m.toParent = this
RETURN
ENDIF
IF PEMSTATUS(m.toParent,'Anchor',5)
toParent.Anchor = 16+32+64+128
ENDIF
IF PEMSTATUS(m.toParent,'FontSize',5)
This.MyCol.Add(m.toParent.FontSize,"_orig_FontSize" + SYS(1272,toParent))
ENDIF
IF PEMSTATUS(m.toParent,'RowHeight',5) && for grid
This.MyCol.Add(m.toParent.RowHeight,"_orig_RowHeight" + SYS(1272,toParent))
ENDIF
IF PEMSTATUS(m.toParent,'HeaderHeight',5) && for grid
This.MyCol.Add(m.toParent.HeaderHeight,"_orig_HeaderHeight" + SYS(1272,toParent))
ENDIF
IF PEMSTATUS(m.toParent,'Controls',5)
FOR EACH loObj IN m.toParent.Controls
This.DoCollect(m.loObj)
NEXT
ENDIF
IF PEMSTATUS(m.toParent,'Pages',5) && for pageframe
FOR EACH loObj IN m.toParent.Pages
This.DoCollect(m.loObj)
NEXT
ENDIF
IF PEMSTATUS(m.toParent,'Columns',5) && for grid
FOR EACH loObj IN m.toParent.Columns
IF This.MyCol.GetKey("_orig_Width" + SYS(1272,toParent)) = 0
This.MyCol.Add(m.loObj.Width,"_orig_Width" + SYS(1272,toParent))
ENDIF
This.DoCollect(m.loObj)
NEXT
ENDIF
ENDPROC
* The resize method (change form's appearance)
PROCEDURE DoResize1
This.nAmount = ThisForm.Width / This.MyCol.Item("_orig_Width" + SYS(1272,ThisForm))
This.nAmountH = ThisForm.Height / This.MyCol.Item("_orig_Height" + SYS(1272,ThisForm))
This.DoResize(ThisForm)
TRY
ThisForm.FontSize = CEILING(This.MyCol.Item("_orig_FontSize" + SYS(1272,ThisForm)) * MIN(This.nAmount, This.nAmountH))
CATCH
ENDTRY
ENDPROC
* The magnifying method (change form's appearance)
PROCEDURE DoResize2
LPARAMETERS tnAmount
IF m.tnAmount > 0
STORE m.tnAmount TO This.nAmount, This.nAmountH
ThisForm.Width = m.tnAmount * This.MyCol.Item("_orig_Width" + SYS(1272,ThisForm))
ThisForm.Height = m.tnAmount * This.MyCol.Item("_orig_Height" + SYS(1272,ThisForm))
This.DoResize(ThisForm)
ENDIF
TRY
ThisForm.FontSize = CEILING(This.MyCol.Item("_orig_FontSize" + SYS(1272,ThisForm)) * MIN(This.nAmount, This.nAmountH))
CATCH
ENDTRY
ENDPROC
* The resize method (adjust form's objects)
PROCEDURE DoResize
LPARAMETERS toParent
LOCAL loObj
IF PEMSTATUS(m.toParent,'FontSize',5)
TRY
toParent.FontSize = FLOOR(This.MyCol.Item("_orig_FontSize" + SYS(1272,toParent)) * MIN(This.nAmount, This.nAmountH))
CATCH
ENDTRY
ENDIF
IF PEMSTATUS(m.toParent,'RowHeight',5) && for grid
toParent.RowHeight = CEILING(This.MyCol.Item("_orig_RowHeight" + SYS(1272,toParent)) * This.nAmountH)
ENDIF
IF PEMSTATUS(m.toParent,'HeaderHeight',5) && for grid
toParent.HeaderHeight = CEILING(This.MyCol.Item("_orig_HeaderHeight" + SYS(1272,toParent)) * This.nAmountH)
ENDIF
IF PEMSTATUS(m.toParent,'Controls',5)
FOR EACH loObj IN m.toParent.Controls
This.DoResize(m.loObj)
NEXT
ENDIF
IF PEMSTATUS(m.toParent,'Pages',5) && for pageframe
FOR EACH loObj IN m.toParent.Pages
This.DoResize(m.loObj)
NEXT
ENDIF
IF PEMSTATUS(m.toParent,'Columns',5) && for grid
FOR EACH loObj IN m.toParent.Columns
loObj.Width = CEILING(This.MyCol.Item("_orig_Width" + SYS(1272,toParent)) * This.nAmount)
This.DoResize(m.loObj)
NEXT
ENDIF
ENDPROC
ENDDEFINE
*************************************************************
* End of the resizer class
*************************************************************
See also
https://www.foxite.com/archives/enlarging-a-form-0000436495.htm
Related posts
http://praisachion.blogspot.com/2016/05/resizer-class-v20.html
http://praisachion.blogspot.com/2016/05/how-to-create-resizer-class-and-zooming.html
Niciun comentariu:
Trimiteți un comentariu