Ce tuto sera en deux parties
- Première partie (Créer des gadgets étendus avec les containers)
- Deuxième partie (Créer un barre d'outils extensible avec les containers)
La partie deux est ICI
Voici la première partie, le module ne gère que les String et les combo. Mais vous pourrez facilement ajouté n'importe quel autre gadget.
Code : Tout sélectionner
; Module pour lma fabrication d'un gadget étendu
DeclareModule field
; Le type de gadget supporté (vous pouvez en ajouter)
Enumeration
#String
#Combo
EndEnumeration
; Les procédures qui seront accessible en dehors du module
Declare Create(Id.i,X.i,Y.i,W.i,H.i,Label.s,Type.i=field::#String,Border=#PB_Container_BorderLess,Value.s="")
Declare SetLabel(Id,Label.s)
Declare SetValue(Id,Value.s)
Declare SetFont(Id,LabelFont,FieldFont)
Declare GetIdLabel(Id)
Declare GetIdField(Id)
Declare Resize(Id,X,Y,W,H)
EndDeclareModule
Module field
Structure Pos
X.i
Y.i
W.i
H.i
EndStructure
Structure field
Type.i
myPos.pos
Label.s
Value.s
IdContainer.i
IdTxt.i
IdGadget.i
Border.i
TxtFont.i
FieldFont.i
EndStructure
Global NewMap myField.field()
;{ Procédures PRIVEE (accessible uniquement dans le module)
Procedure CreateString()
Protected Y
With myField()
\IdContainer=ContainerGadget(#PB_Any,\myPos\X,\myPos\Y,\myPos\W,\myPos\H,\Border)
\IdTxt=TextGadget(#PB_Any,0,Y,\myPos\W,(\myPos\H/2),\Label)
Y+(\myPos\H/2)
\IdGadget=StringGadget(#PB_Any,0,Y,\myPos\W,(\myPos\H/2),\Value)
SetGadgetFont(\IdTxt,FontID(\TxtFont))
SetGadgetFont(\IdGadget,FontID(\FieldFont))
SetGadgetColor(\IdContainer,#PB_Gadget_BackColor,GetWindowColor(GetActiveWindow()))
CloseGadgetList()
EndWith
EndProcedure
Procedure CreateCombo()
Protected Y
With myField()
\IdContainer=ContainerGadget(#PB_Any,\myPos\X,\myPos\Y,\myPos\W,\myPos\H,\Border)
\IdTxt=TextGadget(#PB_Any,0,Y,\myPos\W,(\myPos\H/2),\Label)
Y+(\myPos\H/2)
\IdGadget=ComboBoxGadget(#PB_Any,0,Y,\myPos\W,(\myPos\H/2))
SetGadgetFont(\IdTxt,FontID(\TxtFont))
SetGadgetFont(\IdGadget,FontID(\FieldFont))
SetGadgetColor(\IdContainer,#PB_Gadget_BackColor,GetWindowColor(GetActiveWindow()))
CloseGadgetList()
EndWith
EndProcedure
;}
;{ Procédure PUBLIC (accessible en dehors du module)
Procedure Create(Id.i,X.i,Y.i,W.i,H.i,Label.s,Type.i=field::#String,Border=#PB_Container_BorderLess,Value.s="")
; Si #PB_Any on recherche le premier emplacement vide dans la map
If Id=#PB_Any
Id=0
While FindMapElement(myField(),Str(Id))<>0
Id+1
Wend
EndIf
If FindMapElement(myField(),Str(Id))<>0
MessageRequester("Create Error","This ID "+Str(Id)+" already exists")
ProcedureReturn -1
EndIf
AddMapElement(myField(),Str(Id))
With myField()
\TxtFont=LoadFont(#PB_Any,"Arial",10,#PB_Font_HighQuality)
\FieldFont=LoadFont(#PB_Any,"Arial",10,#PB_Font_HighQuality)
\Border=Border
\Label=Label
\Type=Type
\Value=Value
\myPos\X=X
\myPos\Y=Y
\myPos\W=W
\myPos\H=H
; Selon le type de gadget choisi on crée le gadget
Select Type
Case #String
CreateString()
Case #Combo
CreateCombo()
EndSelect
EndWith
EndProcedure
Procedure SetLabel(Id,Label.s)
;Change le label du gadget
If FindMapElement(myField(),Str(Id))=0
MessageRequester("SetLabel Error","This ID "+Str(Id)+" not exists")
ProcedureReturn #False
EndIf
With myField()
\Label=Label
SetGadgetText(\IdTxt,Label)
EndWith
ProcedureReturn #True
EndProcedure
Procedure SetValue(Id,Value.s)
; Change la valeur du gadget, ou l'élément sélectionné du combo
If FindMapElement(myField(),Str(Id))=0
MessageRequester("SetValue Error","This ID "+Str(Id)+" not exists")
ProcedureReturn #False
EndIf
With myField()
\Value=Value
Select \Type
Case #String
SetGadgetText(\IdGadget,Value)
Case #Combo
SetGadgetState(\IdGadget,Val(Value))
EndSelect
EndWith
ProcedureReturn #True
EndProcedure
Procedure SetFont(Id,LabelFont,FieldFont)
; Change les polices de caractère
If FindMapElement(myField(),Str(Id))=0
MessageRequester("SetFont Error","This ID "+Str(Id)+" not exists")
ProcedureReturn #False
EndIf
With myField()
\TxtFont=LabelFont
\FieldFont=FieldFont
EndWith
ProcedureReturn #True
EndProcedure
Procedure GetIdLabel(Id)
; Retourne l'identifient du gadget texte pour l'utilisation de commande Pb standard
If FindMapElement(myField(),Str(Id))=0
MessageRequester("GetIdLabel Error","This ID "+Str(Id)+" not exists")
ProcedureReturn -1
EndIf
With myField()
ProcedureReturn \IdTxt
EndWith
EndProcedure
Procedure GetIdField(Id)
; Retourne l'identifient du gadget pour l'utilisation de commande Pb standard
If FindMapElement(myField(),Str(Id))=0
MessageRequester("GetIdField Error","This ID "+Str(Id)+" not exists")
ProcedureReturn -1
EndIf
With myField()
ProcedureReturn \IdGadget
EndWith
EndProcedure
Procedure Resize(Id,X,Y,W,H)
; Redimmentionne ou / et repositionne le gadget étendu
; similaire à ResizeGadget()
If FindMapElement(myField(),Str(Id))=0
MessageRequester("Resize Error","This ID "+Str(Id)+" not exists")
ProcedureReturn #False
EndIf
With myField()\myPos
If X<>#PB_Ignore
\X=X
EndIf
If Y<>#PB_Ignore
\Y=Y
EndIf
If W<>#PB_Ignore
\W=W
EndIf
If H<>#PB_Ignore
\H=H
EndIf
ResizeGadget(myField()\IdContainer,\X,\Y,\W,\H)
ResizeGadget(myField()\IdTxt,#PB_Ignore,#PB_Ignore,\W,(\H/2))
ResizeGadget(myField()\IdGadget,#PB_Ignore,(\H/2),\W,(\H/2))
EndWith
EndProcedure
;}
EndModule
; Code de teste
#MainForm=0
Enumeration
#String1
#String2
#String3
#Combo1
#Button
EndEnumeration
Global ActionTrue.b=#False
Procedure Exit()
End
EndProcedure
Procedure EventButton()
If ActionTrue
field::Resize(#String3,350,#PB_Ignore,#PB_Ignore,60)
ActionTrue=#False
Else
field::Resize(#String3,500,#PB_Ignore,#PB_Ignore,100)
ActionTrue=#True
EndIf
EndProcedure
Procedure OpenMainForm()
Protected flag=#PB_Window_ScreenCentered|#PB_Window_SystemMenu
Protected X=50,Y=50
OpenWindow(#MainForm,0,0,800,600,"TUTO les containers",flag)
field::Create(#String1,X,Y,100,60,"String 1")
X+150
field::Create(#String2,X,Y,100,60,"String 2",field::#String,#PB_Container_Double,"teste")
BindEvent(#PB_Event_CloseWindow,@Exit(),#MainForm)
X+150
field::Create(#String3,X,Y,100,60,"String 3",field::#String,#PB_Container_Flat,"teste 2")
BindEvent(#PB_Event_CloseWindow,@Exit(),#MainForm)
X=50
Y+100
field::Create(#Combo1,X,Y,100,60,"Combo 1",field::#Combo)
For N=1 To 10
AddGadgetItem(field::GetIdField(#Combo1),-1,"Texte "+Str(N))
Next
field::SetValue(#Combo1,"0")
X+150
Y+30
ButtonGadget(#Button,X,Y,100,30,"Déplacer un string")
BindGadgetEvent(#Button,@EventButton())
EndProcedure
OpenMainForm()
Repeat:WaitWindowEvent():ForEver
