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

Redimensionne plein écran un formulaire   


L'auteur

fecarabos
France France
Membre Simple
# 0000003237
enregistré le 28/12/2011

Fiche personnelle

Note des membres
pas de note

Contributions > 02 - SCX : Formulaires

Redimensionne plein écran un formulaire
# 0000000810
ajouté le 02/01/2012 21:44:51 et modifié le 19/11/2015
consulté 6618 fois
Niveau initié

Version(s) Foxpro :
VFP 9.0
VFP 8.0
VFP 7.0
VFP 6.0
Description
Modifie les caractérisques géométriques des objets d'un formulaire proportionnelement, pour l'afficher plein écran.
Dans la méthode Activate du formulaire.
A relancer à chaque modification ou ajout d'objet.


Remarque : certains objets ont des caractéristiques qui sont définies par défaut (on le remarque rapidement) :
Il faut revenir dans les propriétés de l'objet du source pour le saisir "en dur", et hop !
Code source :
** Modifie les caractéristiques d'un formulaire, dynamiquement Hauteur, Largeur, Police, Colonne...
** Modifie le source, et à chaque démarrage le formulaire s'adapte à taille de l'écran,
** créé les modifications dans Activate du Form
* Exemple :
*dyna_ecranxy ("form1")
PROCEDURE dyna_ecranxy (form_src)
  IF TYPE('path_form')="U"
    path_form ="."
  ENDIF
  SELECT 0
  CREATE CURSOR RESIZE (obj c(254))
  SELECT 0
  USE (ADDBS(path_form) + FORCEEXT(form_src ,"scx")) ALIAS form_src
  SELECT * FROM form_src INTO CURSOR form_tmp
  SELECT form_src
  USE
  SELECT form_tmp
  objform = ''
  LOCATE FOR 'form' $ LOWER(form_tmp.BASECLASS)
  IF FOUND()
    objform = ALLTRIM(objname)
    =dans_tb(form_tmp.properties)
    LOCATE FOR 'fontsize' $ LOWER(objet)
    std_font = IIF(FOUND(), donnee, "9")
    LOCATE FOR 'height' $ LOWER(objet)
    h_frm = IIF(FOUND(), donnee, "1024")
    LOCATE FOR 'width' $ LOWER(objet)
    w_frm = IIF(FOUND(), donnee, "1280")
  ENDIF
  SELECT form_tmp
  SCAN FOR !EMPTY(properties) AND NOT ( ;
      'dataenvironment' $ LOWER(form_tmp.BASECLASS) OR ;
      'cursor' $ LOWER(form_tmp.BASECLASS) ;
      )
    =dans_tb(form_tmp.properties)
    ch0=""
    SELECT prop0
    SCAN FOR !EMPTY(objet)
      DO CASE
        CASE ;
            ALLTRIM(objet) = "FontSize" OR ;
            ".fontsize" $ LOWER(objet)
          IF donnee # "0"
            INSERT INTO RESIZE VALUES( ;
              IIF(!EMPTY(form_tmp.PARENT), STRTRAN(ALLTRIM(form_tmp.PARENT), objform, '') + "." + ALLTRIM(form_tmp.objname), '') + "." + ALLTRIM(prop0.objet) + " = ROUND(" + ;
              ALLTRIM(prop0.donnee) + " * val_F, 0) " + CHR(38)+ CHR(38)+ " " +  CAST(form_tmp.BASECLASS AS CHARACTER (200)))
          ENDIF
        CASE ;
            ALLTRIM(objet) = "Width" OR ;
            ALLTRIM(objet) = "Left" OR ;
            ".width" $ LOWER(objet) OR ;
            ".left" $ LOWER(objet)
          IF donnee # "0"
            INSERT INTO RESIZE VALUES( ;
              IIF(!EMPTY(form_tmp.PARENT), STRTRAN(ALLTRIM(form_tmp.PARENT), objform, '') + "." + ALLTRIM(form_tmp.objname), '') + "." + ALLTRIM(prop0.objet) + " = ROUND(" + ;
              ALLTRIM(prop0.donnee) + " * val_X, 0)" )
          ENDIF
        CASE ;
            ALLTRIM(objet) = "Height" OR ;
            ALLTRIM(objet) = "Top" OR ;
            ALLTRIM(objet) = "HeaderHeight" OR ;
            ALLTRIM(objet) = "RowHeight" OR ;
            ".fontsize" $ LOWER(objet) OR ;
            ".top" $ LOWER(objet)
          IF donnee # "0"
            INSERT INTO RESIZE VALUES( ;
              IIF(!EMPTY(form_tmp.PARENT), STRTRAN(ALLTRIM(form_tmp.PARENT), objform, '') + "." + ALLTRIM(form_tmp.objname), '') + "." + ALLTRIM(prop0.objet) + " = ROUND(" + ;
              ALLTRIM(prop0.donnee) + " * val_Y, 0)" )
          ENDIF
      ENDCASE
      SELECT prop0
    ENDSCAN
    SELECT form_tmp
  ENDSCAN
  USE
  SELECT prop0
  USE
  ERASE ('retaille.tmp')
  SELECT RESIZE
  COPY TO ('retaille.tmp') FOR LIKE(".*", obj) TYPE DELIMITED WITH  "" WITH CHARACTER ","
  SET TEXTMERGE ON NOSHOW
  TEXT TO ret0
