Vers la programmation automatique des gadgets
Publié : mar. 26/mars/2019 11:24
Bonjour a tous
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.
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