Resize containers or forms with gripper class

Published on by Yousfi Benameur


This code is available for any container on a form containing editbox,image or any vfp controls.
i dont find Marlett font on my win10 pro. can download it at http://www.fontpalace.com/font-download/Marlett/
with explorer go to  c:\windows\fonts   and paste it (marlett.ttf).its autoinstalls automatically.
can read also  https://www.reactos.org/wiki/Marlett_Characters  (usefull for replacing images by labels with this font)
advantage of label on image: can be transparent+can set any color (i made it red in code)
the chars interesting in this code are located in first image  below.the class works with events: mousedown,mousemove and mouseup and a boolean form property (or class property)  res.
By mousedown on the gripper label class can resize any vfp control (begining with the form or container with any vfp control in)
the class is binded to its parent for any resizing for code *2*.in code *1* there is no bindvent() function (code in form or in container class).
can build a visual class from the text code of the class ygrip and upload it on any form or container.

this is initially 2 codes below to show capabilities of this class.Anyone can perfect this class.

*Important: codes tested on windows10 pro & VFP9SP2.


Resize containers or forms with  gripper class

Click on code to select [then copy] -click outside to deselect


*1*
*this code can resize containers (with image or edibtbox as test) by label gripper.the code asks for a picture .
*the container takes the zorder 0 if clicked to be above another one.
*the image and editbox are choosen to be anchored 15 to full area but can make another anchors or no at all.
*there 4 classes: form,ycontainer1,ycontainer2,ygrip
*with specific code,can rebuild visual class and drag it on form.....
*the top level form is with borderstyle=0 to be resized with gripper only.

Publi yform
yform=Newobject("asup")
yform.Show
Read Events
Retu
*
Define Class asup As Form
    BorderStyle = 0  &&if borderstyle=3 can disable gripper control
    Height = 550
    backcolor=rgb(212,208,200)
    Width = 806
    ShowWindow = 2
    AutoCenter = .T.
    Caption = "Resize  containers(with image,editbox... )or the form with grippers."
    Name = "Form1"

    Add Object container1 As ycontainer1 With ;
        Top = 12, ;
        Left = 24, ;
        Width = 298, ;
        Height = 277, ;
        Name = "Container1"

    Add Object container2 As ycontainer2 With ;
        Top = 72, ;
        Left = 372, ;
        Width = 302, ;
        Height = 214, ;
        Name = "Container2"

    Add Object ygrip1 As ygrip With ;
        Top = 524, ;
        Width = 23, ;
        Name = "Label1"


    Procedure Init
        Local m.xpict
        m.xpict=Getpict()
        If !Empty(m.xpict)
            Thisform.container1.image1.Picture=m.xpict
        Endi
        DoDefault()
    Endproc


    Procedure Resize
        Thisform.label1.Resize
    Endproc

    Procedure Destroy
        Clea Events
    Endproc

Enddefine
*
*-- EndDefine: asup

Define Class ycontainer1 As Container
    res=.F.
    Name="ycontainer1"

    Add Object image1  As Image With ;
        Height = 272, ;
        Left = 3, ;
        top = 3, ;
        Width = 260, ;
        visible=.T., ;
        stretch=2,;
        Name = "image1"

    Add Object label1  As Label With ;
        AutoSize = .T., ;
        FontName = "Marlett", ;
        FontSize = 16, ;
        Anchor = 0, ;
        BackStyle = 0, ;
        Caption = "p", ;
        Height = 23, ;
        Left = 237, ;
        MousePointer = 8, ;
        Top = 249, ;
        Width = 23, ;
        ForeColor = Rgb(255,0,0), ;
        visible=.T., ;
        Name = "Label1"

    Procedure Init
        This.Resize
    Endproc

    Procedure image1.Click
        This.Parent.ZOrder(0)
    Endproc


    Procedure Resize
        With This
            Try
                With .image1
                    .Top=0
                    .Left=0
                    .Width =.Parent.Width
                    .Height=.Parent.Height
                Endwith

                With .label1
                    .Left=.Parent.Width-.Width-1
                    .Top =.Parent.Height-.Height-1
                    .ZOrder(0)
                Endwith

            Catch
            Endtry
        Endwith
    Endproc

    Procedure label1.MouseDown
        Lparameters nButton, nShift, nXCoord, nYCoord
        This.Parent.res=.T.
    Endproc

    Procedure label1.MouseMove
        Lparameters nButton, nShift, nXCoord, nYCoord
        If This.Parent.res=.T.
            With This.Parent
                Try
                    .Width =nXCoord-.Left
                    .Height=nYCoord-.Top
                    .ZOrder(0)
                Catch
                Endtry
            Endwith
            This.Parent.Resize
        Endi
    Endproc

    Procedure label1.MouseUp
        Lparameters nButton, nShift, nXCoord, nYCoord
        This.Parent.res=.F.
    Endproc

