Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Базы";
Текущий архив: 2003.01.16;
Скачать: [xml.tar.bz2];

Вниз

Сумма строкой   Найти похожие ветки 

 
Step   (2002-12-18 17:15) [0]

Мне нужен компонент для представления суммы строкой.
Заранее благодарен.


 
Prooksius   (2002-12-18 17:18) [1]

В инете немерянно. Поищи.


 
Sergey Masloff   (2002-12-18 17:28) [2]

{------------------------ Деньги прописью ---------------------}
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;


 
OlegE   (2002-12-18 17:30) [3]

Куда отправить?


 
dash78   (2002-12-19 15:20) [4]

адрес дай


 
MsGuns   (2002-12-19 19:33) [5]

Этот юнит можно просто включить в Uses. Здесь переводится сумма и дата на укр.язык. При небольшой коррекции будет перводить на русский 8)). Кстати, сумма СКЛОНЯЕТСЯ !


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.



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

Форум: "Базы";
Текущий архив: 2003.01.16;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.48 MB
Время: 0.008 c
3-48904
AlexVit
2002-12-20 12:37
2003.01.16
С BDE проблемы!!!


1-49031
LITTEL[MF]
2003-01-07 22:35
2003.01.16
Оформление winXP


4-49359
dumb
2002-11-30 20:23
2003.01.16
Thread Lifetime


3-48926
Nevel
2002-12-20 22:12
2003.01.16
Составил программу теперь нажна пояснительная записка


14-49214
Marser
2002-12-27 23:42
2003.01.16
В жизни любого человека





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский