Petit concourt de dessins de bouton avec VectorDrawing

Sujets variés concernant le développement en PureBasic
Shadow
Messages : 1373
Inscription : mer. 04/nov./2015 17:39

Petit concourt de dessins de bouton avec VectorDrawing

Message par Shadow »

Salut,

Je propose pour ceux qui le veulent, un petit concourt de dessins de bouton avec la librairie VectorDrawing :)
Le dessins devra uniquement être composé de fonction VectorDrawing, les images sont proscrites !

La librairie VectorDrawing permet de faire des choses vraiment cool, moi même ne la connait pas trop
et j'y travail, elle est compliqué à appréhender sur certain aspect !

Une fois que vous l'avez en main, ce qui n'est pas encore mon cas, vous pouvez faire des choses vraiment superbe !
Une fois n'est pas coutume, je me dois de démarrer la marche avec un bouton que j'ai fait :)

Un jolie Bouton avec dégradé, Normal:

Code : Tout sélectionner

If OpenWindow(0, 0, 0, 400, 200, "VectorDrawing", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  CanvasGadget(0, 0, 0, 400, 200)
  
  LoadFont(0, "Times New Roman", 10, #PB_Font_Bold | #PB_Font_HighQuality)
  
  If StartVectorDrawing(CanvasVectorOutput(0))
    
    ; Choix de la taille du Bouton:
    X.i = 25
    Y.i = 25
    Width.i = 300
    Height.i = 100
    
    AddPathBox(X.i + 5, Y.i + 5, Width.i-10, Height.i-10)
    VectorSourceColor(RGBA(150, 150, 150, 255))
    StrokePath(10, #PB_Path_RoundCorner)
    AddPathBox(X.i + 6, Y.i + 6, Width.i-12, Height.i-12)
    VectorSourceColor(RGBA(230, 230, 230, 255))
    StrokePath(10, #PB_Path_RoundCorner)
    VectorSourceLinearGradient(X.i, Y.i, X.i, Height.i + Y.i)
    VectorSourceGradientColor(RGBA(230, 230, 230, 255), 0.0)
    VectorSourceGradientColor(RGBA(200, 200, 200, 255), 0.50)
    VectorSourceGradientColor(RGBA(200, 200, 200, 255), 0.50)
    VectorSourceGradientColor(RGBA(230, 230, 230, 255), 1)
    AddPathBox(X.i + 2, Y.i + 2, Width.i-4, Height.i-4)
    FillPath()
    Texte$ = "Mon Bouton"
    VectorFont(FontID(0), 25)
    MovePathCursor(X.i + (Width.i - VectorTextWidth(Texte$)) / 2, Y.i + (Height.i - VectorTextHeight(Texte$)) / 2)
    AddPathText(Texte$)
    VectorSourceColor(RGBA(0, 0, 0, 255))
    FillPath()
    
    StopVectorDrawing()
  EndIf
  
  Repeat
    Event = WaitWindowEvent()
  Until Event = #PB_Event_CloseWindow
  
EndIf
Un jolie Bouton avec dégradé, Survolé:

Code : Tout sélectionner

If OpenWindow(0, 0, 0, 400, 200, "VectorDrawing", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  CanvasGadget(0, 0, 0, 400, 200)
  
  LoadFont(0, "Times New Roman", 10, #PB_Font_Bold | #PB_Font_HighQuality)
  
  If StartVectorDrawing(CanvasVectorOutput(0))
    
    ; Choix de la taille du Bouton:
    X.i = 25
    Y.i = 25
    Width.i = 300
    Height.i = 100
    
    AddPathBox(X.i + 5, Y.i + 5, Width.i-10, Height.i-10)
    VectorSourceColor(RGBA(255, 203, 41, 255))
    StrokePath(10, #PB_Path_RoundCorner)
    AddPathBox(X.i + 6, Y.i + 6, Width.i-12, Height.i-12)
    VectorSourceColor(RGBA(254, 241, 201, 255))
    StrokePath(10, #PB_Path_RoundCorner)
    VectorSourceLinearGradient(X.i, Y.i, X.i, Height.i + Y.i)
    VectorSourceGradientColor(RGBA(254, 241, 201, 255), 0.0)
    VectorSourceGradientColor(RGBA(254, 227, 143, 255), 0.50)
    VectorSourceGradientColor(RGBA(254, 227, 143, 255), 0.50)
    VectorSourceGradientColor(RGBA(254, 241, 201, 255), 1)
    AddPathBox(X.i + 2, Y.i + 2, Width.i-4, Height.i-4)
    FillPath()
    Texte$ = "Mon Bouton"
    VectorFont(FontID(0), 25)
    MovePathCursor(X.i + (Width.i - VectorTextWidth(Texte$)) / 2, Y.i + (Height.i - VectorTextHeight(Texte$)) / 2)
    AddPathText(Texte$)
    VectorSourceColor(RGBA(0, 0, 200, 255))
    FillPath()
    
    StopVectorDrawing()
  EndIf
  
  Repeat
    Event = WaitWindowEvent()
  Until Event = #PB_Event_CloseWindow
  
EndIf
Un Jolie Bouton avec dégradé, Appuyé:

Code : Tout sélectionner

If OpenWindow(0, 0, 0, 400, 200, "VectorDrawing", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  CanvasGadget(0, 0, 0, 400, 200)
  
  LoadFont(0, "Times New Roman", 10, #PB_Font_Bold | #PB_Font_HighQuality)
  
  If StartVectorDrawing(CanvasVectorOutput(0))
    
    ; Choix de la taille du Bouton:
    X.i = 25
    Y.i = 25
    Width.i = 300
    Height.i = 100
    
    AddPathBox(X.i + 5, Y.i + 5, Width.i-10, Height.i-10)
    VectorSourceColor(RGBA(255, 203, 41, 255))
    StrokePath(10, #PB_Path_RoundCorner)
    AddPathBox(X.i + 6, Y.i + 6, Width.i-12, Height.i-12)
    VectorSourceColor(RGBA(254, 227, 143, 255))
    StrokePath(10, #PB_Path_RoundCorner)
    VectorSourceLinearGradient(X.i, Y.i, X.i, Height.i + Y.i)
    VectorSourceGradientColor(RGBA(254, 227, 143, 255), 0.0)
    VectorSourceGradientColor(RGBA(254, 241, 201, 255), 0.50)
    VectorSourceGradientColor(RGBA(254, 241, 201, 255), 0.50)
    VectorSourceGradientColor(RGBA(254, 227, 143, 255), 1)
    AddPathBox(X.i + 2, Y.i + 2, Width.i-4, Height.i-4)
    FillPath()
    Texte$ = "Mon Bouton"
    VectorFont(FontID(0), 25)
    MovePathCursor(X.i + (Width.i - VectorTextWidth(Texte$)) / 2, Y.i + (Height.i - VectorTextHeight(Texte$)) / 2)
    AddPathText(Texte$)
    VectorSourceColor(RGBA(200, 0, 0, 255))
    FillPath()
    
    StopVectorDrawing()
  EndIf
  
  Repeat
    Event = WaitWindowEvent()
  Until Event = #PB_Event_CloseWindow
  
EndIf
Dernière modification par Shadow le jeu. 30/juil./2020 11:42, modifié 5 fois.
Processeur: Intel Core I7-4790 - 4 Cœurs - 8 Thread: 3.60 Ghz.
Ram: 32 GB.
Disque: C: SDD 250 GB, D: 3 TB.
Vidéo: NVIDIA GeForce GTX 960: 2 GB DDR5.
Écran: Asus VX248 24 Pouces: 1920 x 1080.
Système: Windows 7 64 Bits.

PureBasic: 5.60 x64 Bits.
Avatar de l’utilisateur
falsam
Messages : 7244
Inscription : dim. 22/août/2010 15:24
Localisation : IDF (Yvelines)
Contact :

Re: Petit concourt de dessins de bouton avec VectorDrawing

Message par falsam »

Bonjour Shadow.
Shadow a écrit :e propose pour ceux qui le veulent, un petit concourt de dessins de bouton
Il y a des cadeaux pour le ou les gagnants ? :mrgreen:
Configuration : Windows 11 Famille 64-bit - PB 6.03 x64 - AMD Ryzen 7 - 16 GO RAM
Vidéo NVIDIA GeForce GTX 1650 Ti - Résolution 1920x1080 - Mise à l'échelle 125%
Shadow
Messages : 1373
Inscription : mer. 04/nov./2015 17:39

Re: Petit concourt de dessins de bouton avec VectorDrawing

Message par Shadow »

falsam a écrit :Bonjour Shadow.
Shadow a écrit :e propose pour ceux qui le veulent, un petit concourt de dessins de bouton
Il y a des cadeaux pour le ou les gagnants ? :mrgreen:
C'est simplement pour s'amuser !

Le forum n'est pas très animé alors j’anime un peu voilà tous :)
Et ça peut être vraiment fun :)
Processeur: Intel Core I7-4790 - 4 Cœurs - 8 Thread: 3.60 Ghz.
Ram: 32 GB.
Disque: C: SDD 250 GB, D: 3 TB.
Vidéo: NVIDIA GeForce GTX 960: 2 GB DDR5.
Écran: Asus VX248 24 Pouces: 1920 x 1080.
Système: Windows 7 64 Bits.

PureBasic: 5.60 x64 Bits.
Avatar de l’utilisateur
case
Messages : 1527
Inscription : lun. 10/sept./2007 11:13

Re: Petit concourt de dessins de bouton avec VectorDrawing

Message par case »

Moi j'aime que le dessin bitmap et le gros pixel du coup... vector drawing je participe pas ^^
ImageImage
Avatar de l’utilisateur
Micoute
Messages : 2522
Inscription : dim. 02/oct./2011 16:17
Localisation : 35520 La Mézière

Re: Petit concourt de dessins de bouton avec VectorDrawing

Message par Micoute »

Bonjour à tous,

j'avais fait ça, il y a quelques années, c'est sûr que maintenant, j'aurais bien du mal à le refaire.

Code : Tout sélectionner

;- Module Public

DeclareModule MesVectorGadgets
  
  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)
    ResizeGadget(x, y, dx, dy)
    HideGadget(Etat)
    DisableGadget(Etat)
    GadgetX()
    GadgetY()
    GadgetWidth()
    GadgetHeight()
    GetGadgetAttribute(Attribut)
    SetGadgetAttribute(Attribut, Valeur)
  EndInterface
  
EndDeclareModule

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

;- Module Privé

Module MesVectorGadgets
  EnableExplicit
  
  ;-- Constantes Internes
  Enumeration
    #CouleurBoutonEtatDefaut
    #CouleurBoutonEtatSurvole
    #CouleurBoutonEtatPresse
  EndEnumeration
  
  ;-- Structure Interne
  Structure sGadget
    ; Base
    *tv.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 base 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
      ; Code
      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 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 @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 Vide
  Global Vide.sGadget
  With Vide
    \tv = ?tvGadget
    \id = -1
  EndWith
  
  
  ; -------------------------------------------------------------------------------------
  
  Procedure NouvelleDonnee(id)
    
    Protected *nouveau.sGadget, cle.s
    
    cle = "ID-" + Str(id)
    *nouveau = AddMapElement(MesDonneesGadget(), cle)
    If *nouveau
      *nouveau\tv = ?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 est_multiligne, est_gauche, est_droite
    Protected largeur_texte, hauteur_texte 
    Protected texte_x, texte_y
    Protected lignes , ligne_texte.s, ligne_texte1.s, debut, quantite
    
    est_multiligne = drapeaux & #PB_Button_MultiLine
    est_gauche = drapeaux & #PB_Button_Left
    est_droite = drapeaux & #PB_Button_Right
    
    largeur_texte = VectorTextWidth(texte)
    hauteur_texte = VectorTextHeight(texte)
    
    If Not est_multiligne
      If est_gauche
        texte_x = 6
        texte_y = dy / 2 - hauteur_texte / 2
      ElseIf est_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
      
      MovePathCursor(x + texte_x, y + texte_y)
      DrawVectorText(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 VectorTextWidth(ligne_texte + ligne_texte1) < dx - 12
          ligne_texte + ligne_texte1 + " "
        Else
          Break
        EndIf
      Until debut > quantite
      ligne_texte = Trim(ligne_texte)
      If est_gauche
        texte_x = 6
      ElseIf est_droite
        texte_x = dx - VectorTextWidth(ligne_texte) - 6
      Else
        texte_x = dx / 2 - VectorTextWidth(ligne_texte) / 2
      EndIf
      MovePathCursor(x + texte_x, y + texte_y)
      DrawVectorText(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 = RGBA(Red(\couleurfond) * 85 / 100, Green(\couleurfond) * 85 / 100, Blue(\couleurfond) * 85 / 100, 255)
        couleurbord2 = $FFC0C0C0
      ElseIf \etatCouleur = #CouleurBoutonEtatSurvole
        couleurfond = RGBA(Red(\couleurfond) * 95 / 100, Green(\couleurfond) * 95 / 100, Blue(\couleurfond) * 95 / 100, 255)
        couleurbord2 = $FF000000
      Else
        couleurfond = \couleurfond
        couleurbord2 = $FF000000
      EndIf
      StartVectorDrawing(CanvasVectorOutput(\id))
      If \dx > 2 And \dy > 2
        If \style
          ; Style Windows 8
          AddPathBox(0, 0, \dx, \dy) : VectorSourceColor(\couleurbord) : StrokePath(2)
          AddPathBox(1, 1, \dx - 2, \dy - 2) : VectorSourceColor(couleurfond) : FillPath()
        Else
          ; Style Windows 7
          couleurfond2 = RGBA(Red(couleurfond) * 95 / 100, Green(couleurfond) * 95 / 100, Blue(couleurfond) * 95 / 100, 255)
          AddPathBox(0, 0, \dx, \dy) : VectorSourceColor(\couleurbord) : StrokePath(2)
          AddPathBox(1, 1, \dx - 2, \dy - 2) : VectorSourceColor(couleurbord2) : FillPath()
          dx = \dx - 4
          dy = (\dy - 4) / 2
          AddPathBox(2, 2, dx, dy) : VectorSourceColor(couleurfond) : FillPath()
          AddPathBox(2, 2 + dy, dx, dy) : VectorSourceColor(couleurfond2) : FillPath()
          AddPathLine(0, 0) : VectorSourceColor($FF000000)
          AddPathLine(\dx - 1, 0) : VectorSourceColor($FF000000)
          AddPathLine(0 ,\dy - 1) : VectorSourceColor($FF000000)
          AddPathLine(\dx - 1,\dy - 1) : VectorSourceColor($FF000000)
          AddPathLine(1, 1) : VectorSourceColor(\couleurbord)
          AddPathLine(\dx - 2, 1) : VectorSourceColor(\couleurbord)
          AddPathLine(1 ,\dy - 2) : VectorSourceColor(\couleurbord)
          AddPathLine(\dx - 2,\dy - 2) : VectorSourceColor(\couleurbord)
          AddPathLine(2, 2) : VectorSourceColor(couleurbord2)
          AddPathLine(\dx - 3, 2) : VectorSourceColor(couleurbord2)
          AddPathLine(2 ,\dy - 3) : VectorSourceColor(couleurbord2)
          AddPathLine(\dx - 3,\dy - 3) : VectorSourceColor(couleurbord2)
        EndIf
        If \hPolice
          VectorFont(\hPolice)
        EndIf
        VectorSourceColor(\couleurpremierplan)
        BoiteDessinTexte(0, 0, \dx, \dy, \texte, \drapeaux)
      Else
        AddPathBox(0, 0, \dx, \dy)
        VectorSourceColor($FF808080)
        FillPath()
      EndIf
      StopVectorDrawing()  
      
    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 = @Vide
        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 = @Vide
        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 = $FF000000
        \couleurfond = $FFF0F0F0
        \couleurbord = $FF808080
        If OSVersion() >= #PB_OS_Windows_10 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 MesVectorGadgets
  
  Global quitter = 0
  Global.iGadget *btn0, *btn1, *btn2
  
  ;- 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)
    
    *btn0 = GadgetCouleurBouton(0, 10 ,10, 200, 40, "Bouton 1 (aligné à gauche)", #PB_Button_Left)
    
    *btn1 = GadgetCouleurBouton(1, 10 ,60, 200, 40, "Bouton 2", #PB_Button_MultiLine)
    *btn1\SetGadgetColor(#PB_Gadget_BackColor, $FFFF4040)
    *btn1\SetGadgetColor(#PB_Gadget_FrontColor, $FFFFFFFF)    
    *btn1\SetGadgetFont(FontID(0))
    
    *btn2 = GadgetCouleurBouton(2, 10, 180, 200, 40, "Bouton 3 (aligné à droite)", #PB_Button_Toggle | #PB_Button_Right)
    *btn2\SetGadgetColor(#PB_Gadget_BackColor, $FF8080FF)
    
    *btn1\ResizeGadget(10, 80, 300, 80)
    *btn1\SetGadgetText("Bonjour monde cruel! Multiligne (centré par défaut)")
    
    Debug "Bouton 0"
    Debug *btn0\GetID()
    Debug *btn0\GetHandle()
    Debug *btn0\GetGadgetText()
    Debug "--------------------"
    
    Debug "Bouton 1"
    Debug *btn1\GetID()
    Debug *btn1\GetHandle()
    Debug *btn1\GetGadgetText()
    Debug "--------------------"
    
    Debug "Bouton 2"
    Debug *btn2\GetID()
    Debug *btn2\GetHandle()
    Debug *btn2\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(*btn2\GetGadgetState())
              EndIf
              
          EndSelect
          
          
        Case #PB_Event_CloseWindow
          quitter = 1
          
      EndSelect
      
    Until quitter
  EndIf
  
  CloseWindow(#Window)
  
CompilerEndIf
Microsoft Windows 10 Famille 64 bits : Carte mère : ASRock 970 Extreme3 R2.0 : Carte Graphique NVIDIA GeForce RTX 3080 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 5.73 PB 6.00 LTS (x64)
Un homme doit être poli, mais il doit aussi être libre !
Avatar de l’utilisateur
falsam
Messages : 7244
Inscription : dim. 22/août/2010 15:24
Localisation : IDF (Yvelines)
Contact :

Re: Petit concourt de dessins de bouton avec VectorDrawing

Message par falsam »

Micoute franchement ! C'est moche hahahaha. Mais au moins il y a une gestion événementielle :mrgreen:
Configuration : Windows 11 Famille 64-bit - PB 6.03 x64 - AMD Ryzen 7 - 16 GO RAM
Vidéo NVIDIA GeForce GTX 1650 Ti - Résolution 1920x1080 - Mise à l'échelle 125%
Avatar de l’utilisateur
grendizer
Messages : 59
Inscription : mer. 29/mai/2019 6:29

Re: Petit concourt de dessins de bouton avec VectorDrawing

Message par grendizer »

pas mal du Micoute :)
Avatar de l’utilisateur
Micoute
Messages : 2522
Inscription : dim. 02/oct./2011 16:17
Localisation : 35520 La Mézière

Re: Petit concourt de dessins de bouton avec VectorDrawing

Message par Micoute »

falsam a écrit :Micoute franchement ! C'est moche hahahaha. Mais au moins il y a une gestion événementielle :mrgreen:
J'ai fait ça avec les acquis que j'avais à ce moment, depuis j'avais progressé, mais après j'ai énormément régressé, je pense abandonner la programmation.
Microsoft Windows 10 Famille 64 bits : Carte mère : ASRock 970 Extreme3 R2.0 : Carte Graphique NVIDIA GeForce RTX 3080 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 5.73 PB 6.00 LTS (x64)
Un homme doit être poli, mais il doit aussi être libre !
Avatar de l’utilisateur
Kwai chang caine
Messages : 6962
Inscription : sam. 23/sept./2006 18:32
Localisation : Isere

Re: Petit concourt de dessins de bouton avec VectorDrawing

Message par Kwai chang caine »

Sont cool tes boutons merci 8)
ImageLe bonheur est une route...
Pas une destination

PureBasic Forum Officiel - Site PureBasic
Shadow
Messages : 1373
Inscription : mer. 04/nov./2015 17:39

Re: Petit concourt de dessins de bouton avec VectorDrawing

Message par Shadow »

Kwai chang caine a écrit :Sont cool tes boutons merci 8)
Merci KCC :)
Processeur: Intel Core I7-4790 - 4 Cœurs - 8 Thread: 3.60 Ghz.
Ram: 32 GB.
Disque: C: SDD 250 GB, D: 3 TB.
Vidéo: NVIDIA GeForce GTX 960: 2 GB DDR5.
Écran: Asus VX248 24 Pouces: 1920 x 1080.
Système: Windows 7 64 Bits.

PureBasic: 5.60 x64 Bits.
Répondre