Public oForm
*set step on
oForm = Createobject("frmResizable","Un formulaire redimentionnable")
oForm.Show()
#Define RZ_RIEN 0
#Define RZ_LARGEUR 1
#Define RZ_HAUTEUR 2
#Define RZ_HAUTEUR_LARGEUR 3
#Define ESPACE_CONTOUR 10
#Define CURSEUR_LG_TH csrLgrHtr
Define Class frmResizable As form
DataSession=1
Visible = .T.
AlwaysOnTop = .T.
WindowType= 1
AutoCenter=.T.
oThis = ""
retVal = ""
WindowType=0
AutoSize = .T.
lAutoResizeObject = .T.
minwidth=200
minheight=200
FormMinWidth = 200
FormMinHeight = 200
lresize = .T.
ctitre = ""
Add Object monTitre As Label With ;
caption = "Le titre" , ;
autosize = .T. ,;
nAutoResize = RZ_RIEN ,;
top = 10 , Left = 10
Add Object txtTitre As TextBox With ;
lAutoResize = .T. , ;
nAutoResize = RZ_LARGEUR , ;
width = 300 , left = 10
Add Object edtDescription As EditBox With ;
nAutoResize = RZ_HAUTEUR_LARGEUR,;
width = 300, left = 10
Add Object btnAccept_Cancel As CommandGroup With ;
buttoncount=2 , nAutoResize = RZ_RIEN , AutoSize = .T.
btnAccept_Cancel.command1.Caption = "Accepter"
btnAccept_Cancel.command1.AutoSize = .T.
btnAccept_Cancel.command2.Caption = "Annuler"
btnAccept_Cancel.command2.AutoSize = .T.
Add Object oResize As clssResize Noinit && NoInit si ce n'est pas le dernier objet ajouté
Add Object oPosObj As clssPositionneObjet Noinit
Procedure Init(pcTitre) && of frmResizible
With This As frmResizable Of test.prg
* place command2 à droite de command1 avec 5 pixels d'espace
.oPosObj.m_PlaceAdroite(.btnAccept_Cancel.command2,.btnAccept_Cancel.command1,5)
.oResize.Setup()
.m_PositionneObjet()
* active l'évennement resize
Local lnMaxWidth As Integer
Local lnMaxHeight As Integer
Local loObj As Object
Store 0 To m.lnMaxHeight,m.lnMaxWidth
For Each loObj In Thisform.Controls FoxObject
If Inlist( Proper( m.loObj.BaseClass ) ;
, "Collection","Control","CursorAdapter","Custom","Exception","Hyperlink";
, "Reportlistener","Session","Timer") ;
or Vartype(m.loObj.Left) == "U"
Loop
Endif
m.lnMaxWidth = Max( m.loObj.Width + m.loObj.Left , m.lnMaxWidth )
m.lnMaxHeight = Max( m.loObj.Height + m.loObj.Top , m.lnMaxHeight )
Endfor
Thisform.Height = Iif( m.lnMaxHeight > 0 , m.lnMaxHeight , Thisform.Height ) + ESPACE_CONTOUR
Thisform.Width = Iif( m.lnMaxWidth > 0 , m.lnMaxWidth , Thisform.Width ) + ESPACE_CONTOUR
If .lAutoResizeObject And Vartype(.oResize)=="O"
.oResize.p_nFormHeight = Thisform.Height
.oResize.p_nFormWidth = Thisform.Width
Endif
This.lresize = .T.
Endwith
Endproc && frmResizible :: Init
* /¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ PositionneObjet
* / Eddy Maue a+ -- Créer le : 2010-05-15
Procedure m_PositionneObjet
With This As iform Of test.prg
DoDefault()
With This As frmResizable Of test.prg
.oPosObj.m_placedessous(.txtTitre , .monTitre , 10 )
.oPosObj.m_placedessous(.edtDescription , .txtTitre )
.oPosObj.m_placedessous(.btnAccept_Cancel , .edtDescription )
.oPosObj.m_aligneadroite(.btnAccept_Cancel, .edtDescription )
Endwith
Endwith
Endproc && PositionneObjet
* /¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ Resize
* / Eddy Maue a+ -- Créer le : 2010-05-15
Procedure Resize
DoDefault()
With This
If .lAutoResizeObject And Vartype(.oResize)=="O"
DoEvent
* Set Step On
.oResize.Go()
Endif
.m_PositionneObjet()
Endwith
Endproc && Resize
Procedure Destroy && of frmResizible
* éliminer toutes références d'objets dans
This.RemoveObject("oResize")
Endproc && frmResizible :: Destroy
Enddefine
Define Class clssResize As Custom
Dimension p_aTabCtrl(1) As Object
p_nFormWidth = 0
p_nFormHeight = 0
* /¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ Setup
* / Eddy Maue a+ -- Créer le : 2010-05-15
Procedure Setup
Local lnObject As Integer ;
, loObj As Object ;
, i As Integer
m.lnObject = Thisform.ControlCount
m.i=0
With This
*!* * conserve une référence de la largeur actuel du formulaire à traiter
*!* This.p_nFormWidth = Thisform.Width
*!* This.p_nFormHeight = Thisform.Height
* avec des formulaires dont la quantité d'objets est exessifs, et bien
* le traitement est beaucoup plus rappide
Create Cursor csrLgrHtr ( Width i, Height i )
*For i = 1 To m.lnObject
For Each loObj In Thisform.Controls FoxObject
*loObj = Thisform.Controls(i)
If Vartype(loObj.nAutoResize)=="N" And loObj.nAutoResize > 0
* conserve une référence de l'objet
m.i = m.i + 1
Declare .p_aTabCtrl(m.i)
.p_aTabCtrl(m.i) = loObj
* rempli le curseur comme suivant
Insert Into csrLgrHtr ( Width , Height ) Values ( loObj.Width , loObj.Height )
Endif
Endfor
Endwith
Endproc && Setup
* /¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ Go
* / Eddy Maue a+ -- Créer le : 2010-05-15
Procedure Go
* SET STEP ON
With This As clssResize Of test.prg
Select csrLgrHtr
Locate && GO TOP
Scan
Replace ;
csrLgrHtr.Width With Iif( Bittest( .p_aTabCtrl(Recno()).nAutoResize , 0 ) , ( Thisform.Width - This.p_nFormWidth ) , 0 ) + csrLgrHtr.Width ,;
csrLgrHtr.Height With Iif( Bittest( .p_aTabCtrl(Recno()).nAutoResize , 1 ) , ( Thisform.Height - This.p_nFormHeight ) , 0 ) + csrLgrHtr.Height
* affecte aux objets leurs nouvelles largeurs et hauteurs
Scatter Name .p_aTabCtrl(Recno( [csrLgrHtr] )) Additive
* conserve les nouvelles dimensions du formulaire
Endscan
This.p_nFormWidth = Thisform.Width
This.p_nFormHeight = Thisform.Height
Endwith
Endproc && Go
Procedure Init && of clssResize
This.Setup()
Endproc && clssResize :: Init
Procedure Destroy && of clssResize
Endproc && clssResize :: Destroy
*!* Procedure Error(nError, cMethod, nLine) && of clssResize
*!* Endproc && Error of clssResize
Enddefine
Define Class clssPositionneObjet As Custom
* ******************************************************
* * PlaceAgauche(oGauche,oDroit)
* ******************************************************
Procedure m_PlaceAgauche(o1,o2,pnEspace)
o1.Left = o2.Left -o1.Width -;
Iif(Empty(pnEspace),10,pnEspace)
Return o1
Endproc && PlaceAgauche(o1,oDroit)
* ******************************************************
* * PlaceAdroite(oGauche,oDroit)
* ******************************************************
Procedure m_PlaceAdroite(o1,o2,pnEspace)
o1.Left = o2.Left+o2.Width+;
+Iif(Empty(pnEspace),10,pnEspace)
Return o1
Endproc && PlaceAdroite(oGauche,oDroit)
* ******************************************************
* * PlaceDessus(oDessus,oDessous,pnEspace)
* ******************************************************
Procedure m_PlaceDessus( o1,o2,pnEspace)
o1.Top = o1.Height+o2.Top +;
Iif(Empty(pnEspace),10,pnEspace)
Return o1
Endproc && PlaceDessus(oDessus,oDessous,pnEspace)
* ******************************************************
* * PlaceDessous(oDessus,oDessous,pnEspace)
* ******************************************************
Procedure m_placedessous(o1,o2,pnEspace)
o1.Top= o2.Top+o2.Height+;
Iif(Empty(pnEspace),10,pnEspace)
Return o1
Endproc && PlaceDessous(oDessus,oDessous,pnEspace)
* ******************************************************
* * AligneAdroite(o1,o2,pnOffset)
* ******************************************************
Procedure m_aligneadroite(o1,o2,pnOffset)
o1.Left= Abs(o2.Left+o2.Width - o1.Width)+;
Iif(Empty(pnOffset),0,pnOffset)
Return o1
Endproc && AligneAdroite(o1,o2,pnOffset)
* ******************************************************
* * AligneEnHaut(o1,o2,pnOffset)
* ******************************************************
Procedure m_AligneEnHaut(o1,o2,pnOffset)
o1.Top= o2.Top+Iif(Empty(pnOffset),0,pnOffset)
Return o1
Endproc && AligneEnHaut(o1,o2,pnOffset)
* ******************************************************
* * AligneEnBas(o1,o2,pnOffset)
* ******************************************************
Procedure m_AligneEnBas(o1,o2,pnOffset)
o1.Top= o2.Top+o2.Height-o1.Height +;
IIF(Empty(pnOffset),0,pnOffset)
Return o1
Endproc && AligneEnBas(o1,o2,pnOffset)
* ******************************************************
* * PositionneObjet
* ******************************************************
Procedure m_PositionneObjet()
*!* exemple de code pour le positionnement des objets
*!* With Thisform
*!* .grid1.Height = .Height-.CmdAbandonner.Height-20
*!* .grid1.Width = .Width-20
*!* .placeDessous(;
*!* .AligneAdroite(.CmdAbandonner,.grid1,-10),.grid1,5)
*!* .PlaceAgauche(;
*!* .AligneEnHaut(.cmdenregistrer,.CmdAbandonner),.CmdAbandonner)
*!* .PlaceAgauche(;
*!* .AligneEnHaut(.CmdAjouter,.cmdenregistrer),.cmdenregistrer)
*!* Endwith
Endproc && PositionneObjet
Enddefine
|
Retour à la liste
Canada
Fiche personnelle
Note des membres
Niveau
débutant
le 13/06/2010, 
le 18/06/2010,
Bravo, joli code.
Cependant si vous appliquer le "resize" ,vous avez un message d'erreur dû aux dimensions trop petites.Il va falloir corriger une ligne de code qui provoque cette erreur comme suit avec la structure try/catch/endtry:
try
Scatter Name .p_aTabCtrl(Recno( [csrLgrHtr] )) Additive
catch
endtry
ou bien limiter les dimensions du form avec les propriètés
minWidth
minHeight
Salutations et bon courage.