&& les lignes ci dessous ont été générées automatiquement par la procédure "DYNA_ECRANXY"


WITH THISFORM
.MOVABLE=.T.
.WINDOWSTATE=1
.AUTOCENTER=.F.

val_x = _SCREEN.WIDTH/<<w_frm>>
val_y = (_SCREEN.HEIGHT - SYSMETRIC(29))/<<h_frm>>
val_f = MIN(val_x, val_y)

  ENDTEXT
  TEXT TO ret1

.MOVABLE=.F.
.WINDOWSTATE=0
.AUTOCENTER=.T.
ENDWITH


  ENDTEXT
  SET TEXTMERGE OFF
  sautl = CHR(13)+CHR(10)
  cmt= sautl +CHR(38)+CHR(38)
  ** modification de la Méthode Activate
  USE (ADDBS(path_form) + FORCEEXT(form_src ,"scx")) ALIAS form_src
  LOCATE FOR 'form' $ LOWER(BASECLASS)
  IF FOUND()
    IF EMPTY(entre_balises(UPPER(form_src.methods), ; && Pas de procédure
      sautl + "PROCEDURE ACTIVATE" + sautl, ;
        sautl + "ENDPROC" + sautl, ;
        1))
      meth0 = entre_balises(form_src.methods, ;
        sautl + "PROCEDURE Activate" + ;
        cmt + "_Ecran Dynamique->" + sautl, ;
        cmt + "_Ecran Dynamique-<" + sautl + ;
        "ENDPROC" + sautl, ;
        ret0 + FILETOSTR('retaille.tmp') + ret1)
    ELSE
      meth1 = entre_balises( ;
        entre_balises(form_src.methods, ;
        sautl + "PROCEDURE Activate" + sautl, ;
        sautl + "ENDPROC" + sautl, ;
        1), ;
        cmt + "_Ecran Dynamique->" + sautl, ;
        cmt + "_Ecran Dynamique-<" + sautl , ;
        ret0 + FILETOSTR('retaille.tmp') + ret1)
      meth0 = entre_balises(form_src.methods, ;
        sautl + "PROCEDURE Activate" + sautl, ;
        sautl + "ENDPROC" + sautl, ;
        meth1)
    ENDIF
    ERASE (ADDBS(path_form) + FORCEEXT(form_src + '_meth',"old"))
    STRTOFILE(form_src.methods, ADDBS(path_form) + FORCEEXT(form_src + '_meth',"old"))
    REPLACE methods WITH meth0
    REPLACE objcode WITH ''
    USE
    COMPILE FORM (ADDBS(path_form) + FORCEEXT(form_src ,"scx"))
    *MODIFY FORM (ADDBS(path_form) + FORCEEXT(form_src ,"scx"))
  ENDIF

ENDPROC

