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

Créer un VCX par programme   



L'auteur

Francis Faure
France France
Membre Actif (personne physique)
# 0000000001
enregistré le 11/10/2004

http://www.wanagain.net
51 ans
Faure Francis
de la société Design Or Decline
Fiche personnelle


Note des membres
pas de note

Contributions > 06 - VCX - Bibliothèque de classes visuelles

Créer un VCX par programme
# 0000000808
ajouté le 29/12/2011 12:05:10 et modifié le 29/12/2011
consulté 4083 fois
Niveau initié

Version(s) Foxpro :
VFP 9.0

Description
VFP permet de créer des formulaires visuellement (SCX) basés sur des classes Visuelles (VCX)

l'objet de cet exercice est de créer par programme (PRG) une classe form dans un VCX et de créer un SCX basé sur cette classe form

Cela à déjà été traité dans l'article :
http://www.atoutfox.org/articles.asp?ACTION=FCONSULTER&ID=0000000752


Ce complément permet de créer une classe form : avec, en plus, des propriétés et des méthodes personnalisées
Code source :
Clear
Clear Resources
#Define CRLF Chr(13) + Chr(10)

* VFP permet de créer des formulaires visuellement (SCX) basés sur des classes Visuelles (VCX)
* l'objet de cet exercice est de créer par programme (PRG) une classe form dans un VCX et de créer un SCX basé sur cette classe form

* Cela à déjà été traité dans l'article :
* http://www.atoutfox.org/articles.asp?ACTION=FCONSULTER&ID=0000000752
*
* Ce complément permet de créer une classe form : avec des propriétés et des méthodes personnalisées


If CreateBaseClass("le_nom_du_vcx.vcx""my_".T.)

  * visualiser la classe form créée
  Modify Class "my_form" Of "le_nom_du_vcx"

  * creer un SCX par programme basé sur la classe my_form contenu dans le VCX créé précédement
  If File("le_nom_du_scx.scx")
    Erase "le_nom_du_scx.scx"
    Erase "le_nom_du_scx.sct"
  Endif
  Create Form "le_nom_du_scx" As "my_form" From "le_nom_du_vcx"

Endif


Return



Procedure CreateBaseClass(lsDir_File_VCX As String, lsPrefix As String, llEcraserSiExiste As Boolean)
  Local lobj As Object
  If Type("m.lsDir_File_VCX")<>"C"
    lsDir_File_VCX = "MyClass.vcx"
  Else
    m.lsDir_File_VCX = Alltrim(m.lsDir_File_VCX)
  Endif
  If Type("m.lsPrefix")<>"C"
    lsPrefix = "u_"
  Else
    m.lsPrefix = Alltrim(m.lsPrefix)
  Endif
  * Que faire en cas d'existence du VCX demandé...
  If File(m.lsDir_File_VCX)
    If m.llEcraserSiExiste
      Clear Classlib (m.lsDir_File_VCX)
      Erase (m.lsDir_File_VCX)
    Else
      =Messagebox("La bibliothèque VCX : " + m.lsDir_File_VCX + " Existe déjà !" + Chr(13)+Chr(10) + "Opération Annulée.")
      Return .F.
    Endif
  Endif

  *  creation du VCX
  Create Classlib (m.lsDir_File_VCX)

  * ajout de la surcharge de la classe "Form"
  lobj=Createobject("Form")
  * --- personnalisations des propriétés existante de la classe de base Form ---
  lobj.Caption="Mon super formulaire"
  lobj.Width=320
  lobj.Height=200
  lobj.MaxWidth=1024
  lobj.MaxHeight=768
  lobj.MinWidth=320
  lobj.MinHeight=200
  lobj.Left=100
  lobj.Top=100
  lobj.BackColor=Rgb(240,240,240)
  lobj.WindowType=0 && modless / non modal
  lobj.WindowState=0 && 0 normal
  * ...

  * enregistrement de la classe Form dans le VCX
  lobj.SaveAsClass(m.lsDir_File_VCX, m.lsPrefix+"Form")

  * Ajout de Propriétés personnalisée à la classe MyForm contenu dans le VCX
  =Add_Property(m.lsDir_File_VCX, m.lsPrefix+"Form""MaPropriete1", 0)
  =Add_Property(m.lsDir_File_VCX, m.lsPrefix+"Form""MaPropriete2""test")


  * Ajout de méthodes personnalisées
  * pour cette exemple : ajout de la methode "mon_messagebox()" a la classe
  * Code de la méthode :
  TEXT TO m.lsMethode noshow
