Nombres en lettres

Invité · 05/10/2014, 21h11

bonjour à tous,

j'ai passé beaucoup de temps à chercher un équivalent de morefun (pour excel) que j'utilisais pour mettre des nombres en lettres dans excel pour Delphi.

je suis donc parti de 2 codes que j'ai modifier pour avoir des nombres en français et en anglais, sur 2 décimales en utilisant 2 fonctions ayant la même structure.
j'y ai ajouté des fonctions diverses dont j'ai eu besoin en même temps et qui n'ont rien à voir...

je n'ai pas écris ces codes, je les ai simplement modifié tous les 2 pour avoir des fonctions supportant les nombres négatifs, les décimales et pouvoir modifier les devise.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
unit fctsUtiles;
 
interface        
 
function IIf(b: boolean; vrai: Integer;  faux: Integer ): Integer;  overload;
function IIf(b: boolean; vrai: String;   faux: String  ): String;   overload;
function IIf(b: boolean; vrai: Extended; faux: Extended): Extended; overload;
 
function estEntier(saisie: string): Boolean;
function estNombre(saisie: string): Boolean;
 
function arrondir(float: Extended):Integer; overload;
function arrondir(float: Extended; arrondi: Integer):Extended; overload;
 
function MotsMajuscule(phrase: string): string;
function PhrasesMajuscule(phrase: string): string;
function NombreEnLettreEN(myNumber: string;
                          pbNum: Boolean = True;
                          ptCur: String = 'pound';
                          ptDec: String = 'pence';
                          ptPlu: String = 's'): string;
function NombreEnLettreFR(nombre: string;
                          pbNum:Boolean = True;
                          ptCur: String = 'euro';
                          ptDec: String = 'cent';
                          ptPlu: String = 's'):String;
 
implementation
 
uses SysUtils, StrUtils, Math;   
 
function IIf(b: boolean; vrai: Integer; faux: Integer): Integer;
begin
  if b then Result := vrai else Result := faux;
end;
 
function IIf(b: boolean; vrai: String; faux: String): String;
begin
  if b then Result := vrai else Result := faux;
end;
 
function IIf(b: boolean; vrai: Extended; faux: Extended): Extended;
begin
  if b then Result := vrai else Result := faux;
end;
 
 
function estEntier(saisie: string): Boolean; 
var
  nb: Integer;
  errorPos: Longint;
begin   
  Val(saisie, nb, errorPos);
  Result := errorPos = 0;  
end;  
 
function estNombre(saisie: string): Boolean;
var
  nb: Extended;
  errorPos: Integer;
begin
  Val(StringReplace(saisie, DecimalSeparator, '.', [rfReplaceAll]), nb, errorPos);
  Result := errorPos = 0;
end;
 
function arrondir(float: Extended):Integer;
begin
  Result := Trunc(float);
  if (Abs(Int(Frac(float)*10)) > 4) then
    if float > 0 then
      Result := Result + 1
    else
      Result := Result - 1;
end;
 
function arrondir(float: Extended; arrondi: Integer):Extended; overload;
begin
  Result := arrondir(float * Power(10, arrondi)) / Power(10, arrondi);
end;
 
 
function MotsMajuscule(phrase: string): string;
// mettre la première lettre de tous les mots d'une phrase en majuscule,
// les autres en minuscule
var
  modifier: Boolean;
  i: Integer;
  chaine: string;
begin
  modifier := True;
  chaine := '';
  phrase := LowerCase(Trim(phrase));
 
  for i := 1 to Length(phrase) do begin
    if (phrase[i] in ['a'..'z']) then begin
      if modifier then begin
        chaine := chaine + UpperCase(phrase[i]);
        modifier := False;
      end
      else
        chaine := chaine + phrase[i];
    end
    else begin
      chaine := chaine + phrase[i];
      modifier := True;
    end;
  end;
 
  Result := chaine;
end;
 
 
function PhrasesMajuscule(phrase: string): string;
// mettre la première lettre de chaque phrase en majuscule
// le reste en minuscule
var
  modifier: Boolean;
  i: Integer;
  chaine: string;
begin
  modifier := True;
  chaine := '';
  phrase := LowerCase(Trim(phrase));
 
  for i := 1 to Length(phrase) do begin
    if phrase[i] in ['a'..'z'] then begin
      if modifier then begin
        chaine := chaine + UpperCase(phrase[i]);
        modifier := False;
      end
      else
        chaine := chaine + phrase[i];
    end
    else begin
      if (phrase[i] in ['.', '!', '?', ':']) then
        modifier := True;
      chaine := chaine + phrase[i];
    end;
  end;
 
  Result := chaine;
