Форум: "Основная";
Текущий архив: 2003.01.20;
Скачать: [xml.tar.bz2];

Вниз

Нужно переписать число словами   Найти похожие ветки 

← →
Term   (2003-01-10 17:57) [0]

Если кто сталкивался с такой задачей, киньте процедурку плиз

---

← →
Delirium^.Tremens   (2003-01-10 18:03) [1]

Ссылку не помню, а процедура такая есть, сам протестишь?

unit FullSum;

interface

uses SysUtils;

{ Функция перевода суммы, записанной цифрами в сумму прописью :
например, 23.12 -> двадцать три рубля 12 копеек.
переводит до 999999999 руб. 99 коп.
Функция не отслеживает, правильное ли значение получено в параметре Number
(т.е. положительное и округленное с точностью до сотых) - эту проверку
необходимо провести до вызова функции.}
//----------------- Copyright (c) 1999 by Константин Егоров
//----------------- mailto: egor@vladi.elektra.ru

function SumNumToFull(Number:real):string;

implementation

function SumNumToFull(Number:real):string;
var
PartNum, TruncNum, NumTMP, D: integer;
NumStr : string;
i, R : byte;
Flag11 : boolean;
begin
D:=1000000;
R:=4;
TruncNum:=Trunc(Number); //выделяем рубли
if TruncNum<>0
then
repeat
PartNum:=TruncNum div D;
Dec(R);
D:=D div 1000;
until PartNum<>0
else
R:=0;

// перевод рублей
FOR i:=R DOWNTO 1 DO
BEGIN
Flag11:=False;
NumTMP:=PartNum div 100; {выделение цифры сотен}
case NumTMP of
1: NumStr:=NumStr+"сто ";
2: NumStr:=NumStr+"двести ";
3: NumStr:=NumStr+"триста ";
4: NumStr:=NumStr+"четыреста ";
5: NumStr:=NumStr+"пятьсот ";
6: NumStr:=NumStr+"шестьсот ";
7: NumStr:=NumStr+"семьсот ";
8: NumStr:=NumStr+"восемьсот ";
9: NumStr:=NumStr+"девятьсот ";
end;
NumTMP:=(PartNum mod 100) div 10; {выделение цифры десятков }
case NumTMP of
1: begin
NumTMP:=PartNum mod 100;
case NumTMP of
10: NumStr:=NumStr+"десять ";
11: NumStr:=NumStr+"одиннадцать ";
12: NumStr:=NumStr+"двенадцать ";
13: NumStr:=NumStr+"тринадцать ";
14: NumStr:=NumStr+"четырнадцать ";
15: NumStr:=NumStr+"пятнадцать ";
16: NumStr:=NumStr+"шестнадцать ";
17: NumStr:=NumStr+"семнадцать ";
18: NumStr:=NumStr+"восемнадцать ";
19: NumStr:=NumStr+"девятнадцать ";
end;
case i of
3: NumStr:=NumStr+"миллионов ";
2: NumStr:=NumStr+"тысяч ";
1: NumStr:=NumStr+"рублей ";
end;
Flag11:=True;
end;
2: NumStr:=NumStr+"двадцать ";
3: NumStr:=NumStr+"тридцать ";
4: NumStr:=NumStr+"сорок ";
5: NumStr:=NumStr+"пятьдесят ";
6: NumStr:=NumStr+"шестьдесят ";
7: NumStr:=NumStr+"семьдесят ";
8: NumStr:=NumStr+"восемьдесят ";
9: NumStr:=NumStr+"девяносто ";
end;
NumTMP:=PartNum mod 10; {выделение цифры единиц}
if not Flag11 then
begin
case NumTMP of
1: if i=2 then NumStr:=NumStr+"одна " else NumStr:=NumStr+"один ";
2: if i=2 then NumStr:=NumStr+"две " else NumStr:=NumStr+"два ";
3: NumStr:=NumStr+"три ";
4: NumStr:=NumStr+"четыре ";
5: NumStr:=NumStr+"пять ";
6: NumStr:=NumStr+"шесть ";
7: NumStr:=NumStr+"семь ";
8: NumStr:=NumStr+"восемь ";
9: NumStr:=NumStr+"девять ";
end;
case i of
3: case NumTMP of
1 : NumStr:=NumStr+"миллион ";
2,3,4: NumStr:=NumStr+"миллиона ";
else NumStr:=NumStr+"миллионов ";
end;
2: case NumTMP of
1 : NumStr:=NumStr+"тысяча ";
2,3,4: NumStr:=NumStr+"тысячи ";
else if PartNum<>0 then NumStr:=NumStr+"тысяч ";
end;
1: case NumTMP of
1 : NumStr:=NumStr+"рубль ";
2,3,4: NumStr:=NumStr+"рубля ";
else NumStr:=NumStr+"рублей ";
end;
end;
end;
if i>1 then begin
PartNum:=(TruncNum mod (D*1000)) div D;
D:=D div 1000;
end;
END;

//перевод копеек
PartNum:=Round(Frac(Number)*100);
if PartNum=0 then
begin
SumNumToFull:=NumStr+"00 копеек";
Exit;
end;
NumTMP:=PartNum div 10; {выделение цифры десятков }
if NumTMP=0 then NumStr:=NumStr+"0"+IntToStr(PartNum)+" "
else NumStr:=NumStr+IntToStr(PartNum)+" ";
NumTMP:=PartNum mod 10; {выделение цифры единиц}
case NumTMP of
1: if PartNum<>11 then NumStr:=NumStr+"копейка"
else NumStr:=NumStr+"копеек";
2,3,4: if (PartNum<5) or (PartNum>14)
then NumStr:=NumStr+"копейки"
else NumStr:=NumStr+"копеек";
else NumStr:=NumStr+"копеек";
end;
SumNumToFull:=NumStr;
end; //---SumNumToFull

