Перевел функцию Сумма прописью для FastReport 4.0 паскаль версия
основная статья
http://delphiworld.narod.ru/base/sum_written_out7.html
моя переделка для встроенного языка FastReport
/сумма прописью FastReport V4 /сумма прописью на языке Pascal Открытый код.
{ перевод на язык паскаля для Фаст Репорта Наумов Денис ICQ 368-254-335 mailTo denis-naymov1985@mail.ru for my web NetSoftWare.Ucoz.ru основна http://delphiworld.narod.ru/base/sum_written_out7.html
const Max000 = 6; {Кол-во триплетов - 000} MaxPosition = Max000 * 3; {Кол-во знаков в числе } var
c100: array[0..9] of string; c11: array[0..9] of string; c10: array[0..9] of string; c1: array[0..1, 0..9] of string; c1000w: array[0..Max000] of integer; c1000:array[0..Max000] of string; w:array[0..1, 0..9] of string; ruble: array[0..9] of string; Kopeek: array[0..9] of string;
procedure initalize; begin c1000[0]:=''; c1000[1]:='тысяч'; c1000[2]:='миллион'; c1000[3]:='миллиард'; c1000[4]:='триллион'; c1000[5]:='квадраллион'; c1000[6]:='квинтиллион';
function NumToStr(s: string): string; {Возвращает число прописью} var s000: string;
isMinus: Boolean; isw:integer; i: integer; //Сч?тчик триплетов begin
Result := ''; i := 0; isMinus := (s <> '') and (s[1] = '-');
if isMinus then s := Copy(s, 2, Length(s) - 1); while not ((i >= Ceil(Length(s) / 3)) or (i >= Max000)) do begin s000 := Copy('00' + s, Length(s) - i * 3, 3); isw := c1000w[i]; if (i > 0) and (s000 <> '000') then //тысячи и т.д. Result := c1000[i] + w[Isw, strtoint(iif2(s000[2] = '1', '0', s000[3]))] + Result; Result := Num000toStr(s000, isw) + Result; Inc(i) end; if Result = '' then Result := 'ноль'; if isMinus then Result := 'минус ' + Result; end; {NumToStr}
function TrimLeft(const S: string): string; var I, L: Integer; begin L := Length(S); I := 1; while (I <= L) and (S[I] <= ' ') do Inc(I); Result := Copy(S, I, 32565555); end;
function RealToRouble(c: Extended): string;
function ending(const s: string): Char; var l: Integer; //С l на 8 байт коротче $50->$48->$3F begin //Возвращает индекс окончания
l := Length(s); if(l > 1) and (s[l-1]='1') then result:='0' else result:=s[l];
end;
var rub: string; kop: string; h,x:integer; begin {Возвращает число прописью с рублями и копейками}
Result:=formatfloat('0.00',c); h:=length(Result); for X:=h to 18 do Result:=' '+Result; //Str(c: MaxPosition + 3: 2, Result);
if Pos('E', Result) = 0 then //Если число можно представить в строке <>1E+99 begin rub := TrimLeft(Copy(Result, 1, Length(Result) - 3)); kop := Copy(Result, Length(Result) - 1, 2); Result := NumToStr(rub) + ' рубл'+ruble[strtoint(ending(rub))] + ' ' + kop + ' копе' + Kopeek[strtoint(ending(kop))]; Result := UpperCase(Result[1]) + Copy(Result, 2, Length(Result) - 1);
end; end; function GetSummaToText(r:real):string; begin initalize; result:=RealToRouble(r); end;
begin memo1.lines.text:=GetSummaToText(100425.44); end.
Программа для перевода суммы в число для Pascal ABC
сто двадцать три миллиона четыреста пятьдесят шесть тысяч семьсот восемьдесят девять рублей 00 копеек 987654321,00
девятьсот восемьдесят семь миллионов шестьсот пятьдесят четыре тысячи триста двадцать один рубль 00 копеек
