Créer des gadgets en série

[Guimauve]

Je suis présentement entrain de coder une libraire pour créer des groupes de gadget. Je l'ai testé seulement sur WinXP et je n'ai pas vu de problème. Mais j'aimerais bien savoir si ça fonctionne sur les autres OS.

Merci à l'avance à ceux qui voudront bien faire un essai.

A+
Guimauve

Code : Tout sélectionner

Enumeration
     
     #Main_Win
     
     #Btn_Allo
     #Btn_fleur
     #Btn_Quitter
     #Btn_langue
     #Btn_monde
 
     #String_Allo
     #String_fleur
     #String_Quitter
     #String_langue
     #String_monde
    
EndEnumeration

Dim TxtGUI.s(9)

TxtGUI.s(0) = "Allo"
TxtGUI.s(1) = "Fleur"
TxtGUI.s(2) = "Quitter"
TxtGUI.s(3) = "Langue"
TxtGUI.s(4) = "Monde"
TxtGUI.s(5) = "ToolTip Allo"
TxtGUI.s(6) = "ToolTip fleur"
TxtGUI.s(7) = "ToolTip Quitter"
TxtGUI.s(8) = "ToolTip Langue"
TxtGUI.s(9) = "ToolTip monde"


Procedure SetGadgetArrayText(FirstButtonID, LastButtonID, TxtFirstButtonID)
     
     For Gadget = FirstButtonID To LastButtonID
          SetGadgetText(Gadget, TxtGUI(TxtFirstButtonID))
          TxtFirstButtonID + 1
     Next Gadget
     
EndProcedure


Procedure AddGadgetArrayToolTip(FirstButtonID, LastButtonID, TxtFirstTooltipID)
     
     For Gadget = FirstButtonID To LastButtonID
          GadgetToolTip(Gadget, TxtGUI(TxtFirstTooltipID))
          TxtFirstTooltipID + 1
     Next Gadget
     
EndProcedure

Procedure ButtonGadgetArray(FirstButtonID, LastButtonID, X, Y, Width, Height, Gap_Between_Button)
     
          For Gadget = FirstButtonID To LastButtonID
               ButtonGadget(Gadget, X, Y, Width, Height, "")
               Y + Height + Gap_Between_Button
          Next

EndProcedure

Procedure StringGadgetArray(FirstStringID, LastStringID, X, Y, Width, Height, Gap_Between_String)

          For Gadget = FirstStringID To LastStringID
               StringGadget(Gadget, X, Y, Width, Height, "")
               Y + Height + Gap_Between_String
          Next
     
EndProcedure

#Main_Win_Style = #PB_Window_ScreenCentered  | #PB_Window_SystemMenu

If OpenWindow(#Main_Win, 0, 0, 400, 300, #Main_Win_Style, "Nom du programme") <> 0
     
     If CreateGadgetList(WindowID(#Main_Win)) <> 0
     
          ButtonGadgetArray(#Btn_Allo, #Btn_monde, 5, 5, 75, 25, 2)
          SetGadgetArrayText(#Btn_Allo, #Btn_monde, 0)
          AddGadgetArrayToolTip(#Btn_Allo, #Btn_monde, 5)
          StringGadgetArray(#String_Allo, #String_monde, 175, 7, 75, 20, 7)   
           
     EndIf
     
EndIf

Repeat
     
     EventID = WaitWindowEvent()
     
     If EventID = #PB_EventGadget
          Select EventGadgetID()
                    
               Case #Btn_Allo
                    MessageRequester("Test", "Bouton Allo")
                    
               Case #Btn_fleur
                    MessageRequester("Test", "Bouton fleur")
                 
               Case #Btn_monde
                    MessageRequester("Test", "Bouton monde")

               Case #Btn_langue
                    MessageRequester("Test", "Bouton langue")
    
               Case #Btn_quitter
                    EventID = #PB_Event_CloseWindow
                    
          EndSelect
     EndIf
     
Until EventID = #PB_Event_CloseWindow

[Le Soldat Inconnu]

Pas de problème sur win 2000

apr contre, tu t'es trompé dans les noms de fonction car tu as mis des test à la fin des nom de procedure sans le mettre à la fin des appels au procedure.

[Guimauve]

Oui je sais, je viens de faire la correction plus haut. Je l'avais déja compilé en lib et comme on peut pas mettre dans notre source une procédure qui porte le même nom je l'avais modifié pour faire un essai. Désolé...

Et merci.

A+
Guimauve