end.


---

← →
MsGuns   (2003-01-10 18:32) [2]

По украински:

unit _CnvDatU;

interface
uses Controls, SysUtils;

type
ADateStrUkr = record
DtNumb: integer;
DtMonth: string;
DtYear: integer;
end;

Const
UkrMonth_Tx: array [1..12] of string = ("січня","лютого","березня","квітня","травня",
"червня","липня","серпня","вересня","жовтня","листопада","грудня");
UkrNumber_10: array[0..9] of string = ("","один","два","три","чотири","п`ять","шість","сім","вісім","дев`ять");
UkrNumber_100: array[1..9] of string = ("","двадцять","тридцять","сорок","п`ятдесят","шістдесят","сімдесят","вісімдесят","дев`яносто");
UkrNumber_1000: array[0..9] of string = ("","сто","двісті","триста","чотириста","п`ятьсот","шістьсот","сімсот","вісімсот","дев`ятсот");
UkrNumber_20: array[0..9] of string = ("десять","одинадцять","дванадцять","тринадцять","чотирнадцять","п`ятнадцять","шістнадцять","сімнадцять","вісімнадцять","дев`ятнадцять");
UkrNumber_Ezp: array[0..5] of string = ("","тисяча","мільон","мільярд","трильйон","квадрильйон");
UkrNumber_Tht: array [0..9] of string = ("","а","і","і","і","","","","","");
UkrNumber_Mln: array [0..9] of string = ("ів","","а","а","а","ів","ів","ів","ів","ів");

function Ms_ConvertDataUkr(var DateStr: ADateStrUkr; Date: TDate): string;
function Ms_ConvertSummaUkr(Vl,VlD: string; VlSex: boolean; Sum: extended): string;

implementation

function Ms_ConvertDataUkr(var DateStr: ADateStrUkr; Date: TDate): string;
// Функция конвертирования даты в строку на украинском языке с
// параллельным заполнением структуры ADateStrUkr
var
d,m,y: word;
begin
result := "Error";
try
result := DateToStr(Date);
except
exit;
end;
DecodeDate(Date,y,m,d);
DateStr.DtNumb := d;
DateStr.DtYear := y;
DateStr.DtMonth := UkrMonth_Tx[m];
result := IntToStr(DateStr.DtNumb)+" "+DateStr.DtMonth+" "+IntToStr(DateStr.DtYear)+" г.";
end;

function Ms_ConvertSummaUkr(Vl,VlD: string; VlSex: boolean; Sum: extended): string;
// Функция конвертирования суммы-числа в строку на украинском языке
// Vl - название валюты, VlD - название копеек валюты, VlSex - род валюты: true-муж, false-жен
var
i,n,t: integer;
s: string;

function CompTriada(Numb: integer): string;
// функция получения текстового фрагмента числа от 1 до 999
var
e: integer;

function ConcatString(Const AllLine, Line: string): string;
// процедура присоединения к строке нового фрагмента
begin
result := AllLine;
if Line>"" then
begin
if result>"" then result := result+" ";
result := result+Line;
end;
end;

begin
result := "";
e := Numb mod 100; // Число в сотне (0-99)
result := UkrNumber_1000[Numb div 100]; // Сотни
if e<10 then result := ConcatString(result,UkrNumber_10[e]);
if e in [10..19] then result := ConcatString(result,UkrNumber_20[e-10]);
if e>19 then
begin
result := ConcatString(result,UkrNumber_100[e div 10]) ; // Десятки
result := ConcatString(result,UkrNumber_10[e mod 10]) ; // Единицы
end;
end;

begin
result := "";
n := Round(Sum); // Рубли
i := 0;
while n>0 do // Выделение триад и их конвертация в строку
begin
t := n mod 1000; // Выделение числа-триады
s := CompTriada(t);
if s>"" then
begin
if (i=1) or ((i=0) and (Not VlSex)) then
begin
if (Length(s)>5) and (Copy(s,Length(s)-3,4)="один") then
s := Copy(s,1,Length(s)-4)+"одна";
if (Length(s)>5) and (Copy(s,Length(s)-2,3)="два") then
s := Copy(s,1,Length(s)-3)+"две";
end;
s := s+" "+UkrNumber_Ezp[i];
if i=1 then
begin
if t mod 100 in [10..19] then
s := Copy(s,1,Length(s)-1)
else
begin
s := Copy(s,1,Length(s)-1)+UkrNumber_Tht[t mod 10];
end;
end;
if i>1 then
begin
if t mod 100 in [10..19] then
s := s+"ів"
else
s := s+UkrNumber_Mln[t mod 10];
end;
result := s+" "+result;
end;
n := n div 1000;
inc(i);
end;
if result>"" then
result := AnsiUpperCase(Copy(result,1,1))+Copy(result,2,Length(result)-1)+Vl+" ";
// Обработка копеек
s := IntToStr(Round(Sum*100) Mod 100);
if Length(s)=1 then s := "0"+s; // nn копеек
result := result+s+" "+VlD;
end;

end.

---

← →
Term   (2003-01-11 12:59) [3]

Спасибо

---

Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2003.01.20;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.47 MB
Время: 0.009 c