Programowanie w języku Delphi » Gotowce

Zamiana ceny na jej słowny odpowiednik

  • 2 komentarze
  • 659 odsłon
  • Oceń ten tekst jako pierwszy
Cześć, wiadomo, jak zamienić liczbę na słowa. Jednak kody, z którymi się spotykałem, nie spełniały moich oczekiwań.  Poza tym "tłumaczyły" liczby, a nie ceny(chociaż tu już krótka droga). Postanowiłem napisać swój własny od podstaw(nie przeczę, że pomysł z funkcjami ConvertX zaczerpnąłem z już istniejącego gotowca na 4p). Ta wersja tłumaczy wszystko do 999 999 999 999,99, jednak bardzo łatwo rozszerzyć jej funkcjonalność, wystarczy do funkcji GetBridge dopisać w case np:
13, 14, 15: result:='bilion';

I w taki sposób rozszerzamy funkcjonalność :)
A teraz już bez zbędnego gadania(małe omówienie na końcu):

function PriceToStr(price: Currency): string;
 
             function Convert1(d: integer): string;
             begin
               case d of
                 0: result:='';
                 1: result:='jeden';
                 2: result:='dwa';
                 3: result:='trzy';
                 4: result:='cztery';
                 5: result:='pięć';
                 6: result:='sześć';
                 7: result:='siedem';
                 8: result:='osiem';
                 9: result:='dziewięć';
               end;
             end;
 
             function Convert10(d: integer): string;
             begin
               case d of
                 0: result:='';
                 2: result:='dwadzieścia';
                 3: result:='trzydzieści';
                 4: result:='czterdzieści';
                 5: result:='pięćdziesiąt';
                 6: result:='sześćdziesiąt';
                 7: result:='siedemdziesiąt';
                 8: result:='osiemdziesiąt';
                 9: result:='dziewięćdziesiąt';
               end;
             end;
 
             function Convert11(d: integer): string;
             begin
                case d of
                  0: result:='dziesięć';
                  1: result:='jedenaście';
                  2: result:='dwanaście';
                  3: result:='trzynaście';
                  4: result:='czternaście';
                  5: result:='piętnaście';
                  6: result:='szesnaście';
                  7: result:='siedemnaście';
                  8: result:='osiemnaście';
                  9: result:='dziewiętnaście';
                end;    
             end;
 
 
             function Convert100(d: integer): string;
             begin
               case d of
                 0: result:='';
                 1: result:='sto';
                 2: result:='dwieście';
                 3: result:='trzysta';
                 4: result:='czterysta';
                 5: result:='pięćset';
                 6: result:='sześćset';
                 7: result:='siedemset';
                 8: result:='osiemset';
                 9: result:='dziewięćset';
               end;
             end;
 
             //====Pobranie np: tysiąc/tysięcy==============================\\
             function GetBridge(Count: integer; Digit: integer): string;
             var
               dStr: string;
               ld: integer; //ostatnia cyfra
               pld: integer; //przed ostatnia cyfra
             begin
               case count of
                 4, 5, 6: result:='tysiąc';
                 7, 8, 9: result:='milion';
                 10, 11, 12: result:='miliard'
                 else result:='';
               end;
 
               if digit = 0 then result:='';
               if (result = '') or (digit = 1) then exit;
 
               dStr:=intToStr(digit);
               ld:=StrToInt(dStr[length(dStr)]);
               if length(dStr)>1 then pld:=StrToInt(dStr[length(dStr)-1])
                  else pld:=0;
 
               if pld = 1 then
               begin
                 if result = 'tysiąc' then result:='tysięcy' else
                    result:=result+'ów';
               end else
               if (ld>1) and (ld<5) then
               begin
                 if result = 'tysiąc' then result:='tysiące' else
                    result:=result+'y';
               end else
               if (ld>4) or (ld = 0) then
               begin
                 if result = 'tysiąc' then result:='tysięcy' else
                    result:=result+'ów';
               end;
             end;
 
             //============Czyszczenie 'jeden' z np. 'jeden tysiąc'===========\\
             procedure ClearBridge(var s: string; bridge: string);
             var
               i: integer;
             begin
               i:=pos('jeden '+bridge, s);
               if i=1 then delete(s, i, length('jeden '));
             end;
 
