Ma petite fabrique de boutons

Partagez votre expérience de PureBasic avec les autres utilisateurs.
Répondre
Avatar de l’utilisateur
MLD
Messages : 1103
Inscription : jeu. 05/févr./2009 17:58
Localisation : Bretagne

Ma petite fabrique de boutons

Message par MLD »

Pour ceux qui aiment les jolis logiciel.
Je met a votre disposition un code pour faire des boutons sympas.
Il faut un Pbi qui permet aussi de rendre les fenêtres et boutons et d'autres gadgets si vous le souhaitez indépendant du DPI écran.

Code : Tout sélectionner

;MLD le 8/10/2020
XIncludeFile "SIG_0.pbi" ;obligatoire ******************************************
Enumeration
#fen = 0
#button1 = 1
#button2 
#button3 
#button4 
#button5 
#button6
#button7
#button8
#button9
#button10
#button11
#button12
#fen2 = 100
EndEnumeration

CatchImage(20, ?Image_Start )
DataSection
  Image_Start:
    IncludeBinary #PB_Compiler_Home + "\examples\sources\data\CdPlayer.ico"
  Image_End:
 EndDataSection

Global FontID0 = LoadFont(0,"Courier New", X(12))

Procedure Callback(WindowID, message, wParam, lParam);survol gadgets
      Global svgn 
      Resultat = #PB_ProcessPureBasicEvents
      Select message
      Case #WM_SETCURSOR
        svgn = GetDlgCtrlID_(wParam)
      EndSelect
      ProcedureReturn Resultat
EndProcedure
    