Enddefine
*-- EndDefine: ycontainer1

Define Class ycontainer2 As Container
    res=.F.
    Name="ycontainer2"


    Add Object edit1  As EditBox With ;
        Height = 272, ;
        Left = 3, ;
        top = 3, ;
        Width = 260, ;
        visible=.T., ;
        Name = "edit1"

    Add Object label1  As Label With ;
        AutoSize = .T., ;
        FontName = "Marlett", ;
        FontSize = 16, ;
        Anchor = 0, ;
        BackStyle = 0, ;
        Caption = "p", ;
        Height = 23, ;
        Left = 237, ;
        MousePointer = 8, ;
        Top = 249, ;
        Width = 23, ;
        ForeColor = Rgb(255,0,0), ;
        visible=.T., ;
        Name = "Label1"

    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.
Maecenas molestie erat sit amet molestie tempor. Donec nec nunc nunc. Vestibulum quis magna
vestibulum, vulputate diam ac, varius leo. Duis ac magna eu quam iaculis efficitur. Etiam diam
lectus, condimentum sit amet felis a, vehicula fringilla turpis. Aenean quis venenatis dui. Praesent
suscipit consequat nunc, vitae ultrices lacus fermentum vitae. Pellentesque ultricies nisl eget
maximus elementum. Pellentesque sit amet imperdiet ante. Cras id purus risus.
Praesent convallis mi nulla, sit amet hendrerit odio faucibus in. Donec non ornare elit. Lorem ipsum
dolor sit amet, consectetur adipiscing elit. Maecenas aliquet porttitor augue, id pellentesque libero
faucibus ut. Nullam eu finibus nibh, porta ultricies nunc. Suspendisse est urna, iaculis vitae
tincidunt vitae, volutpat eu arcu. Maecenas a orci venenatis, pretium turpis vitae, suscipit velit.
Suspendisse ut ullamcorper justo. Phasellus vel est libero. Praesent purus neque, pulvinar sed orci
vitae, mollis dignissim mi. Maecenas dolor mi, lacinia at tortor eget, vehicula pharetra felis. Donec
fermentum risus vel velit lacinia fermentum. In sed rhoncus nibh. Vivamus sit amet nibh in tellus
porttitor tincidunt vel eget libero...
        ENDTEXT
        This.Resize
    Endproc


    Procedure Resize
        With This
            Try
                With .edit1
                    .Top=0
                    .Left=0
                    .Width =.Parent.Width
                    .Height=.Parent.Height
                Endwith

                With .label1
                    .Left=.Parent.Width-.Width-1
                    .Top =.Parent.Height-.Height-1
                    .ZOrder(0)
                Endwith
            Catch
            Endtry
        Endwith
    Endproc

    Procedure edit1.Click
        This.Parent.ZOrder(0)
    Endproc

    Procedure label1.MouseDown
        Lparameters nButton, nShift, nXCoord, nYCoord
        This.Parent.res=.T.
        This.Parent.ZOrder(0)
    Endproc

    Procedure label1.MouseMove
        Lparameters nButton, nShift, nXCoord, nYCoord
        If This.Parent.res=.T.
            With This.Parent
                Try
                    .Width =nXCoord-.Left
                    .Height=nYCoord-.Top
                    .ZOrder(0)
                Catch
                Endtry
            Endwith
            This.Parent.Resize
        Endi
    Endproc

    Procedure label1.MouseUp
        Lparameters nButton, nShift, nXCoord, nYCoord
        This.Parent.res=.F.
    Endproc

