#Define DU_param_suivant liParam = Iif(Vartype(liParam)="L",0,m.liParam)+1
#Define di_cp lcP ="p"+Transform(liParam)
#Define dl_frmAutoCenter .t.
#Define DC_msgbox_btn1 "b;Continuer=.t."
= Example()
Function EmMsgBox(p1,p2,p3,p4,p5)
*!* ****************************************************************************
*!* * Note 9 mars 2005
*!* Auteur : Eddy Maue
*!*
*!* EmMsgBox est une boîte à Message Comme Messagbox().
*!"
*!* Sauf qu'on peut ajouter ou retirer :
*!* - la barre de titre "TitleBar" ;
*!* - un titre ;
*!* - un Message ;
*!* - des boutons en quantité variable avec le texte de son choix;
*!* - des cases d'option en quantité variable avec le texte de son choix
*!* - afficher le texte "Caption" que l'on veut sur les boutons de commande
*!* - les icones systèmes de Win95 (stop,Question, Exclamation,Avertissement....) ou une icone de son choix
*!* Enfin le tout peut être affiché sur quatre modèles différents.
*!"
*!* Comment :
*!* EMMsgBox(p1,p2,p3,p4,p5)
*!* p1 = "M;Message,B;la barre de titre, T;un titre"
*!* p2 = "c;Chkbox1,chkbox2,chkbox....,chkboxX"
*!* p3 = "b;Chkbox1,chkbox2,chkbox....,chkboxX"
*!* Important p2 et p3 sont interchangeables
*!* p4 = Icônes systèmes 16,32,48,64 | "une image de votre choix en spécifiant sa localisation"
*!* p5 = 1 à 4 pour la disposition des objets sur la boîte de Message
*!"
*!"
*!* Note :
*!* le premier paramètre correspond au texte à afficher sûr le formulaire
*!* Vous pouvez afficher juste la bar de titre
*!* EmMsgBox("B;.....")
*!* un titre seulement
*!* EmMsgBox("T;.....")
*!* un Message seulement
*!* EmMsgBox("M;....")
*!" une combinaison
*!" EmMsgBox("M;...,B;....,T;....")
*!* p2 et p3 sont inversables mais assurez-vous que l'un soit des boutons et que l'autre soit des cases d'option.
*!* Si p2 et p3 ne sont pas définis, le bouton "Continué..." s'affiche par défaut
*!* Si Vous voulez affiche une icone sans définir les boutons
*!* EmMsgBox("M;...,,,nIcone,nModèle)
*!* Retour : "Continuer,Chk1=.T.,chk2=.F.,chk3=.T.,chk...=.F.,chkX=.F."
*!*
*!* * fin de la note
*!* ****************************************************************************
Local oMsg As Form, liParam As Integer,lcP As Character
Local liMsg As Integer ,lnMsg As In ,laMsg(1) As Character
Assert !Empty(p1) Message "Le premier paramètre est vide ou mal formaté"
p1 = Strtran(p1,"%,","%44")
Local lcChk
lcCmd = Iif(Vartype(p3)=="C" .And. "b;"$p3,p3, Iif(Vartype(p2)=="C".And."b;"$p2,p2,DC_msgbox_btn1))
lcChk = Iif(Vartype(p3)=="C" .And. "c;"$p3,p3, Iif(Vartype(p2)=="C".And."c;"$p2,p2,""))
p2 = Iif(Empty(lcChk),lcCmd,lcChk)
p3 = Iif(Empty(lcChk),"",lcCmd)
p4 = Iif(Empty(p4),1,p4)
p5 = Iif(Empty(p5),1,p5)
LOCAL oRetVal
oRetVal = CREATEOBJECT("custom")
oMsg = Createobject("frmMsgBox",oRetVal)
With oMsg
DU_param_suivant
di_cp
* titleBar,Titre,Message
* --------------------------------------------------------
Local lnMsg As Integer,liMsg As Integer, laMsg As Character
Local llMsg ,llTitre ,llIcone, lnFrmHeight , lnFrmWidth , llCmdGrp, llChkGrp
lnFrmHeight = 0
lnFrmWidth = 0
* s'il y un titre, Titlebar ou un Message
If Inlist(&lcP,"T;","B;","M;")
DU_param_suivant && lcp + 1
lnMsg = Alines(laMsg,&lcP,.T.,",")
* TitleBar
* --------------------------------------------------------
* Set Step On
liMsg = Ascan(laMsg,"B;")
If liMsg>0
.Caption = Substr(Strtran(m.laMsg(m.liMsg),"%44",","),3)
Else
.TitleBar= 0
Endif
* Titre
* --------------------------------------------------------
liMsg = Ascan(laMsg,"T;")
If m.liMsg > 0
.AddObject("o_lbl_titre","clssLbl")
.o_lbl_titre.Caption = Substr(Strtran(m.laMsg(m.liMsg),"%44",","),3)
.oTitre = .o_lbl_titre
m.lnTop = 0
m.llTitre = .T.
With .oTitre
.FontSize = 14
.Width = oMsg.Width
.Left = 10
.Top = 10
* ajoute la ligne sour le titre
Endwith
.AddObject("l1","hline",5,.oTitre.Height+15,.Width-10)
*.l1.Visible = .T.
Endif
* Message
* --------------------------------------------------------
m.liMsg = Ascan(laMsg,"M;")
If m.liMsg > 0
.AddObject("o_lbl_message","clssLbl")
.o_lbl_message.Caption = Substr(Strtran(m.laMsg(m.liMsg),"%44",","),3)
.oMessg = .o_lbl_message
.oMessg.FontSize = 11
m.llMsg = .T.
Endif
Endif
* CommandButton ou CheckBox -------------------------
di_cp
lnMsg = Alines(laMsg,&lcP,.T.,",")
If laMsg="c;"
m.llChkGrp = Iif(laMsg="c;",AddChkBox(oMsg,@laMsg,lnMsg,@liParam,),Iif(laMsg="b;",AddCmdBtn(oMsg,@laMsg,lnMsg,@liParam),.F.))
di_cp
lnMsg = Alines(laMsg,&lcP,.T.,",")
m.llCmdGrp = Iif(laMsg="c;",AddChkBox(oMsg,@laMsg,lnMsg,@liParam),Iif(laMsg="b;",AddCmdBtn(oMsg,@laMsg,lnMsg,@liParam),.F.))
Else
m.llCmdGrp = Iif(laMsg="c;",AddChkBox(oMsg,@laMsg,lnMsg,@liParam),Iif(laMsg="b;",AddCmdBtn(oMsg,@laMsg,lnMsg,@liParam),.F.))
di_cp
lnMsg = Alines(laMsg,&lcP,.T.,",")
m.llChkGrp = Iif(laMsg="c;",AddChkBox(oMsg,@laMsg,lnMsg,@liParam,),Iif(laMsg="b;",AddCmdBtn(oMsg,@laMsg,lnMsg,@liParam),.F.))
Endif
* CommandButton ou CheckBox -------------------------
* Icone
di_cp
If Vartype(&lcP)="N"
If Inlist(&lcP,16,32,48,64) && icone du systeme
DU_param_suivant
* Les icones de Messagebox()
&lcP = Home()+"Graphics\Icons\Computer\W95MBX0"+Transform(&lcP/16)+".ICO"
.AddObject("image1","image")
.Image1.Picture = &lcP
.oImage = .Image1
m.llIcone = .T.
Endif
Else
If Fclose(Fopen(&lcP)) && icone personalisé
DU_param_suivant
.AddObject("image1","image")
.Image1.Picture = &lcP
.oImage = .Image1
m.llIcone
Endif
Endif
.Visible = .T.
.SetAll("visible",.T.)
If m.llMsg
.oMessg.Width = .oMessg.Height * 9/5
Endif
.LockScreen = .T.
If m.llTitre
.l1.Top = .oTitre.Height+.oTitre.Top
Endif
.Width = ;
MAX(;
IIF(m.llTitre,.oTitre.Width,0) ,;
IIF(m.llIcone,.oImage.Width,0) + Iif(m.llMsg,.oMessg.Width,0)+30 )
* positionne l'image en X
If m.llIcone
.oImage.Left = 10
Store Iif(m.llTitre,.l1.Top,0)+10 To .oImage.Top
m.lnFrmHeight = .oImage.Top + .oImage.Height
Endif
* Positionnne le message en Y
If m.llMsg
.oMessg.Left = Iif(m.llIcone,20+.oImage.Width,10)
.oMessg.Top = Iif(m.llTitre,.l1.Top,0)+10
m.lnFrmHeight = Max(m.lnFrmHeight,.oMessg.Height+.oMessg.Top)
Endif
.Height = m.lnFrmHeight
di_cp
.modele = Iif(Vartype(&lcP)="N",&lcP,.modele)
* ajoute les Grps de commandes et de ChkBoxs
= m.llCmdGrp .And. Iif(Inlist(.modele,1,2), GrpH(.oCmdGrp),GrpV(.oCmdGrp))
= m.llChkGrp .And. Iif(Inlist(.modele,1,3),GrpH(.oChkGrp),GrpV(.oChkGrp))
Local lnHeightMax As Integer, lnWidhtMax
* positionne l'icone et le message en vertical
Local liFrmWidth , liFrmHeight
Do Case
Case .modele = 1 && oChkGrp et oCmdGrp sont horizontal
If m.llChkGrp
.oChkGrp.Top = .Height
.Width = Max(.Width,.oChkGrp.Width+20)
.oChkGrp.Left = (.Width-.oChkGrp.Width)/2
.Height = .Height+.oChkGrp.Height+10
Iif(llCmdGrp,.AddObject("lineH2","hline",.l1.Left,.Height,.Width-10),"")
.lineH2.Visible = .T.
.Height = .Height + 10
Endif
If llCmdGrp
.oCmdGrp.Top = .Height + 10
.Width = Max(.Width,.oCmdGrp.Width+20)
.oCmdGrp.Left = (.Width - .oCmdGrp.Width)/2
.Height = .Height + .oCmdGrp.Height + 15
Endif
Case .modele = 2 && ochkGrp : Vertical et oCmdGrp : horizontal
* trouve le plus large
liFrmHeight = ;
Max(.Height,;
Iif(m.llChkGrp,.l1.Top+.oChkGrp.Height+10,0))
liFrmWidth = ;
Max(.Width+Iif(m.llChkGrp,.oChkGrp.Width+20,0),;
IIF(m.llCmdGrp,.oCmdGrp.Width+20,0))
If llCmdGrp
* param passés : left,top,width
.AddObject("lineH2","hline",5,liFrmHeight,liFrmWidth-10)
* .l1.Width = liFrmWidth-10
.lineH2.Visible = .T.
.oCmdGrp.Left = (liFrmWidth - .oCmdGrp.Width)/2
.oCmdGrp.Top = liFrmHeight + 10
.Height = liFrmHeight + 10 + .oCmdGrp.Height
Endif
If m.llChkGrp
.oChkGrp.Left = .Width+10
.oChkGrp.Top = (.Height-.oChkGrp.Height)/2
.Width = .Width+.oChkGrp.Width+10
Endif
Case .modele = 3 && oChkGrp : Horizontal et oCmdGrp : Vertical
liFrmHeight = ;
Max(.Height,;
Iif(m.llCmdGrp,Iif(m.llTitre,.l1.Top,0)+.oCmdGrp.Height+10,0))
liFrmWidth = ;
Max(.Width+Iif(m.llCmdGrp,.oCmdGrp.Width+20,0),;
IIF(m.llChkGrp,.oChkGrp.Width+20,0))
If llChkGrp
* param passés : left,top,width
.AddObject("lineH2","hline",5,liFrmHeight,liFrmWidth-10)
* .l1.Width = liFrmWidth-10
.lineH2.Visible = .T.
.oChkGrp.Left = (liFrmWidth - .oChkGrp.Width)/2
.oChkGrp.Top = liFrmHeight + 10
.Height = liFrmHeight + 10 + .oChkGrp.Height
Endif
If m.llCmdGrp
.oCmdGrp.Left = m.liFrmWidth - .oCmdGrp.Width - 10
.oCmdGrp.Top = m.liFrmHeight-.oCmdGrp.Height-5
.Width = m.liFrmWidth
Endif
Case .modele = 4 && oChkGrp et oCmdGrp sont vertical
.Height = ;
MAX(.Height,;
Iif(m.llChkGrp,Iif(m.llTitre,.l1.Top,0)+.oChkGrp.Height+20,0) ,;
Iif(m.llCmdGrp,Iif(m.llTitre,.l1.Top,0)+.oCmdGrp.Height+20,0))
If llChkGrp
.oChkGrp.Left = .Width + 10
.Width = .Width + .oChkGrp.Width+10
.oChkGrp.Top = Iif(m.llTitre,.l1.Top,0)+10
Endif
If llCmdGrp
* param passés : left, top , height
.AddObject("lineV1","vLine",;
.Width ,;
IIF(m.llTitre,.l1.Top,0)+5,;
.Height - Iif(m.llTitre,.l1.Top,0)-10 )
.LineV1.Visible = .T.
.oCmdGrp.Left = .Width + 10
.oCmdGrp.Top = Iif(m.llTitre,.l1.Top,0) + 10
.Width = .Width + .oCmdGrp.Width + 10
Endif
Endcase
If llTitre
.l1.Width = .Width - 10
Endif
If Type(".default_button")="O"
.default_button.SetFocus()
Endif
.LockScreen = .F.
ENDWITH
oMsg.Show()
RETURN oRetVal.tag
Endfunc
****************************************************************************
* Note 6 mars 2005
* mettre CmdGrp vertical
* fin de la note
****************************************************************************
Procedure GrpV()
Lparameters oGrp
Local lnTop As Integer ,lnLeft As Integer , lnTop As Integer ,lnWidthMax As Integer
With oGrp
lnTop = 3
lnLeft = 3
lnWidthMax = 0
* set step on
For i = 1 To .ControlCount
.Objects(i).Top = lnTop
m.lnTop=.Objects(i).Height+lnTop
m.lnWidthMax= Max(m.lnWidthMax,.Objects(i).Width)
Endfor
.AutoSize = .F.
.Height = m.lnTop+3
.SetAll("left",3)
.SetAll("autosize",.F.)
.SetAll("Width",m.lnWidthMax)
.Width = m.lnWidthMax+6
Endwith
****************************************************************************
* Note 6 mars 2005
* mettre CmdGrp horizontal
* fin de la note
****************************************************************************
Procedure GrpH
Lparameters oGrp
Local lnLeft,lnHeigthMax,lnWidthMax
Store 3 To nLeft,lnHeigthMax,lnWidthMax
* Set Step On
With oGrp
.AutoSize = .T.
.SetAll("Visible",.T.)
For i = 1 To .ControlCount
m.lnHeigthMax = Max(m.lnHeigthMax,.Objects(i).Height)
.Objects(i).Left = m.lnWidthMax
m.lnWidthMax = m.lnWidthMax+.Objects(i).Width + 3
*!* m.lnWidthMax = Max(m.lnWidthMax,.Objects(i).Width)
Endfor
* .SetAll("Width",m.lnWidthMax)
.SetAll("top",3)
.Height = Iif(m.lnHeigthMax<20,20,m.lnHeigthMax) +6
.Width = m.lnWidthMax &&((m.lnWidthMax+3)*.ControlCount)+3
*!* For i = 1 To .ControlCount
*!* .Objects(i).Left = (i*3)+((i-1)*.Objects(i).Width)
*!* Endfor
.SetAll("Autosize",.F.)
.SetAll("Height",Iif(m.lnHeigthMax<20,20,m.lnHeigthMax))
Endwith
*!* ****************************************************************************
*!* * Note 6 mars 2005
*!* * mettre ChkGrp vertical
*!* * fin de la note
*!* ****************************************************************************
*!* Procedure ChkGrpV
*!* Lparameters oGrp
*!* ****************************************************************************
*!* * Note 6 mars 2005
*!* * mettre ChkGrp horizontal
*!* * fin de la note
*!* ****************************************************************************
*!* Procedure ChkGrpH
*!* Lparameters oGrp
****************************************************************************
* Note 6 mars 2005
* Ajoute les checkbox
* fin de la note
****************************************************************************
Function AddChkBox
Lparameters oMsg,aMsg,nMsg,liParam,iMsg,llChkGrp
DU_param_suivant
m.aMsg(1)=Substr(m.aMsg,3)
m.oMsg.AddObject("clssCheckGroup1","clssCheckGroup",@aMsg,nMsg)
m.oMsg.oChkGrp = m.oMsg.clssCheckGroup1
Return .T.
Endfunc
****************************************************************************
* Note 6 mars 2005
* Ajoute les Boutons de commandes
* fin de la note
****************************************************************************
Function AddCmdBtn
Lparameters oMsg,aMsg,nMsg,liParam,iMsg,llCmdGrp
DU_param_suivant
m.aMsg(1)=Substr(m.aMsg,3)
m.oMsg.AddObject("commandGroup1","clssCommandGroup",@aMsg,nMsg)
m.oMsg.oCmdGrp = m.oMsg.commandGroup1
Return .T.
Endfunc
* classe Command Group
Define Class clssCommandGroup As Container
BorderWidth = 0
BorderStyle = 0
Default = 0
AutoSize =.T.
ButtonCount = 0
Procedure Init
Lparameters aMsg,nMsg
Local iMsg,iP,nP,aP(2)
For iMsg = 1 To m.nMsg
m.nP=Alines(aP,aMsg(m.iMsg)+"=0",.T.,"=")
This.AddObject("command"+Transform(m.iMsg),"clssCommand",aP(1),aP(2))
Endfor
Enddefine
* Classe Check Groupe
Define Class clssCheckGroup As Container
BorderWidth = 0
BorderStyle = 0
checkcount = 0
AutoSize = .T.
Procedure Init
Lparameters aMsg,nMsg
Local iMsg,iP,nP,aP(2)
For iMsg = 1 To m.nMsg
m.nP=Alines(aP,aMsg(m.iMsg)+"=.f.",.T.,"=")
This.AddObject("check"+Transform(m.iMsg),"clssChkBox",aP(1),aP(2))
Endfor
Enddefine
Define Class clssCommand As CommandButton
AutoSize = .T.
Procedure Init
Lparameters cCaption,iVal
With This
.Caption = cCaption
If Empty(Evaluate(iVal))
Return
Endif
Thisform.default_button = This
Endwith
Endproc
Procedure Click
Thisform.Release(This.Caption)
Enddefine
Define Class clssChkBox As Checkbox
Value = .F.
Procedure Init
Lparameters cCaption,lVal
With This
.Caption = cCaption
.Value = Eval(lVal)
Endwith
Enddefine
Define Class clssLbl As Label
* BackColor= Rgb(0,128,255)
WordWrap = .T.
AutoSize = .T.
Enddefine
Define Class frmMsgBox As Form
AutoCenter = dl_frmAutoCenter
Desktop = .T.
WindowType = 1
AlwaysOnTop = .T.
default_button = .Null.
modele = 1
oTitre = .Null.
oImage = .Null.
oMessg = .Null.
oChkGrp = .Null.
oCmdGrp = .Null.
oRetVal = .null.
Procedure Init(oRet)
this.oRetVal = oRet
* mettre le boutton par default
If Isnull(This.default_button)
Return
Endif
* This.default_button.SetFocus()
Endproc
PROCEDURE Release(tcRetVal)
local cRetVal
oRetVal = tcRetVal
With This
.oRetVal.tag= ""
If Vartype(.oChkGrp)="O"
For Each oChk In .oChkGrp.objects
.oRetVal.tag=+.oRetVal.tag+","+oChk.Caption+"="+Transform(oChk.Value)
ENDFOR
.oRetVal.tag = tcRetVal+.oRetVal.tag
Endif
Endwith
Enddefine
Define Class hline As Container
Height = 5
SpecialEffect = 0
Procedure Init
Lparameters Left,Top,Width
With This
.Left = Left
.Top = Top
.Width = Width
Endwith
Endproc
Enddefine
Define Class vline As Container
Width = 5
SpecialEffect = 0
Procedure Init
Lparameters Left,Top,Height
With This
.Left = Left
.Top = Top
.Height = Height
Endwith
Enddefine
FUNCTION Example
EMMsgBox("M;Voilà un premier message toute simple comme si c'était un MessageBox sans TitleBar")
EMMsgBox("B;Un message avec une TitleBar,M;Voilà un second message "+Chr(13)+Chr(13)+"avec une TitleBar")
EMMsgBox("B;Une TitleBar,M;Une TitleBar%, un message et pourquoi pas "+Chr(13)+Chr(13)+"des boutons à volontés",;
"b;btn1,btn2,btn...,btnX,Continuer=.t.")
EMMsgBox("T;Et pourquoi un titre,M;Des boutons et surprise des boîtes à cocher avec ça",;
"c;Chk1,chk2,chk3,chk...,chkX")
EMMsgBox("T;Et pourquoi pas un titre,M;On peut y placer une icone du system",;
"c;Chk1,chk2,chk3,chk...,chkX",,16,1)
cRetVal = EMMsgBox("T;Et pourquoi un titre,M;Coché les cases désirées en ajoutant '=.t.'",;
"c;Chk1=.t.,chk2,chk3=.t.,chk...,chkX",,32,1)
cRetVal = EMMsgBox("T;Quatre modèles s'offrent à vous",;
"c;Chk1=.t.,chk2,chk3=.t.,chk...,chkX",,48,1)
cRetVal = EMMsgBox("T;Quatre modèles s'offrent à vous",;
"c;Chk1=.t.,chk2,chk3=.t.,chk...,chkX",,16,1)
cRetVal = EMMsgBox("T;Quatre modèles s'offrent à vous",;
"c;Chk1=.t.,chk2,chk3=.t.,chk...,chkX",,32,2)
cRetVal = EMMsgBox("T;Quatre modèles s'offrent à vous",;
"c;Chk1=.t.,chk2,chk3=.t.,chk...,chkX",,48,3)
cRetVal = EMMsgBox("T;Quatre modèles s'offrent à vous",;
"c;Chk1=.t.,chk2,chk3=.t.,chk...,chkX",,64,4)
cRetVal = EMMsgBox("B;C'est cute non,"+"M; Pour finir si vous voulez placer une '%,' dans votre texte vous devez placer % devant la %,")
For ii = 1 To 4
EMMsgBox(;
"T;Ceci est mon titre,M;Bon voilà j'ai placé plusieur objet sur cette forme et me reste plus qu'à positioner ces objets",;
"c;L'objet Chk1,Chk2=.t.,Chk3,ch4,ch5,ch6",;
"b;Le bouton Btn1,Btn2,btn44=.t.,Btn3,Btn4",16,ii)
Endfor
|