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

, 'Копейка', 'Дополнительные функции', 'Копейка(<Число>,<Копейка>,<Копейки>,<Копеек>)/Возвращает копейки прописью');

Вот вроде бы и все, что хотелось написать.

Желающие могут скачать исходные тексты примера (4.48K)

Со всеми вопросами, замечаниями, претензиями, похвалами и упреками обращайтесь по адресу

Другое по теме:

Категории

Статьи

Советы

Copyright © 2022 - All Rights Reserved - www.delphirus.com