Boite de dialogue avec PureBasic

Partagez votre expérience de PureBasic avec les autres utilisateurs.
nico
Messages : 3702
Inscription : ven. 13/févr./2004 0:57

Boite de dialogue avec PureBasic

Message par nico »

Procédures:

Code : Tout sélectionner

Procedure OpenDialog(id, Dialog_Larg, Dialog_Haut, Dialog_Texte.s, Window_Main, Dialog_Option)
    Protected Valeur.l
    
    Valeur.l=OpenWindow(id,0,0,Dialog_Larg,Dialog_Haut,Dialog_Texte,Dialog_Option,WindowID(Window_Main))
    
    If id=#PB_Any
        id=Valeur
    EndIf
    
    DisableWindow(Window_Main,1)
    ProcedureReturn Valeur
EndProcedure

Procedure CloseDialog(Window_Dialog.l,Window_Main.l)
    DisableWindow(Window_Main,0)
    SetActiveWindow_(Window_Main) 
    CloseWindow(Window_Dialog)
EndProcedure
Un petit exemple:

Code : Tout sélectionner

;-------------------------------------------------------------------------------------------------------
; La procédure Dialog à sa propre boucle d'évènement,
; comme ça elle est complètement indépendante du code principale
; et reste plus facile à corriger
Procedure.s DialogMotdePasse()
    Protected Window.l
    Window=GetActiveWindow()

    Enumeration 100
      #Dialog
    EndEnumeration
 
    Enumeration 100
      #Dialog_Text
      #Dialog_String
      #Dialog_Button
    EndEnumeration

    OpenDialog(#Dialog,280,100,"Boite de Dialogue",Window,#PB_Window_ScreenCentered )
    ;--------------------------------------------------------------------
    ;/ OpenDialog(id, Largeur, Hauteur, Titre$, FenetreMereID, Options)
    ;/ Options peut prendre deux valeurs: #PB_Window_ScreenCentered ou #PB_Window_WindowCentered
   
    ;Je crée une liste de gadget comme pour une fenêtre normal
    If CreateGadgetList(WindowID(#dialog))
      TextGadget(#Dialog_Text, 40, 10,180,20,"Entrez le mot de passe pour continuer",#PB_Text_Center)
      StringGadget(#Dialog_String,40, 40,180,20,"",#PB_String_Password) 
      ButtonGadget(#Dialog_Button,80,70,100,20,"OK")
    EndIf
      ;-------------------------------------------------------------------- 
    Repeat
      EventID.l=WaitWindowEvent()
      Select EventID
        Case #PB_Event_Gadget
          Select EventGadget()
            Case #Dialog_Button
              Texte.s=GetGadgetText(#Dialog_String)
              If Texte=""
                MessageRequester("Info","Mot de passe correct")
              Else
                Quit=1
              EndIf
          EndSelect
         
        Case #PB_Event_CloseWindow
          quit=1
      EndSelect
    Until Quit=1
    CloseDialog(#Dialog,Window)
ProcedureReturn Texte
EndProcedure
;-------------------------------------------------------------------------------------------------------

Enumeration 1
  #Window
EndEnumeration

Enumeration
  #Button
EndEnumeration

OpenWindow(#Window,200,200,400,400,"Fenêtre principale",#PB_Window_SystemMenu)
If CreateGadgetList(WindowID(#Window))
  StringGadget(#String,100,20,180,20,"")
  ButtonGadget(#Button,100,100,180,20,"Mot de passe")
EndIf

Repeat
  EventID.l=WaitWindowEvent()
  Select EventID
    Case #PB_Event_Gadget
      Select EventGadget()
        Case #Button
          MotdePasse.s=DialogMotdePasse()
          SetGadgetText(#String,MotdePasse)
      EndSelect
     
    Case #PB_Event_CloseWindow
      quit=1
  EndSelect
Until Quit=1
Dernière modification par nico le sam. 03/mai/2008 21:07, modifié 2 fois.
lionel_om
Messages : 1500
Inscription : jeu. 25/mars/2004 11:23
Localisation : Sophia Antipolis (Nice)
Contact :

Message par lionel_om »

Pas mal.
Ce serait bien de pouvoir valider la boite de dialogue par la touche Entrée et quitter par la touche Echap. (Les événements que l'on trouve aussi dans Visual Basic), genre en spécifiant les Id des gadgets, #Null sinon.

Lio
Webmestre de Basic-univers
Participez à son extension: ajouter vos programmes et partagez vos codes !
nico
Messages : 3702
Inscription : ven. 13/févr./2004 0:57

Message par nico »

Le problème, c'est qu'avec XP, le tabstop ne fonctionne plus, sinon il faut subclasser le control et traiter le message #WM_KEYUP.
nico
Messages : 3702
Inscription : ven. 13/févr./2004 0:57

Message par nico »

Un exemple qui permet de voir le gadget qui a le focus en pointillé (code du Forum Anglais) et pour les boutons en plus des pointillés j'ai rajouté le pourtour bleu (c'est mieux) et validation par la touche Enter si le bouton a le Focus.

Code : Tout sélectionner

#WM_UPDATEUISTATE = $128
#UIS_CLEAR = 2
#UISF_HIDEFOCUS = 1

Procedure MakeLong(low.w, high.w)
  ProcedureReturn (high * $10000) | (low & $FFFF)
EndProcedure

Procedure OpenDialog(id, Dialog_Larg, Dialog_Haut, Dialog_Texte.s, Window_Main, Dialog_Option)
    Protected Valeur.l
   
    Valeur.l=OpenWindow(id,0,0,Dialog_Larg,Dialog_Haut,Dialog_Texte,Dialog_Option,WindowID(Window_Main))
   
    If id=#PB_Any
        id=Valeur
    EndIf
   
    DisableWindow(Window_Main,1)
    ProcedureReturn Valeur
EndProcedure

Procedure CloseDialog(Window_Dialog.l,Window_Main.l)
    DisableWindow(Window_Main,0)
    SetActiveWindow_(Window_Main)
    CloseWindow(Window_Dialog)
EndProcedure


Procedure.l SubclassAllButton( hWnd, Msg,  wParam, lParam)
  Protected OriginProc.l,Window.l,GadgetID.l
 
  OriginProc= GetProp_(hWnd, "SubclassAllButton")
 
  Window=GetAncestor_(hWnd,#GA_ROOT)
  ;WindowID=GetWindowLong_(Window, #GWL_ID)
  GadgetID=GetDlgCtrlID_(hWnd)
 
  Select Msg
    Case #WM_SETFOCUS
        Style=GetWindowLong_(hWnd,#GWL_STYLE)     
        SetWindowLong_(hWnd,#GWL_STYLE, Style | #BS_DEFPUSHBUTTON) 
       
    Case #WM_KILLFOCUS
        Style=GetWindowLong_(hWnd,#GWL_STYLE)     
        SetWindowLong_(hWnd,#GWL_STYLE, Style ! #BS_DEFPUSHBUTTON)
       
    Case #WM_KEYUP
        If wparam=13 ;Enter
            PostMessage_(Window,#WM_COMMAND,0<<16+GadgetID,hwnd)
        EndIf
       
    Case #WM_NCDESTROY
        SetWindowLong_(hWnd, #GWL_WNDPROC, OriginProc)
        RemoveProp_(hWnd,"SubclassAllButton")     
  EndSelect
  ProcedureReturn CallWindowProc_(OriginProc,hWnd,Msg,wParam,lParam)
EndProcedure

Procedure EnumAllButton(Gadget.l,lParam.l)
    Protected Class.s,OriginProc.l,Style.l
   
    Class=Space(100)
    GetClassName_(Gadget,Class,99)
    If Class="Button"
        Style=GetWindowLong_(Gadget,#GWL_STYLE)
        ;If Style & #BS_3STATE=0 And Style & #BS_AUTO3STATE=0 And Style & #BS_AUTOCHECKBOX=0 And Style & #BS_RADIOBUTTON=0
            If Style & #BS_AUTORADIOBUTTON =0 And Style & #BS_CHECKBOX=0 And Style & #BS_GROUPBOX=0
                OriginProc = SetWindowLong_(Gadget, #GWL_WNDPROC, @SubclassAllButton())
                SetProp_(Gadget, "SubclassAllButton", OriginProc)
            EndIf
        ;EndIf
    EndIf
    ProcedureReturn 1
EndProcedure

;-------------------------------------------------------------------------------------------------------
; La procédure Dialog à sa propre boucle d'évènement,
; comme ça elle est complètement indépendante du code principale
; et reste plus facile à corriger
Procedure.s DialogMotdePasse()
Protected Window.l
Window=GetActiveWindow() 

;{ Windows
Enumeration 100
  #Dialog
EndEnumeration
;}
;{ Gadgets
Enumeration 100
  #Frame3D_1
  #Option_1
  #Option_2
  #Option_3
  #CheckBox_1
  #CheckBox_2
  #CheckBox_3
  #Dialog_Valider
  #Dialog_Annuler
  #String_2
EndEnumeration
;}

    OpenDialog(#Dialog,400,262,"Boite de Dialogue",Window,#PB_Window_ScreenCentered )
   
    ;--------------------------------------------------------------------
    ;/ OpenDialog(id, Largeur, Hauteur, Titre$, FenetreMereID, Options)
    ;/ Options peut prendre deux valeurs: #PB_Window_ScreenCentered ou #PB_Window_WindowCentered
   
    ;Je crée une liste de gadget comme pour une fenêtre normal
    If CreateGadgetList(WindowID(#dialog))
      Frame3DGadget(#Frame3D_1, 15, 15, 180, 110, "Frame3D_1")
      OptionGadget(#Option_1, 30, 35, 120, 24, "Option 1")
      OptionGadget(#Option_2, 30, 65, 120, 24, "Option 2")
      OptionGadget(#Option_3, 30, 95, 120, 24, "Option 3")
      CheckBoxGadget(#CheckBox_1, 245, 20, 120, 24, "CheckBox_1")
      CheckBoxGadget(#CheckBox_2, 245, 60, 120, 24, "#CheckBox_2")
      CheckBoxGadget(#CheckBox_3, 245, 100, 120, 24, "CheckBox_3")
      ButtonGadget(#Dialog_Valider, 55, 215, 120, 24, "Valider")
      ButtonGadget(#Dialog_Annuler, 205, 215, 120, 24, "Annuler")
      StringGadget(#String_2, 30, 155, 115, 25, "")
    EndIf
   
     
     SendMessage_(WindowID(#Dialog), #WM_UPDATEUISTATE, MakeLong(#UIS_CLEAR, #UISF_HIDEFOCUS), 0)

     EnumChildWindows_(WindowID(#Dialog),@EnumAllButton(), 0)
     
      ;--------------------------------------------------------------------
    Repeat
      EventID.l=WaitWindowEvent()
      Select EventID
        Case #PB_Event_Gadget
          Select EventGadget()
            Case #Dialog_Valider
              Texte.s=GetGadgetText(#String_2)
              If Texte<>""
                MessageRequester("Info","Mot de passe correct")
                Quit=1
              EndIf
          EndSelect
         
        Case #PB_Event_CloseWindow
          quit=1
      EndSelect
    Until Quit=1
    CloseDialog(#Dialog,Window)
    ProcedureReturn Texte
EndProcedure
;-------------------------------------------------------------------------------------------------------

Enumeration 1
  #Window
EndEnumeration

Enumeration
  #Button
  #String_1
EndEnumeration

OpenWindow(#Window,200,200,400,400,"Fenêtre principale",#PB_Window_SystemMenu)
If CreateGadgetList(WindowID(#Window))
  StringGadget(#String_1,100,20,180,20,"")
  ButtonGadget(#Button,100,100,180,20,"Mot de passe")
EndIf

Repeat
  EventID.l=WaitWindowEvent()
  Select EventID
    Case #PB_Event_Gadget
      Select EventGadget()
        Case #Button
          MotdePasse.s=DialogMotdePasse()
          SetGadgetText(#String_1,MotdePasse)
      EndSelect
     
    Case #PB_Event_CloseWindow
      quit=1
  EndSelect
Until Quit=1
Dernière modification par nico le sam. 03/mai/2008 21:09, modifié 1 fois.
Avatar de l’utilisateur
Jacobus
Messages : 1559
Inscription : mar. 06/avr./2004 10:35
Contact :

Message par Jacobus »

Pas pu tester j'ai une erreur de macro ici

Code : Tout sélectionner

Procedure MakeLong(low.w, high.w)
  ProcedureReturn (high * $10000) | (low & $FFFF)
EndProcedure
Quand tous les glands seront tombés, les feuilles dispersées, la vigueur retombée... Dans la morne solitude, ancré au coeur de ses racines, c'est de sa force maturité qu'il renaîtra en pleine magnificence...Jacobus.
nico
Messages : 3702
Inscription : ven. 13/févr./2004 0:57

Message par nico »

C'est pas une macro, fonctionne très bien sur version 4.20 beta 4
Avatar de l’utilisateur
Jacobus
Messages : 1559
Inscription : mar. 06/avr./2004 10:35
Contact :

Message par Jacobus »

marche pas avec PB 4.10 (windows vista sp1)
Quand tous les glands seront tombés, les feuilles dispersées, la vigueur retombée... Dans la morne solitude, ancré au coeur de ses racines, c'est de sa force maturité qu'il renaîtra en pleine magnificence...Jacobus.
nico
Messages : 3702
Inscription : ven. 13/févr./2004 0:57

Message par nico »

Tu peux remplacer par:

Code : Tout sélectionner

SendMessage_(WindowID(#Dialog), #WM_UPDATEUISTATE, 65538, 0)
Avatar de l’utilisateur
Jacobus
Messages : 1559
Inscription : mar. 06/avr./2004 10:35
Contact :

Message par Jacobus »

Avec

Code : Tout sélectionner

SendMessage_(WindowID(#Dialog), #WM_UPDATEUISTATE, 65538, 0)
ça fonctionne à condition que je supprime la procédure MakeLong()

Si je veux conserver MakeLong() pour que cela fonctionne il faut que je l'écrive différement, comme ça par exemple : Make_Long() sinon j'ai une erreur de macro de PB et un message debug qui me dit "Le nom d'une procédure doit commencer par un caractère de a-z ou _ "

A part ça la boîte fonctionne bien.
Quand tous les glands seront tombés, les feuilles dispersées, la vigueur retombée... Dans la morne solitude, ancré au coeur de ses racines, c'est de sa force maturité qu'il renaîtra en pleine magnificence...Jacobus.
nico
Messages : 3702
Inscription : ven. 13/févr./2004 0:57

Message par nico »

Il y a un truc bizarre c'est qu'une fois qu'on coché une OptionGadget, on ne peut plus la changer avec la Tab et la barre d'espace?
Avatar de l’utilisateur
Jacobus
Messages : 1559
Inscription : mar. 06/avr./2004 10:35
Contact :

Message par Jacobus »

Même avec ce code basic on ne peut pas...

Code : Tout sélectionner

Enumeration
#Window
#Option_1
#Option_2
#Option_3
#Text_options
EndEnumeration

OpenWindow(#Window,200,200,400,200,"Fenêtre principale",#PB_Window_SystemMenu)
If CreateGadgetList(WindowID(#Window))
  OptionGadget(#Option_1, 30, 35, 120, 24, "Option 1")
  OptionGadget(#Option_2, 30, 65, 120, 24, "Option 2")
  OptionGadget(#Option_3, 30, 95, 120, 24, "Option 3")  
  TextGadget(#Text_options,30,150,200,15,"")
EndIf

Repeat
  EventID.l=WaitWindowEvent()
  Select EventID
    Case #PB_Event_Gadget
      Select EventGadget()
         Case #Option_1 : SetGadgetText(#Text_options,"Vous avez opté pour l'option 1")
         Case #Option_2 : SetGadgetText(#Text_options,"Option 2 a été sélectionné")
         Case #Option_3 : SetGadgetText(#Text_options,"Super! choix de l'option 3")        
      EndSelect
     
    Case #PB_Event_CloseWindow
      quit=1
  EndSelect
Until Quit=1
Quand tous les glands seront tombés, les feuilles dispersées, la vigueur retombée... Dans la morne solitude, ancré au coeur de ses racines, c'est de sa force maturité qu'il renaîtra en pleine magnificence...Jacobus.
nico
Messages : 3702
Inscription : ven. 13/févr./2004 0:57

Message par nico »

Petite modification dans le code, on récupère la fenêtre active avant d'afficher la boite de dialogue avec Window=GetActiveWindow(), plus besoin de le passer en paramètre.


Je pense qu'un exemple de création de boite de dialogue mériterait de figurer dans l'aide surtout que les procédures utilisées n'emploient que des fonctions de PureBasic.
meganet
Messages : 317
Inscription : jeu. 20/janv./2005 22:00

Les raccourcis marchent!

Message par meganet »

Salut, voilà le code du premier message modifié pour pouvoir fermer la boite de dialogue avec échappe, et pour valider avec la touche entrée. Les String Gadgets prennent automatiquement le focus quand la fenêtre obtient elle-même le focus. Je n'est pas trouvé comment faire pour savoir quand la fenêtre perdait celui-ci, donc je n’est pas pue faire en sorte que ça soit le dernier gadget qui avait le focus qui le reprenne. Si quelqu'un à une piste! :!:

Code : Tout sélectionner

  Procedure Open_Dialog(ID.L, Width.l, Height.l, Title.s, Option.l, Window_Main.l)
    Protected Value.l
    
    Value = OpenWindow(ID, 0, 0, Width, Height, Title, Option, WindowID(Window_Main))
    
    If ID = #PB_Any
      ID = Value
    EndIf
    
    If Value <> 0
      DisableWindow(Window_Main, 1)
    EndIf
    ProcedureReturn Value
  EndProcedure
  
  Procedure Close_Dialog(Window_Dialog.l, Window_Main.l)
    DisableWindow(Window_Main, 0)
    SetActiveWindow(Window_Main)
    CloseWindow(Window_Dialog)
  EndProcedure
  
  Procedure.s Password_Dialog()
    Protected Window.l
    
    Window = GetActiveWindow()
    
    Enumeration 100
      #Dialog
    EndEnumeration
    
    Enumeration 100
      #Dialog_Text
      #Dialog_String
      #Dialog_Button
    EndEnumeration
    
    Open_Resultat = Open_Dialog(#Dialog, 280, 100, "Boite de Dialogue", Window, #PB_Window_ScreenCentered)
    
    If Open_Resultat = 0
      MessageRequester("Erreur!", "Impossible d'ouvrir la boite de dialogue demandée.", #PB_MessageRequester_Ok|#MB_ICONERROR)
      ProcedureReturn ""
    EndIf
    
    If CreateGadgetList(WindowID(#Dialog))
      TextGadget(#Dialog_Text, 40, 10, 180, 20, "Entrez le mot de passe pour continuer", #PB_Text_Center)
      StringGadget(#Dialog_String, 40, 40, 180, 20, "", #PB_String_Password)
      ButtonGadget(#Dialog_Button, 80, 70, 100, 20, "Ok", #PB_Button_Default)
    EndIf
    
    AddKeyboardShortcut(#Dialog, #PB_Shortcut_Escape, #PB_Event_CloseWindow)
    AddKeyboardShortcut(#Dialog, #PB_Shortcut_Return, #Dialog_Button)
    
    SetActiveGadget(#Dialog_String)
    ActiveGadget = #Dialog_String
    
    Repeat
      
      EventId.l = WaitWindowEvent()
      
      Select EventID
        
        Case #PB_Event_Menu
        
        Select EventMenu()
          
          Case #Dialog_Button
          Goto Dialog_Button
          
          Case #PB_Event_CloseWindow
          Quit = 1
          
        EndSelect
        
        Case #PB_Event_Gadget
        
        Select EventGadget()
          
          Case #Dialog_Button
          Dialog_Button:
          Text.s = GetGadgetText(#Dialog_String)
          If Text = "ABCD_F Bonjour"
            MessageRequester("OK!", "C'est bien le bon mot de passe!", #PB_MessageRequester_Ok)
            quit = 1
          Else
            MessageRequester("Non!", "Ce n'est pas le bon mot de passe.", #PB_MessageRequester_Ok)
            quit = 1
          EndIf
          
        EndSelect
        
        Case #PB_Event_ActivateWindow
        SetActiveGadget(ActiveGadget)
        
        Case #PB_Event_CloseWindow
        Quit = 1
        
      EndSelect
      
    Until Quit = 1
    Close_Dialog(#Dialog, Window)
    ProcedureReturn Text
  EndProcedure
  
  Enumeration 1
    #Window
  EndEnumeration
  
  Enumeration
    #Button
  EndEnumeration
  
  OpenWindow(#Window, 200, 200, 400, 400, "Fenêtre principale", #PB_Window_SystemMenu)
  
  If CreateGadgetList(WindowID(#Window))
    StringGadget(#String, 100, 20, 180, 20, "Cliquez sur le boutton.")
    ButtonGadget(#Button, 100, 100, 180, 20, "Mot de passe")
  EndIf
  
  SetActiveGadget(#String)
  
  Repeat
    
    EventID.l = WaitWindowEvent()
    
    Select EventID
      
      Case #PB_Event_Gadget
      
      Select EventGadget()
        
        Case #Button
        Password.s = Password_Dialog()
        If Password <> ""
          SetGadgetText(#String, Password)
        EndIf
        
      EndSelect
      
      Case #PB_Event_ActivateWindow
      SetActiveGadget(#String)
      
      Case #PB_Event_CloseWindow
      Quit = 1
      
    EndSelect
    
  Until Quit = 1
  
  End
Voilà!
Répondre