Procedure bts(cd); commande des boutons
  Static svgnp,ptxt$
   Select cd
    Case 513;bt enfoncé
      svgnp = svgn
      Select svgnp  
        Case 1 To 12,101
         If svgnp = 1:im = ImageID(asbt(svgnp,190,36,"Compris",FontID0,#Blue,$BEBEBE,1)):EndIf
         If svgnp = 2:im = ImageID(asbt(svgnp,190,36,"Enfoncé",FontID0,$0,$00D7FF,1)):EndIf
         If svgnp = 3:im = ImageID(asbt(svgnp,190,36,"Alors",FontID0,$0045FF,$56B82D,1)):EndIf
         If svgnp = 4:im = ImageID(asbt(svgnp,190,36,"Bouton 4",FontID0,$D30094,$73A2AA,1)):EndIf
         If svgnp = 5:im = ImageID(asbt(svgnp,190,36,"Bouton 5",FontID0,$578B2E,$AA9873,1)):EndIf
         If svgnp = 6:im = ImageID(asbt(svgnp,190,36,"Bouton 6",FontID0,$FF0000,$0000FF,1)):EndIf 
         If svgnp = 7:im = ImageID(asbtI(svgnp,190,50,20,"Bouton 7",FontID0,#Black,$D400FF,1)):EndIf
         If svgnp = 8:im = ImageID(asbtI(svgnp,190,50,20,"Bouton 8",FontID0,#Black,$3DA8E6,1)):EndIf
         If svgnp = 9:im = ImageID(asbtI(svgnp,190,50,20,"Bouton 9",FontID0,#Black,$E3695A,1)):EndIf
         If svgnp = 10:im = ImageID(asbI(svgnp,190,60,20,$E3C959,1)):EndIf
         If svgnp = 11:im = ImageID(asbI(svgnp,190,60,20,$5EAF5F,1)):EndIf
         If svgnp = 12:im = ImageID(asbI(svgnp,190,60,20,$306F7D,1)):EndIf
         If svgnp = 101:im = ImageID(asbt(svgnp,190,36,"Adieu",FontID0,#Red,$BEBEBE,1)):EndIf
         SetGadgetAttribute(svgnp,#PB_Button_Image,im)
      EndSelect
    Case 514
     Select svgnp  
       Case 1 To 12,101
         If svgnp = 1:im = ImageID(asbt(svgnp,190,36,"Bouton 1",FontID0,#Blue,$BEBEBE,0)):EndIf
         If svgnp = 2:im = ImageID(asbt(svgnp,190,36,"Bouton 2",FontID0,$0,$00D7FF,0)):EndIf
         If svgnp = 3:im = ImageID(asbt(svgnp,190,36,"Bouton 3",FontID0,$0045FF,$56B82D,0)):EndIf
         If svgnp = 4:im = ImageID(asbt(svgnp,190,36,"Bouton 4",FontID0,$D30094,$73A2AA,0)):EndIf
         If svgnp = 5:im = ImageID(asbt(svgnp,190,36,"Bouton 5",FontID0,$578B2E,$AA9873,0)):EndIf
         If svgnp = 6:im = ImageID(asbt(svgnp,190,36,"Bouton 6",FontID0,$FF0000,$0000FF,0)):EndIf 
         If svgnp = 7:im = ImageID(asbtI(svgnp,190,50,20,"Bouton 7",FontID0,#Black,$D400FF,0)):EndIf 
         If svgnp = 8:im = ImageID(asbtI(svgnp,190,50,20,"Bouton 8",FontID0,#Black,$3DA8E6,0)):EndIf
         If svgnp = 9:im = ImageID(asbtI(svgnp,190,50,20,"Bouton 9",FontID0,#Black,$E3695A,0)):EndIf
         If svgnp = 10:im = ImageID(asbI(svgnp,190,60,20,$E3C959,0)):EndIf
         If svgnp = 11:im = ImageID(asbI(svgnp,190,60,20,$5EAF5F,0)):EndIf
         If svgnp = 12:im = ImageID(asbI(svgnp,190,60,20,$306F7D,0)):EndIf
         If svgnp = 1:im = ImageID(asbt(svgnp,190,36,"Stop",FontID0,#Blue,$BEBEBE,0)):EndIf
         SetGadgetAttribute(svgnp,#PB_Button_Image,im)
     EndSelect
  EndSelect  
EndProcedure

Procedure f2()
MLD_openfen(100,720,75,660,250,"Ma Fenêtre 2",#PB_Window_MinimizeGadget,0,0,0,0)
SetWindowCallback(@Callback())
StickyWindow(100,1)
MLD_BtTxt(101,10,20,190,36,"Stop",FontID0,#Blue,$BEBEBE,$FFFFFF,0)
Repeat
  Select WindowEvent ()
   Case #WM_LBUTTONDOWN:bts(#WM_LBUTTONDOWN)
   Case #WM_LBUTTONUP:bts(#WM_LBUTTONUP)    
   Case #PB_Event_Gadget 
      Select EventGadget () 
       Case 101
        If EventType ()= #PB_EventType_LeftClick 
         CloseWindow(100)
         Break   
       EndIf
   EndSelect 
 EndSelect  
ForEver   
EndProcedure

MLD_openfen(0,0,0,820,600,"Boutons",#PB_Window_SystemMenu,#PB_Window_ScreenCentered ,0,0,0)
SetWindowCallback(@Callback())
MLD_BtTxt(1,10,20,190,36,"Bouton 1",FontID0,#Blue,$BEBEBE,$FFFFFF,0)
MLD_BtTxt(2,200,20,190,36,"Bouton 2",FontID0,$0,$00D7FF,$FFFFFF,0)
MLD_BtTxt(3,390,20,190,36,"Bouton 3",FontID0,$0045FF,$56B82D,$FFFFFF,0)
MLD_BtTxt(4,10,60,190,36,"Bouton 4",FontID0,$D30094,$73A2AA,$FFFFFF,0)  
MLD_BtTxt(5,200,60,190,36,"Bouton 5",FontID0,$578B2E,$AA9873,$FFFFFF,0) 
MLD_BtTxt(6,390,60,190,36,"Bouton 6",FontID0,$FF0000,$0000FF,$FFFFFF,0)    
MLD_BtIT(7,10,100,190,50,20,"Bouton 7",FontID0,#Black,$D400FF,$F0FFFF,0) 
MLD_BtIT(8,200,100,190,50,20,"Bouton 8",FontID0,#Black,$3DA8E6,$F0FFFF,0) 
MLD_BtIT(9,390,100,190,50,20,"Bouton 9",FontID0,#Black,$E3695A,$F0FFFF,0) 
MLD_BtImg(10,10,160,60,60,20,$E3C959,$FFFFFF,0)
MLD_BtImg(11,70,160,60,60,20,$5EAF5F,$FFFFFF,0)
MLD_BtImg(12,130,160,60,60,20,$306F7D,$FFFFFF,0)
Repeat 
   Select WindowEvent ()
     Case #WM_LBUTTONDOWN:bts(#WM_LBUTTONDOWN)
     Case #WM_LBUTTONUP:bts(#WM_LBUTTONUP) 
     Case #PB_Event_Gadget 
      Select EventGadget () 
       Case 1
        If EventType ()= #PB_EventType_LeftClick 
           Debug "Le bouton est actif"
        EndIf   
       Case 2
          Debug "Bien vue"   
       Case 12
         f2()
     EndSelect
   Case #PB_Event_CloseWindow : End 
  EndSelect                                 
ForEver
************* Le PBI: SIG_0.pbi******************

Code : Tout sélectionner

;**********************
;MLD le 08/10/2020
;PB 5.72  X86
;Standard Interface Graphique
;Garde les dimensions des fenêtres et boutons en fonction du DPI
;**********************

#Ldef = 1920:#Hdef = 1080 :#Corf = 12

Global definecrlarg.d = GetSystemMetrics_(#SM_CXSCREEN)
Global definecrht.d = GetSystemMetrics_(#SM_CYSCREEN)
Global typH.b
Global St
Global L.d,Hwq.d
hdc = GetDC_(GetDesktopWindow_())
If hdc : dpiX.d = GetDeviceCaps_(hdc, #LOGPIXELSX) :EndIf
If hdc : Global dpiY.d = GetDeviceCaps_(hdc, #LOGPIXELSY) : ReleaseDC_(GetDesktopWindow_(), hdc) : EndIf
Global mmx.d = (dpiX / 2.54)/10
Global mmy.d = (dpiY / 2.54)/10

Procedure Ywp(y.d)
Select y.d
  Case 0
   ProcedureReturn 0 ;en haut de l'écran
 Default
  If definecrht.d = #Hdef
   ProcedureReturn y.d 
  Else
   ProcedureReturn y.d * (definecrht /#Hdef)
  EndIf 
EndSelect   
EndProcedure

Procedure Hw(Dh.d,typH.b)
definecrht.d = GetSystemMetrics_(#SM_CYSCREEN)
SystemParametersInfo_(#SPI_GETWORKAREA,0,@DesktopWorkArea.RECT,0)
htTaskbarwin.d = definecrht.d - DesktopWorkArea\Bottom
OpenWindow(2000,0,0,200,200,"",#PB_Window_SystemMenu|#PB_Window_Invisible)
If OSVersion() = #PB_OS_Windows_XP
 EPframeH.d = WindowX(2000, #PB_Window_InnerCoordinate)
 EPframeL.d = WindowX(2000, #PB_Window_InnerCoordinate)
Else
 EPframeH.d = (WindowX(2000, #PB_Window_InnerCoordinate)*3)
 EPframeL.d = WindowX(2000, #PB_Window_InnerCoordinate)  
EndIf  
Httitre.d = WindowY(2000, #PB_Window_InnerCoordinate)
CloseWindow(2000)
Select typH.b
 Case 1 ;fen avec titre et haut max
  If St = 0  
   Hwq.d = definecrht - (Httitre.d + EPframeH) 
   ProcedureReturn Hwq.d
  Else ; fen sans titre et hauteur max
   Hwq.d = definecrht
   ProcedureReturn Hwq.d 
  EndIf 
 Case 2 ;fen avec titre et barre de tache win visible
  If St = 0   
   Hwq.d = definecrht - (htTaskbarwin  + Httitre.d  + EPframeH)+5
   ProcedureReturn hwq.d 
  Else  ; fen sans titre et barre de tache win visible
   Hwq.d = definecrht - htTaskbarwin 
   ProcedureReturn Hwq.d
  EndIf 
 Default ;fen quelconque
  If Dh = 0:Dh = 1:EndIf
  If definecrht <> #Hdef
   Hwq.d =  Dh * (definecrht /#Hdef)
   ProcedureReturn Hwq.d
  Else
   Hwq.d =  Dh
   ProcedureReturn Hwq.d 
  EndIf  
EndSelect 
EndProcedure

Procedure XWp(lp.d)
Select lp.d
 Case 0
  ProcedureReturn 1 ;a gauche
 Default
  If definecrlarg <> #Ldef
   ProcedureReturn lp.d * (definecrlarg /#Ldef)
  Else
   ProcedureReturn lp.d
  EndIf 
EndSelect 
EndProcedure

Procedure Lw(dL.d)
Select dL.d
 Case 0 
   If St = 0 ;largeur max avec bordure
    L.d = definecrlarg - 10
    ProcedureReturn L.d
   Else ;largeur max sans bordure
    L.d = definecrlarg
    ProcedureReturn L.d
   EndIf 
 Default
  If definecrlarg <> #Ldef
    L.d = dL * (definecrlarg /#Ldef)
    ProcedureReturn L.d
   Else 
     L.d = dL
     ProcedureReturn L.d
   EndIf
EndSelect 
EndProcedure

Procedure MLD_openfen(ng.d,x.d,y.d,Lf.d,H.d,titre$,opt1.l,opt2.l,opt3.l,opt4.l,typH.b)
  If y.d <> 0 :typH.b = 0:EndIf 
  Select #PB_Window_BorderLess
   Case opt1.l,opt2.l,opt3.l,opt4.l
    Global St = 1
   Default
     Global St = 0
     If L.d < 300 And L.d > 0:L.d = 300:EndIf
  EndSelect 
  Select #PB_Window_ScreenCentered 
   Case opt1.l,opt2.l,opt3.l,opt4.l
     typH.b =0
 EndSelect
 If opt1.l = 0 And opt2.l = 0 And opt3.l = 0 And opt4.l = 0; les options ne supporte pas les 0(pas de bouton)
    OpenWindow(ng.d,Xwp(x.d),Ywp(y.d),Lw(Lf.d),Hw(H.d,typH.b),titre$)
 Else  
   OpenWindow(ng.d,Xwp(x.d),Ywp(y.d),Lw(Lf.d),Hw(H.d,typH.b),titre$,opt1.l|opt2.l|opt3.l|opt4.l)
   a.d = Xwp(x.d)
 EndIf 
EndProcedure   

Procedure X(lg.d)
  ProcedureReturn lg *(definecrlarg.d/#Ldef)
EndProcedure

Procedure y(h.d)
  ProcedureReturn h *(definecrht.d /#Hdef) 
EndProcedure 

Procedure MLD_ButtonImageGadget(numgad.d,x.d,y.d,Gl.d,Gh.d,img.d,Opt1.l,Opt2.l,Opt3.l,Opt4.l)
  If img.d = 0
    ButtonImageGadget(numgad.d,X(x.d),y(y.d),X(Gl.d),Y(Gh.d),0, Opt1|Opt2|Opt3|Opt4) 
  Else  
    ButtonImageGadget(numgad.d,X(x.d),y(y.d),X(Gl.d),Y(Gh.d),ImageID(img.d), Opt1|Opt2|Opt3|Opt4)
  EndIf
EndProcedure

Procedure Cibt(num,larg,haut,coulfond,pos);utile pour boutons Cibt = change image bouton
CreateImage(num, X(larg),Y(haut))                                                            
StartDrawing(ImageOutput(num))
DrawingMode(#PB_2DDrawing_Gradient) ;Dessine le fond de l'image 
  If pos = 1
   BackColor($FFFFFF):FrontColor(coulfond)
  Else  
   BackColor(coulfond):FrontColor($FFFFFF)
  EndIf
  LinearGradient(0,Y(haut) *1.5,0,0)
  Box(0,0,X(larg),Y(haut))  
EndProcedure  

Procedure MLD_BtTxt(Gad,x.D,y.D,larg.D,haut.D,txt$,font,coultext,coulfond,coulPplan,pos) ;le num de gadget ne doit jamais être 0
  Cibt(Gad,larg,haut,coulfond,pos)
  ; Position du texte
  DrawingMode(#PB_2DDrawing_Transparent) 
  DrawingFont(font)
  hautxt = TextHeight(txt$)
  largtxt = TextWidth(txt$)
  ctrtxt = (X(larg) - largtxt)/2 ; centre le text en largeur
  ctxt=(Y(haut) - hautxt)/2  ; centre le text en hauteur
  DrawText(ctrtxt,ctxt,txt$,coultext)
  StopDrawing ()
MLD_ButtonImageGadget(Gad,x,y,larg,haut,Gad,0,0,0,0)
EndProcedure

Procedure MLD_BtImg(Gad,x.D,y.D,larg.D,haut.D,image,coulfond,coulPplan,pos);le num de gadget ne doit jamais être 0
  Cibt(Gad,larg,haut,coulfond,pos)
  hautimg = Y(ImageHeight(image))
  largimg = X(ImageWidth(image))
  cthimg=(Y(haut)- hautimg)/2 ;centre l'image en hauteur
  ctlimd = (X(larg) - largimg)/2 ;centre l'image en largeur
  DrawImage(ImageID(image),ctlimd,cthimg,largimg,hautimg)
  StopDrawing ()
MLD_ButtonImageGadget(Gad,x,y,larg,haut,Gad,0,0,0,0)
EndProcedure

Procedure MLD_BtIT(Gad,x.D,y.D,larg.D,haut.D,image,txt$,font,coultext,coulfond,coulPplan,pos) ;le num de gadget ne doit jamais être 0
  Cibt(Gad,larg,haut,coulfond,pos)  
  hautimg = Y(ImageHeight(image))
  largimg = X(ImageWidth(image))  
  dbimg = X(7) ; distance de bord gauche/image 
  cthimg=(Y(haut)- hautimg)/2 ;centre l'image en hauteur
  DrawImage(ImageID(image),dbimg,cthimg,largimg,hautimg)
  ; Position du texte
  DrawingMode(#PB_2DDrawing_Transparent) 
  DrawingFont(font)
  hautxt = TextHeight(txt$)
  ditxt = largimg+dbimg + 2 ; distance image/texte
  centretxt = ditxt+((X(larg) - ditxt) - TextWidth(txt$))/2 ;centre le texte en largeur
  ctxt=(Y(haut) - hautxt)/2 ; centre le text en hauteur
  DrawText(centretxt,ctxt,txt$,coultext)
StopDrawing ()
MLD_ButtonImageGadget(Gad,x,y,larg,haut,Gad,0,0,0,0)
EndProcedure

Procedure asbt(num,larg,haut,txt$,font,coultext,coulfond,pos);Action survol bouton texte attention SetWindowCallback obligatoire par fenêtre
  Cibt(num,larg,haut,coulfond,pos)  
 ; Position du texte
  DrawingMode(#PB_2DDrawing_Transparent) 
  DrawingFont(font)
  hautxt = TextHeight(txt$):largtxt = TextWidth(txt$)
  ctrtxt = (X(larg) - largtxt)/2 ; centre le text en largeur
  ctxt=(Y(haut) - hautxt)/2  ; centre le text en hauteur
  DrawText(ctrtxt,ctxt,txt$,coultext)
  StopDrawing ()
  ProcedureReturn num
EndProcedure

Procedure asbtI(num,larg,haut,image,txt$,font,coultext,coulfond,pos) ;Action survol bouton image + texte 
  Cibt(num,larg,haut,coulfond,pos)  
  hautimg = Y(ImageHeight(image)):largimg = X(ImageWidth(image))
  dbimg = X(7) ; distance de bord gauche/image 
  cthimg=(Y(haut)- hautimg)/2 ;centre l'image en hauteur
  DrawImage(ImageID(image),dbimg,cthimg,largimg,hautimg)
  ;Position du texte
  DrawingMode(#PB_2DDrawing_Transparent) 
  DrawingFont(font)
  hautxt = TextHeight(txt$)
  ditxt = largimg+dbimg + 2 ; distance image/texte
  centretxt = ditxt+((X(larg) - ditxt) - TextWidth(txt$))/2 ;centre le texte en largeur
  ctxt=(Y(haut) - hautxt)/2 ; centre le text en hauteur
  DrawText(centretxt,ctxt,txt$,coultext)
  StopDrawing ()
ProcedureReturn num
EndProcedure

Procedure asbI(num,larg.D,haut.D,image,coulfond,pos);Action survol bouton image
  Cibt(num,larg,haut,coulfond,pos)    
  hautimg = Y(ImageHeight(image)):largimg = X(ImageWidth(image))
  cthimg=(Y(haut)- hautimg)/2 ;centre l'image en hauteur
  ctlimd = (X(larg) - largimg)/2 ;centre l'image en largeur
  DrawImage(ImageID(image),ctlimd,cthimg,largimg,hautimg)
  StopDrawing ()
ProcedureReturn num  
EndProcedure
Bonne soirée a tous
Haut
Avatar de l’utilisateur
Micoute
Messages : 2522
Inscription : dim. 02/oct./2011 16:17
Localisation : 35520 La Mézière

Re: Ma petite fabrique de boutons

Message par Micoute »

Merci beaucoup MLD pour partage,

j'avoue je connaissais déjà ces boutons pour avoir travaillé avec toi, pour les diabétiques normands, ils sont très jolis, (pas les normands, mais tes boutons)
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 !
Haut
Avatar de l’utilisateur
Kwai chang caine
Messages : 6962
Inscription : sam. 23/sept./2006 18:32
Localisation : Isere

Re: Ma petite fabrique de boutons

Message par Kwai chang caine »

Merci pour le partage 8)
ImageLe bonheur est une route...
Pas une destination

PureBasic Forum Officiel - Site PureBasic
Haut
Répondre

Revenir à « Trucs et astuces »