end;  
 
 
(*
'' VBA functions hacked from TechNet Q140704
'' Internationalised by Andy Wiggins, Byg Software Limited
'' Cheque preparation and printing added by Andy Wiggins
 
''Public Const ctCur = "Pound"    '' Change these descriptions for your country's currency
''Public Const ctDec = "Pence"
'''Public Const ctPlu = "s"       '' You may need to uncomment this for your country's currency - see the next note about Britain.
''Public Const ctPlu = ""         '' British "Hoho" : Pence is used as the singular and plural, .'. no need for an "s"
 
'' ***************************************************************************
'' Purpose  : Spell a number
'' Written  : 1995 by Andy Wiggins, Byg Software Limited
'' Modified : 11-Nov-2002 by Andy Wiggins, Byg Software Limited
''
'' There are four optional parameters to the "SpellNumber" function.
'' ptCur is the main currency name.
'' ptDec is the sub currency name
'' ptPlu covers strange instances such as the "British Hoho" where Pence is used as the singular and plural, .'. no need for an "s"
'' pbNum is TRUE to show decimals as numbers or FALSE to show decimal as words
*)
function NombreEnLettreEN(myNumber: string;
                          pbNum: Boolean = True;
                          ptCur: String = 'pound';
                          ptDec: String = 'pence';
                          ptPlu: String = 's'): string;
 
  (********************************************
   * Converts a number from 1 to 9 into text. *
   ********************************************)
  function getDigit(digit: string): string;
  begin
    case StrToInt(digit) of
      1: GetDigit   := 'one';
      2: GetDigit   := 'two';
      3: GetDigit   := 'three';
      4: GetDigit   := 'four';
      5: GetDigit   := 'five';
      6: GetDigit   := 'six';
      7: GetDigit   := 'seven';
      8: GetDigit   := 'eight';
      9: GetDigit   := 'nine';
      else GetDigit := '';
    end;
  end;
 
  (**********************************************
   * Converts a number from 10 to 99 into text. *
   **********************************************)
  function getTens(tensText: string): string;
  var
    txt: string;
  begin
    txt := '';
    if LeftStr(tensText, 1) = '1' then           // 10-19
      case StrToInt(tensText) of
        10: txt := 'ten';
        11: txt := 'eleven';
        12: txt := 'twelve';
        13: txt := 'thirteen';
        14: txt := 'fourteen';
        15: txt := 'fifteen';
        16: txt := 'sixteen';
        17: txt := 'seventeen';
        18: txt := 'eighteen';
        19: txt := 'nineteen';
      end
    else begin
      if LeftStr(tensText, 1) <> '0' then        // 20-99
        // gestion dizaine
        case StrToInt(LeftStr(tensText, 1)) of
          2: txt := 'twenty ';
          3: txt := 'thirty ';
          4: txt := 'forty ';
          5: txt := 'fifty ';
          6: txt := 'sixty ';
          7: txt := 'seventy ';
          8: txt := 'eighty ';
          9: txt := 'ninety ';
        end;
      // gestion unité
      txt := txt + getDigit(RightStr(tensText, 1));
    end;
    Result := txt;
  end;
 
  (********************************************
   * Converts a number from 100-999 into text *
   ********************************************)
  function getHundreds(myNumber000: string): string;
  var
    txt: string;
  begin        
    if not estEntier(myNumber000) then Exit;
    txt := '';
    myNumber000 := RightStr('000' + myNumber000, 3);
 
    // gestion de la centaine
    if MidStr(myNumber000, 1, 1) <> '0' then
      txt := getDigit(MidStr(myNumber000, 1, 1)) + ' hundred ';
 
    // gestion des dizaine
    if MidStr(myNumber000, 2, 2) <> '00' then
      txt := txt + GetTens(MidStr(myNumber000, 2, 2))
    else
      txt := txt + GetDigit(MidStr(myNumber000, 1, 3));
 
    Result := txt;
  end;
 
var
  nombTxt, nombAbs: string;
  numEntier: Int64;
  decimPos, count, numDec,
  errorPos: Integer;
  curr, decm, temp,
  sign, vtPHolder: string;
  place: array[0..9] of string;
const
    NON_SUPPORTE: string = 'Not supported';
begin
  Place[2] := ' thousand ';   // mille
  Place[3] := ' million ';    // million
  Place[4] := ' billion ';    // milliard
  Place[5] := ' trillion ';   // billion
  Place[6] := ' quadrillion ';// billiard
 
  Result := NON_SUPPORTE;
 
  myNumber  := Trim(myNumber);
  nombTxt := myNumber; nombAbs := myNumber;
  if (myNumber = '') or (not estNombre(myNumber)) then
    Exit;
 
  // gestion du signe
    if myNumber[1] = '-' then begin
    nombTxt := RightStr(myNumber, Length(myNumber)-1);
    nombAbs := nombTxt;
    sign := 'Minus ';
  end
  else
    sign := '';
 
  // position décimale
  decimPos := AnsiPos(DecimalSeparator, nombTxt);
 
  // controle si longueur supportée
  if Length(nombAbs) > 0 then begin
    if decimPos > 0 then
      nombTxt := LeftStr(nombTxt, decimPos-1);
 
    Val(StringReplace(nombTxt, DecimalSeparator, '.', [rfReplaceAll]), numEntier, errorPos);
    if errorPos > 0 then
      Exit;
  end
  else
    Exit;
 
  nombTxt := IntToStr(numEntier);
 
  // gestion décimales
  numDec := 0;
  if (decimPos > 0) and (decimPos < Length(nombAbs)) then begin
    // gestion des décimales (ne prend que 2 décimales)
    vtPHolder := LeftStr(RightStr(nombAbs, Length(nombAbs) - decimPos) + '00', 3);
    if LeftStr(vtPHolder, 2) = '99' then
      vtPHolder := '99'
    else
      vtPHolder := RightStr('0' + IntToStr(arrondir(StrToInt(vtPHolder) / 10)), 2);
    numDec := StrToInt(vtPHolder);
    if pbNum and (vtPHolder <> '00') then begin
      decm := getTens(vtPHolder);
    end
    else
      decm := '';
  end;
 
  Count := 1;
  while nombTxt <> '' do begin
    temp := getHundreds(RightStr(nombTxt, 3));
    if Temp <> '' then Curr := temp + place[Count] + curr;
    if Length(nombTxt) > 3 then
      nombTxt := LeftStr(nombTxt, Length(nombTxt) - 3)
    else
      nombTxt := '';
    count := count + 1;
  end;
 
  case AnsiIndexStr(curr, ['', 'One']) of
    0: curr := 'No ' + ptCur + 's';
    1: curr := 'One ' + ptCur;
    else curr := curr + ' ' + ptCur + ptPlu;
  end;
 
  case AnsiIndexStr(decm, ['', 'One']) of
    0: decm := ''; //' No ' + ptDec + ptPlu;
    1: decm := ' and ' + Decm + ' ' + ptDec;
    else decm := ' and ' + Decm + ' ' + ptDec + ptPlu;
  end;
 
  Result := sign + curr + decm;
end;
 
 
function NombreEnLettreFR(nombre: string;
                          pbNum: Boolean = True;
                          ptCur: String = 'euro';
                          ptDec: String = 'cent';
                          ptPlu: String = 's'):String;
const
  NON_SUPPORTE: string = 'Non supporté';
  T: array[0..99] of string = ('zero', 'un', 'deux', 'trois', 'quatre', 'cinq', 'six', 'sept', 'huit', 'neuf',
                               'dix', 'onze', 'douze', 'treize', 'quatorze', 'quinze', 'seize', 'dix-sept', 'dix-huit', 'dix-neuf',
                               'vingt', '', '', '', '', '', '', '', '', '',
                               'trente', '', '', '', '', '', '', '', '', '',
                               'quarante', '', '', '', '', '', '', '', '', '',
                               'cinquante', '', '', '', '', '', '', '', '', '',
                               'soixante', '', '', '', '', '', '', '', '', '',
                               'soixante-dix', '', '', '', '', '', '', '', '', '',
                               'quatre-vingt', '', '', '', '', '', '', '', '', '',
                               'quatre-vingt-dix', '', '', '', '', '', '', '', '', '' );
var
  nombTxt, nombAbs, sign, decim: string;
  decimPos, numDec, errorPos: Integer;
  numEntier: Int64;
 
  //Fonction responsable de verifier si la valeur et entre 0 et 9 ----------------
  function Vun(chiffre: string):string;
  var I: integer;
  Begin
    if chiffre = '0' then Exit
    else
      for i:= 1 to 9 do begin
        if chiffre = inttostr(i) then begin
          Vun := T[i];
          Break;
        end
      end;
  end;
  //Fin de la fonctin Vun --------------------------------------------------------
 
  //Fonction responsable de verifier les valeurs entre 10 et 99 ------------------
  function Vdix(nombre: string):string;
  var
    //i: integer;
    s1,s2: string;
    b:boolean;
  begin
    if nombre[1] = '0' then
      Vdix := Vun(nombre[2])
    else begin
      b := false;
      if T[StrToInt(nombre)] <> '' then begin
        Vdix := T[StrToInt(nombre)];
        b := True;
      end;
      if b = false then begin
        if nombre[1] < '7' then begin // moins de soixante-dix
          s1 := nombre[1]+'0';
          s2 := nombre[2];
          if s2 = '1' then
             Vdix := Vdix(s1) + '-et-' + Vun(s2)
          else
             Vdix := Vdix(s1) + '-' + Vun(s2)
        end//if moins de soixante-dix
        else begin //superieur a soixante-dix
          case nombre[1] of
            '7':
              begin
                s1 := '60';
                s2 := '1' + nombre[2];
                if s2='11' then
                  Vdix := Vdix(s1) + '-et-' + Vdix(s2)
                else
                  Vdix := Vdix(s1) + '-' + Vdix(s2)
              end;//'7'
            '8':
              begin
                s1 := nombre[1] + '0';
                s2 := nombre[2];
                if s2 = '1' then
                  Vdix := Vdix(s1) + '-et-' + Vun(s2)
                else
                  Vdix := Vdix(s1) + '-' + Vun(s2)
              end;// '8'
            '9':
              begin
                s1 := '80';
                s2 := '1' + nombre[2];
                if s2 = '11' then
                  Vdix := Vdix(s1) + '-et-' + Vdix(s2)
                else
                  Vdix := Vdix(s1) + '-' + Vdix(s2)
              end;// '9'
          end; //case
        end; //else superieur a soixante-dix
      end; // T <> ''
    end; // b
  end;
  //Fin de la Fonctiin Vdix ------------------------------------------------------
 
  //Fonction responsable de verifier les valeurs entre 100 et 999 ----------------
  function Vcent(nombre: string):string;
  var s: string;
  begin
    if nombre = '100' then Vcent := 'cent'
    else begin
      if nombre[1] = '0' then begin
        delete(nombre, 1, 1);
        Vcent := Vdix(nombre);
      end
      else
      if nombre[1] = '1' then begin
        delete(nombre, 1, 1);
        Vcent := 'cent ' + Vdix(nombre);
      end
      else begin
        s := Vun(nombre[1]) + ' cent ';
        delete(nombre, 1, 1);
        Vcent := s + Vdix(nombre);
      end
    end
  end;
  //Fin de la Fonction Vcent -----------------------------------------------------
 
  //Fonctin responsable de verifier les valeurs entre 1000 et 9999----------------
  function Vmille(nombre: string):string;
  var s: string;
  begin
    if nombre = '1000' then Vmille := 'mille'
    else if nombre[1] = '0' then begin
      delete(nombre, 1, 1);
      Vmille := Vcent(nombre);
    end
    else if nombre[1] = '1' then begin
      delete(nombre, 1, 1);
      Vmille := 'mille ' + Vcent(nombre);
    end
    else begin
      s := Vun(nombre[1]) + ' mille ';
      delete(nombre, 1, 1);
      Vmille := s + Vcent(nombre);
    end;
  end;
  //Fin de la fonction Vmille ----------------------------------------------------
 
  //Fonctin responsable de verifier les valeurs entre 10000 et 99999--------------
  function Vdixmille(nombre: string):string;
  var s: string;
  begin
    if nombre[1] = '0' then begin
      delete(nombre, 1, 1);
      Vdixmille := Vmille(nombre);
    end
    else begin
      s := Vdix(nombre[1] + nombre[2]) + ' mille ' ;
      delete(nombre, 1, 2);
      Vdixmille := s + Vcent(nombre);
    end;
  end;
  //Fin de la fonction Vdixmille -------------------------------------------------
 
  //Fonctin responsable de verifier les valeurs entre 100000 et 999999------------
  function Vcentmille(Nombre: string):string;
  var s: string;
  begin
    if Nombre[1] = '0' then begin
      delete(Nombre, 1, 1);
      Vcentmille := Vdixmille(Nombre);
    end
    else begin
      s := Vcent(Nombre[1] + Nombre[2] + Nombre[3]) + ' mille ';
      delete(Nombre, 1, 3);
      Vcentmille := S + Vcent(Nombre);
    end
  end;
  //Fin de la fonction Vcentmille ------------------------------------------------
 
  //Fonctin responsable de verifier les valeurs entre 1000000 et 9999999----------
  function Vmillion(nombre: string):string;
  var s: string;
  begin
   if nombre[1] = '0' then begin
     delete(nombre, 1, 1);
     Vmillion := Vcentmille(nombre);
   end
   else begin
     if nombre[1] = '1' then
      S := Vun(nombre[1]) + ' million '
     else
      s := Vun(nombre[1]) + ' millions ';
     delete(nombre, 1, 1);
     Vmillion := s + Vcentmille(nombre);
   end;
  end;
  //Fin de la fonction Vmillion --------------------------------------------------
 
  //Fonctin responsable de verifier les valeurs entre 10000000 et 99999999--------
  function Vdixmillion(nombre: string):string;
  var s: string;
  begin
    if nombre[1] = '0' then begin
      delete(nombre, 1, 1);
      Vdixmillion := Vmillion(nombre);
    end
    else begin
      s := Vdix(nombre[1] + nombre[2]) + ' millions ';
      delete(nombre, 1, 2);
      Vdixmillion := S + Vcentmille(nombre);
    end
  end;
  //Fin de la fonction Vdixmillion -----------------------------------------------
 
  //Fonctin responsable de verifier les valeurs entre 100000000 et 999999999------
  function Vcentmillion(nombre: string):string;
  var s: string;
  begin
    if nombre[1] = '0' then begin
      delete(nombre, 1, 1);
      Vcentmillion := Vdixmillion(nombre);
    end
    else begin
      s := Vcent(nombre[1] + nombre[2] + nombre[3]) + ' millions ';
      delete(nombre, 1, 3);
      Vcentmillion := S + Vcentmille(nombre);
    end;
  end;
  //Fin de la fonction Vcentmillion ----------------------------------------------
 
  //Fonctin responsable de verifier les valeurs entre 1000000000 et 9999999999----
  function Vmilliard(nombre: string):string;
  var s: string;
  begin
    if nombre[1] = '0' then begin
      delete(nombre, 1, 1);
      Vmilliard := Vcentmillion(nombre);
    end
    else begin
      if nombre[1]= '1' then
        s := Vun(nombre[1]) + ' milliard '
      else
        s := Vun(nombre[1]) + ' milliards ';
      delete(nombre, 1, 1);
      Vmilliard := S + Vcentmillion(nombre);
    end;
  end;
  //Fin de la fonction Vmilliard -------------------------------------------------
 
  //Fonctin responsable de verifier les valeurs entre 10000000000 et 99999999999--
  function Vdixmilliard(nombre: string):string;
  var s: string;
  begin
    if nombre[1] = '0' then begin
      delete(nombre, 1, 1);
      Vdixmilliard := Vmilliard(nombre);
    end
    else begin
      s := Vdix(nombre[1] + nombre[2]) + ' milliards ';
      delete(nombre, 1, 2);
      Vdixmilliard := s + Vcentmillion(nombre);
    end;
  end;
  //Fin de la fonction Vdixmilliard ----------------------------------------------
 
  //Fonctin responsable de verifier les valeurs entre 100000000000 et 999999999999
  function Vcentmilliard(nombre: string):string;
  var s: string;
  begin
    if nombre[1] = '0' then begin
      delete(nombre, 1, 1);
      Vcentmilliard := Vdixmilliard(nombre);
    end
    else begin
      s := Vcent(nombre[1] + nombre[2] + nombre[3]) + ' milliards ';
      delete(nombre, 1, 3);
      Vcentmilliard := s + Vcentmillion(nombre);
    end;
  end;
  //Fin de la fonction Vcentmilliard ---------------------------------------------
 
  //Fonctin responsable de verifier les valeurs entre 1000000000000 et 9999999999999
  function Vbillion(nombre: string):string;
  var s: string;
  begin
    if nombre[1] = '0' then
      begin
        delete(nombre, 1, 1);
        Vbillion := Vcentmilliard(Nombre);
      end
    else begin
      if nombre[1] = '1' then
        s := Vun(nombre[1]) + ' billion '
      else
        s := Vun(nombre[1]) + ' billions ';
      delete(nombre, 1, 1);
      Vbillion := s + Vcentmilliard(nombre);
    end;
  end;
  //Fin de la fonction Vbillion --------------------------------------------------
 
  //Fonctin responsable de verifier les valeurs entre 10000000000000 et 99999999999999
  function Vdixbillion(nombre: string):string;
  var s: string;
  begin
    if nombre[1] = '0' then begin
      delete(nombre, 1, 1);
      Vdixbillion := Vbillion(nombre);
    end
    else begin
      s := Vdix(nombre[1] + nombre[2]) + ' billions ';
      delete(nombre, 1, 2);
      Vdixbillion := s + Vcentmilliard(nombre);
    end;
  end;
  //Fin de la fonction Vdixbillion -----------------------------------------------
 
  //Fonctin responsable de verifier les valeurs entre 100000000000000 et 999999999999999
  function Vcentbillion(nombre: string):string;
  var s: string;
  begin
    if nombre[1] = '0' then begin
      delete(nombre, 1, 1);
      Vcentbillion := Vdixbillion(nombre);
    end
    else begin
      s := Vcent(nombre[1] + nombre[2] + nombre[3]) + ' billions ';
      delete(nombre, 1, 3);
      Vcentbillion := s + Vcentmilliard(nombre);
    end;
  End;
  //Fin de la fonction Vcentbillion ----------------------------------------------
 
  //Fonctin responsable de verifier les valeurs entre 1000000000000000 et 9999999999999999
  function Vbilliard(nombre: string):string;
  var s: string;
  begin
    if nombre[1] = '0' then begin
      delete(nombre, 1, 1);
      Vbilliard := Vcentbillion(nombre);
    end
    else begin
      if nombre[1] = '1' then
        s := Vun(nombre[1]) + ' billiard '
      else
        s := Vun(nombre[1]) + ' billiards ';
      delete(nombre, 1, 1);
      Vbilliard := s + Vcentbillion(nombre);
    end;
  end;
  //Fin de la fonction Vbilliard -------------------------------------------------
 
  //Fonctin responsable de verifier les valeurs entre 10000000000000000 et 99999999999999999
  function Vdixbilliard(nombre: string):string;
  var s: string;
  begin
    if nombre[1] = '0' then begin
      delete(nombre,1,1);
      Vdixbilliard := Vbilliard(nombre);
    end
    else begin
      s := Vdix(nombre[1] + nombre[2]) + ' billiards ';
      delete(nombre, 1, 2);
      Vdixbilliard := s + Vcentbillion(nombre);
    end;
  end;
  //Fin de la fonction Vdixbilliard -----------------------------------------------
 
  //Fonctin responsable de verifier les valeurs entre 100000000000000000 et 999999999999999999
  function Vcentbilliard(nombre: string):string;
  var s: string;
  begin
    if nombre[1] = '0' then begin
      delete(nombre, 1, 1);
      Vcentbilliard := Vdixbilliard(nombre);
    end
    else begin
      S := Vcent(nombre[1] + nombre[2] + nombre[3]) + ' billiards ';
      delete(nombre, 1, 3);
      Vcentbilliard := S + Vcentbillion(nombre);
    end;
  end;
  //------------------------------------------------------------------------------
begin
  Result := NON_SUPPORTE;
 
  nombre  := Trim(nombre);
  nombTxt := nombre; nombAbs := nombre;
  if (nombre = '') or (not estNombre(nombre)) then
    Exit;
 
  // gestion du signe
  if nombre[1] = '-' then begin
    nombTxt := RightStr(nombre, Length(nombre)-1);
    nombAbs := nombTxt;
    sign := 'moins ';
  end
  else
    sign := '';
 
  // position décimale
  decimPos := AnsiPos(DecimalSeparator, nombTxt);
 
  // controle si longueur supportée
  if Length(nombAbs) > 0 then begin
    if decimPos > 0 then
      nombTxt := LeftStr(nombTxt, decimPos-1);
 
    Val(StringReplace(nombTxt, DecimalSeparator, '.', [rfReplaceAll]), numEntier, errorPos);
    if errorPos > 0 then
      Exit;
  end
  else
    Exit;
 
  nombTxt := IntToStr(numEntier);
 
  // gestion décimales
  numDec := 0;
  if (decimPos > 0) and (decimPos < Length(nombAbs)) then begin
    // gestion des décimales (ne prend que 2 décimales)
    decim := LeftStr(RightStr(nombAbs, Length(nombAbs) - decimPos) + '00', 3);
    if LeftStr(decim, 2) <> '99' then
      decim := RightStr('0' + IntToStr(arrondir(StrToInt(decim) / 10)), 2)
    else
      decim := '99';
    numDec := StrToInt(decim);
    if pbNum and (decim <> '00') then begin
      decim := (*' virgule ' +*)' et ' + Vdix(decim) + ' ' + ptDec;
      if numDec > 1 then
        decim := decim + ptPlu;
    end
    else
      decim := '';
  end;
 
  if length(nombTxt) <> 0 then begin
    if nombTxt = '0' then
      Result := T[0]
    else
      case length(trim(nombTxt)) of
         1: Result := Vun(nombTxt);
         2: Result := Vdix(nombTxt);
         3: Result := Vcent(nombTxt);
         4: Result := Vmille(nombTxt);
         5: Result := Vdixmille(nombTxt);
         6: Result := Vcentmille(nombTxt);
         7: Result := Vmillion(nombTxt);
         8: Result := Vdixmillion(nombTxt);
         9: Result := Vcentmillion(nombTxt);
        10: Result := Vmilliard(nombTxt);
        11: Result := Vdixmilliard(nombTxt);
        12: Result := Vcentmilliard(nombTxt);
        13: Result := Vbillion(nombTxt);
        14: Result := Vdixbillion(nombTxt);
        15: Result := Vcentbillion(nombTxt);
        16: Result := Vbilliard(nombTxt);
        17: Result := Vdixbilliard(nombTxt);
        18: Result := Vcentbilliard(nombTxt);
      end;
 
      Result := Result + ' ' + ptCur;
      if numEntier > 1 then
        Result := Result + ptPlu;
 
    Result := sign + Result + decim;
  end
end;  
 
end.

**ALWEBER** · 06/10/2014, 09h35

Voici une procédure que j'utilise depuis des années chez un client aisément transposable en langage pascal

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
 
method EnToutesLettres(N1 Number,st6 string) string
var
	STaille1,s2 smallint
	st1,st2,st3,st4,st5 string
endvar
	N1 = N1 * 100
	st1 = string (longint(round(N1,0)))
	STaille1 = st1.size()
	st4 = ""
	st5 = ""
	if (STaille1 >=8) then
		st3 = st1.substr (STaille1-7,1)
		switch
			case st3 = "2" : st4 = st4 + "DEUX "
			case st3 = "3" : st4 = st4 + "TROIS "
			case st3 = "4" : st4 = st4 + "QUATRE "
			case st3 = "5" : st4 = st4 + "CINQ "
			case st3 = "6" : st4 = st4 + "SIX "
			case st3 = "7" : st4 = st4 + "SEPT "
			case st3 = "8" : st4 = st4 + "HUIT "
			case st3 = "9" : st4 = st4 + "NEUF "
		endswitch
		if smallint (st3)>0 then st4 = st4 + "CENT " endif
	endif
	if (STaille1 >=6) then
		s2 = iif (STaille1=6,smallint (st1.substr (1,1)),smallint (st1.substr (STaille1-6,2)))
		if s2>1 then
			st4 = st4 + p01 (s2) + " "
		endif
		if (s2>0) or (N1>=100000) then
			st4 = st4 + "MILLE "
		endif
	endif
	if (STaille1 >=5) then
		st3 = st1.substr (STaille1-4,1)
		switch
			case st3 = "2" : st4 = st4 + "DEUX "
			case st3 = "3" : st4 = st4 + "TROIS "
			case st3 = "4" : st4 = st4 + "QUATRE "
			case st3 = "5" : st4 = st4 + "CINQ "
			case st3 = "6" : st4 = st4 + "SIX "
			case st3 = "7" : st4 = st4 + "SEPT "
			case st3 = "8" : st4 = st4 + "HUIT "
			case st3 = "9" : st4 = st4 + "NEUF "
		endswitch
		if smallint (st3)>0 then st4 = st4 + "CENT " endif
	endif
	if (STaille1 >=3) then
		s2 = iif (STaille1=3,smallint (st1.substr (1,1)),smallint (st1.substr (STaille1-3,2)))
		st4 = st4 + p01 (s2)
		st4 = st4 + " "+st6
;		if S2 >1 then st4 = st4 + "S" endif
	endif
	if (STaille1>=2) and (st1.substr (STaille1-1,2)<>"00") then
		st4 = st4 + ", "
		s2 = smallint (st1.substr (STaille1-1,2))
		if s2 = 0 then
			st4 = ST4 + "ZERO"
		else
			st4 = ST4 + p01 (s2)
		endif
; 		st4 = st4 + " CT"
;		if S2 >1 then st4 = st4 + "S" endif
	endif
	if st4.size ()  > 2 then
		st5 = st4.substr(2,st4.size()-1)
		st4 = st4.substr(1,1)
		st4 = st4.upper()
	endif
	st5 = st5.lower()
	return st4+st5
endmethod

Invité · 08/10/2014, 21h34

salut à tous,

ce sujet ne déchaîne pas les foules

en tout cas, je reviens avec un code français modifié.
le précédent était faux, il y avait des erreurs de grammaire, je l'ai donc corrigé.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
unit fctsUtiles;
 
interface        
 
function IIf(b: boolean; vrai: Integer;  faux: Integer ): Integer;  overload;
function IIf(b: boolean; vrai: String;   faux: String  ): String;   overload;
function IIf(b: boolean; vrai: Extended; faux: Extended): Extended; overload;
 
function estEntier(saisie: string): Boolean;
function estNombre(saisie: string): Boolean;
 
function arrondir(float: Extended):Integer; overload;
function arrondir(float: Extended; arrondi: Integer):Extended; overload;
 
function MotsMajuscule(phrase: string): string;
function PhrasesMajuscule(phrase: string): string;
function NombreEnLettreEN(myNumber: string;
                          pbNum: Boolean = True;
                          ptCur: String = 'pound';
                          ptDec: String = 'pence';
                          ptPlu: String = 's'): string;
function NombreEnLettreFR(nombre: string;
                          pbNum:Boolean = True;
                          ptCur: String = 'euro';
                          ptDec: String = 'cent';
                          ptPlu: String = 's'):String;
 
implementation
 
uses SysUtils, StrUtils, Math;   
 
function IIf(b: boolean; vrai: Integer; faux: Integer): Integer;
begin
  if b then Result := vrai else Result := faux;
end;
 
function IIf(b: boolean; vrai: String; faux: String): String;
begin
  if b then Result := vrai else Result := faux;
end;
 
function IIf(b: boolean; vrai: Extended; faux: Extended): Extended;
begin
  if b then Result := vrai else Result := faux;
end;
 
 
function estEntier(saisie: string): Boolean; 
var
  nb: Integer;
  errorPos: Longint;
begin   
  Val(saisie, nb, errorPos);
  Result := errorPos = 0;  
end;  
 
function estNombre(saisie: string): Boolean;
var
  nb: Extended;
  errorPos: Integer;
begin
  Val(StringReplace(saisie, DecimalSeparator, '.', [rfReplaceAll]), nb, errorPos);
  Result := errorPos = 0;
end;
 
function arrondir(float: Extended):Integer;
begin
  Result := Trunc(float);
  if (Abs(Int(Frac(float)*10)) > 4) then
    if float > 0 then
      Result := Result + 1
    else
      Result := Result - 1;
end;
 
function arrondir(float: Extended; arrondi: Integer):Extended; overload;
begin
  Result := arrondir(float * Power(10, arrondi)) / Power(10, arrondi);
end;
 
 
function MotsMajuscule(phrase: string): string;
// mettre la première lettre de tous les mots d'une phrase en majuscule,
// les autres en minuscule
var
  modifier: Boolean;
  i: Integer;
  chaine: string;
begin
  modifier := True;
  chaine := '';
  phrase := LowerCase(Trim(phrase));
 
  for i := 1 to Length(phrase) do begin
    if (phrase[i] in ['a'..'z']) then begin
      if modifier then begin
        chaine := chaine + UpperCase(phrase[i]);
        modifier := False;
      end
      else
        chaine := chaine + phrase[i];
    end
    else begin
      chaine := chaine + phrase[i];
      modifier := True;
    end;
  end;
 
  Result := chaine;
end;
 
 
function PhrasesMajuscule(phrase: string): string;
// mettre la première lettre de chaque phrase en majuscule
// le reste en minuscule
var
  modifier: Boolean;
  i: Integer;
  chaine: string;
begin
  modifier := True;
  chaine := '';
  phrase := LowerCase(Trim(phrase));
 
  for i := 1 to Length(phrase) do begin
    if phrase[i] in ['a'..'z'] then begin
      if modifier then begin
        chaine := chaine + UpperCase(phrase[i]);
        modifier := False;
      end
      else
        chaine := chaine + phrase[i];
    end
    else begin
      if (phrase[i] in ['.', '!', '?', ':']) then
        modifier := True;
      chaine := chaine + phrase[i];
    end;
  end;
 
  Result := chaine;
end;  
 
 
(*
'' VBA functions hacked from TechNet Q140704
'' Internationalised by Andy Wiggins, Byg Software Limited
'' Cheque preparation and printing added by Andy Wiggins
 
''Public Const ctCur = "Pound"    '' Change these descriptions for your country's currency
''Public Const ctDec = "Pence"
'''Public Const ctPlu = "s"       '' You may need to uncomment this for your country's currency - see the next note about Britain.
''Public Const ctPlu = ""         '' British "Hoho" : Pence is used as the singular and plural, .'. no need for an "s"
 
'' ***************************************************************************
'' Purpose  : Spell a number
'' Written  : 1995 by Andy Wiggins, Byg Software Limited
'' Modified : 11-Nov-2002 by Andy Wiggins, Byg Software Limited
''
'' There are four optional parameters to the "SpellNumber" function.
'' ptCur is the main currency name.
'' ptDec is the sub currency name
'' ptPlu covers strange instances such as the "British Hoho" where Pence is used as the singular and plural, .'. no need for an "s"
'' pbNum is TRUE to show decimals as numbers or FALSE to show decimal as words
*)
function NombreEnLettreEN(myNumber: string;
                          pbNum: Boolean = True;
                          ptCur: String = 'pound';
                          ptDec: String = 'pence';
                          ptPlu: String = 's'): string;
 
  (********************************************
   * Converts a number from 1 to 9 into text. *
   ********************************************)
  function getDigit(digit: string): string;
  begin
    case StrToInt(digit) of
      1: GetDigit   := 'one';
      2: GetDigit   := 'two';
      3: GetDigit   := 'three';
      4: GetDigit   := 'four';
      5: GetDigit   := 'five';
      6: GetDigit   := 'six';
      7: GetDigit   := 'seven';
      8: GetDigit   := 'eight';
      9: GetDigit   := 'nine';
      else GetDigit := '';
    end;
  end;
 
  (**********************************************
   * Converts a number from 10 to 99 into text. *
   **********************************************)
  function getTens(tensText: string): string;
  var txt: string;
  begin
    txt := '';
    if LeftStr(tensText, 1) = '1' then           // 10-19
      case StrToInt(tensText) of
        10: txt := 'ten';
        11: txt := 'eleven';
        12: txt := 'twelve';
        13: txt := 'thirteen';
        14: txt := 'fourteen';
        15: txt := 'fifteen';
        16: txt := 'sixteen';
        17: txt := 'seventeen';
        18: txt := 'eighteen';
        19: txt := 'nineteen';
      end
    else begin
      if LeftStr(tensText, 1) <> '0' then        // 20-99
        // gestion dizaine
        case StrToInt(LeftStr(tensText, 1)) of
          2: txt := 'twenty ';
          3: txt := 'thirty ';
          4: txt := 'forty ';
          5: txt := 'fifty ';
          6: txt := 'sixty ';
          7: txt := 'seventy ';
          8: txt := 'eighty ';
          9: txt := 'ninety ';
        end;
      // gestion unité
      txt := txt + getDigit(RightStr(tensText, 1));
    end;
    Result := Trim(txt);
  end;
 
  (********************************************
   * Converts a number from 100-999 into text *
   ********************************************)
  function getHundreds(myNumber000: string): string;
  var txt: string;
  begin        
    if not estEntier(myNumber000) then Exit;
    txt := '';
    myNumber000 := RightStr('000' + myNumber000, 3);
 
    // gestion de la centaine
    if MidStr(myNumber000, 1, 1) <> '0' then
      txt := getDigit(MidStr(myNumber000, 1, 1)) + ' hundred ';
 
    // gestion des dizaine
    if MidStr(myNumber000, 2, 2) <> '00' then
      txt := txt + GetTens(MidStr(myNumber000, 2, 2))
    else
      txt := txt + GetDigit(MidStr(myNumber000, 1, 3));
 
    Result := Trim(txt);
  end;   