parameters cMessageText, nDialogBox, cTitleBar
LOCAL liReturn as Integer
  * Si message non précisé
  IF TYPE("cMessageText")<>"C"
    m.cMessageText = "Message"
  endif
  * Si type non précisé = Bouton ok
  IF TYPE("m.nDialogBox")<>"N"
    m.nDialogBox = 0
  ENDIF
  * Si titre non précisé : caption de la form
  IF TYPE("m.cTitleBar")<>"C"
    m.cTitleBar = THISFORM.Caption
  ENDIF
  liReturn=MessageBox(m.cMessageText, m.nDialogBox, m.cTitleBar)
  RETURN m.liReturn
  ENDTEXT
  * Ajout de la méthode à la Form dans le  VCX
  =Add_Method(m.lsDir_File_VCX, m.lsPrefix+"Form""Mon_MessageBox", m.lsMethode)


  * etc... pour les autres classes


  Return .T.
Endproc







*
* Add_Method() : But ajouter une méthode dans une classe contenu dans un VCX
*
Function Add_Method(lsVCX, lsClassName, lsMethodName, lsMethod) As Boolean
  Local llReturn As Boolean
  Local lsSelect As String
  llReturn = .F.
  m.lsClassName = Lower(Alltrim(m.lsClassName))
  m.lsMethodName = Lower(Alltrim(m.lsMethodName))
  If Type("m.lsMethod")<>"C"
    m.lsMethod=""
  Endif
  * recherche fichier vcx
  If Not File(m.lsVCX)
    =Messagebox("Le fichier VCX : "+m.lsVCX+" n'existe pas", 16, "Add_Method")
  Else
    * ouverture vcx
    Clear Classlib (m.lsVCX)
    lsSelect = Select()
    Select 0
    Try
      Use (m.lsVCX) Exclusive
    Catch
      =Messagebox("Impossible d'ouvrire le fichier VCX : "+m.lsVCX, 16, "Add_Method")
    Endtry
    If Used()
      * recherche de la classe
      Locate For Lower(Alltrim(objname))==m.lsClassName And Not Empty(Class)
      If Not Found()
        =Messagebox("Ne trouve pas la classe :"+m.lsClassName+" dans le fichier VCX : "+m.lsVCX, 16, "Add_Method")
      Else
        If "*"+Alltrim(m.lsMethodName)+CRLF $ RESERVED3
          =Messagebox("la méthode "+m.lsMethodName+" existe déjà dans la classe classe :"+m.lsClassName+" du fichier VCX : "+m.lsVCX, 16, "Add_Method")
        Else
          If Empty(RESERVED3)
            Replace RESERVED3 With "*"+m.lsMethodName + CRLF
          Else
            Replace RESERVED3 With RESERVED3 + "*" + m.lsMethodName + CRLF
          Endif
          If Not Empty(m.lsMethod)
            If Empty(METHODS)
              Replace METHODS With "PROCEDURE "+m.lsMethodName + CRLF + m.lsMethod + CRLF + "ENDPROC" + CRLF
            Else
              Replace METHODS With METHODS + CRLF + "PROCEDURE "+m.lsMethodName + CRLF + m.lsMethod + CRLF + "ENDPROC" + CRLF
            Endif
            m.llReturn=.T.
          Endif
        Endif
      Endif
      Use
      Compile Classlib (m.lsVCX)
    Endif
    Select (m.lsSelect)
  Endif
  Return m.llReturn
