Il y a quelques jours Boddhi nous a produit un outil électronique pour lire le code couleur des résistances électronique. Voici ma version et un peu plus.
Je vous donne le code. Toutes remarques constructive sera pris en compte.
Code : Tout sélectionner
;ATTENTION: Pour un fonctionnement sur tous écrans, il faut absolument décocher la case DPI dans les options du compilateur.
;résistance électrique MLD 13/05/2023
;¤¤¤¤ Assignation des gadgets ¤¤¤¤
#Fp = 1:#etipr1 = 2:#etipr2 = 3:#band = 4:#Btaide = 5:#btBarre = 6:#btstop = 7
#contg = 21:#an1 = 22:#an2 = 23:#an3 = 24:#an4 = 25:#an5 = 26
#traith1 = 31:#traith2 = 32:#traiV = 33
#contg2 = 51:#coch1 = 52:#coch2 = 53:#coch3 = 54
#bttol1 = 58:#bttol2 = 59:
#btc0 = 60:#btc1 = 61:#btc2 = 62:#btc3 = 63:#btc4 = 64:#btc5 = 65:#btc6 = 66:#btc7 = 67:#btc8 = 68:#btc9 = 69:
#eticR1 = 70:#eticR2 = 71:#eticR3 = 72:#eticR4 = 73:#eticR5 = 74:#eticR6 = 75:#eticR7 = 76:#eticR8 = 77:#eticR9 = 78:#btrazcr =79:#btcalr = 80
#St1 = 85
#eticalertr = 90:
#contg3 = 100:#eticH1 = 101:#eticH2 = 102:#eticH3 = 103:#eticH4 = 104:#eticH5 = 105:#eticH6 = 106:#eticH7 = 107:#eticH8 = 108:#eticH9 = 109
#cochH1 = 120:#cochH2 = 121:#cochH3 = 122:#cochH4 = 123:#StH1 = 124:#StH2 = 125:#StH3 = 126:#eticStH1 = 127:#eticStH2 = 128:#eticStH3 = 129
#btrazH = 130:#btcalH = 131
#eticF1 = 150:#eticF2 = 151:#eticF3 = 152:#eticF4 = 153:#eticF5 = 154:
#cochF1 = 160:#cochF2 = 161:#StF1 = 162:#StF2 = 163:#eticStF1 = 164:#eticStF2 = 165:#btrazF = 166:#btcalF = 167
#Ldef = 1920:#Hdef = 1080
Global typH.b,L.d
Global definecrht.d = GetSystemMetrics_(#SM_CYSCREEN):Global definecrlarg.d = GetSystemMetrics_(#SM_CXSCREEN)
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 Hw(Dh.d,typH.b)
SystemParametersInfo_(#SPI_GETWORKAREA,0,@DesktopWorkArea.RECT,0)
htTaskbarwin.d = definecrht.d - DesktopWorkArea\Bottom
If opt1.l = #PB_Window_BorderLess
OpenWindow(2000,0,0,200,200,"",#PB_Window_BorderLess|#PB_Window_Invisible)
Else
OpenWindow(2000,0,0,200,200,"",#PB_Window_SystemMenu|#PB_Window_Invisible)
EndIf
EPframeL.d = WindowX(2000, #PB_Window_InnerCoordinate)
Httitre.d = WindowY(2000, #PB_Window_InnerCoordinate)
CloseWindow(2000)
Select typH.b
Case 1 ;fen avec titre et haut max
Hwq.d = definecrht - Httitre.d
Case 2 ;fen avec titre et barre de tache win visible
Hwq.d = definecrht - (htTaskbarwin + Httitre.d + EPframeH)
Case 3 ;fen sans titre et hauteur max
Hwq.d = definecrht
Case 4 ;fen sans titre et barre de tache win visible
Hwq.d = definecrht - htTaskbarwin
Default ;fen quelconque
Hwq.d = Dh * (definecrht /#Hdef)
EndSelect
ProcedureReturn Hwq.d
EndProcedure
Procedure Lw(dL.d)
L.d = dL * (definecrlarg /#Ldef)
ProcedureReturn L.d
EndProcedure
Procedure Ywp(y.d)
ProcedureReturn y.d *(definecrht.d /#Hdef)
EndProcedure
Procedure XWp(lp.d)
ProcedureReturn lp.d * (definecrlarg /#Ldef)
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 typH.b <> 0 : y.d = 0:EndIf
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)
EndProcedure
Procedure X(lg.d)
ProcedureReturn lg *(definecrlarg.d/#Ldef)
EndProcedure
Procedure Y(h.d)
ProcedureReturn h *(definecrht.d /#Hdef)
EndProcedure
Global FontID0 = LoadFont(0,"Tahoma", X(14))
Global FontID1 = LoadFont(1,"Segoe Print",X(16),#PB_Font_HighQuality)
Global FontID2 = LoadFont(2,"Tahoma", X(16))
Global FontID3 = LoadFont(3,"Segoe Print", X(30))
Global FontID4 = LoadFont(4,"Segoe Print", X(25))
Global FontID5 = LoadFont(5,"Tahoma", X(20))
Global FontID6 = LoadFont(6,"Tahoma", X(30))
Global Sann.b = 0,Pcr = 0,valres.D = 0,rho.D = 1.7
Global ccr$ = "Couleur cercle"
Macro coulf(gad)
SetGadgetColor(gad,#PB_Gadget_BackColor,$A3AA74)
EndMacro
Macro coult(gad,ct,ft)
SetGadgetColor(gad,#PB_Gadget_FrontColor,ct):SetGadgetFont(gad,ft)
EndMacro
Macro razR(indraz)
Pcr = 0
If indraz = 1
c1$ = "":c2$ = "":c3$ = "":c4$ = "":Sann.b = 0
MLD_ActCoche(52,1):MLD_ActCoche(53,0):HideGadget(25,1)
MLD_ActCoche(54,0):HideGadget(26,1):eticcoul():SetGadgetText(76," Précision: 20%"):Pcr = 0:prc()
manipbout(1)
For r = 22 To 26
SetGadgetColor(r,#PB_Gadget_BackColor,$93C5DA)
Next
SetGadgetText(74,"000"):SetGadgetText(75,""):SetGadgetText(77,""):SetGadgetText(85,""):valres.D = 0
EndIf
If indraz = 2
c1$ = "":c2$ = "":c3$ = "":c4$ = "":Sann.b = 0
For r = 22 To 25
SetGadgetColor(r,#PB_Gadget_BackColor,$93C5DA)
Next
SetGadgetText(74,"000"):SetGadgetText(75,""):SetGadgetText(77,""):valres.D = 0
EndIf
If indraz = 3:SetGadgetColor(26,#PB_Gadget_BackColor,$93C5DA):sann = 0:EndIf
EndMacro
Macro eticcoul()
SetGadgetText(71,"Choix couleur d'un cercle")
EndMacro
Macro Mstr(G,lt,corps)
SetGadgetColor(G,#PB_Gadget_BackColor,$D6CE27)
SendMessage_(GadgetID(G), #EM_LIMITTEXT,lt, 0)
SendMessage_(GadgetID(G),#EM_SETCUEBANNER,#True,corps)
EndMacro
Macro chtxt(G,corps)
SetGadgetText(G,corps)
EndMacro
Procedure MLD_ContainerGadget(numgad.d,x.d,y.d,Gl.d,Gh.d,Opt1.l,Opt2.l,Opt3.l,Opt4.l)
ContainerGadget(numgad.d,X(x.d),y(y.d),X(Gl.d),Y(Gh.d),Opt1.l|Opt2.l|Opt3.l|Opt4.l)
EndProcedure
Procedure MLD_TextGadget(numgad.d,x.d,y.d,Gl.d,Gh.d,Text$,Opt1.l,Opt2.l,Opt3.l,Opt4.l)
TextGadget(numgad.d,X(x.d),y(y.d),X(Gl.d),Y(Gh.d),Text$,Opt1|Opt2|Opt3|Opt4)
EndProcedure
Procedure MLD_StringGadget(numgad.d,x.d,y.d,Gl.d,Gh.d,Text$,Opt1.l,Opt2.l,Opt3.l,Opt4.l)
StringGadget(numgad.d,X(x.d),y(y.d),X(Gl.d),y(Gh.d),Text$,Opt1|Opt2|Opt3|Opt4)
EndProcedure
Procedure MLD_ImageGadget(numgad.d,x.d,y.d,Gl.d,Gh.d,img.d,Opt1.l,Opt2.l,Opt3.l,Opt4.l)
If img.d = 0
idimg.d = 0
Else
idimg.d = ImageID(img.d)
EndIf
ImageGadget(numgad.d,X(x.d),y(y.d),X(Gl.d),Y(Gh.d),idimg.d, Opt1|Opt2|Opt3|Opt4)
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, larg,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,larg,haut)
EndProcedure
Procedure MLD_BtTxt(Gad,x.D,y.D,larg.D,haut.D,txt$,font,coultext,coulfond,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 = (larg - largtxt)/2 ; centre le text en largeur
ctxt=(haut - hautxt)/2 ; centre le text en hauteur
DrawText(ctrtxt,ctxt,txt$,coultext)
StopDrawing ()
If pos = 0
MLD_ButtonImageGadget(Gad,x,y,larg,haut,Gad,0,0,0,0)
Else
ProcedureReturn Gad
EndIf
EndProcedure
Procedure bts(cd); commande des boutons
Static svgnp,Txt$,Fontg,Clt,Clf,image
Select cd
Case 513;bt enfoncé
svgnp = svgn
Select svgnp
Case 5,6,7,58 To 69,79,80,130,131,166,167;bt texte
If svgnp = 5:Txt$ = "Aide":Fontg = FontID3:Clt = $0:Clf = $578B2E:EndIf
If svgnp = 6:Txt$ = Chr(8645) + " " + Chr(8645):Fontg = FontID6:Clt = $0:Clf = $FF901E:EndIf
If svgnp = 7:Txt$ = "Stop":Fontg = FontID3:Clt = $0:Clf = $8080F0:EndIf
If svgnp = 58:Txt$ = "Argent = 10%":Fontg = FontID0:Clt = $0:Clf = $393939:EndIf
If svgnp = 59:Txt$ = "Or = 5%":Fontg = FontID0:Clt = $0:Clf = $0DAEF0 :EndIf
If svgnp = 60:Txt$ = "Noir = 0":Fontg = FontID0:Clt = $0:Clf = $393939 :EndIf
If svgnp = 61:Txt$ = "Marron= 1":Fontg = FontID0:Clt = $2D52A0:Clf = $393939 :EndIf
If svgnp = 62:Txt$ = "Rouge =2":Fontg = FontID0:Clt = $0000FF:Clf = $393939:EndIf
If svgnp = 63:Txt$ = "Orange = 3":Fontg = FontID0:Clt = $006FCA:Clf = $393939:EndIf
If svgnp = 64:Txt$ = "Jaune = 4":Fontg = FontID0:Clt = $16FFF0:Clf = $393939:EndIf
If svgnp = 65:Txt$ = "Vert = 5":Fontg = FontID0:Clt = $28A428:Clf = $393939:EndIf
If svgnp = 66:Txt$ = "Bleu = 6":Fontg = FontID0:Clt = $E16941:Clf = $393939:EndIf
If svgnp = 67:Txt$ = "Violet = 7":Fontg = FontID0:Clt = $CC3299:Clf = $393939:EndIf
If svgnp = 68:Txt$ = "Gris = 8":Fontg = FontID0:Clt = $6E6155:Clf = $393939:EndIf
If svgnp = 69:Txt$ = "Blanc = 9":Fontg = FontID0:Clt = $FFFFFF:Clf = $393939:EndIf
If svgnp = 79:Txt$ = " Raz ":Fontg = FontID0:Clt = $0:Clf = $00D7FF:EndIf
If svgnp = 80:Txt$ = "Calcul couleurs":Fontg = FontID0:Clt = $0:Clf = $00FC7C:EndIf
If svgnp = 130:Txt$ = " Raz ":Fontg = FontID0:Clt = $0:Clf = $00D7FF:EndIf
If svgnp = 131:Txt$ = "Calcul":Fontg = FontID0:Clt = $0:Clf = $00FC7C:EndIf
If svgnp = 166:Txt$ = " Raz ":Fontg = FontID0:Clt = $0:Clf = $00D7FF:EndIf
If svgnp = 167:Txt$ = "Calcul":Fontg = FontID0:Clt = $0:Clf = $00FC7C:EndIf
im = ImageID(MLD_BtTxt(svgnp,GadgetX(svgnp),GadgetY(svgnp),GadgetWidth(svgnp),GadgetHeight(svgnp),Txt$,Fontg,Clt,Clf,1))
SetGadgetAttribute(svgnp,#PB_Button_Image,im)
EndSelect
Case 514
Select svgnp
Case 5,6,7,58 To 69,79,80,130,131,166,167;bt texte
im = ImageID( MLD_BtTxt(svgnp,GadgetX(svgnp),GadgetY(svgnp),GadgetWidth(svgnp),GadgetHeight(svgnp),Txt$,Fontg,Clt,Clf,2))
SetGadgetAttribute(svgnp,#PB_Button_Image,im)
EndSelect
EndSelect
EndProcedure
Procedure MLD_ActCoche(Gad,Act) ;1 = actif 0 = non actif
haut.D = GadgetHeight(Gad): larg.D = haut.D
fontche = LoadFont(Gad,"Arial", Y(haut * 0.75),#PB_Font_Bold)
CreateImage(Gad, X(larg),Y(haut))
hdc=StartDrawing(ImageOutput(Gad))
;Dessine l'image
DrawingMode(#PB_2DDrawing_Gradient)
BackColor($BEBEBE):FrontColor($FFFFFF)
LinearGradient(0,Y(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 = (X(larg) - largtxtC)/2 ; centre le text en largeur
ctxtC =(Y(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,CouleurFond,Action) ;le num de gadget ne doit jamais être 0| Action 1 = ok 0 = no ok
MLD_ButtonImageGadget(Gad,x,y,haut,haut,0,#PB_Button_Toggle,0,0,0)
Font = LoadFont(5000,"Tahoma", Y(haut/2))
hautbt.D = GadgetHeight(Gad)
plG = x + hautbt.D + 20
txtgad = TextGadget(#PB_Any,x(plG),Y(y),X(larg.D),Y(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 bd()
CreateImage(4,X(1500),Y(70))
StartDrawing(ImageOutput(4))
DrawingMode(#PB_2DDrawing_Gradient) ;Dessine le fond de l'image
BackColor($87B8DE):FrontColor($FFFFFF)
LinearGradient(0,Y(70) *1.5,0,0)
Box(0,0,X(1500),Y(70))
DrawingMode(#PB_2DDrawing_Transparent)
DrawingFont(FontID3)
DrawText(x(50),Y(2),"Rélec Mesures en électricité",$0)
StopDrawing()
EndProcedure
Procedure String_NumericD(Gadget)
If Len(GetGadgetText(Gadget)) <> 0
SendMessage_(GadgetID(Gadget), #EM_GETSEL, @Debut_Position, @Fin_position)
a$ = Mid(GetGadgetText(Gadget),Debut_position,1)
ValeurASCII = Asc(a$)
If ValeurASCII = 46
Else
If ValeurASCII <48 Or ValeurASCII > 57
y = Debut_Position
Texte.s = GetGadgetText(Gadget)
x = Len(Texte)
If Mid(Texte,y,1) = "," ; modification d'une virgule en point
Texte2.s = Left(Texte,y -1) + "." + Right(Texte,x-y)
SetGadgetText(Gadget,Texte2)
SendMessage_(GadgetID(Gadget), #EM_SETSEL, x + 1, x + 1)
Else
Texte2.s = Left(Texte,y -1) + Right(Texte,x-y)
SetGadgetText(Gadget,Texte2)
SendMessage_(GadgetID(Gadget), #EM_SETSEL, x-1, x-1)
EndIf
EndIf
EndIf
EndIf
EndProcedure
Procedure alertinfo(*valeur)
Beep_(440,100)
Select *valeur
Case 1
SetGadgetText(90,"Choisissez un cercle sur la résistance")
Case 2
SetGadgetText(90,"Couleur noir interdite pour ce cercle")
Case 3
SetGadgetText(90,"Couleur interdite pour ce cercle")
Case 4
SetGadgetText(90,"Il faut indiquer une valeur")
Case 5
SetGadgetText(90,"Valeur hors limites du logiciel")
Case 6
SetGadgetText(90,"Il manque des éléments pour le calcul")
EndSelect
HideGadget(90,0):Delay(3500):HideGadget(90,1)
EndProcedure
Procedure manipbout(num)
If num = 1
For x = 60 To 69
HideGadget(x,0)
Next
HideGadget(58,1):HideGadget(59,1)
Else
For x = 60 To 69
HideGadget(x,1)
Next
HideGadget(58,0):HideGadget(59,0)
EndIf
EndProcedure
Procedure prc();calcul min/max précision
If valres.D <> 0
Select Pcr
Case 0
pc = 20
Case 1
pc = 10
Case 2
pc = 5
EndSelect
Dt.D = (valres.D * pc)/100
max.D = valres.D + Dt.D :min.D = valres.D - Dt.D
If valres.D > 99
Amax.D = Round(max.D,#PB_Round_Nearest)
Amin.D = Round(min.D,#PB_Round_Nearest):Amin$ = StrD(Amin.D,2)
Else
Amax.D = max.D:Amin = min.D
EndIf
If valres.D < 1000
Amax$ = StrD(Amax.D,2):Amin$ = StrD(Amin.D,2)
SetGadgetText(77,"Min " + Amin$ + " " + Chr(937) + " Max " + Amax$ + " " + Chr(937))
EndIf
If valres.D > 999 And valres.D < 999999
Amin$ = StrD(Amin.D/1000):Amax$ = StrD(Amax.D/1000)
SetGadgetText(77,"Min " + Amin$ + " K " + Chr(937) + " Max " + Amax$ + " K " + Chr(937) )
EndIf
If valres.D > 999999
Amin$ = StrD(Amin.D/1000000,1):Amax$ = StrD(Amax.D/1000000,1)
SetGadgetText(77,"Min " + Amin$ + " M " + Chr(937) + " Max " + Amax$ + " M " + Chr(937) )
EndIf
EndIf
EndProcedure
Procedure affvr(sann,numcoul.b)
Global c1$,c2$,c3$,c4$,c5$
valres.D = 0
Select sann
Case 22
c1$ = Str(numcoul.b)
Case 23
c2$ = Str(numcoul.b)
Case 24
If GetGadgetState(52)=1
a$ ="0":c3$ = ""
For z = 1 To numcoul.b
c3$ = c3$ +a$
Next
Else
c3$ = Str(numcoul.b)
EndIf
Case 25
a$ ="0":c4$ = ""
For z = 1 To numcoul.b
c4$ = c4$ +a$
Next
EndSelect
valres.D = ValD(c1$+c2$+c3$+c4$)
SetGadgetText(74,FormatNumber(valres,0, ","," "))
If GetGadgetColor(24,#PB_Gadget_BackColor) <> $93C5DA
SetGadgetText(75,Chr(937))
If valres.D > 999 And valres.D < 999999
afk$ = StrD(valres.D/1000)
SetGadgetText(75,Chr(937) + " ou " + afk$ + " K " + Chr(937))
EndIf
If valres.D > 999999
afk$ = StrD(valres.D/1000000)
SetGadgetText(75,Chr(937) + " ou " + afk$ + " M " + Chr(937))
EndIf
prc()
EndIf
EndProcedure
Procedure Coloran(numcoul.b)
indcoul = 0
If sann <> 0
Select numcoul.b
Case 0
If sann = 22
CreateThread(@alertinfo(),2):ca = $93C5DA
Else
ca = $0
EndIf
Case 1
ca = $2D52A0
Case 2
ca = $0000FF
Case 3
ca = $008CFF
Case 4
ca = $16FFF0
Case 5
ca = $28A428
Case 6
ca = $E16941
Case 7
If sann = 24 And GetGadgetState(52)=1 Or sann = 25
indcoul = 1:CreateThread(@alertinfo(),3):ca = $93C5DA
Else
ca = $CC3299
EndIf
Case 8
If sann = 24 And GetGadgetState(52)=1 Or sann = 25
indcoul = 1:CreateThread(@alertinfo(),3):ca = $93C5DA
Else
ca = $A9A9A9
EndIf
Case 9
If sann = 24 And GetGadgetState(52)=1 Or sann = 25
indcoul = 1:CreateThread(@alertinfo(),3):ca = $93C5DA
Else
ca = $FFFFFF
EndIf
Case 10
ca = $D9D9D9:SetGadgetText(76," Précision: 10%"):Pcr = 1
Case 11
ca = $0DD9FF:SetGadgetText(76," Précision: 5%"):Pcr = 2
EndSelect
SetGadgetColor(Sann.b ,#PB_Gadget_BackColor,ca)
If indcoul <> 1:affvr(sann,numcoul.b):EndIf
Else
CreateThread(@alertinfo(),1)
EndIf
EndProcedure
Procedure calcoul()
If GetGadgetText(85) <> ""
Vres.D = ValD(GetGadgetText(85))
If Vres.D < 10 Or Vres.D > 999000000
CreateThread(@alertinfo(),5)
ProcedureReturn 0
Else
razR(1):SetGadgetText(85,StrD(Vres.D,0))
If Vres.D > 9 And Vres.D < 100
sann = 22:coloran(Val(Left(GetGadgetText(85),1))):sann = 23:Coloran(Val(Right(GetGadgetText(85),1)))
sann = 24:Coloran(0)
EndIf
If Val(Mid(GetGadgetText(85),3,1)) <> 0 Or Vres.D > 99000000
MLD_ActCoche(52,0):MLD_ActCoche(53,1):HideGadget(25,0):eticcoul()
lg= Len(GetGadgetText(85)):nbz = lg - 3
sann = 22:coloran(Val(Left(GetGadgetText(85),1))):sann = 23:Coloran(Val(Mid(GetGadgetText(85),2,1)))
sann = 24:Coloran(Val(Mid(GetGadgetText(85),3,1))):sann = 25:coloran(nbz)
Else
If Vres.D > 99 And Vres.D < 99000000
lg= Len(GetGadgetText(85)):nbz = lg - 2
sann = 22:coloran(Val(Left(GetGadgetText(85),1))):sann = 23:Coloran(Val(Mid(GetGadgetText(85),2,1)))
sann = 24:coloran(nbz)
EndIf
EndIf
EndIf
Else
CreateThread(@alertinfo(),4)
EndIf
EndProcedure
Procedure razH ()
MLD_ActCoche(120,1)
For z = 121 To 123
MLD_ActCoche(z,0)
Next
For z = 124 To 126
chtxt(z,"")
Next
chtxt(127,"R:"):chtxt(128,"I:"):chtxt(129,"P:"):Mstr(124,9,"En Ohm"):Mstr(125,4,"En Ampere"):Mstr(126,6,"P (en Watt)")
chtxt(109,"00.00")
EndProcedure
Procedure Mstrh(c.b)
For z = 124 To 126
chtxt(z,"")
Next
Select c.b
Case 1
chtxt(127,"R:"):chtxt(128,"I:"):chtxt(129,"P:"):Mstr(124,9,"En Ohm"):Mstr(125,5,"En Ampere"):Mstr(126,6,"P En Watt")
Case 2
chtxt(127,"U:"):chtxt(128,"I:"):chtxt(129,"P:"):Mstr(124,5,"En Volt"):Mstr(125,5,"En Ampere"):Mstr(126,6,"P En Watt")
Case 3
chtxt(127,"U:"):chtxt(128,"R:"):chtxt(129,"P:"):Mstr(124,5,"En Volt"):Mstr(125,9,"En Ohm"):Mstr(126,6,"P En Watt")
Case 4
chtxt(127,"U:"):chtxt(128,"I:"):chtxt(129,"R:"):Mstr(124,5,"En Volt"):Mstr(125,5,"En Ampere"):Mstr(126,9,"En Ohm")
EndSelect
EndProcedure
Procedure calculh()
t= 0 :U.D = 0
For z = 124 To 126
If GetGadgetText(z) <> "":t =t +1:EndIf
Next
If t=> 2
i = 0
For zz = 120 To 123
i = i +1
If GetGadgetState(zz) <> 0: Break :EndIf
Next
E1.D = ValD(GetGadgetText(124)):E2.D = ValD(GetGadgetText(125)):E3.D = ValD(GetGadgetText(126))
Select i
Case 1;tension
If E1.D = 0:U.D = E3.D/E2.D :EndIf:If E2.D = 0:U.D = Sqr((E3.D * E1.D)) :EndIf
If E3.D = 0:U.D = E1.D * E2.D :EndIf :If U.D = 0:U.D = E1.D * E2.D :EndIf:affr$ = StrD(U.D,2) + " V"
Case 2;résistance
If E1.D = 0:R.D = E3.D/ Pow(E2.D,2) :EndIf:If E2.D = 0:R.D = Pow(E1.D,2)/E3.D:EndIf
If E3.D = 0:R.D = E1.D / E2.D :EndIf :If R.D = 0:R.D = E1.D / E2.D :EndIf:affr$ = StrD(R.D,2) + " " + Chr(937)
Case 3;intensité
If E1.D = 0:A.D = Sqr((E3.D/E2.D)):EndIf:If E2.D = 0:A.D = E3.D/E1.D:EndIf
If E3.D = 0:A.D = E1.D / E2.D :EndIf :If A.D = 0:A.D = E1.D / E2.D :EndIf:affr$ = StrD(A.D,2) + " A"
Case 4;intensité
If E1.D = 0:P.D = E3.D * Pow(E2.D,2):EndIf:If E2.D = 0:P.D = Pow(E1.D,2)/E3.D :EndIf
If E3.D = 0:P.D = E1.D * E2.D :EndIf :If P.D = 0:P.D = E1.D * E2.D :EndIf:affr$ = StrD(P.D,2) + " W"
EndSelect
Else
CreateThread(@alertinfo(),6)
EndIf
chtxt(109,affr$)
EndProcedure
Procedure razF()
Mstr(162,5,"Section (en mm²)"):Mstr(163,5,"Longueur (en mètre)")
MLD_ActCoche(160,1):MLD_ActCoche(161,0):rho.D = 1.7:chtxt(154,"00.00")
EndProcedure
Procedure calculF()
If GetGadgetText(162) = "" Or GetGadgetText(163) = ""
CreateThread(@alertinfo(),6)
Else
S.D = ValD(GetGadgetText(162)):L.D = ValD(GetGadgetText(163))
R.D = (rho.D/1000000000) * L.D/(S.D/10000000)
chtxt(154,StrD(R.D,5) + " " + Chr(937))
EndIf
EndProcedure
Procedure aide()
Dim L.s(9)
L.s(1) = "INFORMATIONS "+#CRLF$ +#CRLF$
L.s(2) = " Simple et efficace ce logiciel sera utile aux électroniciens, électriciens, électriciens automobile"+#CRLF$+#CRLF$
L.s(3) = "UTILISATION"+#CRLF$
L.s(4) = " Pour colorer les cercles d'une résistance. Cliquez dabord sur l'un des cercles, puis sur un des boutons de couleur. "+#CRLF$
L.s(5) = " Vous pouvez choisir la précision de la résistance entre 5% et 20%."
L.s(6) = "Ce logiciel permet aussi a partir d'une valeur en Ohm de peindre les cercles de la résistance."+#CRLF$
L.s(7) = " Les différents calculs de la loi d'Ohm sont possible. Il suffit de choisir avec les cases a cocher et de remplir au minimum les cases de deux valeurs."+#CRLF$
L.s(8) = " Vous avez la possibilité de calculer la résistance d'un fil électrique en cuivre ou en aluminium"+#CRLF$
L.s(9) = " Programation MLD le 13/05/2023. Programmer avec Pure Basic 6,01 LTS(x86)"+#CRLF$
For X = 1 To 9
LT$ = LT$ + L.s(X)
Next
FreeArray(L.s())
MessageRequester("MLD Rélec (Résistance et loi d'Ohm)",LT$,#PB_MessageRequester_Ok | #PB_MessageRequester_Info)
EndProcedure
hwnd = MLD_openfen(1,0,0,1920,1080,"",#PB_Window_BorderLess,#NUL,#NUL,#NUL,4)
SetWindowCallback(@Callback())
SetWindowColor(1,$A3AA74)
StickyWindow(1,1)
bd()
MLD_ImageGadget(4,0,0,1500,70,4,Opt1.l,Opt2.l,Opt3.l,Opt4.l)
bd()
MLD_BtTxt(5,1500,0,140,70,"Aide",FontID3,$0,$578B2E,0)
MLD_BtTxt(6,1640,0,140,70,Chr(8645) + " " + Chr(8645),FontID6,$0,$FF901E,0)
MLD_BtTxt(7,1780,0,140,70,"Stop",FontID3,$0,$8080F0,0)
MLD_TextGadget(2,20,150,1090,60," Calcul des résistances",#PB_Text_Center,0,0,0)
coult(2,$00FF00,FontID3):coulf(2)
MLD_TextGadget(3,1140,150,760,60,"Loi d'Ohm et résistance d'un fil",#PB_Text_Center,0,0,0)
coult(3,$00FF00,FontID3):coulf(3)
MLD_ContainerGadget(21,420,300,300,100,#PB_Container_Flat,0,0,0)
SetGadgetColor(21,#PB_Gadget_BackColor,$73B5D0)
MLD_TextGadget(22,15,0,20,98,"",#SS_NOTIFY,0,0,0)
MLD_TextGadget(23,55,0,20,98,"",#SS_NOTIFY,0,0,0)
MLD_TextGadget(24,95,0,20,98,"",#SS_NOTIFY,0,0,0)
MLD_TextGadget(25,135,0,20,98,"",#SS_NOTIFY,0,0,0):HideGadget(25,1)
MLD_TextGadget(26,205,0,20,98,"",#SS_NOTIFY,0,0,0):HideGadget(26,1)
CloseGadgetList()
MLD_TextGadget(31,310,352,107,2,"",0,0,0,0)
MLD_TextGadget(32,720,352,107,2,"",0,0,0,0)
MLD_TextGadget(33,1120,400,2,540,"",0,0,0,0);trait vert
SetGadgetColor(33,#PB_Gadget_BackColor,$00FC7C)
MLD_ContainerGadget(51,1,450,1100,480,#PB_Container_BorderLess,0,0,0)
SetGadgetColor(51,#PB_Gadget_BackColor,$A3AA74)
MLD_Coche(52,100,120,250,30,"Valeur avec 3 cercles",$FFFFFF,$A3AA74,1)
MLD_Coche(53,100,190,250,30,"Valeur avec 4 cercles",$FFFFFF,$A3AA74,0)
MLD_Coche(54,100,290,250,30,"Cercle de précision",$FFFFFF,$A3AA74,0)
MLD_BtTxt(58,500,70,150,35,"Argent = 10%",FontID0,$0,$393939,0):HideGadget(58,1)
MLD_BtTxt(59,500,110,150,35,"Or = 5%",FontID0,$0,$0DAEF0,0):HideGadget(59,1)
MLD_BtTxt(60,500,70,150,35,"Noir = 0",FontID0,$0,$393939,0)
MLD_BtTxt(61,500,110,150,35,"Marron = 1",FontID0,$2D52A0,$393939,0)
MLD_BtTxt(62,500,150,150,35,"Rouge = 2",FontID0,$0000FF,$393939,0)
MLD_BtTxt(63,500,190,150,35,"Orange = 3",FontID0,$006FCA,$393939,0)
MLD_BtTxt(64,500,230,150,35,"Jaune = 4",FontID0,$16FFF0,$393939,0)
MLD_BtTxt(65,500,270,150,35,"Vert = 5",FontID0,$28A428,$393939,0)
MLD_BtTxt(66,500,310,150,35,"Bleu = 6",FontID0,$E16941,$393939,0)
MLD_BtTxt(67,500,350,150,35,"Violet = 7",FontID0,$CC3299,$393939,0)
MLD_BtTxt(68,500,390,150,35,"Gris = 8",FontID0,$6E6155,$393939,0)
MLD_BtTxt(69,500,430,150,35,"Blanc = 9",FontID0,$FFFFFF,$393939,0)
MLD_TextGadget(70,120,5,240,40,"Type de résistance",#PB_Text_Center,0,0,0)
coult(70,$FF0000,FontID1):coulf(70)
MLD_TextGadget(71,435,5,300,40,"Choix couleur d'un cercle",#PB_Text_Center,0,0,0)
coult(71,$FF0000,FontID1):coulf(71)
MLD_TextGadget(72,770,5,290,40,"Valeur de la résistance",#PB_Text_Center,0,0,0)
coult(72,$FF0000,FontID1):coulf(72)
MLD_TextGadget(73,770,80,290,40,"Valeur en Ohms",#PB_Text_Center,0,0,0)
coult(73,$00FFFF,FontID1):coulf(73)
MLD_TextGadget(74,700,140,220,50,"000",#PB_Text_Right,0,0,0)
coult(74,$00FFFF,FontID5):coulf(74)
MLD_TextGadget(75,930,140,180,50,"",0,0,0,0)
coult(75,$00FFFF,FontID5):coulf(75)
MLD_TextGadget(76,790,190,280,40," Précision: 20%",#PB_Text_Center,0,0,0)
coult(76,$00FFFF,FontID1):coulf(76)
MLD_TextGadget(77,800,240,300,40,"+ 00 "+ Chr(937) + " - 00 " + Chr(937) ,#PB_Text_Center,0,0,0)
coult(77,$00FFFF,FontID2):coulf(77)
MLD_TextGadget(78,790,300,280,40,"Couleurs par la valeur",#PB_Text_Center,0,0,0)
coult(78,$FFFFFF,FontID2):coulf(78)
MLD_StringGadget(85,805,350,260,35,"",#PB_String_Numeric,0,0,0)
coult(85,$FFFFFF,FontID2):Mstr(85,9,"De 10 "+ Chr(937) + " a 999 000 000 " + Chr(937))
MLD_BtTxt(79,785,420,140,40," Raz ",FontID0,$0,$00D7FF,0)
MLD_BtTxt(80,945,420,140,40,"Calcul couleurs",FontID0,$0,$00FC7C,0)
CloseGadgetList()
MLD_TextGadget(90,1,950,1100,70,"",#PB_Text_Center,0,0,0);etic alert
coult(90,$0000D2,FontID3):coulf(90)
;***************** Loi d'ohm *****************************
MLD_ContainerGadget(100,1140,300,775,670,#PB_Container_BorderLess,0,0,0)
SetGadgetColor(100,#PB_Gadget_BackColor,$A3AA74)
MLD_TextGadget(101,270,5,300,50,"Loi générale",#PB_Text_Center,0,0,0)
coult(101,$FF0000,FontID4):coulf(101)
MLD_TextGadget(102,2,130,440,30,"U (en volt) = R x I ou P/I ou Sqr(P x R)",0,0,0,0)
coult(102,$13458B,FontID2):coulf(102)
MLD_TextGadget(103,2,165,440,30,"R (en Ohm) = U/I ou U²/P ou P/I²",0,0,0,0)
coult(103,$13458B,FontID2):coulf(103)
MLD_TextGadget(104,2,200,440,30,"I (en Ampere) = U/R ou P/U ou Sqr(P/R)",0,0,0,0)
coult(104,$13458B,FontID2):coulf(104)
MLD_TextGadget(105,2,235,440,30,"P (en Watt) = U x I ou R X I² ou U²/R",0,0,0,0)
coult(105,$13458B,FontID2):coulf(105)
MLD_TextGadget(106,550,80,200,30,"Recherche",#PB_Text_Center,0,0,0)
coult(106,$FFFFFF,FontID1):coulf(106)
MLD_TextGadget(107,5,270,340,35,"Indiquez vos valeurs ci dessous",0,0,0,0)
coult(107,$FFFFFF,FontID1):coulf(107)
MLD_TextGadget(108,5,370,100,30,"Résultat:",0,0,0,0)
coult(108,$00FFFF,FontID1):coulf(108)
MLD_TextGadget(109,105,372,250,50,"00.00",0,0,0,0)
coult(109,$00FFFF,FontID5):coulf(109)
MLD_Coche(120,530,130,200,30,"Tension (U)",$FFFFFF,$A3AA74,1)
MLD_Coche(121,530,165,200,30,"Résistance (R)",$FFFFFF,$A3AA74,0)
MLD_Coche(122,530,200,200,30,"Intensité (I)",$FFFFFF,$A3AA74,0)
MLD_Coche(123,530,235,200,30,"Puissance (P)",$FFFFFF,$A3AA74,0)
MLD_StringGadget(124,25,320,140,30,"",0,0,0,0)
coult(124,$FFFFFF,FontID2):Mstr(124,9,"En Ohm")
MLD_StringGadget(125,200,320,140,30,"",0,0,0,0)
coult(125,$FFFFFF,FontID2):Mstr(125,5,"En Ampere")
MLD_StringGadget(126,375,320,140,30,"",0,0,0,0)
coult(126,$FFFFFF,FontID2):Mstr(126,6,"En Watt")
MLD_TextGadget(127,2,322,20,30,"R:",0,0,0,0)
coult(127,$FFFFFF,FontID2):coulf(127)
MLD_TextGadget(128,177,322,20,30,"I:",0,0,0,0)
coult(128,$FFFFFF,FontID2):coulf(128)
MLD_TextGadget(129,350,322,20,30,"P:",0,0,0,0)
coult(129,$FFFFFF,FontID2):coulf(129)
MLD_BtTxt(130,535,315,100,40," Raz ",FontID0,$0,$00D7FF,0)
MLD_BtTxt(131,645,315,100,40,"Calcul",FontID0,$0,$00FC7C,0)
;*** Résistance d'un fil ******
MLD_TextGadget(150,280,400,300,50,"Résistance d'un fil",#PB_Text_Center,0,0,0)
coult(150,$FF0000,FontID4):coulf(150)
MLD_TextGadget(151,5,480,220,35,"Type de matériaux:",0,0,0,0)
coult(151,$FFFFFF,FontID1):coulf(151)
MLD_TextGadget(152,5,525,340,35,"Indiquez vos valeurs ci dessous",0,0,0,0)
coult(152,$FFFFFF,FontID1):coulf(152)
MLD_TextGadget(153,5,615,100,30,"Résultat:",0,0,0,0)
coult(153,$00FFFF,FontID1):coulf(153)
MLD_TextGadget(154,105,617,250,50,"00.00",0,0,0,0)
coult(154,$00FFFF,FontID5):coulf(154)
MLD_Coche(160,240,480,120,30,"Cuivre",$FFFFFF,$A3AA74,1)
MLD_Coche(161,420,480,170,30,"Aluminium",$FFFFFF,$A3AA74,0)
MLD_StringGadget(162,25,570,200,30,"",0,0,0,0)
coult(162,$FFFFFF,FontID2):Mstr(162,5,"Section (en mm²)")
MLD_StringGadget(163,270,570,220,30,"",0,0,0,0)
coult(163,$FFFFFF,FontID2):Mstr(163,5,"Longueur (en mètre)")
MLD_TextGadget(164,2,572,20,30,"S:",0,0,0,0)
coult(164,$FFFFFF,FontID2):coulf(164)
MLD_TextGadget(165,247,572,20,30,"L:",0,0,0,0)
coult(165,$FFFFFF,FontID2):coulf(165)
MLD_BtTxt(166,535,565,100,40," Raz ",FontID0,$0,$00D7FF,0)
MLD_BtTxt(167,645,565,100,40,"Calcul",FontID0,$0,$00FC7C,0)
CloseGadgetList()
razR(1)
Repeat
Select WindowEvent ()
Case #WM_LBUTTONDOWN
If svgn = 0
SendMessage_(WindowID(1), #WM_NCLBUTTONDOWN, #HTCAPTION, 0)
Else
bts(#WM_LBUTTONDOWN)
EndIf
Case #WM_LBUTTONUP:bts(#WM_LBUTTONUP)
Case #PB_Event_Gadget
Select EventGadget()
Case 5;aide
aide()
Case 6;barre de tache
ShowWindow_(WindowID(1),#SW_MINIMIZE)
Case 7;bt stop
If EventType ()= #PB_EventType_LeftClick
CloseWindow(1)
Break
EndIf
Case 22 To 26
Sann.b = EventGadget()
Select sann
Case 22,23
txt$ = ccr$ + " " + "n°" + Str(sann - 21):manipbout(1):SetGadgetText(85,"")
Case 24
If GetGadgetState(52)=1
txt$ = "Multiplcateur Nb de 0":manipbout(1):SetGadgetText(85,"")
Else
txt$ = ccr$ + " " + "n°" + Str(sann - 21):manipbout(1):SetGadgetText(85,"")
EndIf
Case 25
txt$ = "Multiplcateur Nb de 0":manipbout(1):SetGadgetText(85,"")
Case 26
txt$ = "Choix de la Précision":manipbout(2)
EndSelect
SetGadgetText(71, Txt$)
Case 52
MLD_ActCoche(52,1):MLD_ActCoche(53,0):HideGadget(25,1):eticcoul():razR(1)
Case 53
MLD_ActCoche(52,0):MLD_ActCoche(53,1):HideGadget(25,0):eticcoul():razR(2)
Case 54
If GetGadgetState(54)=1
MLD_ActCoche(54,1):HideGadget(26,0):eticcoul()
Else
MLD_ActCoche(54,0):HideGadget(26,1):eticcoul():manipbout(1):razR(3):SetGadgetText(76," Précision: 20%"):Pcr = 0:prc()
EndIf
Case 58,59
Coloran(EventGadget() -48)
Case 60 To 69
Coloran(EventGadget() -60)
Case 79;raz cacul R
razR(1)
Case 80;calcul coul
calcoul()
Case 120;U
MLD_ActCoche(120,1):MLD_ActCoche(121,0):MLD_ActCoche(122,0):MLD_ActCoche(123,0):Mstrh(1):chtxt(109,"00.00")
Case 121;R
MLD_ActCoche(120,0):MLD_ActCoche(121,1):MLD_ActCoche(122,0):MLD_ActCoche(123,0):Mstrh(2):chtxt(109,"00.00")
Case 122;I
MLD_ActCoche(120,0):MLD_ActCoche(121,0):MLD_ActCoche(122,1):MLD_ActCoche(123,0):Mstrh(3):chtxt(109,"00.00")
Case 123;P
MLD_ActCoche(120,0):MLD_ActCoche(121,0):MLD_ActCoche(122,0):MLD_ActCoche(123,1):Mstrh(4):chtxt(109,"00.00")
Case 124;strH1
String_NumericD(124)
Case 125
String_NumericD(125)
Case 126
String_NumericD(125)
Case 130 ;razh
razH ()
Case 131;calcuh
calculh()
Case 160;cuivre
MLD_ActCoche(160,1):MLD_ActCoche(161,0):rho.D = 1.7:chtxt(154,"00.00")
Case 161;alu
MLD_ActCoche(160,0):MLD_ActCoche(161,1):rho.D = 2.7:chtxt(154,"00.00")
Case 162
String_NumericD(162)
Case 163
String_NumericD(163)
Case 166;razF
razF()
Case 167 ;calculF
calculF()
EndSelect
EndSelect
ForEver
End