var
  nombTxt, nombAbs: string;
  numEntier: Int64;
  decimPos, count, numDec,
  errorPos: Integer;
  curr, decm, temp,
  sign, vtPHolder: string;
const
  NON_SUPPORTE: string = 'Not supported';
  place: array[0..6] of string = ('', '', ' thousand ', ' million ', ' billion ', ' trillion ', ' quadrillion ');
begin
  Result := NON_SUPPORTE;
 
  myNumber  := Trim(myNumber);
  nombTxt := myNumber; nombAbs := myNumber;
  if (myNumber = '') or (not estNombre(myNumber)) then
    Exit;
 
  // gestion du signe
  if myNumber[1] = '-' then begin
    nombTxt := RightStr(myNumber, Length(myNumber)-1);
    nombAbs := nombTxt;
    sign := 'Minus ';
  end
  else
    sign := '';
 
  // position décimale
  decimPos := AnsiPos(DecimalSeparator, nombTxt);
 
  // controle si longueur supportée
  if Length(nombAbs) > 0 then begin
    if decimPos > 0 then
      nombTxt := LeftStr(nombTxt, decimPos-1);
 
    Val(StringReplace(nombTxt, DecimalSeparator, '.', [rfReplaceAll]), numEntier, errorPos);
    if errorPos > 0 then
      Exit;
  end
  else
    Exit;
 
  nombTxt := IntToStr(numEntier);
 
  // gestion décimales
  numDec := 0;
  if (decimPos > 0) and (decimPos < Length(nombAbs)) then begin
    // gestion des décimales (ne prend que 2 décimales)
    vtPHolder := LeftStr(RightStr(nombAbs, Length(nombAbs) - decimPos) + '00', 3);
    if LeftStr(vtPHolder, 2) = '99' then
      vtPHolder := '99'
    else
      vtPHolder := RightStr('0' + IntToStr(arrondir(StrToInt(vtPHolder) / 10)), 2);
    numDec := StrToInt(vtPHolder);
    if pbNum and (vtPHolder <> '00') then begin
      decm := getTens(vtPHolder);
    end
    else
      decm := '';
  end;
 
  Count := 1;
  while nombTxt <> '' do begin
    temp := getHundreds(RightStr(nombTxt, 3));
    if Temp <> '' then Curr := Trim(temp + place[Count] + curr);
    if Length(nombTxt) > 3 then
      nombTxt := LeftStr(nombTxt, Length(nombTxt) - 3)
    else
      nombTxt := '';
    count := count + 1;
  end;
 
  case AnsiIndexStr(curr, ['', 'One']) of
    0: curr := 'No ' + ptCur + 's';
    1: curr := 'One ' + ptCur;
    else curr := Trim(curr + ' ' + ptCur + ptPlu);
  end;
 
  case AnsiIndexStr(decm, ['', 'One']) of
    0: decm := ''; //' No ' + ptDec + ptPlu;
    1: decm := Trim(' and ' + Decm + ' ' + ptDec);
    else decm := Trim(' and ' + Decm + ' ' + ptDec + ptPlu);
  end;
 
  Result := Trim(sign + curr + ' '  + decm);
