Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2004.07.04;
Скачать: CL | DM;

Вниз

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

 
MakNik   (2004-06-17 11:45) [0]

Подскажите, может у кого есть готовый,алгоритмом формирования суммы прописью на украинском языке! Заранее спасибо


 
Ozone ©   (2004-06-17 11:55) [1]

Посмотри в кладовке, там были даже компоненты на эту тему


 
Тимохов ©   (2004-06-17 12:08) [2]

вот посмотри http://dtimokhov.narod.ru/2.txt
из моего старого проекта.
разберешься как сделать на украинском.


 
Mim1 ©   (2004-06-17 15:43) [3]

Хых, я вот подумал заменить результат русской функции на украинскую в конце квартала после 4х часов автоматом.
Вот приколка то будет :)


 
Ihor Osov'yak ©   (2004-06-17 16:15) [4]

Писалось лет надцать назад, еще в рамках подготовки перехода на гривню, посему одновременная поддержка и гривни, и

карбованца..
Выбросишь то, что относится к карбованцу. Вообще то первая редакция была еще на BP7, этим и обьясняется немного

странное использование comp. Имеет смысл изменить на int64.  Аргумент - в копейках.

Зы. Вот так я писал лет с десяток назад :-(.


unit u_Str;

interface

function UnMoneyToStr(M: Comp; flGr: boolean): string;

implementation

uses SysUtils;

function IntoRight(const aSrcStr: string; aLen: word): string;
var
 wStr: string;
 i: word;
begin
 if length(aSrcStr) >= alen then
 begin
   result := aSrcStr;
   Exit;
 end;
 wStr := "";
 for i := 1 to aLen - length(aSrcStr) do
   wStr := wStr + " ";
 result := wStr + aSrcStr;
end;

function LeadingZero(aI: integer): string;
begin
 result := IntToStr(aI);
 if length(result) = 1 then
   result := "0" + result;
end;

function Get_3Digit(aVal: comp; mode: byte): word;
{mode:
 0 - коп
 1 - крб
 2 - тисячi
 3- млн
 4- млрд
 5 -трилй }
var
 s: string;
 w: word;
 i: integer;
begin
 Str(aVal: 20: 0, S);
 Trim(s);
 s := IntoRight(s, 20);
 case mode of
   0: s := Copy(s, 19, 2);
   1: s := Copy(s, 16, 3);
   2: s := Copy(s, 13, 3);
   3: s := Copy(s, 10, 3);
   4: s := Copy(s, 7, 3);
   5: s := Copy(s, 4, 3);
 end;
 Trim(S);
 if s = "" then
   s := "0";
 Val(S, W, i);
 Get_3Digit := w;
end;

const
 flWomanDigit: boolean = false;

function Conv9ToStr(w: word): string;
begin
 case w of
   0: Conv9ToStr := "";
   1: if flWomanDigit then
       Conv9ToStr := "одна"
     else
       Conv9ToStr := "один";
   2: if flWomanDigit then
       Conv9ToStr := "двi"
     else
       Conv9ToStr := "два";
   3: Conv9ToStr := "три";
   4: Conv9ToStr := "чотири";
   5: Conv9ToStr := "п""ять";
   6: Conv9ToStr := "шiсть";
   7: Conv9ToStr := "сiм";
   8: Conv9ToStr := "вiсiм";
   9: Conv9ToStr := "дев""ять";
 else
   Conv9ToStr := "??";
 end;
end;

function Conv19ToStr(w: word): string;
begin
 case w of
   0..9: Conv19ToStr := Conv9ToStr(w);
   10: Conv19ToStr := "десять";
   11: Conv19ToStr := "одинадцять";
   12: Conv19ToStr := "дванадцять";
   13: Conv19ToStr := "тринадцять";
   14: Conv19ToStr := "чотирнадцять";
   15: Conv19ToStr := "п""ятнадцять";
   16: Conv19ToStr := "шiстьнадцять";
   17: Conv19ToStr := "сiмнадцять";
   18: Conv19ToStr := "вiсiмнадцять";
   19: Conv19ToStr := "дев""ятнадцять";
 else
   Conv19ToStr := "???";
 end;
end;

function Conv999ToStr(w: word): string;
var
 H, D, O: word;
 s: string;
begin
 H := W div 100;
 D := (w mod 100) div 10;
 O := w mod 10;
 s := "";
 case H of
   0: ;
   1: s := "сто";
   2: s := "двiстi";
   3: s := "триста";
   4: s := "чотириста";
   5: s := "п""ятсот";
   6: s := "шiстьсот";
   7: s := "сiмсот";
   8: s := "вiсiмсот";
   9: s := "дев""ятсот";
 end;
 if s <> "" then
   s := s + " ";
 case D of
   0: s := s + Conv9ToStr(O);
   1: s := s + Conv19ToStr(10 + O);
 else
   begin
     case D of
       2: s := s + "двадцять " + Conv9ToStr(O);
       3: s := s + "тридцять " + Conv9ToStr(O);
       4: s := s + "сорок " + Conv9ToStr(O);
       5: s := s + "п""ятдесят " + Conv9ToStr(O);
       6: s := s + "шiстдесят " + Conv9ToStr(O);
       7: s := s + "сiмдесят " + Conv9ToStr(O);
       8: s := s + "вiсiмдесят " + Conv9ToStr(O);
       9: s := s + "девяносто " + Conv9ToStr(O);
     end;
   end;
 end;
 if s <> "" then
   s := " " + s + " ";
 //UpperRus(s);
 s := AnsiUpperCase(s);
 Conv999ToStr := s;
end;

function GramDigit(w: word): word;
begin
 GramDigit := 0;
 if w = 0 then
   exit;
 GramDigit := 3;
 if ((w > 4) and (w < 20)) then
   Exit;
 case (w mod 10) of
   1: GramDigit := 1;
   2..4: GramDigit := 2;
 end;
end;

function UnMoneyToStr(M: Comp; flGr: boolean): string;
{GrMoneyToStr(M:Comp):string;}
var
 s, pref: string;
 w: word;
begin
 pref := "";
 if M < 0 then
 begin
   pref := "МIНУС ";
   M := -M;
 end;
 flWomanDigit := false;
 s := "";
 w := Get_3Digit(M, 5);
 s := Conv999ToStr(w);
 case GramDigit(w) of
   0: ;
   1: s := s + " Трильйон ";
   2: s := s + " Трильйони ";
 else
   s := s + " Трильйонiв ";
 end;

 w := Get_3Digit(M, 4);
 s := Conv999ToStr(w);
 case GramDigit(w) of
   0: ;
   1: s := s + " Мiльярд ";
   2: s := s + " Мiльярди ";
 else
   s := s + " Мiльярдiв ";
 end;

 w := Get_3Digit(M, 3);
 s := s + Conv999ToStr(w);
 case GramDigit(w) of
   0: ;
   1: s := s + " мiльйон ";
   2: s := s + " мiльйони ";
 else
   s := s + " мiльйонiв ";
 end;

 flWomanDigit := true;

 w := Get_3Digit(M, 2);
 s := s + Conv999ToStr(w);
 case GramDigit(w) of
   0: ;
   1: s := s + " тисяча ";
   2: s := s + " тисячi ";
 else
   s := s + " тисяч ";
 end;
 flWomanDigit := flGr {true};

 w := Get_3Digit(M, 1);
 s := s + Conv999ToStr(w);
 if s = "" then
   s := "0";
 if flGr then
   s := s + " ГРН "
 else
   s := s + " КРБ ";

 s := s + " " + LeadingZero(Get_3Digit(M, 0)) + " коп.";
 //DeleteDoubleSpace(s);
 UnMoneyToStr {GrMoneyToStr} := pref + s;
end;

end.



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

Текущий архив: 2004.07.04;
Скачать: CL | DM;

Наверх




Память: 0.5 MB
Время: 0.031 c
6-1084109098
WHS
2004-05-09 17:24
2004.07.04
winsock


14-1087281882
infom
2004-06-15 10:44
2004.07.04
Gde mojno dostat ProLib for Delphi 7 , srochno nado


4-1085574862
Александр_
2004-05-26 16:34
2004.07.04
version info


14-1086964065
Delphin
2004-06-11 18:27
2004.07.04
Красивый интерфейс


4-1085114215
Random
2004-05-21 08:36
2004.07.04
реестр