* 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 ModifyClass"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 IfFile("le_nom_du_scx.scx") Erase"le_nom_du_scx.scx" Erase"le_nom_du_scx.sct" Endif CreateForm"le_nom_du_scx"As"my_form"From"le_nom_du_vcx"
Endif
Return
Procedure CreateBaseClass(lsDir_File_VCX AsString, lsPrefix AsString, llEcraserSiExiste As Boolean) Local lobj AsObject IfType("m.lsDir_File_VCX")<>"C"
lsDir_File_VCX = "MyClass.vcx" Else
m.lsDir_File_VCX = Alltrim(m.lsDir_File_VCX) Endif IfType("m.lsPrefix")<>"C"
lsPrefix = "u_" Else
m.lsPrefix = Alltrim(m.lsPrefix) Endif * Que faire en cas d'existence du VCX demandé... IfFile(m.lsDir_File_VCX) If m.llEcraserSiExiste ClearClasslib (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 CreateClasslib (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 : TEXTTO m.lsMethode noshow parameters cMessageText, nDialogBox, cTitleBar LOCAL liReturn asInteger * Si message non précisé IFTYPE("cMessageText")<>"C"
m.cMessageText = "Message" endif * Si type non précisé = Bouton ok IFTYPE("m.nDialogBox")<>"N"
m.nDialogBox = 0 ENDIF * Si titre non précisé : caption de la form IFTYPE("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 AsString
llReturn = .F.
m.lsClassName = Lower(Alltrim(m.lsClassName))
m.lsMethodName = Lower(Alltrim(m.lsMethodName)) IfType("m.lsMethod")<>"C"
m.lsMethod="" Endif * recherche fichier vcx IfNotFile(m.lsVCX)
=Messagebox("Le fichier VCX : "+m.lsVCX+" n'existe pas", 16, "Add_Method") Else * ouverture vcx ClearClasslib (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 IfUsed() * recherche de la classe
Locate ForLower(Alltrim(objname))==m.lsClassName AndNotEmpty(Class) IfNotFound()
=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 IfEmpty(RESERVED3) Replace RESERVED3 With"*"+m.lsMethodName + CRLF Else Replace RESERVED3 With RESERVED3 + "*" + m.lsMethodName + CRLF Endif IfNotEmpty(m.lsMethod) IfEmpty(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 CompileClasslib (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 AsString Local lsDefault AsString
llReturn = .F.
m.lsClassName = Lower(Alltrim(m.lsClassName))
m.lsPropertyName = Lower(Alltrim(m.lsPropertyName)) * recherche fichier vcx IfNotFile(m.lsVCX)
=Messagebox("Le fichier VCX : "+m.lsVCX+" n'existe pas", 16, "Add_Property") Else * ouverture vcx ClearClasslib (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 IfUsed() * recherche de la classe
Locate ForLower(Alltrim(objname))==m.lsClassName AndNotEmpty(Class) IfNotFound()
=Messagebox("Ne trouve pas la classe :"+m.lsClassName+" dans le fichier VCX : "+m.lsVCX, 16, "Add_Property") Else IfAlltrim(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 IfEmpty(RESERVED3) Replace RESERVED3 With m.lsPropertyName + CRLF Else Replace RESERVED3 With m.lsPropertyName + CRLF + RESERVED3 Endif DoCase CaseType("m.lDefault") == "C" IfEmpty(m.lDefault)
m.lsDefault = "" Else
m.lsDefault = ["] + m.lDefault + ["] Endif CaseType("m.lDefault") == "N"
m.lsDefault = Alltrim(Cast(m.lDefault As M)) CaseType("m.lDefault") == "D"
m.lsDefault = [{^] + Str(Year(m.lDefault),4,0) + "/" + Padl(Month(m.lDefault),2,"0")+ "/" + Padl(Day(m.lDefault),2,"0") + [}] CaseType("m.lDefault") == "L"
m.lsDefault = Iif(m.lDefault, [.T.], [.F.]) Otherwise
m.lsDefault = [.F.] Endcase IfEmpty(PROPERTIES) Replace PROPERTIES With m.lsPropertyName + " = " + m.lsDefault + CRLF Else If CRLF+[Name = "]$PROPERTIES Replace PROPERTIES WithStrtran(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 CompileClasslib (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 !
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