end;
 
 
function NombreEnLettreFR(nombre: string;
                          pbNum: Boolean = True;
                          ptCur: String = 'euro';
                          ptDec: String = 'cent';
                          ptPlu: String = 's'):String;
 
const
  NON_SUPPORTE: string = 'Non supporté';
  T: array[0..100] of string = ('zero', 'un', 'deux', 'trois', 'quatre', 'cinq', 'six', 'sept', 'huit', 'neuf',
                               'dix', 'onze', 'douze', 'treize', 'quatorze', 'quinze', 'seize', 'dix-sept', 'dix-huit', 'dix-neuf',
                               'vingt', '', '', '', '', '', '', '', '', '',
                               'trente', '', '', '', '', '', '', '', '', '',
                               'quarante', '', '', '', '', '', '', '', '', '',
                               'cinquante', '', '', '', '', '', '', '', '', '',
                               'soixante', '', '', '', '', '', '', '', '', '',
                               'soixante-dix', '', '', '', '', '', '', '', '', '',
                               'quatre-vingt', '', '', '', '', '', '', '', '', '',
                               'quatre-vingt-dix', '', '', '', '', '', '', '', '', '',
                               'cent');
  Place: array[0..6] of string = ('', '', 'mille', 'million', 'milliard', 'billion', 'billiard');
 
  function unites(nombre: string): string;
  begin
    Result := T[StrToInt(nombre)];
  end;
 
  function dixaines(nombre: string): string;
  var s1, s2: string;
  begin
    s1 := T[StrToInt(nombre)];
    nombre := RightStr('0' + nombre, 2);
    if s1 <> '' then
      Result := s1
    else begin
      if (nombre[1] = '7') or (nombre[1] = '9') then begin
        s1 := T[StrToInt(nombre[1] + '0') - 10];
        s2 := T[StrToInt('1' + nombre[2])];
      end
      else begin
        s1 := T[StrToInt(nombre[1] + '0')];
        s2 := unites(nombre[2]);
      end;
      if (nombre[2] = '1') and (nombre[1] <> '8') and (nombre[1] <> '9') then
        Result := s1 + ' et ' + s2
      else
        Result := s1 + '-' + s2;
    end;
    if nombre = '80' then
      Result := Result + ptPlu;
  end;
 
  function centaines(nombre: string): string;
  var s1, s2: string;
  begin
    Result := T[100];
    if nombre = '100' then Exit;
    nombre := RightStr('00' + nombre, 3);
    if nombre[2] + nombre[3] = '00' then
      s2 := ''
    else
      s2 := ' ' + dixaines(nombre[2] + nombre[3]);
    if (nombre[1] = '0') and (s2 = '') then Result := T[0]
    else if nombre[1] = '0' then Result := s2
    else begin
      s1 := 'cent';
      if nombre[1] <> '1' then begin
        s1 := unites(nombre[1]) + ' ' + s1;
        if nombre[2] + nombre[3] = '00' then
          s1 := s1 + ptPlu;
      end;
      Result := s1 + s2;
    end;
  end;
