FastReport - сумма прописью

== FastReport - сумма прописью ==
Если задать вопрос программисту: "что делала Ваша первая программа", то половина, наверное, ответит, что она печатала платежные поручения. Какие проблемы встают обычно при написании такой программы? А проблемы возникают следующие: как хранить платежные поручения, как их вводить и изменять, как их распечатывать. Если бы Вы сейчас стали писать такую программу, то какой генератор отчетов вы бы стали использовать? Я думаю, половина ответов была бы – FastReport. Не секрет, что генератор отчетов FastReport является одним из самых популярных генераторов отчетов в нашей стране. И эта популярность легко объяснить удобством его использования. Но в нем не хватает такой мелочи, как сумма прописью. Эта проблема опытным программистом обычно решаются очень быстро или не встает вообще. Но каждый опытный программист когда-то был начинающим. Написанием процедуры вывода суммы прописью мы и займемся.
// Для начала напишем несколько вспомогательных процедур.
// Итак, процедура номер один:
 
procedure Num(Value: byte);
begin
 case Value of
 1: if Rend = true then Result := Result + 'один ' else Result := Result + 'одна ';
 2: if Rend = true then Result := Result + 'два ' else Result := Result + 'две ';
 3: Result := Result + 'три ';
 4: Result := Result + 'четыре ';
 5: Result := Result + 'пять ';
 6: Result := Result + 'шесть ';
 7: Result := Result + 'семь ';
 8: Result := Result + 'восемь ';
 9: Result := Result + 'девять ';
 10: Result := Result + 'десять ';
 11: Result := Result + 'одиннадцать ';
 12: Result := Result + 'двенадцать ';
 13: Result := Result + 'тринадцать ';
 14: Result := Result + 'четырнадцать ';
 15: Result := Result + 'пятнадцать ';
 16: Result := Result + 'шестнадцать ';
 17: Result := Result + 'семнадцать ';
 18: Result := Result + 'восемнадцать ';
 19: Result := Result + 'девятнадцать ';
 end
end;
 
// Эта процедура добавляет число прописью в диапазоне от 1 до 19 к результату.
 
// Процедура номер два:
 
procedure Num10(Value: byte);
begin
 case Value of
 2: Result := Result + 'двадцать ';
 3: Result := Result + 'тридцать ';
 4: Result := Result + 'сорок ';
 5: Result := Result + 'пятьдесят ';
 6: Result := Result + 'шестьдесят ';
 7: Result := Result + 'семьдесят ';
 8: Result := Result + 'восемьдесят ';
 9: Result := Result + 'девяносто ';
 end;
end;
 
// Эта процедура добавляет десятки в диапазоне от 20 до 90 к результату.
 
// Процедура номер три:
 
procedure Num100(Value: byte);
begin
 case Value of
 1: Result := Result + 'сто ';
 2: Result := Result + 'двести ';
 3: Result := Result + 'триста ';
 4: Result := Result + 'четыреста ';
 5: Result := Result + 'пятьсот ';
 6: Result := Result + 'шестьсот ';
 7: Result := Result + 'семьсот ';
 8: Result := Result + 'восемьсот ';
 9: Result := Result + 'девятьсот ';
 end
end;
 
// Эта процедура добавляет сотни в диапазоне от 100 до 900 к результату.
 
// Дальше немного подробнее. Итак, процедура номер четыре:
 
// На входе число от 1 до 999
 
procedure Num00;
begin
 // Добавляем сотни если они есть
 Num100(ValueTemp div 100);
 // Отбрасываем сотни
 ValueTemp := ValueTemp mod 100;
 // Если меньше 20, то добавляем число прописью от 1 до 19
 if ValueTemp < 20 then
 Num(ValueTemp)
 else
 begin
 // Добавляем десятки
 Num10(ValueTemp div 10);
 // Отбрасываем десятки
 ValueTemp := ValueTemp mod 10;
 // Добавляем число прописью от 1 до 9
 Num(ValueTemp);
 end;
end;
 
// Процедура номер пять:
 
// Mult - Предел обработки числа
// s1- единственное число, именительный падеж (например ‘миллион’)
// s2- единственное число, родительный падеж (например ‘миллиона’)
// s3- множественное число, родительный падеж (например ‘миллионов’)
procedure NumMult(Mult: int64; s1, s2, s3: string);
var
 ValueRes: Int64;
begin
 // Если число больше предела обработки, то обрабатываем
 if Value >= Mult then
 begin
 // Выделяем число в диапазоне от 1 до 999
 ValueTemp := Value div Mult;
 ValueRes := ValueTemp;
 // Добавляем число прописью в диапазоне от 1 до 999
 Num00;
 // Добавляем обозначение числа в диапазоне от 1 до 999 (например, миллионов)
 if ValueTemp = 1 then
 Result := Result + s1
 else if (ValueTemp > 1) and (ValueTemp < 5) then
 Result := Result + s2
 else
 Result := Result + s3;
 // Вычитаем обработанное число
 Value := Value - Mult * ValueRes;
 end;
end;
 
// Собственно, сама функция "сумма прописью":
 
function TfrCalc.Propis(Value: int64): string;
var
 Rend: Boolean;
 ValueTemp, ValueOst: Int64;
 
