PureBasic

Code : Tout sélectionner

;Gestion d'événéments avec rappel
;{ Fichiers inclus
XIncludeFile "D:\Programmation\Prg Perso\M\Modules en francais\MesBoutons.pb"
UseModule MesBoutons
;}
;{ Enumérations
Enumeration Fichiers
  #Fichier_Json
EndEnumeration

Enumeration Fenetres
  #Fenetre_principale
EndEnumeration

Enumeration Gadgets
  #Cal ;calendrier
  #Btn_Ajouter ; bouton pour ajouter un événement
  #Btn_Charger ; bouton pour charger les événements
  #Btn_Sauvegarder ; bouton pour sauvegarder les événements
  #Lst_Evenements  ; liste pour afficher les événements
EndEnumeration

Enumeration Polices
  #police
EndEnumeration
;}
;{ Structures
; Structure de l'événement
Structure Evenement
  Date.q
  Heure.q
  Description.s
EndStructure
;}
;{ Variables
Global.s Rep$ = GetPathPart(ProgramFilename()) : SetCurrentDirectory(Rep$)
; Liste globale des événements
Global NewList ListEvenements.Evenement(), NewList ListeTemp.Evenement()
Global.b Quitter = #False

Global.s Fichier_Evenements = Rep$ + "Mes événements.Json"
Global.b SauvegardeEffectuee = #True
Global.q DateActuelle, HeureEvenement
Global.iGadget *Btn_Ajouter, *Btn_Charger, *Btn_Sauvegarder
LoadFont(#police, "Arial Nova", 12, #PB_Font_Bold)
SetGadgetFont(#PB_Default, FontID(#police))

;- Init position
ExamineDesktops()
Global Xmax = DesktopWidth(0)
Global LargeurInterface = 340
;}
Procedure TrierListeEvenement()
  ClearList(ListeTemp())
  ForEach ListEvenements()
    AddElement(ListeTemp())
    ListeTemp() = ListEvenements()
  Next
  
  SortStructuredList(ListeTemp(), #PB_Sort_Ascending, OffsetOf(Evenement\Heure), TypeOf(Evenement\Heure))
  SortStructuredList(ListeTemp(), #PB_Sort_Ascending, OffsetOf(Evenement\Date), TypeOf(Evenement\Date))
EndProcedure
Procedure Charger_Liste()
  Select #PB_EventType_LeftClick
    Case EventType()
      If ReadFile(#Fichier_Json, Fichier_Evenements)
        CloseFile(#Fichier_Json)    
        ;Lecture du fichier JSON
        LoadJSON(#Fichier_JSON, Fichier_Evenements, #PB_JSON_NoCase)    
        ;Extraction de la chaine JSON vers la liste chainée ListEvenements()
        ExtractJSONList(JSONValue(#Fichier_JSON), ListEvenements())
        
        TrierListeEvenement()
        
        If IsWindow(#Fenetre_principale)
          ;Affichage de la liste d'évenements
          ForEach ListeTemp()
            With ListeTemp()
              AddGadgetItem(#Lst_Evenements, -1, FormatDate("%dd/%mm/%yyyy", \Date) + " " + FormatDate("%hh:%ii", \Heure) + " : " + \Description)
              SetGadgetItemData(#Lst_Evenements, CountGadgetItems(#Lst_Evenements) - 1, ListIndex(ListEvenements()))
            EndWith
          Next
        EndIf
      EndIf
  EndSelect
EndProcedure
Procedure Sauvegarder_Evenements()
  Select #PB_EventType_LeftClick
    Case EventType()
      ;Création d'un objet JSON
      CreateJSON(#Fichier_JSON)  
      ;Insertion de la liste chainée "ListEvenements()" dans l'objet JSON
      InsertJSONList(JSONValue(#Fichier_JSON), ListEvenements())  
      ;Sauvegarde du fichier
      SaveJSON(#Fichier_JSON, Fichier_Evenements, #PB_JSON_PrettyPrint)
      SauvegardeEffectuee = #True
  EndSelect
EndProcedure
Procedure Ajouter_Evenement()
  Select #PB_EventType_LeftClick
    Case EventType()
      Date = GetGadgetState(#Cal)
      Heure$ = InputRequester("Nouvel Événement", "Entrez l'heure de l'événement (HH:MM):", "")
      If Heure$ <> ""
        Txt_Evenement$ = InputRequester("Nouvel Événement", "Entrez le détail de l'événement:", "")
        If Txt_Evenement$ <> ""
          AddElement(ListEvenements())
          ListEvenements()\Date = Date
          ListEvenements()\Heure = ParseDate("%hh:%ii", Heure$)
          ListEvenements()\Description = Txt_Evenement$
          AddGadgetItem(#Lst_Evenements, -1, FormatDate("%dd/%mm/%yyyy", Date) + " " + FormatDate("%hh:%ii", ListEvenements()\Heure) + " : " + Txt_Evenement$)
          SauvegardeEffectuee = #False
        EndIf
      EndIf
  EndSelect
EndProcedure
Procedure Verifier_Rappels()
  DateActuelle = Date()
  ForEach ListEvenements()
    ; Vérifier si l'événement est dans le futur
    If ListEvenements()\Date + ListEvenements()\Heure > DateActuelle
      ; Rappel 10 minutes avant
      If ListEvenements()\Date + ListEvenements()\Heure <= DateActuelle + 600
        MessageRequester("Rappel d'Événement", "Événement imminent : " + ListEvenements()\Description, #PB_MessageRequester_Ok)
      EndIf
    EndIf
  Next
EndProcedure
Procedure Verifier_Rappels_Au_Demarrage()
  DateActuelle = Date()
  ForEach ListEvenements()
    HeureEvenement = ListEvenements()\Date + ListEvenements()\Heure
    If FormatDate("%yyyy%mm%dd", HeureEvenement) = FormatDate("%yyyy%mm%dd", DateActuelle)
      Debug HeureEvenement
      MessageRequester("Rappel d'Événement", "Événement aujourd'hui : " + ListEvenements()\Description + " à " + FormatDate("%hh:%ii", ListEvenements()\Heure), #PB_MessageRequester_Ok)
    EndIf
  Next
EndProcedure
; Ouverture de la fenêtre principale
Procedure Programme_principal()
  If OpenWindow(#Fenetre_principale, Xmax-LargeurInterface-10, 40, 340, 800, "Gestion d'événéments avec rappel")
    CalendarGadget(#Cal, 10, 10, 325, 250)
    setwindowTheme_(GadgetID(#Cal), @"", @"")
    *Btn_Ajouter = GadgetCouleurBouton(#Btn_Ajouter, 67, 270, 200, 30, "Ajouter Événement")
    *Btn_Charger = GadgetCouleurBouton(#Btn_Charger, 67, 310, 200, 30, "Charger Événements")
    *Btn_Sauvegarder = GadgetCouleurBouton(#Btn_Sauvegarder, 67, 350, 200, 30, "Sauvegarder Événements")
    ListViewGadget(#Lst_Evenements, 10, 390, 320, 400)
    
    *Btn_Ajouter\SetGadgetColor(#PB_Gadget_BackColor, $C9AF10)
    *Btn_Ajouter\SetGadgetColor(#PB_Gadget_FrontColor, $F9F0B9)
    *Btn_Charger\SetGadgetColor(#PB_Gadget_BackColor, $03A2D5)
    *Btn_Charger\SetGadgetColor(#PB_Gadget_FrontColor, $C1EFFD)
    *Btn_Sauvegarder\SetGadgetColor(#PB_Gadget_BackColor, $08CF1C)
    *Btn_Sauvegarder\SetGadgetColor(#PB_Gadget_FrontColor, $CDFCD2)
    Charger_Liste()
    Verifier_Rappels_Au_Demarrage()
    
    ; Boucle d'événements
    Repeat
      Evenement = WaitWindowEvent()
      
      Select Evenement 
        Case #PB_Event_Gadget
          Select EventGadget()
            Case #Btn_Ajouter ; Bouton Ajouter Événement
              Ajouter_Evenement()
              
            Case #Btn_Charger ; Bouton Charger Événements
              Charger_Liste()
              
            Case #Btn_Sauvegarder ; Bouton Sauvegarder Événements
              Sauvegarder_Evenements()
          EndSelect
          
        Case #PB_Event_CloseWindow
          Quitter = #True
      EndSelect
      
      Verifier_Rappels()
      
    Until Quitter
    
    If Not SauvegardeEffectuee
      Reponse = MessageRequester("ATTENTION", "Vous n'avez pas sauvegardé votre travail, voulez-vous le faire maintenant ?", #PB_MessageRequester_YesNo)
      If Reponse = #PB_MessageRequester_Yes
        Sauvegarder_Evenements()
      EndIf
    EndIf
    
  EndIf
  End
EndProcedure
Programme_principal()

Code : Tout sélectionner

;- Init position
ExamineDesktops()
Global Xmax = DesktopWidth(0)
Global LargeurInterface = 340

Code : Tout sélectionner

If OpenWindow(#Fenetre_principale, Xmax-LargeurInterface, 40, 340, 800, "Gestion d'événéments avec rappel")

Code : Tout sélectionner

If OpenWindow(#Fenetre_principale, 2210, 40, 340, 800, "Gestion d'événéments avec rappel")

Code : Tout sélectionner

Debug DesktopWidth(0)  ; = 3840
   Debug DesktopHeight(0) ; = 2160

Code : Tout sélectionner

;- Init position
ExamineDesktops()
Global Xmax = DesktopWidth(0)
Global Ymax = DesktopHeight(0)
Global dpix.d = DesktopResolutionX()
Global dpiy.d = DesktopResolutionY()
/...
;Ajout de 80 à 800 pour la hauteur de la Taskbar.
If OpenWindow(#Fenetre_principale, ValD(StrD(Xmax/dpix,0))-340, ValD(StrD(Ymax/dpiy,0))-880, 340, 800, "Gestion d’évènements avec rappel")
/...

Code : Tout sélectionner

;- Module Public

DeclareModule MesBoutons
  
  Declare GadgetCouleurBouton(id, x, y, dx, dy, texte.s, drapeaux = #PB_Button_Default)
  
  Interface iGadget
    GetID()
    GetHandle()
    GetType()
    FreeGadget()
    GetGadgetState()
    SetGadgetState(Etat)
    GetGadgetText.s()
    SetGadgetText(Texte.s)
    GetGadgetColor(TypeCouleur)
    SetGadgetColor(TypeCouleur, Couleur)
    GetGadgetFont()
    SetGadgetFont(hPolice)
    SetActiveGadget()
    ResizeGadget(x, y, dx, dy)
    HideGadget(Etat)
    DisableGadget(Etat)
    GadgetX()
    GadgetY()
    GadgetWidth()
    GadgetHeight()
    GetGadgetAttribute(Attribut)
    SetGadgetAttribute(Attribut, Valeur)
  EndInterface
  
EndDeclareModule

; -------------------------------------------------------------------------------------

;- Module Privé

Module MesBoutons
  EnableExplicit
  
  ;-- Constantes Internes
  #CouleurBoutonEtatDefaut = 0
  #CouleurBoutonEtatSurvole = 1
  #CouleurBoutonEtatPresse = 2
  
  ;-- Structure Interne
  Structure sGadget
    ; Base
    *vt.iGadget ; Table  Virtuelle Fonctions
    id.i        ; Gadget PB_ID
    type.i      ; Gadget Type
                ; Données
    x.i
    y.i
    dx.i
    dy.i
    texte.s
    drapeaux.i
    etat.i
    etatCouleur.i
    style.i
    hPolice.i
    couleurpremierplan.i
    couleurfond.i
    couleurbord.i
  EndStructure
  
  ;-- Données Internes (Mémoire)
  Global NewMap MesDonneesGadget.sGadget() 
  
  ;-- Declaraton des fonctions de bases Internes
  Declare NouvelleDonnee(id)
  Declare LibererDonnees(id)
  
  ;-- Declaration des Fonctions Internes
  Declare DessinerBouton(*sGadget)
  
  ; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  
  ;-- Fonctions Interface
  
  Procedure MonObtenirID(*objet.sGadget)    
    Protected resultat
    
    With *objet
      resultat = \id
    EndWith
    
    ProcedureReturn resultat    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  Procedure MonObtenirGestionnaire(*objet.sGadget)    
    Protected resultat
    
    With *objet
      If \type
        resultat = GadgetID(\id)
      EndIf
    EndWith
    
    ProcedureReturn resultat    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  Procedure MonObtenirType(*objet.sGadget)    
    Protected resultat
    
    With *objet
      resultat = \type
    EndWith
    
    ProcedureReturn resultat    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  Procedure MonLibererGadget(*objet.sGadget)    
    Protected resultat
    
    With *objet
      If \type
        If IsGadget(\id)
          FreeGadget(\id)
        EndIf
        resultat = LibererDonnees(\id)
      EndIf
    EndWith
    
    ProcedureReturn resultat    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  Procedure MonObtenirEtatGadget(*objet.sGadget)    
    Protected resultat
    
    With *objet
      resultat = \etat
    EndWith
    
    ProcedureReturn resultat    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  Procedure MonDefinirEtatGadget(*objet.sGadget, Etat)    
    Protected resultat
    
    With *objet
      If \type
        \etat = Etat
        Select \type
          Case #PB_GadgetType_Button : DessinerBouton(*objet)
        EndSelect
      EndIf
    EndWith
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  Procedure.s MonObtenirTexteGadget(*objet.sGadget)    
    Protected resultat.s
    
    With *objet
      resultat = \texte
    EndWith
    
    ProcedureReturn resultat    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  Procedure MonDefinirTexteGadget(*objet.sGadget, Texte.s)
    
    With *objet
      If \type
        \texte = Texte
        Select \type
          Case #PB_GadgetType_Button : DessinerBouton(*objet) 
        EndSelect
      EndIf
    EndWith
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  Procedure MonObtenirCouleurGadget(*objet.sGadget, TypeCouleur)    
    Protected resultat
    
    With *objet
      Select TypeCouleur
        Case #PB_Gadget_BackColor
          resultat = \couleurfond
        Case #PB_Gadget_FrontColor
          resultat = \couleurpremierplan
        Case #PB_Gadget_LineColor
          resultat = \couleurbord          
      EndSelect      
    EndWith
    
    ProcedureReturn resultat    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  Procedure MonDefinirCouleurGadget(*objet.sGadget, TypeCouleur, Couleur)
    
    With *objet
      If \type
        Select TypeCouleur
          Case #PB_Gadget_BackColor
            \couleurfond = Couleur
          Case #PB_Gadget_FrontColor
            \couleurpremierplan = Couleur
          Case #PB_Gadget_LineColor
            \couleurbord = Couleur            
        EndSelect
        Select \type
          Case #PB_GadgetType_Button : DessinerBouton(*objet)
        EndSelect
      EndIf
    EndWith
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  Procedure MonObtenirPoliceGadget(*objet.sGadget)    
    Protected resultat
    
    With *objet
      resultat = \hPolice
    EndWith
    
    ProcedureReturn resultat    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  Procedure MonDefinirPoliceGadget(*objet.sGadget, hPolice)
    
    With *objet
      If \type
        If hPolice
          \hPolice = hPolice
        Else
          \hPolice = #PB_Default
        EndIf
        Select \type
          Case #PB_GadgetType_Button : DessinerBouton(*objet)
        EndSelect
      EndIf
    EndWith
    
  EndProcedure
  
  Procedure MonDefinirGadetActif(*objet.sgadget)    
    Protected resultat
    
    With *objet
      resultat = SetActiveGadget(\id)
    EndWith
    
    DessinerBouton(*objet)
    
    ProcedureReturn resultat
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  Procedure MonRedimensionnerGadget(*objet.sGadget, x.i, y.i, largeur.i, hauteur.i)
    
    With *objet
      If \type
        If x <> #PB_Ignore
          \x = x
        EndIf
        If y <> #PB_Ignore
          \y = y
        EndIf
        If largeur <> #PB_Ignore
          \dx = largeur
        EndIf
        If hauteur <> #PB_Ignore
          \dy = hauteur
        EndIf
        Select \type
          Case #PB_GadgetType_Button
            ResizeGadget(\id, \x, \y, \dx, \dy)
            DessinerBouton(*objet)
            
        EndSelect
      EndIf
    EndWith
    
  EndProcedure
  
  Procedure MonCacherGadget(*objet.sgadget, Etat)
    
    With *objet
      If \type
        \etat = Etat
        If IsGadget(\id)           
            HideGadget(\id, \etat)
        EndIf
      EndIf
    EndWith 
    
  EndProcedure
  
  Procedure MonDesactiverGadget(*objet.sgadget, Etat)
    
    With *objet
      If \type
        \etat = Etat
        If IsGadget(\id)
          DisableGadget(\id, \etat)
        EndIf
      EndIf
    EndWith
    
  EndProcedure
  
  Procedure MonGadgetX(*objet.sgadget)    
    Protected resultat
    
    With *objet
      resultat = GadgetX(\id)
    EndWith
    
    ProcedureReturn resultat
  EndProcedure
  
  Procedure MonGadgetY(*objet.sgadget)    
    Protected resultat
    
    With *objet
      resultat = GadgetY(\id)
    EndWith
    
    ProcedureReturn resultat
  EndProcedure
  
  Procedure MonLongueurGadget(*objet.sgadget)
    Protected resultat
    
    With *objet
      resultat = GadgetWidth(\id)
    EndWith
    ProcedureReturn resultat
    
  EndProcedure
  
  Procedure MonHauteurGadget(*objet.sgadget)
    Protected resultat
    
    With *objet
      resultat = GadgetHeight(\id)
    EndWith
    
    ProcedureReturn resultat
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  Procedure MonObtenirAttributGadget(*objet.sGadget, Attribut)
    Protected resultat
    
    With *objet
      resultat = GetGadgetAttribute(\id, Attribut)
    EndWith  
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  Procedure MonDefinirAttributGadget(*objet.sGadget, Attribut, Valeur)
    Protected resultat
    
    With *objet
      resultat = SetGadgetAttribute(\id, Attribut, Valeur)
    EndWith 
    
  EndProcedure
  
  ; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  
  ;-- Gestion des données
  
  DataSection 
    tvGadget:
    Data.i @MonObtenirID()
    Data.i @MonObtenirGestionnaire()
    Data.i @MonObtenirType()
    Data.i @MonLibererGadget()
    Data.i @MonObtenirEtatGadget()
    Data.i @MonDefinirEtatGadget()
    Data.i @MonObtenirTexteGadget()
    Data.i @MonDefinirTexteGadget()
    Data.i @MonObtenirCouleurGadget()
    Data.i @MonDefinirCouleurGadget()
    Data.i @MonObtenirPoliceGadget()
    Data.i @MonDefinirPoliceGadget()
    Data.i @MonDefinirGadetActif()
    Data.i @MonRedimensionnerGadget()
    Data.i @MonCacherGadget()
    Data.i @MonDesactiverGadget()
    Data.i @MonGadgetX()
    Data.i @MonGadgetY()
    Data.i @MonLongueurGadget()
    Data.i @MonHauteurGadget()
    Data.i @MonObtenirAttributGadget()
    Data.i @MonDefinirAttributGadget()
    
    
  EndDataSection
  
  ; Init Rien
  Global Rien.sGadget
  With Rien
    \vt = ?tvGadget
    \id = -1
  EndWith
  
  
  ; -------------------------------------------------------------------------------------
  
  Procedure NouvelleDonnee(id)    
    Protected *nouveau.sGadget, cle.s
    
    cle = "ID-" + Str(id)
    *nouveau = AddMapElement(MesDonneesGadget(), cle)
    If *nouveau
      *nouveau\vt = ?tvGadget
    EndIf
    
    ProcedureReturn *nouveau    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  Procedure LibererDonnees(id)    
    Protected resultat, cle.s
    
    cle = "ID-" + Str(id)
    If FindMapElement(MesDonneesGadget(), cle)
      DeleteMapElement(MesDonneesGadget())
      ProcedureReturn #True
    Else
      ProcedureReturn #False
    EndIf
    
  EndProcedure
  
  ; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  
  ;-- Fonctions Internes
  
  Procedure BoiteDessinTexte(x, y, dx, dy, texte.s, drapeaux)    
    Protected si_multiligne, si_gauche, si_droite
    Protected largeur_texte, hauteur_texte 
    Protected texte_x, texte_y
    Protected lignes , ligne_texte.s, ligne_texte1.s, debut, quantite
    
    si_multiligne = drapeaux & #PB_Button_MultiLine
    si_gauche = drapeaux & #PB_Button_Left
    si_droite = drapeaux & #PB_Button_Right
    
    largeur_texte = TextWidth(texte)
    hauteur_texte = TextHeight(texte)
    
    If Not si_multiligne
      If si_gauche
        texte_x = 6
        texte_y = dy / 2 - hauteur_texte / 2
      ElseIf si_droite
        texte_x = dx - largeur_texte - 6
        texte_y = dy / 2 - hauteur_texte / 2
      Else
        texte_x = dx / 2 - largeur_texte / 2
        texte_y = dy / 2 - hauteur_texte / 2
      EndIf
      DrawText(x + texte_x, y + texte_y, texte)
      ProcedureReturn 1
    EndIf
    
    lignes = largeur_texte / dx
    debut = 1
    texte_y = (dy / 2 - hauteur_texte / 2) - (hauteur_texte / 2 * lignes)
    quantite = CountString(texte, " ") + 1
    
    Repeat
      ligne_texte = StringField(texte, debut, " ") + " "
      
      Repeat
        debut + 1
        ligne_texte1 = StringField(texte, debut, " ")
        If TextWidth(ligne_texte + ligne_texte1) < dx - 12
          ligne_texte + ligne_texte1 + " "
        Else
          Break
        EndIf
      Until debut > quantite
      
      ligne_texte = Trim(ligne_texte)
      
      If si_gauche
        texte_x = 6
      ElseIf si_droite
        texte_x = dx - TextWidth(ligne_texte) - 6
      Else
        texte_x = dx / 2 - TextWidth(ligne_texte) / 2
      EndIf
      
      DrawText(x + texte_x, y + texte_y, ligne_texte)
      texte_y + hauteur_texte
    Until debut > quantite
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  Procedure DessinerBouton(*objet.sGadget)    
    Protected couleurfond, couleurfond2, couleurbord2
    Protected dx, dy
    Protected largeur_texte, hauteur_texte
    Protected texte_x, texte_y
    
    With *objet      
      If \etatCouleur = #CouleurBoutonEtatPresse Or \etat = 1
        couleurfond = RGB(Red(\couleurfond) * 85 / 100, Green(\couleurfond) * 85 / 100, Blue(\couleurfond) * 85 / 100)
        couleurbord2 = $00C0C0C0
      ElseIf \etatCouleur = #CouleurBoutonEtatSurvole
        couleurfond = RGB(Red(\couleurfond) * 95 / 100, Green(\couleurfond) * 95 / 100, Blue(\couleurfond) * 95 / 100)
        couleurbord2 = $00FFFFFF
      Else
        couleurfond = \couleurfond
        couleurbord2 = $00FFFFFF
      EndIf
      
      StartDrawing(CanvasOutput(\id))
      If \dx > 2 And \dy > 2
        If \style
          ; Style Windows 8
          Box(0, 0, \dx, \dy, \couleurbord)
          Box(1, 1, \dx - 2, \dy - 2, couleurfond)
        Else
          ; Style Windows 7
          couleurfond2 = RGB(Red(couleurfond) * 95 / 100, Green(couleurfond) * 95 / 100, Blue(couleurfond) * 95 / 100)
          Box(0, 0, \dx, \dy, \couleurbord)
          Box(1, 1, \dx - 2, \dy - 2, couleurbord2)
          dx = \dx - 4
          dy = (\dy - 4) / 2
          Box(2, 2, dx, dy, couleurfond)
          Box(2, 2 + dy, dx, dy, couleurfond2)
          Plot(0, 0, $00FFFFFF) : Plot(\dx - 1, 0, $00FFFFFF) : Plot(0 ,\dy - 1, $00FFFFFF) : Plot(\dx - 1,\dy - 1, $00FFFFFF)
          Plot(1, 1, \couleurbord) : Plot(\dx - 2, 1, \couleurbord) : Plot(1 ,\dy - 2, \couleurbord) : Plot(\dx - 2,\dy - 2, \couleurbord)
          Plot(2, 2, couleurbord2) : Plot(\dx - 3, 2, couleurbord2) : Plot(2 ,\dy - 3, couleurbord2) : Plot(\dx - 3,\dy - 3, couleurbord2)
        EndIf
        If \hPolice
          DrawingFont(\hPolice)
        EndIf
        DrawingMode(#PB_2DDrawing_Transparent)
        FrontColor(\couleurpremierplan)
        BoiteDessinTexte(0, 0, \dx, \dy, \texte, \drapeaux)
      Else
        Box(0, 0, \dx, \dy, $00808080)
      EndIf
      StopDrawing()      
    EndWith
    
  EndProcedure
  
  ; -------------------------------------------------------------------------------------
  
  Procedure GestionEvenements_Bouton()    
    Protected id, *objet.sGadget, cle.s
    
    id = EventGadget()
    If Not IsGadget(id)
      ProcedureReturn 0
    EndIf
    cle = "ID-" + Str(id)
    *objet = FindMapElement(MesDonneesGadget(), cle)
    If *objet
      With *objet
        Select EventType()
          Case #PB_EventType_MouseEnter
            \etatCouleur = #CouleurBoutonEtatSurvole
            DessinerBouton(*objet)
          Case #PB_EventType_MouseLeave
            \etatCouleur = #CouleurBoutonEtatDefaut
            DessinerBouton(*objet)
          Case #PB_EventType_LeftButtonDown
            \etatCouleur = #CouleurBoutonEtatPresse
            DessinerBouton(*objet)
          Case #PB_EventType_LeftButtonUp
            If \etatCouleur = #CouleurBoutonEtatPresse
              \etatCouleur = #CouleurBoutonEtatSurvole
            Else
              \etatCouleur = #CouleurBoutonEtatDefaut
            EndIf
            DessinerBouton(*objet)
          Case #PB_EventType_LeftClick
            If \drapeaux & #PB_Button_Toggle = #PB_Button_Toggle
              If \etat
                \etat = 0
              Else
                \etat = 1
              EndIf
              DessinerBouton(*objet)
            EndIf
            
        EndSelect
        
      EndWith
    EndIf
    
  EndProcedure
  
  ; *************************************************************************************
  
  ;-- Fonctions Publiques
  
  Procedure GadgetCouleurBouton(id, x, y, dx, dy, texte.s, drapeaux = #PB_Button_Default)    
    Protected resultat, nr, *objet.sGadget
    
    Repeat
      ; Créer Gadget
      resultat = CanvasGadget(id, x, y , dx, dy)
      If resultat = 0
        *objet = @Rien
        Break
      EndIf
      If id = #PB_Any
        nr = resultat
      Else 
        nr = id
      EndIf
      ; Créer vos données perso
      *objet = NouvelleDonnee(nr)
      If Not *objet
        FreeGadget(nr)
        *objet = @Rien
        Break
      EndIf
      ; Attribuer vos données perso
      With *objet
        \id = nr
        \type = #PB_GadgetType_Button
        \x = x
        \y = y
        \dx = dx
        \dy = dy
        \texte = texte
        \drapeaux = drapeaux
        \etat = 0
        \etatCouleur = #CouleurBoutonEtatDefaut
        \hPolice = GetGadgetFont(#PB_Default)
        \couleurpremierplan = $00000000
        \couleurfond = $00F0F0F0
        \couleurbord = $00808080
        If OSVersion() >= #PB_OS_Windows_8 And OSVersion() <= #PB_OS_Windows_Future
          \style = 1
        Else
          \style = 0
        EndIf
      EndWith
      ; Dessiner
      DessinerBouton(*objet)
      ; définir Gestion événements
      BindGadgetEvent(nr, @GestionEvenements_Bouton(), #PB_All)
    Until #True
    
    ProcedureReturn *objet
    
  EndProcedure  
EndModule

;- Fin Module

; ***************************************************************************************

;- Test

CompilerIf #PB_Compiler_IsMainFile
  
  ;- <constantes
  Enumeration ; Window ID
    #Window
  EndEnumeration
  
  Enumeration ; Menu ID
    #Menu
  EndEnumeration
  
  Enumeration ; MenuItem ID
    #Menu_quitter
  EndEnumeration
  
  Enumeration ; Statusbar ID
    #Statusbar
  EndEnumeration
  
  Enumeration ; Gadget ID
    
  EndEnumeration
  
  ; ***************************************************************************************
  
  ;- Variables Globales
  
  UseModule MesBoutons
  
  Global quitter = 0
  Global.iGadget *btn1, *btn2, *btn3
  
  ;- Fenêtres
  style = #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget
  If OpenWindow(#Window, #PB_Ignore, #PB_Ignore, 500, 400, "Fenêtre", style)
    ; Menu
    If CreateMenu(#Menu, WindowID(#Window))
      MenuTitle("&Fichier")
      MenuItem(#Menu_quitter, "&Quitter")
    EndIf
    ; Statusbar
    CreateStatusBar(#Statusbar, WindowID(#Window))
    ; Gadgets
    
    LoadFont(0, "Arial", 16)
    
    *btn1 = GadgetCouleurBouton(0, 10 ,10, 200, 40, "Bouton 1 (aligné à gauche)", #PB_Button_Left)
    *btn1\DisableGadget(#True)
    
    *btn2 = GadgetCouleurBouton(1, 10 ,60, 200, 40, "Bouton 2", #PB_Button_MultiLine)
    *btn2\SetGadgetColor(#PB_Gadget_BackColor, $00FF4040)
    *btn2\SetGadgetColor(#PB_Gadget_FrontColor, $00FFFFFF)
    
    *btn2\SetGadgetFont(FontID(0))
    
    *btn3 = GadgetCouleurBouton(2, 10, 180, 200, 40, "Bouton 3 (aligné à droite)", #PB_Button_Toggle | #PB_Button_Right)
    *btn3\SetGadgetColor(#PB_Gadget_BackColor, $008080FF)
    *btn3\HideGadget(0) ;0 = visible, 1 = caché
    
    *btn2\ResizeGadget(10, 80, 300, 80)
    *btn2\SetGadgetText("Bonjour monde cruel! Multiligne (centré par défaut)")
    
    Debug "Bouton 0"
    Debug *btn1\GetID()
    Debug *btn1\GetHandle()
    Debug *btn1\GetGadgetText()
    Debug *btn1\GadgetX()
    Debug *btn1\GadgetY()
    Debug *btn1\GadgetWidth()
    Debug *btn1\GadgetHeight()
    Debug "--------------------"
    
    Debug "Bouton 1"
    Debug *btn2\GetID()
    Debug *btn2\GetHandle()
    Debug *btn2\GetGadgetText()
    Debug "--------------------"
    
    Debug "Bouton 2"
    Debug *btn3\GetID()
    Debug *btn3\GetHandle()
    Debug *btn3\GetGadgetText()
    Debug "--------------------"
    
    ;-- Boucle événementielle
    Repeat
      evenement   = WaitWindowEvent()
      Select evenement
        Case #PB_Event_Menu
          Select menu
            Case #Menu_quitter
              quitter = 1
          EndSelect
        Case #PB_Event_Gadget
          Select EventGadget()
            Case 0
              Select EventType()
                Case #PB_EventType_LeftClick
                  Debug "Bouton 1 Cliqué"
                Case #PB_EventType_LeftButtonDown
                  Debug "Bouton 1 Pressé"
                Case #PB_EventType_LeftButtonUp
                  Debug "Bouton 1 Relâché"
              EndSelect
              
            Case 1
              If EventType() = #PB_EventType_LeftClick
                Debug "Bouton 2"
              EndIf
            Case 2
              If EventType() = #PB_EventType_LeftClick
                Debug "Bouton 3 Etat : " + Str(*btn3\GetGadgetState())
              EndIf
              
          EndSelect
          
          
        Case #PB_Event_CloseWindow
          quitter = 1
          
      EndSelect
      
    Until quitter
  EndIf
  
  CloseWindow(#Window)
  
CompilerEndIf