var
  nombTxt, nombAbs, sign, decim, temp, curr: string;
  decimPos, numDec, errorPos, count: Integer;
  numEntier: Int64;
begin
  Result := NON_SUPPORTE;
 
  nombre  := Trim(nombre);
  nombTxt := nombre; nombAbs := nombre;
  if (nombre = '') or (not estNombre(nombre)) then
    Exit;
 
  // gestion du signe
  if nombre[1] = '-' then begin
    nombTxt := RightStr(nombre, Length(nombre)-1);
    nombAbs := nombTxt;
    sign := 'moins ';
  end
  else
    sign := '';
 
  // position décimale
  decimPos := AnsiPos(DecimalSeparator, nombTxt);
 
  // controle si longueur supportée
  if Length(nombAbs) > 0 then begin
    if decimPos > 0 then
      nombTxt := LeftStr(nombTxt, decimPos-1);
 
    Val(StringReplace(nombTxt, DecimalSeparator, '.', [rfReplaceAll]), numEntier, errorPos);
    if errorPos > 0 then
      Exit;
  end
  else
    Exit;
 
  nombTxt := IntToStr(numEntier);
 
  // gestion décimales
  numDec := 0;
  if (decimPos > 0) and (decimPos < Length(nombAbs)) then begin
    // gestion des décimales (ne prend que 2 décimales)
    decim := LeftStr(RightStr(nombAbs, Length(nombAbs) - decimPos) + '00', 3);
    if LeftStr(decim, 2) <> '99' then
      decim := RightStr('0' + IntToStr(arrondir(StrToInt(decim) / 10)), 2)
    else
      decim := '99';
    numDec := StrToInt(decim);
    if pbNum and (decim <> '00') then begin
      decim := (*' virgule ' +*)' et ' + dixaines(decim) + ' ' + ptDec;
      if numDec > 1 then
        decim := decim + ptPlu;
    end
    else
      decim := '';
  end;
 
  count := 1;
  curr := '';
  while nombTxt <> '' do begin
    temp := Trim(centaines(RightStr(nombTxt, 3)));
    if curr = '' then
      curr := temp
    else begin
      if curr = T[0] then
        curr := ''
      else if temp = T[0] then temp := '';
 
      // suppression du s de 80 et 100 avant mille
      if (count = 2) then begin
        if (Length(temp) > 4) and (RightStr(temp, 5) = 'cents') then
          Delete(temp, Length(temp), 1)
        else if (Length(temp) > 5) and (RightStr(temp, 6) = 'vingts') then
          Delete(temp, Length(temp), 1);
      end;
 
      // pluriel au dessus des milliers
      if temp <> T[0] then begin
        if (count > 2) and (StrToInt(RightStr(nombTxt, 3)) > 1) then
          curr := Trim(temp + ' ' + place[Count] + ptPlu + ' ' + curr)
        else
          curr := Trim(temp + ' ' + place[Count] + ' ' + curr);
        if (count = 2) and (StrToInt(RightStr(nombTxt, 3)) = 1) then Delete(curr, 1, Length(temp)); // un mille
      end
      else
        curr := temp;
    end;
    if Length(nombTxt) > 3 then
      nombTxt := LeftStr(nombTxt, Length(nombTxt) - 3)
    else
      nombTxt := '';
    count := count + 1;
  end;
  curr := curr + ' ' + ptCur;
 
  if numEntier > 1 then
    curr := curr + ptPlu;
 
  Result := sign + curr + decim;
