Ma petite fabrique de boutons
Publié : ven. 09/oct./2020 15:22
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.
************* Le PBI: SIG_0.pbi******************
Bonne soirée a tous
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
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