var
 PriceStr: string;
 SL: TStringList;
 BC, AC: string; //przed i po przecinku
 res: string;
 i: integer;
 bridge: string;
 BCTemp: string;
begin
  PriceStr:=CurrToStr(Price); //mam cenę jako string
  sl:=TStringList.Create;
  explode(PriceStr, sl, decimalSeparator);
  BC:=sl.Strings[0];
  if sl.Count>1 then AC:=sl.Strings[1];
  if length(AC)>2 then delete(AC, 3, 2) else
     if length(AC) = 1 then AC:=AC+'0' else
        if AC = '' then AC:='00';
 
 
 
  repeat
    i:=length(BC) mod 3;
    if i = 0 then i:=3;
    BCTemp:=copy(BC, 1, i);
    bridge:=getBridge(length(BC), strToInt(BCTemp));
    delete(BC, 1, i);
 
   //3 cyfry
     if length(BCTemp) = 3 then
     begin
       res:=res+' '+convert100(strToInt(BCTemp[1]));
       delete(BCTemp, 1, 1);
     end;
 
   //2 cyfry
     if length(BCTemp)=2 then
     begin
       if BCTemp[1] = '1' then res:=res+' '+convert11(strToInt(BCTemp[2])) else
       begin
         res:=res+' '+convert10(strToInt(BCTemp[1]));
         res:=res+' '+convert1(StrToInt(BCTemp[2]));
       end;
       delete(BCTemp, 1, 2);
     end;
 
   //1 cyfra
     if length(BCTemp) = 1 then
     begin
       res:=res+' '+convert1(strToInt(BCtemp[1]));
       delete(BCTemp, 1, 1);
     end;
 
     res:=res+' '+bridge;
  until length(BC) = 0;
 
//pozbywam się zbędnych spacji
  res:=trim(res);
  while pos('  ', res)>0 do res:=stringReplace(res, '  ', ' ', [rfReplaceAll]);
 
//pozbywam się efektu typu: jeden tysiąc...
  clearBridge(res, 'miliard');
  clearBridge(res, 'milion');
  clearBridge(res, 'tysiąc');
 
  res:=res+' zł';
  //już mam postać np. dwa złote
 
  //teraz zajmuje się częścią po przecinku
  if ac = '00' then res:=res+' zero gr' else  
  begin
    if ac[1] = '1' then res:=res+' '+convert11(StrToInt(ac[2])) else
    begin
      res:=res+' '+convert10(StrToInt(ac[1]));
      res:=res+' '+convert1(StrToInt(ac[2]));
    end;
    res:=res+' gr';
  end;
 
 
  result:=res;
end;


Funkcja jest właściwie ograniczona tylko i wyłącznie zakresem Currency, a to ze względu na to, że:
Na początku są oddzielane części całkowite(złotówki) od ułamkowych(groszy). Następnie części całkowite są zamieniane trójkami, tzn., załóżmy, że mamy kwotę: 123 456,00
Wtedy jest to dzielone na 2 części: 123 i 456, i one są oddzielnie rozpatrywane. Jeśli nie można ułożyć takiego ciągu 3 cyfrowego(np: 12 345), to wtedy tworzymy ciąg jak największy, ale mniejszy od 3 cyfr oczywiście :)

Kod rozpoznaje cyfrę, wie na jakim miejscu stoi, następnie ją usuwa i ciąg pomniejszony o jedną cyfrę przekazuje dalej.

Prostymi słowami z kwoty: 123 456, operacje wyglądają tak:

123

Tłumaczenie cyfry 1 na sto
Usunięcie cyfry 1


23

Tłumaczenie cyfry 2 na dwadzieścia
Usunięcie cyfry 2


3

Tłumaczenie cyfry 3 na trzy
Usunięcie cyfry 3



No, funckja jest dość prosta w użyciu, wystarczy:
  kw_slow:=priceToStr(20000);


Jak są jakieś pytania to odpowiem pewnie ;)

2 komentarze

Majonez115 2011-08-14 22:19

Fajna funkcja tylko w Delphi 7 nie działa
Brak
explode(PriceStr, sl, decimalSeparator);
O co chodzi ???

Drajwer 2006-08-31 21:13

Ogolnie fajne tylko ze mozna zamiast instrukcji case dac kilka tablic i by bylo krocej.