ATOUTFOX
COMMUNAUTÉ FRANCOPHONE DES PROFESSIONNELS FOXPRO
Visual FoxPro : le développement durable

Resizer et positionner des objets sur un formulaire   



L'auteur

eddymaue
Canada Canada
Membre Simple
# 0000000075
enregistré le 26/10/2004
Maue Eddy
j8j 8j8 Gatineau
de la société Formatek
Fiche personnelle


Note des membres
pas de note

Contributions > 01 - PRG : Programmation

Resizer et positionner des objets sur un formulaire
# 0000000757
ajouté le 16/05/2010 20:57:22 et modifié le 28/08/2013
consulté 11401 fois
Niveau débutant

Version(s) Foxpro :
VFP 9.0
VFP 8.0
VFP 7.0
VFP 6.0

Description
Simple à faire fonctionner et l'avantage c'est de pouvoir controler chaque objet du formulaire comme on le désire

l'exemple est simple il donne un avant goût de ce que l'on peut faire.

Code source :
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 InlistProper( 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  IifBittest( .p_aTabCtrl(Recno()).nAutoResize , 0 ) , ( Thisform.Width  - This.p_nFormWidth  )  , 0 ) + csrLgrHtr.Width  ,;
          csrLgrHtr.Height With  IifBittest( .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.LeftAbs(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



Commentaires
le 13/06/2010, ybenam a écrit :
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.

le 13/06/2010, eddymaue a écrit :
la solution est de limiter par minWidth et minHeight le dimensionnement minimum recherché

a+ Eddy

le 18/06/2010, FoxInCloud (Th. Nivelet) a écrit :
Peux-tu expliquer en deux mots ce que ton code fait en plus de la propriété anchor ?
merci
thn

le 19/06/2010, eddymaue a écrit :
Avec Anchor, j'ai de la difficuté à bien redimensionner les éléments d'un formulaire lorsqu'il y a plusieurs éléments

Lors de l'agrandissement d'un formulaire, certains éléments du
formulaire s'agrandissent plus vite que d'autres et à l'inverse , ils se
contractent moins biens que d'autres. En plus des difficulté de voir
des éléments empiéter sur d'autres

bref je traine ce code depuis vfp 5 et ca toujours bien fonctionné.


Publicité

Les pubs en cours :


www.atoutfox.org - Site de la Communauté Francophone des Professionnels FoxPro - v3.4.0 - © 2004-2024.
Cette page est générée par un composant COM+ développé en Visual FoxPro 9.0-SP2-HF3