Petit amusement sans prétention.
Mais aussi pour montrer a mon amis Micoute et a d'autres , que les BindEvent ne sont pas forcément d'une grande utilités, surtout mal utilisés.
Ici il y a 61 boutons pas de BindEvent, et pas une boucle principale démesurée.
( Pas de plat de spaghettis au menu principal) 
Code : Tout sélectionner
;MLD traducteur de chiffres exotiques 29/04/2021/ Merci a Flyp pour la routine entiers/romains
;¤¤¤¤ Assignation des gadgets ¤¤¤¤
#Ma_fen = 1:#titre = 2:#etic1 = 3:#etic2 = 4:#etic3 = 5:#etic4 = 6:#etic5 = 7:#etic6 = 8:#trais1 = 9
#r1 = 10 : #r2 = 11: #r3 = 12 : #r4 = 13: #r5 = 14 : #r6 = 15
#bt_aid = 23:#bt_pp = 24:#bt_raz = 25:#bt_bar = 26
Enumeration 110
#bt10 : #bt11 : #bt12 : #bt13 : #bt14 : #bt15 : #bt16 : #bt17 : #bt18 :#bt19
#bt20 =120 : #bt21 : #bt22 : #bt23 : #bt24 : #bt25 : #bt26 : #bt27 : #bt28 :#bt29
#bt30 = 130: #bt31 : #bt32 : #bt33 : #bt34 : #bt35 : #bt36 : #bt37 : #bt38 :#bt39
#bt40 = 140 : #bt41 : #bt42 : #bt43 : #bt44 : #bt45 : #bt46 : #bt47 : #bt48 :#bt49
#bt50 = 150: #bt51 : #bt52 : #bt53 : #bt54 : #bt55 : #bt56 : #bt57 : #bt58 :#bt59
#bt60 = 160: #bt61 : #bt62 : #bt63 : #bt64 : #bt65 : #bt66
EndEnumeration
;¤¤¤¤¤¤¤¤
txtcf$ = "Standards,Arabes,Persans (Iran),Hindous (sanscrit),Chinois / Japonnais,Romains"
txtr$ = "I,V,X,L,C,D,M"
Global Dim chf(10,5)
Global Dim Tv(28),Dim L.s(5)
Tv(7) = 100:Tv(8) = 500:Tv(13) = 1:Tv(16) = 50:Tv(17) = 1000:Tv(26) = 5:Tv(28) = 10
Global FontID1 = LoadFont(1,"Segoe Print",20,#PB_Font_HighQuality)
Global FontID2 = LoadFont(2,"Segoe Print",16,#PB_Font_HighQuality)
Global FontID3 = LoadFont(3,"Tahoma",14,#PB_Font_HighQuality)
Global FontID4 = LoadFont(4,"Tahoma",18,#PB_Font_HighQuality)
;¤¤¤¤¤ Aide ¤¤¤¤¤¤¤¤¤¤¤
L.s(1) = "But du logiciel:" +#CRLF$
L.s(2) = "Former et traduire des nombres a partir de chiffres exotiques."+#CRLF$
L.s(3) = "Utilisation:"+#CRLF$
L.s(4) = "Pour former un nombre, cliquez sur un des boutons vert" +#CRLF$
L.s(5) = "Les chiffres romains servent principalement aux dates de ce fait la limite est < a 5000"+#CRLF$
L.s(5) = "Pour le reste tout est inscrit sur les boutons de couleurs."+#CRLF$
For X = 1 To 5
LT$ = LT$ + L.s(X)
Next
Macro cl(g,ft,cf,ct)
SetGadgetFont(g,ft):SetGadgetColor(g,#PB_Gadget_BackColor,cf):SetGadgetColor(g,#PB_Gadget_FrontColor,ct)
EndMacro
Procedure Forme(win)
Region = CreateRoundRectRgn_(0, 0, WindowWidth(win), WindowHeight(win), 20, 20) ; Création de la région
SetWindowRgn_(WindowID(win), Region, #True) ; On applique la région
DeleteObject_(Region) ; On supprime la région
EndProcedure
Procedure ButtonColorGadget(num,x,y,w,h,text$,font,fcolor,bcolor,flags=0)
img=CreateImage(#PB_Any,w,h)
If StartDrawing(ImageOutput(img))
DrawingFont(font)
Box(0,0,w,h,bcolor)
DrawText(w/2-TextWidth(text$)/2,h/2-TextHeight(text$)/2,text$,fcolor,bcolor)
StopDrawing() : ok=ButtonImageGadget(num,x,y,w,h,ImageID(img),flags)
EndIf
EndProcedure
Procedure.s Rom(nb.l) ; Conversion d'un nombre entier en chiffres romains
Protected i.l, value.l, cr.s
For i = 1 To 13
value = Val(StringField("1000,900,500,400,100,90,50,40,10,9,5,4,1", i, ","))
While nb >= value
cr + StringField("M,CM,D,CD,C,XC,L,XL,X,IX,V,IV,I", i, ",")
nb - value
Wend
Next
ProcedureReturn cr
EndProcedure
Procedure RA(r$)
For x = 1 To Len(r$)
b = 0
If x = 1:a = Tv(Asc(Mid(r$,x,1))-60):EndIf
If x > 1
b = Tv(Asc(Mid(r$,x,1))-60)
a = a + b
If x = > 2
If Tv(Asc(Mid(r$,x-1,1))-60) < b
a = a - (2* Tv(Asc(Mid(r$,x-1,1))-60))
EndIf
EndIf
EndIf
Next
ProcedureReturn a
EndProcedure
Procedure rt(g)
For w = 10 To 14
txt$ = GetGadgetText(w) + Chr(chf(g,w-9)):SetGadgetText(w,txt$)
Next
If Val(GetGadgetText(10))< 5000
SetGadgetText(15,""):SetGadgetText(15,Rom(Val(GetGadgetText(10))))
Else
SetGadgetText(15,"Hors limites")
EndIf
EndProcedure
Procedure rtr(cf)
For x = 10 To 14
SetGadgetText(x,"")
Next
c$ = Str(cf):l = Len(c$)
For z = 1 To Len(c$)
cf$ = Mid(c$,z,1):g = Val(cf$)+1
rt(g)
Next
EndProcedure
a = 48:b = 1632:c = 1776:d = 2406
For y = 1 To 5
For x = 1 To 10
If y = 1:chf(x,1) = a:a = a +1:EndIf
If y = 2:chf(x,2) = b:b = b +1:EndIf
If y = 3:chf(x,3) = c:c = c +1:EndIf
If y = 4:chf(x,4) = d:d = d +1:EndIf
Next
Next
chf(1,5) = 38646:chf(2,5) = 19968:chf(3,5) = 20108:chf(4,5) = 19977:chf(5,5) = 22235
chf(6,5) = 20116:chf(7,5) = 20845:chf(8,5) = 19971:chf(9,5) = 20843:chf(10,5) = 20061
OpenWindow(1,720,75,1000,800,"",#PB_Window_BorderLess|#PB_Window_ScreenCentered)
Forme(1)
SetWindowColor(1,$D3D3D3)
SetWindowPos_(WindowID(1), 0,0,0,0,0,#SWP_NOSIZE|#SWP_NOMOVE|#SWP_NOZORDER|#SWP_FRAMECHANGED)
TextGadget(2,20,10,700,40,"Convertisseur de chiffres"):cl(2,FontID1,$D3D3D3,$CD0000)
hte = 70
For e = 3 To 8
TextGadget(e,30,hte,230,30,StringField(txtcf$,e-2,",")):cl(e,FontID2,$D3D3D3,$CD0000)
hte = hte + 110
Next
TextGadget(9,30,757,940,1,""):cl(9,FontID2,$FF00FF,$F0FFFF)
htr = 120
For s = 10 To 15
StringGadget(s,750,htr,205,40,"",#PB_String_ReadOnly|#ES_CENTER):cl(s,FontID4,$D3D3D3,$2A2AA5)
htr = htr + 110
Next
htb = 120:t1 = 1
For b = 110 To 150 Step 10
pl = 60:t2 = 1
For p = b To b + 9
ButtonColorGadget(p,pl,htb,50,50,Chr(chf(t2,t1)),FontID4,$FFFFFF,$B1BF5B,0)
pl = pl + 60:t2 = t2 +1
Next
htb = htb + 110:t1 = t1 + 1
Next
plr = 60:tr =1
For br = 160 To 166
ButtonColorGadget(br,plr,670,50,50,StringField(txtr$,tr,","),FontID4,$FFFFFF,$B1BF5B,0)
plr = plr + 60:tr = tr + 1
Next
ButtonColorGadget(23,550,760,100,35,"Aide",FontID3,$E0FFFF,$0066CD,0)
ButtonColorGadget(24,650,760,100,35,"Efface ",FontID3,$E0FFFF,$CD5969,0)
ButtonColorGadget(25,750,760,100,35,"Barre " + Chr(8645),FontID3,$E0FFFF,$008B00,0)
ButtonColorGadget(26,850,760,100,35,"Stop",FontID3,$E0FFFF,$3333CD,0)
Repeat
Event = WaitWindowEvent()
If Event = #WM_LBUTTONDOWN
SendMessage_(WindowID(1), #WM_NCLBUTTONDOWN, #HTCAPTION, 0)
EndIf
If Event = #PB_Event_Gadget
Select EventGadget()
Case 110 To 159
lch$ = Right(Str(EventGadget()),1):col = Val(lch$) + 1
rt(col)
Case 160 To 166
rtr(RA(GetGadgetText(15)+ StringField(txtr$,(EventGadget()-160)+1,",")))
Case 23
MessageRequester("Logiciel CEXO (MLD 2021)",LT$,#PB_MessageRequester_Ok | #PB_MessageRequester_Info)
Case 24 ;bt efface
For x = 10 To 15
SetGadgetText(x,"")
Next
Case 25;bt barre
ShowWindow_(WindowID(1),#SW_MINIMIZE)
Case 26;bt stop
CloseWindow(1)
Break
EndSelect
EndIf
ForEver
End