// Описанные выше функции
begin
 // Определяем если ноль
 if (Value = 0) then
 Result := 'ноль'
 else
 begin
 Result := ;
 // устанавливаем окончания мужского рода (триллион, миллиард, миллион)
 Rend := true;
 // обрабатываем триллионы
 NumMult(1000000000000, 'триллион ', 'триллиона ', 'триллионов ');
 // обрабатываем миллиарды
 NumMult(1000000000, 'миллиард ', 'миллиарда ', 'миллиардов ');
 // обрабатываем миллионы
 NumMult(1000000, 'миллион ', 'миллиона ', 'миллионов ');
 // устанавливаем окончания женского рода (тысячи)
 Rend := false;
 // обрабатываем тысячи
 NumMult(1000, 'тысяча ', 'тысячи ', 'тысяч ');
 // устанавливаем окончания мужского рода
 Rend := true;
 ValueTemp := Value;
 Num00;
 end;
end;
 
// Я думаю, в самой функции ничего сложного нет, а если есть то можно разобраться.
// Теперь необходимо подключить нашу функцию к FastReport.
// Добавим обработчик события OnUserFuncton класса TfrReport:
 
procedure TForm1.frReport1UserFunction(const Name: string;
 p1, p2, p3: Variant; var Val: Variant);
begin
 if AnsiCompareText('Пропись', Name) = 0 then
 val := Propis(Trunc(frParser.Calc(p1)));
end;
 
// Для того чтобы функция появилась в списке функций:
 
frAddFunctionDesc(nil, 'Пропись', 'Дополнительные функции',
 'Пропись(<Число>)/Возвращает Число прописью');
 
// Итак, функцию мы написали, но не хватает одной мелочи- названия валюты.
// Итак, напишем еще тройку функций.
 
// Функция номер один записывает в S1,S2,S3 строки разделенные ';',
// например 'рубль;рубля;рублей'.
 
procedure Fst(S: string; var S1: string; var S2: string; var S3: string);
var
 pos: Integer;
begin
 S1 := ; S2 := ; S3 := ; pos := 1;
 
 while ((pos <= Length(S)) and (S[pos] <> ';')) do
 begin
 S1 := S1 + S[pos];
 Inc(pos);
 end;
 Inc(pos);
 
 while ((pos <= Length(S)) and (S[pos] <> ';')) do
 begin
 S2 := S2 + S[pos];
 Inc(pos);
 end;
 Inc(pos);
 
 while ((pos <= Length(S)) and (S[pos] <> ';')) do
 begin
 S3 := S3 + S[pos];
 Inc(pos);
 end;
 Inc(pos);
end;
 
// Функция номер два возвращает запись о валюте с нужным склонением
 
// Value – число для склонения
// Skl1 - единственное число, именительный падеж (рубль)
// Skl2 - единственное число, родительный падеж (рубля)
// Skl3 - множественное число, родительный падеж (рублей)
 
function Ruble(Value: int64; Skl: string): string;
var
 hk10, hk20: integer;
 Skl1, Skl2, Skl3: string;
begin
 Fst(Skl, Skl1, Skl2, Skl3);
 hk10 := Value mod 10;
 hk20 := Value mod 100;
 if (hk20 > 10) and (hk20 < 20) then
 Result := Result + Skl3
 else if (hk10 = 1) then
 Result := Result + Skl1
 else if (hk10 > 1) and (hk10 < 5) then
 Result := Result + Skl2
 else
 Result := Result + Skl3;
end;
 
// И то же самое для копеек.
// Функция номер три возвращает запись о копейках с нужным склонением
 
// Value – число для склонения
// Skp1 - единственное число, именительный падеж (копейка)
// Skp2 - единственное число, родительный падеж (копейки)
// Skp3 - множественное число, родительный падеж (копеек)
 
function Kopeika(Value: Integer; Skp: string): string;
var
 hk10, hk20: Integer;
 Skp1, Skp2, Skp3: string;
begin
 Fst(Skp, Skp1, Skp2, Skp3);
 hk10 := Value mod 10;
 hk20 := Value mod 100;
 if (hk20 > 10) and (hk20 < 20) then
 Result := Result + Skp3
 else if (hk10 = 1) then
 Result := Result + Skp1
 else if (hk10 > 1) and (hk10 < 5) then
 Result := Result + Skp2
 else
 Result := Result + Skp3;
end;
 
// Подключаем все это к FastReport.
// Добавляем обработчик события OnUserFuncton класса TfrReport:
 
procedure TForm1.frReport1UserFunction(const Name: string;
 p1, p2, p3: Variant; var Val: Variant);
begin
 if AnsiCompareText('Рубль', Name) = 0 then
 val := Ruble(Trunc(frParser.Calc(p1)), frParser.Calc(p2));
 
 if AnsiCompareText('Копейка', Name) = 0 then
 val := Kopeika(Trunc(frParser.Calc(p1)), frParser.Calc(p2));
end;
 
// Для того чтобы функция появилась в списке функций:
frAddFunctionDesc(nil, 'Рубль', 'Дополнительные функции',
 'Рубль(<Число>,<Рубль>,<Рубля>,<Рублей>)/Возвращает рубль прописью');
frAddFunctionDesc(nil, 'Копейка', 'Дополнительные функции',
 'Копейка(<Число>,<Копейка>,<Копейки>,<Копеек>)/Возвращает копейки прописью');
Вот вроде бы и все, что хотелось написать.
Author: Виталий Кубекин
Source: http://www.delphiplus.org
Category:Создание отчетов