Back
...
Subject: Re: [D] Сумма
прописью
Date: Sun, 19 Jul 1998 16:55:17 +0300
From: Roman Ryltsov <ryltsov@kharkov.com>
Organization: Once bitten twice shy
Newsgroups: fido.ru.delphi
References: 1
Sergey Zorenko wrote:
> Очень не хочется изобретать в
который раз велосипед.
> Hамыльте plz функцию $ -> сумма
прописью
По многочисленным просьбам
жаждущих научитсься писать
числительные прописью выставляю на
всеобщее оборзение
юнит еще тех времен, когда о виндовс
95 знал только
Билл Гейтс...
--
Sincerely, mailto:roman@swiftsoft.de
Roman Ryltsov http://surf.to/ryltsov
library NumSpell;
const hundrs: array[0..9] of String[10] = (
'', 'сто ', 'двести ', 'триста ',
'четыреста ', 'пятьсот ',
'шестьсот ', 'семьсот ', 'восемьсот ',
'девятьсот ' );
tens: array[2..9] of String[12] = (
'двадцать ', 'тридцать ', 'сорок ',
'пятьдесят ',
'шестьдесят ', 'семьдесят ',
'восемьдесят ', 'девяносто ' );
ones: array[0..19] of String[20] = (
'', 'один ', 'два ', 'три ', 'четыре ', 'пять
', 'шесть ',
'семь ', 'восемь ', 'девять ', 'десять ',
'одиннадцать ',
'двенадцать ', 'тринадцать ',
'четырнадцать ', 'пятнадцать ',
'шестнадцать ', 'семнадцать ',
'восемнадцать ', 'девятнадцать ' );
onetwo: array[0..1,1..2] of String[5] = (
('один ', 'два '), ('одна ', 'две ') );
abbrs: array[0..3,1..5] of String[12] = (
('миллиарда ', 'миллиард ',
'миллиардов ', 'млрд. ', ''),
('миллиона ', 'миллион ', 'миллионов ',
'млн. ', ''),
('тысячи ', 'тысяча ', 'тысяч ', 'тыс. ',
''),
('', '', '', '', '') );
{ ('карбованца ', 'карбованец ',
'карбованцев ', 'крб. ', 'карбованцев')
); }
function Trans1000(var S,N: string; i: integer): integer;
var x1, x2, x3: byte;
begin
x1 := Ord(N[i ]) - 48;
x2 := Ord(N[i+1]) - 48;
x3 := Ord(N[i+2]) - 48;
if x1 + x2 + x3 = 0 then
begin
if (i = 10) and (N = '000000000000') then S := S + 'ноль ';
Trans1000 := 5
end
else
begin
S := S + hundrs[x1];
if x2 < 2 then inc(x3, 10 * x2) else S := S + tens[x2];
S := S + ones[x3];
if (x3 > 4) or (x3 = 0) then Trans1000 := 3
else Trans1000 := 1 + Ord(x3 = 1);
end
end;
function SpellNum(x: extended): String; export;
var S: String; N: string[15]; i,j: integer;
begin
S := '';
if x < 0 then
begin
x := -x; S := 'минус ';
end;
Str(x:12:0, N);
i := 1; while N[i] = ' ' do begin N[i] := '0'; inc(i) end;
for j := 0 to 3 do
begin
ones[1] := onetwo[Ord(j >= 2),1];
ones[2] := onetwo[Ord(j >= 2),2];
i := Trans1000(S, N, j * 3 + 1);
S := S + abbrs[j, i];
end;
i := length(S);
while (i > 0) and (S[i] = ' ') do begin dec(S[0]); dec(i) end;
SpellNum := S;
end;
function SpellCurrency(x: extended;
const CurName: string): String; export;
var cn1, cn2: string;
i: integer;
begin
cn1 := CurName; cn2 := '';
i := Pos(';', cn1);
if i > 0 then
begin
cn2 := Copy(cn1, i+1, 255);
Delete(cn1, i, 255);
end;
Result := SpellNum(Int(x)) + ' ' + cn1;
x := Round(Frac(x) * 100);
if (cn2 <> '') then
Result := Result + ' ' + SpellNum(x) + ' ' + cn2;
end;
exports SpellNum index 1,
SpellCurrency index 2;
begin
end.
Д _RU.DELPHI (2:461/256)
ДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДД
_RU.DELPHI Д
Msg : 77 of 80
From : Andrew Bezkorovainy 2:4624/9.62 Fri 30 Aug 96 11:21
To : Alexey Solodovnikov
Subj : -Ёб<R ЇpRЇЁбмо...
ДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДД
Hг §¤p ўбвўгc, ¤RpR_Rc Alexey!
08 Aug 96 15:28, Sergey Aldoukhov wrote to Alexey Solodovnikov:
SA> 01 Aug 96, Alexey Solodovnikov writes to All:
AS>> _Ё-мв_, pls, ЁбеR¤-Ёз_Є.
=== Cut ===
unit Sum2str;
interface
uses
SysUtils, StrUtils;
function SumToSumString(Value : String) : string;
implementation
function SumToSumString(Value : String) : string;
const
S1 : array['1'..'9'] of String = (
'один ', 'два ', 'три ', ''отири ', 'п''ять ',
'ш_сть ', 'с_м ', 'в_с_м ', 'дев''ять ');
S1s : array['1'..'9'] of String = (
'одна ', 'дв_ ', 'три ', ''отири ', 'п''ять ',
'ш_сть ', 'с_м ', 'в_с_м ', 'дев''ять ');
S100 : array['1'..'9'] of String = (
'сто ', 'дв_ст_ ', 'триста ', ''отириста ',
'п''ятсот ', 'ш_стсот ', 'с_мсот ',
'в_с_мсот ', 'дев''ятьсот ');
S10 : array['1'..'9'] of String = (
'десять ', 'двад+ять ', 'трид+ять ',
'сорок ',
'п''ятдесят ', 'ш_стдесят ', 'с_мдесят ',
'в_с_мдесят ', 'дев''яносто ');
S11 : array['0'..'9'] of String = ('десять ',
'одинад+ять ', 'дванад+ять ',
'тринад+ять ', ''отирнад+ять ',
'п''ятнад+ять ', 'ш_стнад+ять ',
'с_мнад+ять ', 'в_с_мнад+ять ',
'дев''ятнад+ять ');
Ident : array[0..5] of String = (
' ', 'тися'а ', 'м_льон ', 'м_льярд ',
'трильйон ', 'трильярд ');
Idents : array[0..5] of String = (
' ', 'тися'_ ', 'м_льона ', 'м_льярда ',
'трильйона ', 'трильярда ');
Idents1 : array[0..5] of String = (
' ', 'тися' ', 'м_льон_в ', 'м_льярд_в ',
'трильйон_в ', 'трильярд_в ');
var
Precis,
Decimals : string;
function ConvertGroup(Start : byte; Value, Decs : string) :
string;
var
With1,
Enabled : boolean;
begin
Result:='';
Enabled:=false; With1:=false;
if Value<>'' then
begin
if (Length(Value) > 2) and (Value[Length(Value)-2]<>'0')
then begin Result:=S100[Value[Length(Value)-2]]; Enabled:=true
end;
if (Length(Value) > 1) and (Value[Length(Value)-1] = '1') then
begin
Result:=Result + S11[Value[Length(Value)]];
With1:=true; Enabled:=true
end
else
begin
if (Length(Value) > 1) and (Value[Length(Value)-1] <>
'0')
then begin Result:=Result + S10[Value[Length(Value)-1]];
Enabled:=true
end;
if Value[Length(Value)]<>'0' then
begin
Enabled:=true;
if Start <> 1
then Result:=Result + S1[Value[Length(Value)]]
else Result:=Result + S1s[Value[Length(Value)]]
end
else
if (Start = 0) and (Length(Value)<3) then Result:=Result +
'Нуль '
end;
if (Start > 0) then
if Enabled then
if not With1 then
case Value[Length(Value)] of
'1' : Result:=Result + Ident[Start];
'2'..'4' : Result:=Result + Idents[Start];
else Result:=Result + Idents1[Start]
end
else Result:=Result + Idents1[Start]
else
else
Result:=Result + 'крб. ' + Decs + ' коп.';
Result:=ConvertGroup(Start + 1, Copy(Value, 1, Length(Value)-3),
'') +
Result
end;
end;
begin
Decimals:='00';
if Pos(DecimalSeparator, Value) > 0 then
begin
Precis := ExtractWord(1, Value, [DecimalSeparator]);
Decimals := ExtractWord(2, Value, [DecimalSeparator])
end
else
Precis:=Value;
Result:=ConvertGroup(0, Precis, Decimals);
Result[1]:=AnsiUpperCase(Result[1])[1]
end;
end.
=== Cut ===
Hг ЇRЄ - ЇRЄ ... Andrew
--- "_¤, R- ¦_ _R<лc R- ¦_ §R<RвRc R- ¦_
GoldEd... ўб__R 2.50+ влб.- Ё¬_-Rў -Ёc
* Origin: City Financial Dept., Khmelnitsky, UA (038-22) 65236
(2:4624/9.62)
23.01.99 20:00:15