** Extrait toutes les propriétés de l'objet dans un curseur
** et ajoute des propriétés si elles sont définies par défaut
** set library to foxtools.fll && pour les fonctions words() et wordnum()
PROCEDURE dans_tb
  PARAMETER chp
  CREATE CURSOR prop0 (objet c(250), donnee c(250))
  chaine=""
  ch_obj=""
  val_chp = (chp)
  FOR i = 1 TO LEN(val_chp)
    x = SUBSTR(val_chp, i, 1)
    DO CASE
      CASE x = "=" AND EMPTY(ch_obj)
        ch_obj = ALLTRIM(chaine)
        chaine = ""
      CASE x = CHR(13) AND !EMPTY(ch_obj)
        INSERT INTO prop0 (objet, donnee) VALUES (ch_obj, ALLTRIM(chaine))
        IF USED("prop1")
          INSERT INTO prop1 (ID, classe, obj, pere ,objet, donnee) VALUES ;
            (form_tmp.uniqueid, form_tmp.CLASS, form_tmp.objname, form_tmp.PARENT, ch_obj, ALLTRIM(chaine))
        ENDIF
        ch_obj = ""
        chaine = ""
      CASE x != CHR(13) OR x != CHR(10)
        chaine=chaine + x
    ENDCASE
  ENDFOR
  ** Pour les polices de taille par défaut créé la propriété FontSize par defaut du formulaire
  SELECT COUNT(*) FROM prop0 WHERE "FONTSIZE" $ UPPER(ALLTRIM(objet)) INTO ARRAY xx
  IF xx = 0 AND ( ;
      LOWER(ALLTRIM(form_tmp.BASECLASS)) $ "checkbox,combobox,commandbutton,editbox,grid,header,label,spinner,textbox" ;
      )
    INSERT INTO prop0 (objet, donnee) VALUES ("FontSize", std_font)
  ENDIF
  IF ;
      'optiongroup' $ LOWER(form_tmp.BASECLASS)
    SELECT DISTINCT PADR(wordnum(ALLTRIM(objet), 1, "."), 60) AS ob FROM prop0 WHERE '.' $ wordnum(objet, 1, "=") INTO CURSOR prop1
    SCAN FOR !EMPTY(ob)
      ob0 = LOWER(ALLTRIM(prop1.ob) + ".fontsize")
      SELECT prop0
      GO TOP
      LOCATE FOR  ob0 $ LOWER(prop0.objet)
      IF NOT FOUND()
        INSERT INTO prop0 (objet, donnee) VALUES (ob0, std_font)
      ENDIF
      SELECT prop1
    ENDSCAN
    USE
  ENDIF
ENDPROC

* Manipule du texte entre 2 balises /!\ Casse et saut de lignes
* entre_balises (txt_src, bal1, bal2[, txt_ins])
* entre_balises ('abc<def>gh', '<', '>')    && Supprime les balises et le contenu
* entre_balises ('abc<def>gh', '<', '>', 'zorro')  && Insère à la fin si pas de balise 1 (avec balises)
*                          && Remplace si 2 balises successives (y compris balises)
*                          && Erreur si pas de balise 2 en suivant
* entre_balises ('abc<*def*>gh', '<', '>', 1)  && renvoi le texte entre balises
FUNCTION entre_balises (txt_src, bal1, bal2, txt_ins)
  typ_trait = IIF(PCOUNT()< 4, "S", "")
  typ_trait = ICASE(VARTYPE(txt_ins) = "C", "I", VARTYPE(txt_ins) = "N", "L", typ_trait)

  pos_b1 = AT(bal1, txt_src)
  IF pos_b1 = 0
    typ_trait = IIF(VARTYPE(txt_ins) = "C", "I", "")
  ELSE
    pos_b2 = 0
    i=1
    DO WHILE pos_b2 < pos_b1 + LEN(bal1)
      old_b2 = pos_b2
      pos_b2 = AT(bal2, txt_src, i)
      i= i + 1
      IF old_b2 = pos_b2
        pos_b2 = 0
        RETURN txt_src + CHR(13)+CHR(10) + "Erreur : pas de balise de fin"
      ENDIF
      typ_trait = IIF(typ_trait == "I" , "R", typ_trait)
    ENDDO
  ENDIF

  DO CASE
    CASE typ_trait == "S"
      txt_new = STUFF(txt_src, pos_b1, pos_b2 + LEN(bal2) - pos_b1, '')
    CASE typ_trait == "I"
      txt_new = txt_src + bal1 + txt_ins + bal2
    CASE typ_trait == "R"
      txt_new = STUFF(txt_src, pos_b1, pos_b2 + LEN(bal2) - pos_b1 , bal1 + txt_ins + bal2)
    CASE typ_trait == "L"
      txt_new = SUBSTR(txt_src, pos_b1 + LEN(bal1), pos_b2 - pos_b1 - LEN(bal1))
    OTHERWISE
      txt_new = ""
  ENDCASE
  RETURN txt_new
ENDFUNC
Commentaires
le 19/11/2015, benothmanchiheb a écrit :
dans_tb ????
le 19/11/2015, Marc Thivolle a écrit :
Peut-être modifier la ligne

PROCEDURE dans_tbPour passer

en

PROCEDURE dans_tb
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