end;  
 
end.

a+
ben

**SergioMaster** · 09/10/2014, 10h12

Bonjour,

Envoyé par benoit1024

ce sujet ne déchaîne pas les foules

Non, car on utilise rarement les chiffres en lettres . Dans ma carrière j'ai du l'utiliser 3 fois ! dans des langages différents , par contre lorsque j'étais prof d'info c'était un de mes exercices favoris

à l'époque où la taille de la mémoire était petite , c'était un très bon exercice pour limiter la taille des tableaux (j'ai eu des élèves me disant que c'était trop long à écrire

je laisse imaginer pourquoi

)

par exemple ces tableaux

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
T: array[0..100] of string = ('zero', 'un', 'deux', 'trois', 'quatre', 'cinq', 'six', 'sept', 'huit', 'neuf',
                               'dix', 'onze', 'douze', 'treize', 'quatorze', 'quinze', 'seize', 'dix-sept', 'dix-huit', 'dix-neuf',
                               'vingt', '', '', '', '', '', '', '', '', '',
                               'trente', '', '', '', '', '', '', '', '', '',
                               'quarante', '', '', '', '', '', '', '', '', '',
                               'cinquante', '', '', '', '', '', '', '', '', '',
                               'soixante', '', '', '', '', '', '', '', '', '',
                               'soixante-dix', '', '', '', '', '', '', '', '', '',
                               'quatre-vingt', '', '', '', '', '', '', '', '', '',
                               'quatre-vingt-dix', '', '', '', '', '', '', '', '', '',
                               'cent');
  Place: array[0..6] of string = ('', '', 'mille', 'million', 'milliard', 'billion', 'billiard');

