Newsgroup: it.comp.lang.delphi
Titolo: da cifre in lettere

Esiste una funzione che converte i valori numerici in lettere??
ad esempio
123
centoventitre
Grazie

Su torry ne ho visti, anche in italiano
----------------------------
Saluti
Andrea
----------------------------

Dove sono, non riesco a trovarli....


Preso, copiato ed incollato da libero.mrcoke-repository.
Sono ambasciatore, non so la validità dell'insieme.
Ciao
Marco
-- 
MaoSw
Reporter Professional srl
supporto...@reporterprofessional.it
---------------------------------------------------------------------------
Questa e' una unit scritta in gioventu' (infatti originariamente era per
delphi 2), quindi non e' che sia il massimo delle mie capacita'
programmatorie, che serve per la conversione in lettere di una cifra.
Nonostante al suo interno abbia numerose funzioni e procedure (che non
mi ricordo piu' come funzionano...), esporta una sola funzione:
  function Num2Lett(StrNum: string): string;
che si aspetta come parametro una stringa che contiene il numero da
convertire (Es. '100.150') e restituisce la stringa
'CENTOMILACENTOCINQUANTA'. La funzione ignora completamente i caratteri
che non siano le cifre da 0 a 9, e restituisce 'error' solo se non c'e'
nessuna cifra nella stringa passata, altrimenti converte lo stesso. Nel
caso di prima '100a150', '100asdf150' darebbero lo stesso risultato (ma
non e' difficile modificare il codice per restituire l'errore anche in
questi casi), mentre 'asdf' darebbe 'error'.
La sintassi non varrebbe la pena di segnalarla, ma per completezza...
cifralett := Num2Lett(cifranum)
dove cifranum e' la stringa che rappresenta il valore da convertire (es:
se cifranum = '1234567' allora cifralett =
'unmilioneduecentotrentaquattromilacinquecentosessantasette' (tutto in
uppercase).
P.S. Se preferite potete modificare la funzione in modo che accetti un
double o un longint in ingresso, basta fare la conversione a stringa
all'interno della funzione
--
Mr Coke -- D&D Provider
unit Num2Word;
interface
  function Num2Lett(StrNum: string):string;
implementation
uses SysUtils;
const
   maxpck = 10;
   error  = 'error';
type
  TArrPack = array[1..maxpck] of string[3];
  var
     neg:   boolean;
function PackString(nums: string; var Pack: TArrPack; var lim: byte):
boolean;
var
   i,j,l,n,
   numpack,
   resto:    byte;
begin
   if nums[1] = '-' then
      neg := true;
   l := length(nums);
   i := 1;
   while (i > 0) and (i <=l) do
      if not (nums[i] in ['0'..'9']) then
         begin
            Delete(nums, i, 1);
            l := length(nums)
         end
      else
         inc(i);
   if l > 0 then
      begin
         numpack := (l div 3);
         resto := l mod 3;
         i := numpack;
         n := i + 1;
         if resto <> 0 then
            begin
               numpack := numpack + 1;
               i := numpack;
               Pack[i] := Copy(nums, 1, resto);
               i := i - 1
            end;
         j := i;
         while j > 0 do
         begin
            Pack[j] := Copy(nums, (resto + 1 + 3 * (n-j-1)), 3);
            j := j - 1
         end;
         lim := numpack;
         result := true
      end
   else
      result := false
end;
function NoZeri(num: string): string;
var
   c:   char;
begin
   repeat
      c := num[1];
      if c = '0' then
        Delete(num, 1, 1);
   until (c <> '0') or (num = '');
   result := num
end;
function Cifra(num: char): string;
begin
   case num of
      '1':   result := 'uno';
      '2':   result := 'due';
      '3':   result := 'tre';
      '4':   result := 'quattro';
      '5':   result := 'cinque';
      '6':   result := 'sei';
      '7':   result := 'sette';
      '8':   result := 'otto';
      '9':   result := 'nove'
   end
end;
function Dieci(num: string): string;
var
   numero:   byte;
begin
   numero := StrToInt(num);
   case numero of
      10   : result := 'dieci';
      11   : result := 'undici';
      12   : result := 'dodici';
      13   : result := 'tredici';
      14   : result := 'quattordici';
      15   : result := 'quindici';
      16   : result := 'sedici';
      17   : result := 'diciassette';
      18   : result := 'diciotto';
      19   : result := 'diciannove'
   end
end;
function Zero2Cento(num: string): string;
var
   cd,
   cu:   char;
   s:   string;
   i:    byte;
   b:    boolean;
begin
   s := '';
   b := True;
   cd := num[1];
   cu := num[2];
   case cd of
      '1':    begin
                 b := False;
                 s := Dieci(num)
              end;
      '2':    s := 'venti';
      '3':    s := 'trenta';
      '4':    s := 'quaranta';
      '5':    s := 'cinquanta';
      '6':    s := 'sessanta';
      '7':    s := 'settanta';
      '8':    s := 'ottanta';
      '9':    s := 'novanta';
   end;
   if (cu <> '0') and b then
      begin
         if (cu in ['1','8']) then
            begin
               i := length(s);
               Delete(s, i, 1)
            end;
         s := s + Cifra(cu)
      end;
   result := s
end;
function Zero2Mille(num: string): string;
var
   c:   char;
   s,
   s1:  string;
begin
   s := '';
   c := num[1];
   case c of
      '1'       : s := 'cento';
      '2'..'9'  : s := Cifra(c) + 'cento'
   end;
   s1 := Copy(num, 2, 2);
   s := s + Zero2Cento(s1);
   result := s
end;
function Num2Lett(StrNum: string):string;
var
   ArrP:   TArrPack;
   i,j,
   k:      byte;
   num,
   tmp,
   tmp1:   string;
   c:      char;
begin
   neg := false;
   if PackString(StrNum, ArrP, j) then
      begin
         num := '';
         tmp := '';
         tmp1 := '';
         for i := j downto 1 do
            begin
               tmp := ArrP[i];
               tmp := NoZeri(tmp);
               k := length(tmp);
               if k > 0 then
                  begin
                     c := tmp[1];
                     case k of
                        1:   tmp1 := Cifra(c);
                        2:   tmp1 := Zero2Cento(tmp);
                        3:   tmp1 := Zero2Mille(tmp)
                     end;
                     case i of
                        2:   if (k = 1) and (c = '1') then
                                begin
                                   tmp1 := Copy(tmp1, 1, length(tmp1) - 3);
                                   tmp1 := tmp1 + 'mille'
                                end
                             else
                                tmp1 := tmp1 + 'mila';
                        3:   if (k = 1) and (c = '1') then
                                begin
                                   tmp1 := Copy(tmp1, 1, length(tmp1) - 1);
                                   tmp1 := tmp1 + 'milione'
                                end
                             else
                                tmp1 := tmp1 + 'milioni';
                        4:   if (k = 1) and (c = '1') then
                                begin
                                   tmp1 := Copy(tmp1, 1, length(tmp1) - 1);
                                   tmp1 := tmp1 + 'miliardo'
                                end
                             else
                                tmp1 := tmp1 + 'miliardi';
                     end;
                     num := num + tmp1
                  end
            end;
         j := length(num);
         for i := 1 to j do
            num[i] := UpCase(num[i]);
         if neg then
            num := 'MENO ' + num;
         if num = '' then
            num := 'ZERO';
         result := num
      end
   else
      result := error
end;
end.

Ciao Vegeta,
Ti riporto la funzione che ho scritto ed uso io.
Saluti,
Carmine Moleti
----------------------------------------------------------------------------
----------------------------
unit MainUnit;
interface
uses
  Windows, Messages, SysUtils, Classes;
function CifreToLettere(Numero:currency;const Separatore:string):string;
implementation
function CifreToLettere(Numero:currency;const Separatore:string):string;
type
    TStato      = (sUnita,sDecine,sCentinaia);
    TStatoSuffissi = (sInferiore,sMigliaia,sMilioni,sMiliardi);
    // Struttura utile nel caso si vogliano usare numeri con cifre
"illimitate"
    PStack  = ^TStack;
    TStack  = record
        fTerna      : string[3];
        fSuffisso   : string;
    end;
const
    suffissi    : array [TStatoSuffissi] of string =
('','mila','milion','miliard');
    traduzione  : array [0..9,0..1] of string = (
                                                    ('zero',''),
                                                    ('uno','dieci'),
                                                    ('due','vent'),
                                                    ('tre','trent'),
                                                    ('quattro','quarant'),
                                                    ('cinque','cinquant'),
                                                    ('sei','sessant'),
                                                    ('sette','settant'),
                                                    ('otto','ottant'),
                                                    ('nove','novant')
                                                 );
    eccezionetraduzione : array [0..9] of string = (
                                                    'dieci',
                                                    'undici',
                                                    'dodici',
                                                    'tredici',
                                                    'quattordici',
                                                    'quindici',
                                                    'sedici',
                                                    'diciassette',
                                                    'diciotto',
                                                    'diciannove'
                                                 );
var
    lista       : TList;
    elemento    : PStack;
    i           : integer;
    temp        : string;
    decimali    : string;
    indicesuff  : TStatoSuffissi;
function TraduciTerna(Terna:PStack;Doppia:boolean):string;
var
    temp        : string;
    cifra       : integer;
    cifraprec   : integer;
    cifrasucc   : integer;
    p           : integer;
    Stato       : TStato;
    tradotto    : string;
begin
    Result:='';
    temp:=Terna^.fTerna;
    p:=Length(temp);
    Stato:=sUnita;
    while (p>=1) do
    begin
        cifra:=StrToInt(temp[p]);
        if p>1 then cifrasucc:=StrToInt(temp[p-1]);
        case Stato of
            sUnita:begin
                if ((not ((cifra=0) and (p=Length(temp)))) or ((cifra=0) and
(Length(temp)=1))) and (cifrasucc<>1) then
                    tradotto:=traduzione[cifra,0];
            end;
            sDecine:begin
                if cifra<>1 then
                begin
                    tradotto:=traduzione[cifra,1];
                    if (cifra<>2) and (cifraprec in [2,3,4,5,6,7,9,0]) and
(tradotto<>'') then
                        tradotto:=tradotto+'a'
                    else if (cifraprec in [2,3,4,5,6,7,9,0]) and
(tradotto<>'') then
                        tradotto:=tradotto+'i';
                end
                else
                    // dieci, undici...diciannove
                    tradotto:=eccezionetraduzione[cifraprec];
            end;
            sCentinaia:begin
                if cifra in [0] then tradotto:=''
                else
                begin
                    if cifra<>1 then
                        tradotto:=traduzione[cifra,0]
                    else
                        tradotto:='';
                    if (cifraprec=8) and (not Doppia) then
                        tradotto:=format('%scent',[tradotto])
                    else
                        tradotto:=format('%scento',[tradotto]);
                end;
            end;
        end;
        try
            Stato:=Succ(Stato);
        except
            on exception do
                Stato:=sUnita;
        end;
        Result:=format('%s%s',[tradotto,Result]);
        dec(p);
        cifraprec:=cifra;
    end;
end;
begin
    Result:='';
    lista:=TList.Create;
    indicesuff:=sInferiore;
    try
        temp:=CurrToStr(Numero);
        if LastDelimiter(Separatore,temp)>0 then
        begin
            decimali:=Copy(temp,LastDelimiter(Separatore,temp)+1,100);
            if Length(decimali)=1 then decimali:=decimali+'0';
            temp:=Copy(temp,1,LastDelimiter(Separatore,temp)-1);
        end;
        i:=Length(temp);
        while (i>=1) do
        begin
            New(elemento);
            elemento^.fTerna:=Copy(temp,Length(temp)-2,3);
            if indicesuff<>sInferiore then
            begin
                elemento^.fSuffisso:=suffissi[indicesuff];
                case indicesuff of
                    sMigliaia:begin
                        case StrToInt(elemento^.fTerna) of
                            0:begin
                                elemento^.fSuffisso:='';
                                elemento^.fTerna:='';
                            end;
                            1:begin
                                elemento^.fSuffisso:='mille';
                                elemento^.fTerna:='';
                            end;
                        end;
                    end;
                    sMilioni:begin
                        case StrToInt(elemento^.fTerna) of
                            0:begin
                                elemento^.fSuffisso:='';
                                elemento^.fTerna:='';
                            end;
                            1:begin
elemento^.fSuffisso:='un'+elemento^.fSuffisso+'e';
                                elemento^.fTerna:='';
                            end;
                            else
elemento^.fSuffisso:=elemento^.fSuffisso+'i';
                        end;
                    end;
                    sMiliardi:begin
                        case StrToInt(elemento^.fTerna) of
                            0:begin
elemento^.fSuffisso:=elemento^.fSuffisso+'i';
                                elemento^.fTerna:='';
                            end;
                            1:begin
elemento^.fSuffisso:='un'+elemento^.fSuffisso+'o';
                                elemento^.fTerna:='';
                            end;
                            else
elemento^.fSuffisso:=elemento^.fSuffisso+'i';
                        end;
                    end;
                end;
            end
            else
                elemento^.fSuffisso:='';
            lista.Add(elemento);
            temp:=Copy(temp,1,Length(temp)-3);
            try
                indicesuff:=Succ(indicesuff);
            except
                on exception do
                    indicesuff:=sMigliaia;
            end;
Result:=format('%s%s%s',[TraduciTerna(elemento,True),elemento^.fSuffisso,Res
ult]);
            dec(i,3);
        end;
        if decimali<>'' then
            Result:=format('%s/%s',[Result,decimali])
        else
            Result:=format('%s/00',[Result]);
    finally
        FreeAndNil(lista);
    end;
end;
end.

 Carmine Moleti
scusate, ma volendo trasformare in lettere gli euro come fate ?  Bisogna
tradurre in lettere anche i centesimi o si lasciano in formato numerico dopo
una barra come negli assegni ?
Es.
123,45
Centoventitreequarantacinquecentesimi
Centoventitre/45
Dario.

Ciao Dario,
Per quanto ne so, si lasciano in formato numerico (come ho fatto nel codice
da me riportato).
Quindi:
blablabla/centesimi
Saluti

 da me riportato).
Grazie Carmine, č che non avevo ancora provato il tuo codice.
Ciao,
Dario.