Наши проекты:
Журнал · Discuz!ML · Wiki · DRKB · Помощь проекту |
||
ПРАВИЛА | FAQ | Помощь | Поиск | Участники | Календарь | Избранное | RSS |
[13.58.77.98] |
|
Сообщ.
#1
,
|
|
|
Вот несколько решений.
Автор Александр {------------------------ Деньги прописью ---------------------} function TextSum(S: double): string; function Conv999(M: longint; fm: integer): string; const c1to9m: array[1..9] of string[6] = ('один', 'два', 'три', 'четыре', 'пять', 'шесть', 'семь', 'восемь', 'девять'); c1to9f: array[1..9] of string[6] = ('одна', 'две', 'три', 'четыре', 'пять', 'шесть', 'семь', 'восемь', 'девять'); c11to19: array[1..9] of string[12] = ('одиннадцать', 'двенадцать', 'тринадцать', 'четырнадцать', 'пятнадцать', 'шестнадцать', 'семнадцать', 'восемнадцать', 'девятнадцать'); c10to90: array[1..9] of string[11] = ('десять', 'двадцать', 'тридцать', 'сорок', 'пятьдесят', 'шестьдесят', 'семьдесят', 'восемьдесят', 'девяносто'); c100to900: array[1..9] of string[9] = ('сто', 'двести', 'триста', 'четыреста', 'пятьсот', 'шестьсот', 'семьсот', 'восемьсот', 'девятьсот'); var s: string; i: longint; begin s := ''; i := M div 100; if i <> 0 then s := c100to900[i] + ' '; M := M mod 100; i := M div 10; if (M > 10) and (M < 20) then s := s + c11to19[M - 10] + ' ' else begin if i <> 0 then s := s + c10to90[i] + ' '; M := M mod 10; if M <> 0 then if fm = 0 then s := s + c1to9f[M] + ' ' else s := s + c1to9m[M] + ' '; end; Conv999 := s; end; {--------------------------------------------------------------} var i: longint; j: longint; r: real; t: string; begin t := ''; j := Trunc(S / 1000000000.0); r := j; r := S - r * 1000000000.0; i := Trunc(r); if j <> 0 then begin t := t + Conv999(j, 1) + 'миллиард'; j := j mod 100; if (j > 10) and (j < 20) then t := t + 'ов ' else case j mod 10 of 0: t := t + 'ов '; 1: t := t + ' '; 2..4: t := t + 'а '; 5..9: t := t + 'ов '; end; end; j := i div 1000000; if j <> 0 then begin t := t + Conv999(j, 1) + 'миллион'; j := j mod 100; if (j > 10) and (j < 20) then t := t + 'ов ' else case j mod 10 of 0: t := t + 'ов '; 1: t := t + ' '; 2..4: t := t + 'а '; 5..9: t := t + 'ов '; end; end; i := i mod 1000000; j := i div 1000; if j <> 0 then begin t := t + Conv999(j, 0) + 'тысяч'; j := j mod 100; if (j > 10) and (j < 20) then t := t + ' ' else case j mod 10 of 0: t := t + ' '; 1: t := t + 'а '; 2..4: t := t + 'и '; 5..9: t := t + ' '; end; end; i := i mod 1000; j := i; if j <> 0 then t := t + Conv999(j, 1); t := t + 'руб. '; i := Round(Frac(S) * 100.0); t := t + Long2Str(i) + ' коп.'; TextSum := t; end; -------------------------------------------------------------------------------- unit RoubleUnit; {$D Пропись © Близнец Антон '99 http:\\anton-bl.chat.ru\delphi\1001.htm } { 1000011.01->'Один миллион одинадцать рублей 01 копейка' } interface function RealToRouble(c: Extended): string; implementation uses SysUtils, math; const Max000 = 6; {Кол-во триплетов - 000} MaxPosition = Max000 * 3; {Кол-во знаков в числе } //Аналог IIF в Dbase есть в proc.pas для основных типов, частично объявлена тут для независимости function IIF(i: Boolean; s1, s2: Char): Char; overload; begin if i then result := s1 else result := s2 end; function IIF(i: Boolean; s1, s2: string): string; overload; begin if i then result := s1 else result := s2 end; function NumToStr(s: string): string; {Возвращает число прописью} const c1000: array[0..Max000] of string = ('', 'тысяч', 'миллион', 'миллиард', 'триллион', 'квадраллион', 'квинтиллион'); c1000w: array[0..Max000] of Boolean = (False, True, False, False, False, False, False); w: array[False..True, '0'..'9'] of string[3] = (('ов ', ' ', 'а ', 'а ', 'а ', 'ов ', 'ов ', 'ов ', 'ов ', 'ов '), (' ', 'а ', 'и ', 'и ', 'и ', ' ', ' ', ' ', ' ', ' ')); function Num000toStr(S: string; woman: Boolean): string; {Num000toStr возвращает число для триплета} const c100: array['0'..'9'] of string = ('', 'сто ', 'двести ', 'триста ', 'четыреста ', 'пятьсот ', 'шестьсот ', 'семьсот ', 'восемьсот ', 'девятьсот '); c10: array['0'..'9'] of string = ('', 'десять ', 'двадцать ', 'тридцать ', 'сорок ', 'пятьдесят ', 'шестьдесят ', 'семьдесят ', 'восемьдесят ', 'девяносто '); c11: array['0'..'9'] of string = ('', 'один', 'две', 'три', 'четыр', 'пят', 'шест', 'сем', 'восем', 'девят'); c1: array[False..True, '0'..'9'] of string = (('', 'один ', 'два ', 'три ', 'четыре ', 'пять ', 'шесть ', 'семь ', 'восемь ', 'девять '), ('', 'одна ', 'две ', 'три ', 'четыре ', 'пять ', 'шесть ', 'семь ', 'восемь ', 'девять ')); begin {Num000toStr} Result := c100[s[1]] + iif((s[2] = '1') and (s[3] > '0'), c11[s[3]] + 'надцать ', c10[s[2]] + c1[woman, s[3]]); end; {Num000toStr} var s000: string[3]; isw, isMinus: Boolean; 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, iif(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 RealToRouble(c: Extended): string; const ruble: array['0'..'9'] of string[2] = ('ей', 'ь', 'я', 'я', 'я', 'ей', 'ей', 'ей', 'ей', 'ей'); Kopeek: array['0'..'9'] of string[3] = ('ек', 'йка', 'йки', 'йки', 'йки', 'ек', 'ек', 'ек', 'ек', 'ек'); function ending(const s: string): Char; var l: Integer; //С l на 8 байт коротче $50->$48->$3F begin //Возвращает индекс окончания l := Length(s); Result := iif((l > 1) and (s[l - 1] = '1'), '0', s[l]); end; var rub: string[MaxPosition + 3]; kop: string[2]; begin {Возвращает число прописью с рублями и копейками} 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[ending(rub)] + ' ' + kop + ' копе' + Kopeek[ending(kop)]; Result := AnsiUpperCase(Result[1]) + Copy(Result, 2, Length(Result) - 1); end; end; end. -------------------------------------------------------------------------------- Редянов Денис function CifrToStr(Cifr: string; Pr: Integer; Padeg: Integer): string; {Функция возвращает прописью 1 цифры признак 3-единицы 2-десятки 1-сотни 4-11-19 Padeg - 1-нормально 2- одна, две } var i: Integer; begin i := StrToInt(Cifr); if Pr = 1 then case i of 1: CifrToStr := 'сто'; 2: CifrToStr := 'двести'; 3: CifrToStr := 'триста'; 4: CifrToStr := 'четыреста'; 5: CifrToStr := 'пятьсот'; 6: CifrToStr := 'шестьсот'; 7: CifrToStr := 'семьсот'; 8: CifrToStr := 'восемьсот'; 9: CifrToStr := 'девятьсот'; 0: CifrToStr := ''; end else if Pr = 2 then case i of 1: CifrToStr := ''; 2: CifrToStr := 'двадцать'; 3: CifrToStr := 'тридцать'; 4: CifrToStr := 'сорок'; 5: CifrToStr := 'пятьдесят'; 6: CifrToStr := 'шестьдесят'; 7: CifrToStr := 'семьдесят'; 8: CifrToStr := 'восемьдесят'; 9: CifrToStr := 'девяносто'; 0: CifrToStr := ''; end else if Pr = 3 then case i of 1: if Padeg = 1 then CifrToStr := 'один' else CifrToStr := 'одна'; 2: if Padeg = 1 then CifrToStr := 'два' else CifrToStr := 'две'; 3: CifrToStr := 'три'; 4: CifrToStr := 'четыре'; 5: CifrToStr := 'пять'; 6: CifrToStr := 'шесть'; 7: CifrToStr := 'семь'; 8: CifrToStr := 'восемь'; 9: CifrToStr := 'девять'; 0: CifrToStr := ''; end else if Pr = 4 then case i of 1: CifrToStr := 'одиннадцать'; 2: CifrToStr := 'двенадцать'; 3: CifrToStr := 'тринадцать'; 4: CifrToStr := 'четырнадцать'; 5: CifrToStr := 'пятнадцать'; 6: CifrToStr := 'шестнадцать'; 7: CifrToStr := 'семнадцать'; 8: CifrToStr := 'восемнадцать'; 9: CifrToStr := 'девятнадцать'; 0: CifrToStr := 'десять'; end; end; function Rasryad(K: Integer; V: string): string; {Функция возвращает наименование разряда в зависимости от последних 2 цифр его} var j: Integer; begin j := StrToInt(Copy(v, Length(v), 1)); if (StrToInt(Copy(v, Length(v) - 1, 2)) > 9) and (StrToInt(Copy(v, Length(v) - 1, 2)) < 20) then case K of 0: Rasryad := ''; 1: Rasryad := 'тысяч'; 2: Rasryad := 'миллионов'; 3: Rasryad := 'миллиардов'; 4: Rasryad := 'триллионов'; end else case K of 0: Rasryad := ''; 1: case j of 1: Rasryad := 'тысяча'; 2..4: Rasryad := 'тысячи'; else Rasryad := 'тысяч'; end; 2: case j of 1: Rasryad := 'миллион'; 2..4: Rasryad := 'миллионa'; else Rasryad := 'миллионов'; end; 3: case j of 1: Rasryad := 'миллиард'; 2..4: Rasryad := 'миллиарда'; else Rasryad := 'миллиардов'; end; 4: case j of 1: Rasryad := 'триллион'; 2..4: Rasryad := 'триллиона'; else Rasryad := 'триллионов'; end; end; end; function GroupToStr(Group: string; Padeg: Integer): string; {Функция возвращает прописью 3 цифры} var i: Integer; S: string; begin S := ''; if (StrToInt(Copy(Group, Length(Group) - 1, 2)) > 9) and (StrToInt(Copy(Group, Length(Group) - 1, 2)) < 20) then begin if Length(Group) = 3 then S := S + ' ' + CifrToStr(Copy(Group, 1, 1), 1, Padeg); S := S + ' ' + CifrToStr(Copy(Group, Length(Group), 1), 4, Padeg); end else for i := 1 to Length(Group) do S := S + ' ' + CifrToStr(Copy(Group, i, 1), i - Length(Group) + 3, Padeg); GroupToStr := S; end; {Функция возвращает сумму прописью} function RubToStr(Rubs: Currency; Rub, Kop: string): string; var i, j: Integer; R, K, S: string; begin S := CurrToStr(Rubs); S := Trim(S); if Pos(',', S) = 0 then begin R := S; K := '00'; end else begin R := Copy(S, 0, (Pos(',', S) - 1)); K := Copy(S, (Pos(',', S) + 1), Length(S)); end; S := ''; i := 0; j := 1; while Length(R) > 3 do begin if i = 1 then j := 2 else j := 1; S := GroupToStr(Copy(R, Length(R) - 2, 3), j) + ' ' + Rasryad(i, Copy(R, Length(R) - 2, 3)) + ' ' + S; R := Copy(R, 1, Length(R) - 3); i := i + 1; end; if i = 1 then j := 2 else j := 1; S := Trim(GroupToStr(R, j) + ' ' + Rasryad(i, R) + ' ' + S + ' ' + Rub + ' ' + K + ' ' + Kop); S := ANSIUpperCase(Copy(S, 1, 1)) + Copy(S, 2, Length(S) - 1); RubToStr := S; end; -------------------------------------------------------------------------------- Вот еще одно решение, присланное Олегом Клюкач. unit Numinwrd; interface function sMoneyInWords(Nin: currency): string; export; function szMoneyInWords(Nin: currency): PChar; export; { Денежная сумма Nin в рублях и копейках прописью 1997, в.2.1, by О.В.Болдырев} implementation uses SysUtils, Dialogs, Math; type tri = string[4]; mood = 1..2; gender = (m, f); uns = array[0..9] of string[7]; tns = array[0..9] of string[13]; decs = array[0..9] of string[12]; huns = array[0..9] of string[10]; nums = array[0..4] of string[8]; money = array[1..2] of string[5]; endings = array[gender, mood, 1..3] of tri; {окончания числительных и денег} const units: uns = ('', 'один ', 'два ', 'три ', 'четыре ', 'пять ', 'шесть ', 'семь ', 'восемь ', 'девять '); unitsf: uns = ('', 'одна ', 'две ', 'три ', 'четыре ', 'пять ', 'шесть ', 'семь ', 'восемь ', 'девять '); teens: tns = ('десять ', 'одиннадцать ', 'двенадцать ', 'тринадцать ', 'четырнадцать ', 'пятнадцать ', 'шестнадцать ', 'семнадцать ', 'восемнадцать ', 'девятнадцать '); decades: decs = ('', 'десять ', 'двадцать ', 'тридцать ', 'сорок ', 'пятьдесят ', 'шестьдесят ', 'семьдесят ', 'восемьдесят ', 'девяносто '); hundreds: huns = ('', 'сто ', 'двести ', 'триста ', 'четыреста ', 'пятьсот ', 'шестьсот ', 'семьсот ', 'восемьсот ', 'девятьсот '); numericals: nums = ('', 'тысяч', 'миллион', 'миллиард', 'триллион'); RusMon: money = ('рубл', 'копе'); ends: endings = ((('', 'а', 'ов'), ('ь', 'я', 'ей')), (('а', 'и', ''), ('йка', 'йки', 'ек'))); threadvar str: string; function EndingIndex(Arg: integer): integer; begin if ((Arg div 10) mod 10) <> 1 then case (Arg mod 10) of 1: Result := 1; 2..4: Result := 2; else Result := 3; end else Result := 3; end; function sMoneyInWords(Nin: currency): string; { Число Nin прописью, как функция } var // str: string; g: gender; //род Nr: comp; {целая часть числа} Fr: integer; {дробная часть числа} i, iTri, Order: longint; {триада} procedure Triad; var iTri2: integer; un, de, ce: byte; //единицы, десятки, сотни function GetDigit: byte; begin Result := iTri2 mod 10; iTri2 := iTri2 div 10; end; begin iTri := trunc(Nr / IntPower(1000, i)); Nr := Nr - int(iTri * IntPower(1000, i)); iTri2 := iTri; if iTri > 0 then begin un := GetDigit; de := GetDigit; ce := GetDigit; if i = 1 then g := f else g := m; {женского рода только тысяча} str := TrimRight(str) + ' ' + Hundreds[ce]; if de = 1 then str := TrimRight(str) + ' ' + Teens[un] else begin str := TrimRight(str) + ' ' + Decades[de]; case g of m: str := TrimRight(str) + ' ' + Units[un]; f: str := TrimRight(str) + ' ' + UnitsF[un]; end; end; if length(numericals[i]) > 1 then begin str := TrimRight(str) + ' ' + numericals[i]; str := TrimRight(str) + ends[g, 1, EndingIndex(iTri)]; end; end; //triad is 0 ? if i = 0 then Exit; Dec(i); Triad; end; begin str := ''; Nr := int(Nin); Fr := round(Nin * 100 + 0.00000001) mod 100; if Nr > 0 then Order := trunc(Log10(Nr) / 3) else begin str := 'ноль'; Order := 0 end; if Order > High(numericals) then raise Exception.Create('Слишком большое число для суммы прописью'); i := Order; Triad; str := Format('%s %s%s %.2d %s%s', [Trim(str), RusMon[1], ends[m, 2, EndingIndex(iTri)], Fr, RusMon[2], ends[f, 2, EndingIndex(Fr)]]); str[1] := (ANSIUpperCase(copy(str, 1, 1)))[1]; str[Length(str) + 1] := #0; Result := str; end; function szMoneyInWords(Nin: currency): PChar; begin sMoneyInWords(Nin); Result := @(str[1]); end; end. Взято из Советов по Delphi от Валентина Озерова Сборник Kuliba Большая просьба: протестировать, лучший вариант я положу в FAQ |