on pourrait les voir autrement (gros avantage à Delphi qui permet des tableaux indice 0 ou 1)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Unite    : array [0..9] of string = ('zero', 'un', 'deux', 'trois', 'quatre', 'cinq', 'six', 'sept', 'huit', 'neuf');
Dizaine  : array [1..7] of string =('dix','vingt','trente','quarante','cinquante','soixante','quatre-vingt');
DizSP : array[1..6] of string = ('onze','douze','treize','quatorze','quinze','seize');
T : array[1..6] of string =  ('cent','mille','million','milliard','billion','billiard');

Bref chacun a ses petites manies , il faudrait que je retrouve ce que j'ai fait en Delphi (pour preuve que cela ne sert pas souvent , je ne sais même pas où j'aurais pu l'utiliser )

**GoustiFruit** · 09/10/2014, 16h32

Envoyé par SergioMaster

Bref chacun a ses petites manies , il faudrait que je retrouve ce que j'ai fait en Delphi (pour preuve que cela ne sert pas souvent , je ne sais même pas où j'aurais pu l'utiliser )

A la compta, pour remplir des chèques automatiquement ?

**Roland Chastain** · 09/10/2014, 21h04

Bonjour ! Je signale qu'il y a dans la FAQ un article consacré à ce sujet : Transformer un nombre entier en lettres