Enddefine
*-- EndDefine: ycontainer2


Define Class ygrip As Label
    AutoSize = .T.
    FontName = "Marlett"
    FontSize = 16
    BackStyle = 0
    Caption = "o"
    Height = 23
    Left = 779
    MousePointer = 8
    Top = 524
    Width = 23
    Name = "YGRIP"
    res=.F.


    Procedure MouseDown
        Lparameters nButton, nShift, nXCoord, nYCoord
        This.res=.T.
    Endproc

    Procedure MouseMove
        Lparameters nButton, nShift, nXCoord, nYCoord
        If This.res=.T.
            Try
                With This.Parent
                    .Width =nXCoord-.Left
                    .Height=nYCoord-.Top
                    .ZOrder(0)
                Endwith
            Catch
            Endtry
            This.Resize
        Endi
    Endproc

    Procedure MouseUp
        Lparameters nButton, nShift, nXCoord, nYCoord
        This.res=.F.
    Endproc

    Procedure Resize
        With This
            .Left=.Parent.Width-.Width-1
            .Top =.Parent.Height-.Height-1
            .ZOrder(0)
        Endwith
    Endproc
Enddefine
*ENDDEFINE ygrip


Resize containers or forms with  gripper class

Click on code to select [then copy] -click outside to deselect


*2*
*this code is available for any container on a form containing editbox,image or any vfp controls
*here a grid on a top level form as demo.
*the class have bindevent() function with resize event on parent.

Publi yfgripper
yfgripper=Newobject("asup")
yfgripper.Show
Read Events
Retu
*
Define Class asup As Form
Height = 456
Width = 797
ShowWindow = 2
backcolor=rgb(212,208,200)
BorderStyle=0
AutoCenter = .T.
Caption = "Resize by mousedown on gripper the container or the form."
res = .F.
Name = "Form1"

Add Object container1 As ycontainer With ;
    Top = 1, ;
	Left = 1, ;
	Width = 263, ;
	Height = 276, ;
	Name = "Container1"

Add Object label2 As ygrip With ;
	AutoSize = .T., ;
	FontName = "Marlett", ;
	FontSize = 16, ;
	Anchor = 0, ;
	BackStyle = 0, ;
	Caption = "p", ;
	Height = 23, ;
	Left = 771, ;
	MousePointer = 8, ;
	Top = 431, ;
	Width = 23, ;
	ForeColor = Rgb(255,0,0), ;
	Name = "Label2"

Procedure Destroy
	Clea Events
Endproc

Procedure Resize
   * With Thisform.label2
   *     .Left=.Parent.Width-.Width-1
	*    .Top =.Parent.Height-.Height-1
	*    .ZOrder(0)
	*Endwith
Endproc

Enddefine
*
*-- EndDefine: asup

Define Class ycontainer As Container
Add Object grid1  As Grid With ;
	Height = 272, ;
	Left = 3, ;
	ScrollBars = 0, ;
	Top = 3, ;
	Width = 260, ;
	visible=.T., ;
	scrollbars=3, ;
	Name = "Grid1"

Add Object label1  As ygrip With ;
	AutoSize = .T., ;
	FontName = "Marlett", ;
	FontSize = 16, ;
	Anchor = 0, ;
	BackStyle = 0, ;
	Caption = "p", ;
	Height = 23, ;
	Left = 237, ;
	MousePointer = 8, ;
	Top = 249, ;
	Width = 23, ;
	ForeColor = Rgb(255,0,0), ;
	visible=.T., ;
	Name = "Label1"

Procedure Init
	Sele * From Home(1)+"samples\data\customer" Into Cursor ycurs
	With This.grid1
		.RecordSource="ycurs"
		.Themes=.F.
		.DeleteMark=.F.
		.GridLines=0
		.Themes=.F.
		.BackColor=0
		.HeaderHeight=24
		.RowHeight=19
		.FontSize=11
		.ForeColor=Rgb(255,255,255)
		.FontBold=.T.
		For i=1 To .ColumnCount
			.Columns(i).header1.ForeColor=Rgb(255*Rand(),255*Rand(),255*Rand())
		Endfor
		.SetAll("backcolor",Rgb(212,208,200),"header")
		.SetAll("fontbold",.T.,"header")
		.SetAll("DynamicBackColor","IIF(MOD(RECNO( ), 2)=0, RGB(0,0,0), RGB(100,55,255))", "Column")
		Locate
		.Refresh
	Endwith
