Mam kod do zmiany kwoty na kwote slownie, i nie wiem w ktorym miejscu kodu ma on ja pobierac a w ktorym ma ja zwracac jako text. I jak go uruchomic?
Za pomoc z gory dziekuje.
O to kod:
unit slowniezl;
(*
<<<<<<<<<<<<<<< NIE WOLNO USUWAĆ TEGO NAGŁÓWKA >>>>>>>>>>>>>>>>>>>>
Moduł służący do zmiany kwoty złotych wyrażonej liczbą na formę wyrazową,
czyli konwersja liczb na słownie złotych.
Moduł domyślnie obsługuje liczby 12 cyfrowe jednak przez usunięcie odpowiednich
znaków komentujących można poszerzyć jego możliwości o liczby 15 cyfrowe,
a obsługę 18, 21 itd. cyfrowych, należy wprowadzić w sposób analogiczny do liczb 15 cyfrowych.
Autor: Marcin BACIK Koteras
email: [email protected]
data powstania: 30.09.1999 (wersja pierwotna)
1 modyfikacja: 02.10.1999 (usuwanie podwójnych spacji)
2 modyfikacja: 03.10.1999 (PoprawkaDlaJedynki - opis nizej)
następna modyfikacja: nie jest przewidywana.
Moduł ten jest rozpowszechniany jako Freeware.
Można go wykorzystywać do własnych programów freeware, shareware, komercja,
ale tylko pod warunkiem, że robi się to na własną odpowiedzialność.
Będę wdzięczny jeśli informacja o pochodzeniu tego modułu będzie dołączana do programów.
Proszę zgłaszać wszelkie uwagi/błędy, a mogą takie być ponieważ jest to bardzo
młode rozwiązanie.
<<<<<<<<<<<<<<< NIE WOLNO USUWAĆ TEGO NAGŁÓWKA >>>>>>>>>>>>>>>>>>>>
*)
interface
uses sysutils;
function Slownie(Suma: Extended): String;
implementation
const jednosci:array[0..19]of string[20]=
(`,'jeden','dwa','trzy','cztery','pięć','sześć','siedem',
'osiem','dziewięć','dziesięć','jedenaście','dwanaście',
'trzynaście','czternaście','piętnaście','szesnaście',
'siedemnaście','osiemnaście','dziewiętnaście');
dziesiatki:array[0..9]of string[20]=
(`,'dziesięć','dwadzieścia','trzydzieści','czterdzieści',
'pięćdziesiąt','sześćdziesiąt','siedemdziesiąt',
'osiemdziesiąt','dziewięćdziesiąt');
setki:array[0..9]of string[20]=
('','sto','dwieście','trzysta','czterysta','pięćset',
'sześćset','siedemset','osiemset','dziewięćset');
tysiace:array[0..9]of string[20]=
('tysięcy','tysiąc','tysiące','tysiące','tysiące','tysięcy',
'tysięcy','tysięcy','tysięcy','tysięcy');
miliony:array[0..9]of string[20]=
('milionów','milion','miliony','miliony','miliony','milionów',
'milionów','milionów','milionów','milionów');
miliardy:array[0..9]of string[20]=
('miliardów','miliard','miliardy','miliardy','miliardy','miliardów',
'miliardów','miliardów','miliardów','miliardów');
{***********uaktywnić aby była obsługa bilionów ***********
{i rozwijanie dalsze w ten sam sposób...
biliony:array[0..9]of string[20]=
('bilionów','biliony','biliony','biliony','biliony','bilionów',
'bilionów','bilionów','bilionów','bilionów');
}
zlote:array[0..9]of string[20]=
('złotych','złotych','złote','złote','złote','złotych','złotych',
'zł
otych','złotych','złotych');
grosze:array[0..9]of string[20]=
('groszy','groszy','grosze','grosze','grosze','groszy','groszy',
'groszy','groszy','groszy');
function SetkiUniwersalne(SumaStr: String; Groszy: Boolean): String;
var
I, Idx: Integer;
Setka, Slowo, UniSetka, UniDzies, UniJedn: String;
*domyślnie obsługuje liczby typu 101 000, 11 000
*gdy to jest False to obsługa 1 000, 1 001 000,
PoprawkaDlaJedynki: Boolean;
begin
Result := `;
//wstępna obróbka - ucięcie przecinka i tego co po przecinku
Delete(SumaStr, Length(SumaStr)-2, 3);
//obsługa jedynek złoty/grosz
//jesli ktos uważa, że poprawnie jest: jeden złotych/jeden groszy
//to ten warunek należy usunąć i chyba bedzie tak jak się chce
if (SumaStr = '1') or (SumaStr = '0') then
begin
if SumaStr[1] = '1' then
if Groszy then
Result := 'jeden grosz'
else Result := 'jeden złoty';
if SumaStr[1] = '0' then //zero groszy obslużone jest w funkcji slownie()
Result := 'zero złotych';
Exit;
end;
//wszystko pracuje na trójcyfrowych
//ciągach więc trzeba podciągnąć do 3 cyfr
case Length(SumaStr) of
1: SumaStr:= '00'+ SumaStr;
2: SumaStr:= '0' + SumaStr;
end;
UniSetka := ; UniDzies := ; UniJedn := `;
I:= 0;
while Length(SumaStr) >= 3 do
begin
Setka := Copy(SumaStr, Length(SumaStr) - 2, 3);
Delete(SumaStr, Length(SumaStr) - 2, 3);
Inc(I);{<- która trojka z kolei, czyli zlote/tysiace/miliony...}
PoprawkaDlaJedynki := Setka <> '001'; {<- to musi być przed konwersją do trójki!!}
*konwersja do trójki:
case Length(SumaStr) of
1: SumaStr:= '00'+ SumaStr;
2: SumaStr := '0' + SumaStr;
end;
UniSetka := Setki[StrToInt(Setka[1])];
case Setka[2] of
'0','1': begin
UniDzies := `;
UniJedn := Jednosci[StrToInt(Setka[2] + Setka[3])];
end;
else
begin
UniDzies := Dziesiatki[StrToInt(Setka[2])];
UniJedn := Jednosci[StrToInt(Setka[3])];
end;
end;
// obsługa liczb z zakresu 10-19
if (StrToInt(Setka[2] + Setka[3]) < 20) and (StrToInt(Setka[2] + Setka[3]) > 9) then
Idx := 9 else Idx := StrToInt(Setka[3]);
//to jest potrzebne dla liczb typu: 101 000
//czyli sto jeden tysięcy złotych , a nie sto jeden tysiąc złotych
if PoprawkaDlaJedynki and (setka[3] = '1') then Idx := 9;
//po każdej trójce jest odpowiednia końcówka:
case I of
1: if not Groszy then Slowo := zlote [ Idx ] else Slowo := grosze [ Idx ];
2: Slowo := tysiace [ Idx ];
3: Slowo := miliony [ Idx ];
4: Slowo := miliardy[ Idx ];
// 5: Slowo := biliony [ idx ]; {*****uaktywnić dla bilionów i gotowe!!!!!!!!********}
//6: tutaj trzeba dodać dla rozwinięcie dla jeszcze większych liczb ....
end;
//zabezpieczenie dla 1000, 1000 000, 1000 000 000 itp.
//aby się nic nie pojawiało co każdą trójkę
//tzn. jesli jest jeden milion zł to nie pisze sie jeden milion zero tysięcy zł.
if (Setka = '000') and (I >1) then Slowo := `;
if Slowo <> '' then Slowo := ' ' + Slowo; { <- dodać spację pod warunkiem,
że trójka jest różna od '000' }
Result := UniSetka + ' ' + UniDzies +' '+ UniJedn +' '+ Slowo + ' ' + Result;
end;
Result := Trim(Result);{ usunięcie pierwszej spacji...}
end;
function Slownie(Suma: Extended): String;
var
LiczbaStr: String;
begin
*LiczbaStr := FormatFloat('0.00', Suma); */<-- to (15 cyfrowe max)
LiczbaStr := FloatToStrF(Suma, ffFixed, 18, 2); *<-- lub to (18 cyfrowe max) - do własnego wyboru
*złote:
Result := SetkiUniwersalne( LiczbaStr, False );
*grosze:
LiczbaStr := Copy(LiczbaStr, Length(LiczbaStr) -1, 2);
*szybkie zero groszy
if StrToInt(LiczbaStr) = 0 then
begin
Result := Result + ' zero groszy';
*czasem może wystąpić podwójna spacja - a że nie chce mi się szukać kiedy, to:
while POS(' ', Result) > 0 do Delete(Result, POS(' ', Result), 1);
Exit;
end;
Result := Result + ' ' + SetkiUniwersalne( LiczbaStr + ',00', True );
//czasem może wystąpić podwójna spacja - a że nie chce mi się szukać kiedy, to:
while POS(' ', Result) > 0 do Delete(Result, POS(' ', Result), 1);
end;
end.