Endfunc


*
* Add_Property() : But ajouter une propriété dans une classe contenu dans un VCX
*
Function Add_Property(lsVCX, lsClassName, lsPropertyName, lDefault) As Boolean
  Local llReturn As Boolean
  Local lsSelect As String
  Local lsDefault As String
  llReturn = .F.
  m.lsClassName = Lower(Alltrim(m.lsClassName))
  m.lsPropertyName = Lower(Alltrim(m.lsPropertyName))
  * recherche fichier vcx
  If Not File(m.lsVCX)
    =Messagebox("Le fichier VCX : "+m.lsVCX+" n'existe pas", 16, "Add_Property")
  Else
    * ouverture vcx
    Clear Classlib (m.lsVCX)
    lsSelect = Select()
    Select 0
    Try
      Use (m.lsVCX) Exclusive
    Catch
      =Messagebox("Impossible d'ouvrire le fichier VCX : "+m.lsVCX, 16, "Add_Property")
    Endtry
    If Used()
      * recherche de la classe
      Locate For Lower(Alltrim(objname))==m.lsClassName And Not Empty(Class)
      If Not Found()
        =Messagebox("Ne trouve pas la classe :"+m.lsClassName+" dans le fichier VCX : "+m.lsVCX, 16, "Add_Property")
      Else
        If Alltrim(m.lsPropertyName)+CRLF $ RESERVED3
          =Messagebox("La propriété"+m.M.lsPropertyName+" existe déjà dans la classe classe :"+m.lsClassName+" du fichier VCX : "+m.lsVCX, 16, "Add_Property")
        Else
          If Empty(RESERVED3)
            Replace RESERVED3 With m.lsPropertyName + CRLF
          Else
            Replace RESERVED3 With m.lsPropertyName + CRLF + RESERVED3
          Endif
          Do Case
            Case Type("m.lDefault") == "C"
              If Empty(m.lDefault)
                m.lsDefault = ""
              Else
                m.lsDefault = ["] + m.lDefault + ["]
              Endif
            Case Type("m.lDefault") == "N"
              m.lsDefault = Alltrim(Cast(m.lDefault As M))
            Case Type("m.lDefault") == "D"
              m.lsDefault = [{^] + Str(Year(m.lDefault),4,0) + "/" + Padl(Month(m.lDefault),2,"0")+ "/" + Padl(Day(m.lDefault),2,"0") + [}]
            Case Type("m.lDefault") == "L"
              m.lsDefault = Iif(m.lDefault, [.T.][.F.])
            Otherwise
              m.lsDefault = [.F.]
          Endcase
          If Empty(PROPERTIES)
            Replace PROPERTIES With  m.lsPropertyName + " = " + m.lsDefault + CRLF
          Else
            If CRLF+[Name = "]$PROPERTIES
              Replace PROPERTIES With Strtran(PROPERTIES, CRLF+[Name = "], CRLF + m.lsPropertyName + " = " + m.lsDefault + CRLF+[Name = "],1,1)
            Else
              Replace PROPERTIES With m.lsPropertyName + " = " + m.lsDefault + CRLF + PROPERTIES
            Endif
          Endif
          m.llReturn=.T.
        Endif
      Endif
      Use
      Compile Classlib (m.lsVCX)
    Endif
    Select (m.lsSelect)
  Endif
  Return m.llReturn
Endfunc


Commentaires
le 30/12/2011, Jean à Grenoble a écrit :
C'est super !
J'ai 'amélioré' GENDBC.PRG pour créer la classe d'accès (ouverture, fermeture, recherche, ajout, modification, suppression, ...) et la classe de maintenance (création, création des vues, reindexation, ...) d'une table. Mais je buttai pour créer le form associé. Et là, tu m'as ouvert des horizons !

merci Francis !
Jean


Publicité

Les pubs en cours :

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