Comme je n'aime toujours pas écrire sans arrêt la même chose, j'ai fait ceci. Ce sont les gadgets que j'utilise la plus dans des logiciels de bureautique.
je pense a beaucoup plus élaboré en fonction de mon temps, et de votre intérêt pour ce genre de programme.
Dans ce cadre, vos sujétions sont les bien venues.
Code : Tout sélectionner
;*** Calcul la largueur, hauteur des gadgets suivants: ****
;*** ButtonGadget:EditorGadget:ListwiewGadget:StrinsgGadget:TextGadget
;*** en fonction des paramètres d'une police choisie. Window seulement****
;*** MLD le 26/03/2019. PB 5.70 LTS(X86) Cochez la case Enable DPI aware***
;*** Utilisation libre ***
#FP = 1:#List1 = 2:#Eticlist1 = 3:#List2 = 4:#Eticlist2 = 5:#Eticlist3 = 6:#Eticlistr = 7:#frame1 = 8
#coche1 =10:#coche2 =11:#coche3 =12:#coche4 =13:#coche5 = 14
#frame2 = 15:#TXTpolice = 16:#cochecoulfd = 17:#cochecoultxt = 18:#txtcoulfd = 19:#txtcoultxt = 20
#frame3 = 24:#listgad = 25
#txtpara1 = 26:#txtpara2 = 27:#txtpara3 = 28:#txtpara4 = 29:#txtpara5 = 30
#stringpara1 = 35:#stringpara2 = 36:#stringpara3 = 37:#stringpara4 = 38
#cochepara1 = 39:#cochepara2 = 40:#cochepara3 = 41:#cochepara4 = 42:#canvas = 43
#frame4 = 45:#Eticres1 = 46:#Eticres2 = 47:#Eticres3 = 48:#Eticres4 = 49:#Eticres5= 50
#Txtresu1 = 55:#Txtresu2 = 56:#Txtresu3 = 57:#contener1 = 58:#editor1 = 59
#Cocheresu1 = 60:#Cocheresu2 = 61:#Cocheresu3 = 62:#Cocheresu4 = 63
#BTpp = 68:#BTstop = 69
Global Dpencadr.b
Global FontID1 = LoadFont(160,"Arial",13)
Global NewList NomFont.s()
Global copfont$, Cgad$, CgadF$, CgadCLF$, CgadCLT$
Declare EnumFontFamExProc(*lpelfe.ENUMLOGFONTEX,*lpntme.NEWTEXTMETRICEX,FontType,lParam)
Declare testPolice(Ft$,St1,St2,st3,st4,st5)
Declare LH(Ft$,tp,st1,st2,st3,st4,st5)
Declare SpecificGad(tw.D,th)
Macro Ecrit(gad);couleur de fond fenêtre de travail
SetGadgetFont(gad,FontID1)
SetGadgetColor(gad, #PB_Gadget_FrontColor,$CD0000)
EndMacro
Procedure MLD_ActCoche(Gad,Act) ;1 = actif 0 = non actif
haut.D = GadgetHeight(Gad): larg.D = haut.D
fontche = LoadFont(Gad,"Arial", haut * 0.75)
CreateImage(Gad,larg,haut)
hdc=StartDrawing(ImageOutput(Gad))
;Dessine l'image
DrawingMode(#PB_2DDrawing_Gradient)
BackColor($BEBEBE):FrontColor($FFFFFF)
LinearGradient(0,haut *1.5,0,0)
Box(0,0,larg,haut)
;Position du texte
DrawingMode(#PB_2DDrawing_Transparent)
DrawingFont(fontche)
txtcoche$ = Chr(10003)
hautxtC = TextHeight(txtcoche$):largtxtC = TextWidth(txtcoche$)
ctrtxtC = (larg - largtxtC)/2 ; centre le text en largeur
ctxtC = (haut - hautxtC)/2 ; centre le text en hauteur
If Act = 1
SetGadgetState(Gad,1):DrawText(ctrtxtC,ctxtC,txtcoche$,$32CD32)
Else
SetGadgetState(Gad,0)
EndIf
StopDrawing()
SetGadgetAttribute(Gad,#PB_Button_Image,ImageID(Gad))
EndProcedure
Procedure MLD_Coche(Gad,x.D,y.D,larg.D,haut.D,txt$,coultxt,Action) ;le num de gadget ne doit jamais être 0| Action 1 = ok 0 = no ok
ButtonImageGadget(Gad,x,y,haut,haut,0,#PB_Button_Toggle)
CouleurFond = GetSysColor_(#COLOR_3DFACE)
Font = LoadFont(0,"Arial", haut/2)
hautbt.D = GadgetHeight(Gad)
plG = x + hautbt.D + 20
txtgad = TextGadget(#PB_Any,plG,y,larg.D,haut.D,txt$,#SS_CENTERIMAGE)
SetGadgetColor(txtgad,#PB_Gadget_BackColor,CouleurFond)
SetGadgetColor(txtgad,#PB_Gadget_FrontColor,coultxt)
SetGadgetFont(txtgad,Font)
MLD_ActCoche(Gad,Action)
EndProcedure
Procedure cadrestring(Gad)
SetWindowLongPtr_(GadgetID(Gad),#GWL_EXSTYLE,GetWindowLongPtr_(GadgetID(Gad),#GWL_EXSTYLE)|#WS_EX_STATICEDGE &~ #WS_EX_CLIENTEDGE)
SetWindowPos_(GadgetID(Gad),0,0,0,0,0,#SWP_NOZORDER|#SWP_NOMOVE|#SWP_NOSIZE|#SWP_FRAMECHANGED|#SWP_DRAWFRAME)
EndProcedure
Procedure EnumFontFamExProc(*lpelfe.ENUMLOGFONTEX,*lpntme.NEWTEXTMETRICEX,FontType,lParam)
NomFont$ = PeekS(@*lpelfe\elfFullName)
Select FontType
Case #TRUETYPE_FONTTYPE
Type$ = "[TT] "
EndSelect
dp =0
ForEach NomFont()
If NomFont() = Type$ + NomFont$:dp=1:EndIf
Next
If dp =0
AddElement(NomFont())
NomFont() = Type$ + NomFont$ :Type$ = ""
EndIf
ProcedureReturn #True
EndProcedure
Procedure VisuEmumFont()
lf.LOGFONT
lf\lfCharset = #DEFAULT_CHARSET
hdc = GetDC_(WindowID(1))
EnumFontFamiliesEx_(hdc,lf,@EnumFontFamExProc(),0,0)
ReleaseDC_(WindowID(1),hdc)
SortList( NomFont.s(),#PB_Sort_Ascending)
ForEach NomFont()
AddGadgetItem(2,-1,NomFont())
Next
EndProcedure
Procedure testPolice(Ft$,st1,St2,st3,st4,st5)
SetGadgetText(15,"Test police: taille 14:"+ Ft$)
FontID5 = LoadFont(101,Ft$,14,st1|St2|st3|st4|st5)
SetGadgetFont(16,FontID5)
EndProcedure
Procedure colorgadfond()
If GetGadgetState(17) = 1
Couleur = ColorRequester()
If couleur > -1:SetGadgetColor(16,#PB_Gadget_BackColor,couleur):EndIf
Else
SetGadgetColor(16,#PB_Gadget_BackColor,#PB_Default)
EndIf
EndProcedure
Procedure colorgadtxt()
If GetGadgetState(18) = 1
Couleur = ColorRequester()
If couleur > -1:SetGadgetColor(16,#PB_Gadget_FrontColor,couleur):EndIf
Else
SetGadgetColor(16,#PB_Gadget_FrontColor,#PB_Default)
EndIf
EndProcedure
Procedure style(Ft$,tp)
If GetGadgetState(10) = 1
MLD_ActCoche(10,1):st1 = #PB_Font_Bold
Else
MLD_ActCoche(10,0):st1 = 0
EndIf
If GetGadgetState(11) = 1
MLD_ActCoche(11,1):st2 = #PB_Font_Italic
Else
MLD_ActCoche(11,0):st2 = 0
EndIf
If GetGadgetState(12) = 1
MLD_ActCoche(12,1):st3 = #PB_Font_Underline
Else
MLD_ActCoche(12,0):st3 = 0
EndIf
If GetGadgetState(13) = 1
MLD_ActCoche(13,1):st4 = #PB_Font_StrikeOut
Else
MLD_ActCoche(13,0):st4 = 0
EndIf
If GetGadgetState(14) = 1
MLD_ActCoche(14,1):st5 = #PB_Font_HighQuality
Else
MLD_ActCoche(14,0):st5 = 0
EndIf
testPolice(Ft$,st1,St2,st3,st4,st5)
LH(Ft$,tp,st1,st2,st3,st4,st5)
EndProcedure
Procedure LH(Ft$,tp,st1,st2,st3,st4,st5)
tw.D = 0:th = 0
FontID3 = LoadFont(102,Ft$,tp,st1|st2|st3|st4|st5)
For t= 40 To 42
If GetGadgetState(t) = 1:Break:EndIf
Next
Select t
Case 40
a$ ="ABwbikMplR"
Case 41
a$ ="ABWJLIPYFS"
Case 42
a$ ="0123456789"
EndSelect
StartDrawing(CanvasOutput(43))
DrawingFont(FontID3)
DrawText(43, 80,a$,$0, 0)
tw.D = (TextWidth(a$)/10)
th = TextHeight(a$)
StopDrawing()
copfont$ = "FontID = LoadFont(#Police," + Chr(34) + Ft$+ Chr(34) + "," + Str(tp)+ "," + Str(st1) + "|" + Str(st2)+ "|" + Str(st3)+ "|" + Str(st4)+ "|" + Str(st5)+ ")"
SetGadgetText(57,copfont$)
SpecificGad(tw.D,th)
EndProcedure
Procedure SpecificGad(tw.D,th)
cdW = 0:cdH = 0
If Dpencadr.b = 1:cdW = 14:cdH = 5:EndIf
Gad$ = GetGadgetText(25)
nbl = Val(GetGadgetText(35));nombre de lettres
nblg = Val(GetGadgetText(36));nombre de lignes
If Gad$ = "Button"
Gadw = Round((tw.D*nbl + (2.6*nbl)),#PB_Round_Up)
Gadh = th + 6 + cdH
EndIf
If Gad$ = "Editor"
If GetGadgetState(41) = 1;majuscule
Gadw = Round((tw.D*nbl + (2.8*nbl)),#PB_Round_Up)+ 40 ;+ cdW;25 = larg srollbar
Gadh = (th * nblg)+ (th * 0.32);+ cdH
Else
Gadw = Round(tw.D*nbl,#PB_Round_Up)+ 40 + cdW;40 = larg srollbar
Gadh = (th * nblg)+ (th * 0.38) ;+ cdH
EndIf
EndIf
If Gad$ = "ListView"
If GetGadgetState(41) = 1;majuscule
Gadw = Round((tw.D*nbl + (2.8*nbl)),#PB_Round_Up)+ 35 ;+ cdW;25 = larg srollbar
Gadh = (th * nblg)+ (th * 0.32);+ cdH
Else
Gadw = Round(tw.D*nbl,#PB_Round_Up)+ 35 ;+ cdW;25 = larg srollbar
Gadh = (th * nblg)+ (th * 0.32); cdH
EndIf
EndIf
If Gad$ = "String"
If GetGadgetState(41) = 1;majuscule
Gadw = Round((tw.D*nbl + (3.8*nbl)),#PB_Round_Up)+ cdW
Gadh = th + 2 + cdH
Else
Gadw = Round((tw.D*nbl + (1.7*nbl)),#PB_Round_Up)+ cdW
Gadh = th + 2
EndIf
EndIf
If Gad$ = "Text"
If GetGadgetState(41) = 1;majuscule
Gadw = Round((tw.D*nbl + (2.8*nbl)),#PB_Round_Up)+ cdW
Gadh = th + 2 + cdH
Else
Gadw = Round(tw.D*nbl,#PB_Round_Up)+ cdW
Gadh = th + 2 + cdH
EndIf
EndIf
SetGadgetText(55,Str(Gadw)):SetGadgetText(56,Str(Gadh))
;¤¤¤¤¤¤¤ construction gadget ¤¤¤¤¤¤¤¤¤¤
ClearGadgetItems(59)
If Gad$ = "Editor" Or Gad$ = "ListView"
Cgad$ = Gad$+ "Gadget(#Gadget," + GetGadgetText(37) + "," + GetGadgetText(38) + "," + Str(Gadw) + "," + Str(Gadh) + ")"
Else
Cgad$ = Gad$+ "Gadget(#Gadget," + GetGadgetText(37) + "," + GetGadgetText(38) + "," + Str(Gadw) + "," + Str(Gadh) + ",Texte$)"
EndIf
AddGadgetItem (59,-1,Cgad$)
CgadF$ = "SetGadgetFont(#Gadget,FontID)"
AddGadgetItem (59,-1,CgadF$)
If GetGadgetState(17) = 1;coul fond
Coulf$ = Hex(GetGadgetColor(16,#PB_Gadget_BackColor))
CgadCLF$ = "SetGadgetColor(#Gadget,#PB_Gadget_BackColor,$" + Coulf$ + ")"
AddGadgetItem (59,-1,CgadCLF$)
EndIf
If GetGadgetState(18) = 1;coul text
CoulT$ = Hex(GetGadgetColor(16,#PB_Gadget_FrontColor))
CgadCLT$ = "SetGadgetColor(#Gadget,#PB_Gadget_FrontColor,$" + CoulT$ + ")"
AddGadgetItem (59,-1,CgadCLT$)
EndIf
EndProcedure
Procedure PP()
ClearClipboard()
If GetGadgetState(60) = 1:SetClipboardText(copfont$):ProcedureReturn:EndIf
If GetGadgetState(61) = 1
ppgad$ = Cgad$
EndIf
If GetGadgetState(62) = 1
ppgad$ = Cgad$ + Chr (13) + Chr (10) + CgadF$
EndIf
If GetGadgetState(63) = 1
ppgad$ = copfont$ + Chr (13) + Chr (10) + Cgad$ + Chr (13) + Chr (10) + CgadF$
EndIf
If GetGadgetState(17) = 1:ppgad$ = ppgad$ + Chr (13) + Chr (10) + CgadCLF$:EndIf
If GetGadgetState(18) = 1:ppgad$ = ppgad$ + Chr (13) + Chr (10) + CgadCLT$:EndIf
SetClipboardText( ppgad$)
EndProcedure
OpenWindow(1,0,0,1500,650,"Auto_Prog_Gad",#WS_OVERLAPPEDWINDOW | 1)
StickyWindow(1,1)
CanvasGadget(43,0,0,1000,500):HideGadget(43,1)
ListViewGadget(2,10,40,400,555)
SetGadgetFont(2,FontID1):cadrestring(2)
VisuEmumFont()
SetGadgetText(2,"[TT] Tahoma");sélectionne
TextGadget(3,20,10,130,25,"Choix polices")
ListViewGadget(4, 420,40,80,555)
cadrestring(4)
For z = 6 To 70
AddGadgetItem(4,-1,Str(z))
Next
TextGadget(5,425,10,80,25,"Taille:")
SendMessage_(GadgetID(2),#LB_SETTOPINDEX,GetGadgetState(2),0);montre la sélection
SetGadgetText(4,"14");sélectionne
TextGadget(6,530,10,130,25,"Style:")
TextGadget(7,250,610,180,20,"Nb polices: "+ Str(CountGadgetItems(2)))
For xx = 2 To 7
Ecrit(xx)
Next
FrameGadget(8,510,40,180,555,"",#PB_Frame_Flat)
MLD_Coche(10,520,80,100,28,"Gras",$CD0000,0)
MLD_Coche(11,520,180,100,28,"Italique",$CD0000,0)
MLD_Coche(12,520,280,100,28,"Souligné",$CD0000,0)
MLD_Coche(13,520,380,100,28,"Barré",$CD0000,0)
MLD_Coche(14,520,480,120,28,"Hte qualité",$CD0000,0)
FrameGadget(15,700,10,790,80,"")
Ecrit(15)
TextGadget(16,710,35,470,50,"AZuytmwxc1230TRF45 ЯЍ ΩΣ WX")
testPolice("Tahoma",st1,st2,st3,st4,st5)
MLD_Coche(17,1200,23,140,28,"couleur fond",$CD0000,0)
MLD_Coche(18,1200,58,140,28,"couleur texte",$CD0000,0)
FrameGadget(24,700,90,790,180,"Paramètres")
ListViewGadget(25,705,140,140,120)
cadrestring(25):SetGadgetColor(25,#PB_Gadget_BackColor,$00FFFF)
TextGadget(26,720,115,120,25,"Choix gadgets")
AddGadgetItem (25,-1,"Button"):AddGadgetItem (25,-1,"Editor")
AddGadgetItem (25,-1,"ListView"):AddGadgetItem (25,-1,"String"):AddGadgetItem (25,-1,"Text")
SetGadgetText(25,"Text");sélectionne
TextGadget(27,900,115,250,20,"Nombre de lettres ou signes:")
TextGadget(28,900,150,250,20,"Nombre de ligne(s) visible(s):")
DisableGadget(28,1)
TextGadget(29,1150,193,120,20,"Emplacement: X")
TextGadget(30,1370,193,20,20,"Y")
StringGadget(35,1150,112,130,25,"1",#PB_String_Numeric|#ES_CENTER)
SendMessage_(GadgetID(35),#EM_LIMITTEXT,3,0)
cadrestring(35):SetGadgetColor(35,#PB_Gadget_BackColor,$00FFFF)
StringGadget(36,1150,147,130,25,"1",#PB_String_Numeric|#ES_CENTER)
SendMessage_(GadgetID(36),#EM_LIMITTEXT,3,0)
cadrestring(36):SetGadgetColor(36,#PB_Gadget_BackColor,$00FFFF)
DisableGadget(36,1)
StringGadget(37,1280,190,80,25,"0",#PB_String_Numeric|#ES_CENTER)
SendMessage_(GadgetID(37),#EM_LIMITTEXT,4,0)
cadrestring(37):SetGadgetColor(37,#PB_Gadget_BackColor,$00FFFF)
StringGadget(38,1390,190,80,25,"0",#PB_String_Numeric|#ES_CENTER)
SendMessage_(GadgetID(38),#EM_LIMITTEXT,4,0)
cadrestring(38):SetGadgetColor(38,#PB_Gadget_BackColor,$00FFFF)
For xx = 24 To 38
If xx >23 And xx < 31:Ecrit(xx):EndIf :If xx > 34 And xx <39:Ecrit(xx):EndIf
Next
MLD_Coche(39,900,190,200,25,"Gadget avec encadrement",$CD0000,0)
MLD_Coche(40,900,230,130,25,"Maj / minus",$CD0000,1)
MLD_Coche(41,1080,230,130,25,"Maj seulement",$CD0000,0)
MLD_Coche(42,1290,230,170,25,"Chiffres uniquement",$CD0000,0)
FrameGadget(45,700,270,790,325,"Résultats")
TextGadget(46,720,300,80,20,"Largeur")
TextGadget(47,980,300,80,20,"Hauteur")
TextGadget(48,720,350,80,20,"Code fonte")
TextGadget(49,720,405,100,20,"Code Gadget")
TextGadget(50,720,530,130,20,"Presse papier")
TextGadget(55,800,298,100,22,"",#SS_SUNKEN|#PB_Text_Center)
SetGadgetColor(55,#PB_Gadget_BackColor,$00FF7F)
TextGadget(56,1060,298,100,22,"",#SS_SUNKEN|#PB_Text_Center)
SetGadgetColor(56,#PB_Gadget_BackColor,$00FF7F)
TextGadget(57,720,375,760,22,"",#SS_SUNKEN)
SetGadgetColor(57,#PB_Gadget_BackColor,$00FF7F)
ContainerGadget(58,720,435,760,85,#PB_Container_Single)
EditorGadget(59,0,0,756,81)
SetGadgetColor(59,#PB_Gadget_BackColor,$00FF7F)
CloseGadgetList()
For xx = 44 To 59
If xx >44 And xx < 51:Ecrit(xx):EndIf :If xx > 54 And xx < 60:Ecrit(xx):EndIf
Next
MLD_Coche(60,720,560,100,25,"Fonte seule",$CD0000,0)
MLD_Coche(61,880,560,100,25,"Gadget seul",$CD0000,1)
MLD_Coche(62,1040,560,140,25,"Gadget + ref Fonte",$CD0000,0)
MLD_Coche(63,1240,560,130,25,"Fonte + Gadget",$CD0000,0)
ButtonGadget(68,1240,600,150,43,"Presse papier")
Ecrit(68)
ButtonGadget(69,1390,600,100,43,"Stop")
Ecrit(69)
If Left(GetGadgetText(2),3) = "[TT"
Ft$ = Mid(GetGadgetText(2),7,Len(GetGadgetText(2)));Si TT enlève le type
Else
Ft$ = GetGadgetText(2)
EndIf
tp =Val(GetGadgetText(4))
style(Ft$,tp)
Repeat
Event = WaitWindowEvent()
If Event = #PB_Event_Gadget
Select EventGadget()
Case 2;liste Police
If Left(GetGadgetText(2),3) = "[TT"
Ft$ = Mid(GetGadgetText(2),7,Len(GetGadgetText(2)));Si TT enlève le type
Else
Ft$ = GetGadgetText(2)
EndIf
style(Ft$,tp)
Case 4;liste taille
tp = Val(GetGadgetText(4))
style(Ft$,tp)
Case 10;coche gras
style(Ft$,tp)
Case 11;coche Italique
style(Ft$,tp)
Case 12;coche Souligné
style(Ft$,tp)
Case 13;coche Barré
style(Ft$,tp)
Case 14;coche Haute qualité
style(Ft$,tp)
Case 17;coul fond
If GetGadgetState(17) = 1
MLD_ActCoche(17,1):colorgadfond()
Else
MLD_ActCoche(17,0):colorgadfond()
EndIf
style(Ft$,tp)
Case 18;coul texte
If GetGadgetState(18) = 1
MLD_ActCoche(18,1):colorgadtxt()
Else
MLD_ActCoche(18,0):colorgadtxt()
EndIf
style(Ft$,tp)
Case 25;list gad
If Trim(GetGadgetText(25)) = "Editor" Or Trim(GetGadgetText(25)) = "ListView"
DisableGadget(28,0):DisableGadget(36,0)
Else
DisableGadget(28,1):DisableGadget(36,1)
EndIf
style(Ft$,tp)
Case 35;nb lettres
Select EventType()
Case #PB_EventType_Change
style(Ft$,tp)
EndSelect
Case 36;nb lignes
Select EventType()
Case #PB_EventType_Change
style(Ft$,tp)
EndSelect
Case 37;X
Select EventType()
Case #PB_EventType_Change
style(Ft$,tp)
EndSelect
Case 38;Y
Select EventType()
Case #PB_EventType_Change
style(Ft$,tp)
EndSelect
Case 39 ;coche encadrement
If GetGadgetState(39) = 1
MLD_ActCoche(39,1):Dpencadr.b =1
Else
MLD_ActCoche(39,0):Dpencadr.b = 0
EndIf
style(Ft$,tp)
Case 40;Coche Maj/minus
MLD_ActCoche(40,1)
MLD_ActCoche(41,0)
MLD_ActCoche(42,0)
style(Ft$,tp)
Case 41;Coche Maj
MLD_ActCoche(41,1)
MLD_ActCoche(40,0)
MLD_ActCoche(42,0)
style(Ft$,tp)
Case 42;Coche chiffre
MLD_ActCoche(42,1)
MLD_ActCoche(40,0)
MLD_ActCoche(41,0)
style(Ft$,tp)
Case 60;font seule
MLD_ActCoche(60,1)
MLD_ActCoche(61,0)
MLD_ActCoche(62,0)
MLD_ActCoche(63,0)
Case 61;Gad seul
MLD_ActCoche(61,1)
MLD_ActCoche(60,0)
MLD_ActCoche(62,0)
MLD_ActCoche(63,0)
Case 62;Gad + ref fonte
MLD_ActCoche(62,1)
MLD_ActCoche(60,0)
MLD_ActCoche(61,0)
MLD_ActCoche(63,0)
Case 63;Gad + fonte
MLD_ActCoche(63,1)
MLD_ActCoche(60,0)
MLD_ActCoche(61,0)
MLD_ActCoche(62,0)
Case 68;bt PP
PP()
Case 69;bt stop
CloseWindow(1)
End
EndSelect
EndIf
Until Event = #PB_Event_CloseWindow
End