Endproc

Procedure Resize
	With This
		Try
			With .grid1
				.Top=0
				.Left=0
				.Width =.Parent.Width
				.Height=.Parent.Height
			Endwith

			DoDefault()
		Catch
		Endtry
	Endwith
Endproc

Enddefine
*-- EndDefine: ycontainer

*gripper class (can rebuild it as visual class)
Define Class ygrip As Label
AutoSize = .T.
FontName = "Marlett"
FontSize = 16
BackStyle = 0
Caption = "o"
Height = 23
Left = 779
MousePointer = 8
Top = 524
Width = 23
Name = "YGRIP"
res=.F.

Procedure Init
	Bindevent(This.Parent,"resize",This,"resize")
Endproc

Procedure MouseDown
	Lparameters nButton, nShift, nXCoord, nYCoord
	This.res=.T.
Endproc

Procedure MouseMove
	Lparameters nButton, nShift, nXCoord, nYCoord
	If This.res=.T. And nButton=1
		Try
			With This.Parent
				.Width =nXCoord-.Left
				.Height=nYCoord-.Top
				.ZOrder(0)
			Endwith
		Catch
		Endtry
		This.Resize
	Endi
Endproc

Procedure MouseUp
	Lparameters nButton, nShift, nXCoord, nYCoord
	This.res=.F.
Endproc

Procedure Resize
	With This
		.Left=.Parent.Width-.Width-1
		.Top =.Parent.Height-.Height-1
		.ZOrder(0)
	Endwith
Endproc
Enddefine
*ENDDEFINE ygrip


Resize containers or forms with  gripper class

Click on code to select [then copy] -click outside to deselect


*3 *
*resize any form with no borders (borderstyle=0) by adding a gripper class
* it can be applied to form.borderstyle=,0,1,2,3
*the label can be also any gripper small gif image transparent.

Public oform
oform=Newobject("yform")
oform.Show
Return

Define Class yform As Form
  Top = 0
  Left = 0
  Height = 400
  Width = 400
  ShowWindow=2     &&0,1
  BorderStyle =0  &&no borders
  Caption = "Form1"
  Visible = .T.
  Name = "Form1"

  Add Object ogripper1 As ogripper With ;
    Top = 375, ;
    Left = 375, ;
    name="ogripper1"

  Procedure Resize
    With This.ogripper1
      .Top = This.Height - .Height+1
      .Left = This.Width - .Width+1
    Endwith
  Endproc
Enddefine

Define Class ogripper As Label
  AutoSize=.T.
  BackStyle = 0
  BorderWidth = 0
  FontName="marlett"
  FontSize=16
  Caption="p"     &&as gripper
  Name = "ogripper"
  originalxpos = 0
  originalypos = 0
  originalwidth = 0
  originalheight = 0

  Procedure MouseDown
    Lparameters nButton, nShift, nXCoord, nYCoord
    If nButton = 1
      With This
        .originalxpos = nXCoord
        .originalypos = nYCoord
        .originalwidth = Thisform.Width
        .originalheight = Thisform.Height
      Endwith
    Endi
      Endproc

  Procedure MouseUp
    Lparameters nButton, nShift, nXCoord, nYCoord
    If nButton = 1
      This.MousePointer=0
    Endi
  Endproc

  Procedure MouseMove
    Lparameters nButton, nShift, nXCoord, nYCoord
    If nButton = 1
      With This
        .MousePointer=8
        Thisform.Width = .originalwidth + nXCoord - .originalxpos
        Thisform.Height =  .originalheight + nYCoord - .originalypos
      Endwith
    Endif
  Endproc
Enddefine


To be informed of the latest articles, subscribe:
Comment on this post
Z
very good!<br /> WOW<br /> Thank you
Reply
Z
WOW<br /> Cool!
Reply