P.-S. Non seulement un article mais une belle unité prête à l'emploi. (Sur l'auteur ou les auteurs du code, voir cette discussion.)

Invité · 09/10/2014, 21h08

pour ma part, j'en ai vu l'utilité pour faire des factures.
c'est difficile de trouver des fonctions qui fonctionnent correctement avec des décimales, sans fautes, en anglais et français.

c'est effectivement un très bon exercice, il y a plein de méthode de faire...

**SergioMaster** · 10/10/2014, 07h10

Bonjour,

Envoyé par GoustiFruit

A la compta, pour remplir des chèques automatiquement ?

Ça fait belle lurette que c'est des virements ! en tout cas lorsque je me suis mis à Delphi (1998) c'était déjà le cas dans la société . Avant dans d'autres langages (GAP, COBOL, BASIC, ABAL) je ne dis pas mais là , j'ai plus ces sources < 1995

Envoyé par Benoit1024

j'en ai vu l'utilité pour faire des factures.

Tous les états factures que j'ai pu faire , n'avais jamais cette spécificité , donc ce n'est pas encore dans cette direction que je vais chercher dans mes vieux sources .

c'est difficile de trouver des fonctions qui fonctionnent correctement avec des décimales, sans fautes, en anglais et français.

c'est sur que le multilingue poserai de drôles de difficultés ! impossible, je pense , d'utiliser TKLang, dgGettext ou autres outils la "grammaire" différente implique automatiquement une fonction différente

**GoustiFruit** · 10/10/2014, 11h50

Envoyé par SergioMaster

Bonjour,

Ça fait belle lurette que c'est des virements ! en tout cas lorsque je me suis mis à Delphi (1998) c'était déjà le cas dans la société . Avant dans d'autres langages (GAP, COBOL, BASIC, ABAL) je ne dis pas mais là , j'ai plus ces sources < 1995

Les impôts aussi. J'ai reçu un chèque de leur part cette année...

Nombres en lettres

Contribuez Delphi

Discussions similaires

Partager

Partager