Cheques et documents facile

MLD · Message par **MLD** » jeu. 22/avr./2021 11:13

Ce logiciel sans prétention, mais utile, transforme un chiffre entier ou décimal en lettres pour la monnaie courante. vous pourrez via le presse-papier transférer le résultat dans votre traitement de texte préféré. Ceci sera utile pour les agents immobilier, notaires avocats etc qui ont des documents avec des sommes en lettres a rédiger couramment.

Code : Tout sélectionner

;MLD logiciel CEL 22/4/2021 PB 5.73LTS(X86)
;¤¤¤¤ Assignation des gadgets ¤¤¤¤
#Ma_fen = 1:#txt1= 2:#txt2= 3:#txt3= 4:#txt4= 5:#txt5= 6:
#string1 = 10:#bt_ok = 12:#bt_aid = 13:#bt_pp = 14:#bt_raz = 15:#bt_bar = 16:#bt_stop = 17
;¤¤¤¤¤¤¤¤
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|#PB_Font_Bold)
Global FontID5 = LoadFont(5,"Tahoma",12,#PB_Font_HighQuality)
Global Dim Te$(102), Dim L.s(7) 
Te$(1) = "un": Te$(2) = "deux": Te$(3) = "trois": Te$(4) = "quatre" :Te$(5) = "cinq": Te$(6) = "six":Te$(7) = "sept": Te$(8) = "huit"
Te$(9) = "neuf": Te$(10) = "dix": Te$(11) = "onze": Te$(12) = "douze":Te$(13) = "treize": Te$(14) = "quatorze": Te$(15) = "quinze" 
Te$(16) = "seize":Te$(17) = "dix sept":Te$(18) = "dix huit":Te$(19) = "dix neuf":Te$(20) = "vingt":Te$(21) = "vingt et un"
Te$(30) = "trente":Te$(31) = "trente et un":Te$(40) = "quarante":Te$(41) = "quarante et un":Te$(50) = "cinquante":Te$(51) = "cinquante et un"
Te$(60) = "soixante":Te$(61) = "soixante et un":Te$(70) = "soixante dix":Te$(71) = "soixante et onze":Te$(72) = "soixante douze"
Te$(73) = "soixante treize":Te$(74) = "soixante quatorze":Te$(75) = "soixante quinze":Te$(76) = "soixante seize":Te$(80) = "quatre vingt"
Te$(100) = "cent":Te$(101) = "mille":Te$(102) = "million"
;¤¤¤¤¤ Aide ¤¤¤¤¤¤¤¤¤¤¤
 L.s(1) = "But du logiciel:" +#CRLF$
 L.s(2) = "Transformer en lettres un chiffre en vue de sont transfert vers un traitement de texte via le presse-papier."+#CRLF$
 L.s(3) = "Utilisation:"+#CRLF$
 L.s(4) = "Inscrivez un chiffre entier ou avec décimales dans le champ décriture.(limite 9999 999 999,99)"+#CRLF$
 L.s(5) = "Ensuite cliquez sur le bouton OK"+#CRLF$
 L.s(6) = "Si vous désirez le transmettre dans le presse-papier, cliquez sur le bouton P - P "+#CRLF$
 L.s(7) = "Pour le reste, les boutons sont suffisamment explicites"+#CRLF$
For X = 1 To 7
   LT$ = LT$ + L.s(X)
 Next
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 GestionCaret(Gadget) ; Gestion du caret 
 SendMessage_(GadgetID(Gadget), #EM_GETSEL, @Debut_Position, @Fin_position)    
 y = Debut_Position
 Texte.s = GetGadgetText(Gadget)
 x =Len(Texte)
 Texte2.s = Left(Texte,y ) + Right(Texte,x-y)
 SendMessage_(GadgetID(Gadget), #EM_SETSEL, x, x) 
EndProcedure

Procedure String_NumericD(Gadget)   
If Len(GetGadgetText(Gadget)) <>0 
  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):GestionCaret(10)
      Else
       Texte2.s = Left(Texte,y -1) + Right(Texte,x-y)
       SetGadgetText(Gadget,Texte2):GestionCaret(10)
      EndIf
     EndIf
    EndIf 
EndIf 
EndProcedure

Procedure.s CCR(chf)
 If chf = 0 :ProcedureReturn "zéro":EndIf  
  Select Len(Str(chf))
    Case 1  
      ProcedureReturn Te$(chf)
    Case 2
      Select chf
        Case 1 To 20
          ProcedureReturn Te$(chf)
        Case 21,31,41,51,61,71,72 To 76
          ProcedureReturn Te$(chf)
        Case 90 To 99
          z$ = Str(chf):b$ = Right(z$,1)
          ProcedureReturn  Te$(80) + " " + Te$(Val(b$)+10)
        Default
          z$ = Str(chf):a$ = Left(z$,1):b$ = Right(z$,1)
          ProcedureReturn Te$(Val(a$)*10) + " " + Te$(Val(b$))
      EndSelect    
  EndSelect    
EndProcedure

Procedure.s ct(nbr); centaines
x = (nbr/100) :y = nbr % 100  
If x <> 1: a$ = CCR(x) +" " + Te$(100):Else:a$ = Te$(100):EndIf
If y <> 0:a$ = a$ + " " + CCR(y):EndIf
ProcedureReturn a$
EndProcedure

Procedure.s mil(nbr);1000 - 99999  
 w = (nbr/1000):ww = nbr % 1000
 If w = 1:b$ = "" + Te$(101):Else: b$ = CCR(w) + " " + Te$(101):EndIf 
 If ww = 0 And w >1 :a$ = b$ :Else:a$ = Te$(101):EndIf  
 If ww > 0 And ww < 100 :a$ = b$ +  " " + CCR(ww):EndIf
 If ww > 99 :a$ = b$  + " " + CCR(ww) + " " + ct(ww):EndIf
 ProcedureReturn a$  
EndProcedure

Procedure.s cmil(nbr);100000 - 999999
 nbrm = nbr % 100000:v = (nbr/100000)
 If v = 1 And nbrm = 0:a$ = Te$(100)+ " " + Te$(101):EndIf 
 If v >1 And v < 10 And nbrm = 0:a$ = CCR(v)+ " "+ Te$(100)+ " " + Te$(101):EndIf 
 If v = 1: b$ = Te$(100):Else :b$ = CCR(v)+ " "+ Te$(100) :EndIf
 If nbrm > 0 And nbrm < 100:a$ = b$ + " " + Te$(101) + " " + CCR(nbrm):EndIf
 If nbrm > 99 And nbrm < 1000:a$ = b$ + " " + Te$(101) + " " + ct(nbrm) :EndIf
 If nbrm = > 1000 And nbrm < 2000:a$ = b$ + " " + Te$(1) + " " + mil(nbrm):EndIf
 If nbrm = > 2000:a$ = b$ + " " + mil(nbrm):EndIf 
 ProcedureReturn a$ 
EndProcedure

Procedure.s mn(nbr)
 u = nbr/1000000 :t = nbr % 1000000:If u = 1:p$= " ":Else:p$ = "s ":EndIf  
     If u > 99:m$ = ct(u):Else:m$ = CCR(u):EndIf
     If t > 0 
      Select Len(Str(t))
       Case 1,2
         r$ = CCR(t)
       Case 3
         r$ = ct(t)
       Case 4,5 
         r$ = mil(t)
       Case 6 
         r$ = cmil(t)
     EndSelect
    EndIf 
    a$ = m$ + " " + Te$(102) + p$ + r$ 
    ProcedureReturn a$
EndProcedure  

Procedure.s AC(cd);analyse chiffres
  nbr = Int(cd)
  Select Len(Str(cd))
   Case 1,2 ;unités, dizaines  
     a$ =  CCR(nbr)
   Case 3; centaines
     a$ = ct(nbr)
   Case 4,5 ;1000 - 99999  
    a$ = mil(nbr)
   Case 6 ;centaine de mille
     a$ = cmil(nbr)
   Case 7 To 9;million
     a$ =  mn(nbr)
 EndSelect
 ProcedureReturn a$  
EndProcedure

OpenWindow(1,720,75,1300,230,"",#PB_Window_BorderLess|#PB_Window_ScreenCentered)
SetWindowColor(1,$C0B65C)
StickyWindow(1,1)
SetWindowLongPtr_(WindowID(1), #GWL_STYLE, GetWindowLongPtr_(WindowID(1), #GWL_STYLE) | #WS_DLGFRAME)
SetWindowPos_(WindowID(1), 0,0,0,0,0,#SWP_NOSIZE|#SWP_NOMOVE|#SWP_NOZORDER|#SWP_FRAMECHANGED)
TextGadget(2, 10,10,700,40,"Convertisseur de chiffres en lettres pour l'euro")
SetGadgetFont(2,FontID1):SetGadgetColor(2,#PB_Gadget_BackColor,$C0B65C):SetGadgetColor(2,#PB_Gadget_FrontColor,$FFFFFF)
TextGadget(3,953,35,230,30,"Inscrivez un chiffre")
SetGadgetFont(3,FontID2):SetGadgetColor(3,#PB_Gadget_BackColor,$C0B65C):SetGadgetColor(3,#PB_Gadget_FrontColor,$FFFFFF)
TextGadget(4,50,120,230,30,"Résultat")
SetGadgetFont(4,FontID2):SetGadgetColor(4,#PB_Gadget_BackColor,$C0B65C):SetGadgetColor(4,#PB_Gadget_FrontColor,$FFFFFF)
TextGadget(5,20,160,1250,30,"",#PB_Text_Center|#PB_Text_Border)
SetGadgetFont(5,FontID3):SetGadgetColor(5,#PB_Gadget_BackColor,$7AA0FF):SetGadgetColor(5,#PB_Gadget_FrontColor,$EE0000)
TextGadget(6,280,195,350,20,"")
SetGadgetFont(6,FontID5):SetGadgetColor(6,#PB_Gadget_BackColor,$C0B65C):SetGadgetColor(6,#PB_Gadget_FrontColor,$FF0000)
StringGadget(10,955,80,205,30,""):SetActiveGadget(10)
SendMessage_(GadgetID(10),#EM_LIMITTEXT,12, 0)
SetGadgetFont(10,FontID3):SetGadgetColor(10,#PB_Gadget_BackColor,$A2983C):SetGadgetColor(10,#PB_Gadget_FrontColor,$00FFFF)
ButtonColorGadget(12,825,65,90,50,"OK",FontID4,$E0FFFF,$95993C,0)
ButtonColorGadget(13,890,190,80,35,"Aide",FontID3,$E0FFFF,$0066CD,0)
ButtonColorGadget(14,970,190,80,35,"P - P",FontID3,$E0FFFF,$CD0000,0)
ButtonColorGadget(15,1050,190,80,35,"Efface ",FontID3,$E0FFFF,$CD5969,0)
ButtonColorGadget(16,1130,190,80,35,"Barre " + Chr(8645),FontID3,$E0FFFF,$008B00,0)
ButtonColorGadget(17,1210,190,60,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 10
         string_NumericD(10) 
         Select EventType()
           Case #PB_EventType_Change
             SetGadgetText(5,""):SetGadgetText(6,"")
         EndSelect    
       Case 12;bt ok
        z$ = GetGadgetText(10):D = FindString(z$,".")
        If D  <> 0
         u = (Len(z$) - D)
         If u = 1:p = FindString(z$,"."):z$ = Left(z$,p) + "0" + Right(z$,1):EndIf 
         v = (Len(z$) - D)
         d$ = CCR(Val(Right(z$,v))):a$ = ac(Val(Left(z$,D -1)))
         If Val(Left(z$,D -1)) > 1:eur$ = "euros":Else:eur$ = "euro":EndIf 
         If Val(Right(z$,v)) > 1:ct$ = " centimes":Else:ct$ = " centime":EndIf 
         rl$ = a$ +" " + eur$   + " " + d$ + ct$
        Else
         a$ = ac(Val(z$)):If Val(z$) > 1:eur$ = "euros":Else:eur$ = "euro":EndIf 
         rl$ = a$ + " " + eur$
        EndIf
        SetGadgetText(5,rl$)
        SetGadgetText(10,z$):GestionCaret(10):SetActiveGadget(10)
      Case 13;aide
        MessageRequester("Logiciel CEL (MLD 2021)",LT$,#PB_MessageRequester_Ok | #PB_MessageRequester_Info)   
       Case 14;bt presse papier
        ClearClipboard()
        SetGadgetText(6,"Inscription dans le presse-papier effectuée")
        SetClipboardText(GetGadgetText(5)):SetActiveGadget(10)
       Case 15;bt efface
        SetGadgetText(6,""):SetGadgetText(5,""):SetGadgetText(10,""):SetActiveGadget(10)
       Case 16;bt barre
        ShowWindow_(WindowID(1),#SW_MINIMIZE)    
       Case 17;bt stop
        CloseWindow(1)
        Break    
    EndSelect
  EndIf
ForEver
End

Toutes remarques sera la bienvenue

Michel

jak64 · Message par **jak64** » jeu. 22/avr./2021 11:18

Bonjour MLD,
Très intéressant ce programme.
merci.

Marc56 · Message par **Marc56** » jeu. 22/avr./2021 12:54

Quelques petits bugs et suggestions:

Conformité: En principe, il faut afficher ET s'il y a des centimes (un euro et dix centimes)
Conformité: On ne doit pas afficher les centimes s'il n'y en a pas (10.00 € doit écrire "dix euros")
Bug: 100000 affiche juste euros et oublie cent mille
Bug: 200000 affiche... "2 euros" etc
Oubli: 1000000 affiche "un million euro" (manque le « d' » )
Bug: Si une seule décimale, c'est faux (1.2 affiche "1 euro deux centimes" au lieu de "un euro et vingt centimes")
Conformité: Enfin, il faut ajouter un remplissage avant et après "ex: ###" pour empêcher l'agrandissement

Tout ça de mémoire car ça fait 15 ans que j'ai du écrire un programme qui remplissait des lettres chèque et donc potasser avant 10 pages de documentation bancaire pour la mise en conformité (attention un tas de programmes et conseils sur le net ne sont pas conformes)
On a de la chance que les nombreuses réformes d'orthographe aient simplifiées le truc. Maintenant on peut tout mettre au singulier et ignorer les tirets.
Avant c'était:
80 : quatre-vingts
90 : quatre-vingt-dix
etc
Le programme avait plus de lignes de gestion des exceptions que le reste du code, même s'il était écrit en Perl.

MLD · Message par **MLD** » jeu. 22/avr./2021 17:02

@Marc56
Bonsoir
Merci pour les remarques.

Ok il y a un bug dans le calcul des centaines de mille.
j'ai vu le problème. Je fait une modif demain, car pas le temps ce soir .
Pour 1.2 affiche un euro deux centimes, c'est voulue. Tu ne dit pas a ta boulangère je voudrais une baguette a un euro deux

Mais une baguette a un euro 20 centimes, ou un euro 20 (1,20)

Pour le million euros ou million d'euros, il me semble que les deux sont valable. on ne dit pas un million 250 mille d'euro

pour le reste tu as raison, mais pas vraiment tous au singulier

Bonne soirée a toi.
Michel

MLD · Message par **MLD** » ven. 23/avr./2021 13:35

Bonjour
Bug rectifié.code dans le 1er post

Pour faire plaisir a Marc56

Lhistoire du 1.2 euro devient 1.02 euro soit un euro deux centime, si l'on inscrit pas 1.20.
Pas d'hésitation pour d'autres remarques.

Michel

PureBasic

Cheques et documents facile

Cheques et documents facile

Re: Cheques et documents facile

Re: Cheques et documents facile

Re: Cheques et documents facile

Re: Cheques et documents facile