PureBasic

Forums PureBasic
Nous sommes le Ven 26/Fév/2021 19:49

Heures au format UTC + 1 heure




Poster un nouveau sujet Répondre au sujet  [ 3 messages ] 
Auteur Message
 Sujet du message: Ma petite fabrique de boutons
MessagePosté: Ven 09/Oct/2020 15:22 
Hors ligne

Inscription: Jeu 05/Fév/2009 17:58
Messages: 993
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:
;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:
;**********************
;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
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Ma petite fabrique de boutons
MessagePosté: Mar 13/Oct/2020 14:43 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 02/Oct/2011 16:17
Messages: 2362
Localisation: 50200 Coutances
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.72 LTS
Un homme doit être poli, mais il doit aussi être libre !


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Ma petite fabrique de boutons
MessagePosté: Mer 21/Oct/2020 18:37 
Hors ligne
Avatar de l’utilisateur

Inscription: Sam 23/Sep/2006 18:32
Messages: 6764
Localisation: Isere
Merci pour le partage 8)

_________________
ImageLe bonheur est une route...
Pas une destination

PureBasic Forum Officiel - Site PureBasic


Haut
 Profil  
Répondre en citant le message  
Afficher les messages postés depuis:  Trier par  
Poster un nouveau sujet Répondre au sujet  [ 3 messages ] 

Heures au format UTC + 1 heure


Qui est en ligne

Utilisateurs parcourant ce forum: Aucun utilisateur enregistré et 3 invités


Vous ne pouvez pas poster de nouveaux sujets
Vous ne pouvez pas répondre aux sujets
Vous ne pouvez pas éditer vos messages
Vous ne pouvez pas supprimer vos messages

Rechercher:
Aller à:  
cron

 


Powered by phpBB © 2008 phpBB Group | Traduction par: phpBB-fr.com
subSilver+ theme by Canver Software, sponsor Sanal Modifiye