Работа с числами
Code: |
{ **** UBPFD *********** by kladovka.net **** >> Конвертация : Римские -> арабские ; Арабские->Римские
Зависимости: Автор: Gua, fbsdd ukr.net, ICQ:141585495, Simferopol Copyright: Дата: 03 мая 20012 г. ********************************************** }
Const R: Array[1..13] ofString[2] = ('I','IV','V','IX','X','XL','L','XC','C','CD','D','CM','M'); A: Array[1..13] of Integer= (1,4,5,9,10,40,50,90,100,400,500,900,1000);
..............
Function RomanToArabic(S : String) : Integer; //Римские в арабские var i, p : Integer; begin Result := 0; i := 13; p := 1; While p <=Length(S) do begin While Copy(S, p, Length(R[i])) <>R[i] do begin Dec(i); If i = 0then Exit; end; Result := Result + A[i]; p := p + Length(R[i]); end; end; |
- Подробности
- Родительская категория: Язык программирования Дельфи
- Категория: Работа с числами
Преобразование числа с плавающей точкой (далее в этом разделе просто числа) в текстовую строку и обратно всегда было достаточно сложной задачей. Для ее решения в Delphi есть функции сразу трех уровней сложности.
Первый — самый простой — представлен функцией FloatToStr:
Code: |
function FloatToStr( Value : Extended): string; |
Число, заданное параметром Value, преобразуется в возвращаемую функцией строку. Формат преобразования соответствует типу преобразования g функции Format, причем длина выходной строки принимается равной 15 символам.
Больше возможностей для управления форматом вывода дает функция:
Code: |
function PloatToStrF(Value: Extended; Format: TFloatFormat; Precision, Digits: Integer): string; |
Здесь Value — преобразуемое значение, Format — один из предопределенных форматов. Хотя этот параметр имеет тип TFloatFormat, он имеет очень много общего с типами преобразований в функции Format (ссылки на них есть в предлагаемой таблице). Параметр Precision задает общее число символов в выходной строке и не должен превышать 7 для фактического параметра типа Single, 15 — для Double и 18 — для Extended. Digits — это параметр, интерпретируемый в зависимости от значения параметра Format:
ffExponent Научный формат, соответствует типу е. Precision задает общее число символов, Digits — число знаков в показателе экспоненты {0-4).
ffFixed Формат с фиксированной точкой; соответствует типу f. Precision задает общее число символов, Digits — число знаков после запятой (0-18). Если значение Precision мало для представления числа, используется научный формат.
ffGeneral Обобщенный формат, соответствует типу д (см. описание функции Format).
ffNumber Отличается от fTFixed наличием символов-разделителей тысяч (см. тип преобразования п).
ffCurrency Соответствует типу преобразования т. Параметр Digits задает число символов после десятичной точки в выходной строке (0-18).
В случае, когда в функцию переданы значения Value, соответствующие особым случаям сопроцессора ("не-число", плюс и минус бесконечность), она возвращает соответственно строки 'NAN', 'INF' и '-INF'.
Наконец, возможность полного управления форматом предоставляет функция FormatFloat:
function FormatFloat(const Format: string; Value: Extended): string;
Она преобразует число в строку в соответствии со спецификатором формата, содержащимся в параметре Format. Правила его задания следующие:
0 Поле для цифры. Если форматируемая величина имеет в этой позиции цифру, то вставляется она, в противном случае вставляется 0.
# Поле для цифры. Если форматируемая величина имеет в этой позиции цифру, то вставляется она, в противном случае ничего не вставляется.
Поле для десятичной точки. Сюда вставляется символ, определенный константой DecimalSeparator.
; Поле для разделителя тысяч. Оно означает, что группы по три цифры, считая влево от десятичной точки, будут разделяться специальным символом (он задан константой ThousandSeparator). Местоположение поля может быть произвольным.
Е+, Е-, е+, е- Признаки представления числа в научном формате. Появление любого из этих аргументов означает, что число будет преобразовано с характеристикой и мантиссой. Вставка нулей после такого аргумента позволяет определить ширину мантиссы. Разница между Е+, е+ и Е-, е-в том, что в первых двух случаях ставится "+" при выводе положительных чисел.
'хх' "хх" Символы, заключенные в обычные или двойные кавычки, напрямую включаются в выходную строку.
; Разделяет спецификаторы формата для положительных, отрицательных и нулевых чисел.
Примечания:
1. Число всегда округляется до той точности, которую позволяет заданное программистом количество полей для размещения цифр ('0' и '#').
2. Если у преобразуемого числа слева от десятичной точки получается больше значащих цифр, чем задано полей для их размещения, то цифры все равно добавляются в строку. Если полей недостаточно справа от точки, происходит округление.
3. Символ ';' позволяет задать три разных формата вывода для чисел с разным знаком. При различном количестве форматов они применяются следующим образом:
• один: применяется для всех чисел;
• два: первый применяется для чисел, больших или равных нулю, второй — для отрицательных;
• три: первьш применяется для положительных, второй — для отрицательных чисел, третий — для нуля.
Если форматы для отрицательных чисел или нуля пусты, применяется формат для положительных чисел.
Если пуст формат для положительных чисел или спецификатор формата вообще не задан (пустая строка), то числа форматируются согласно обобщенному формату (как в функции FloatToStr). Такое форматирование применяется также в случае, если число значащих цифр слева от десятичной точки превысило 18 и не задан научный формат.
Применение спецификатора иллюстрируется в таблице на примере преобразования четырех чисел:
Спецификатор
1234 -1234 0.5 0
0 1234 -1234 1 0
0.00 1234.00 -1234.00 0.50 0.00
#.## 1234 -1234 .5
#.##0.00 1,234.00 -1,234.00 0.50 0.00
#,##0.00;(#,##0.00) 1,234.00 (1,234.00) 0.50 0.00
#,##0.00;;Zero 1,234.00 -1,234.00 0.50 Zero
О.ОООЕ+00 1.234Е+03 -1.234Е+03 5.000Е-01 О.ОООЕ+00
#.###Е-0 1.234ЕЗ -1.234ЕЗ 5Е-1 ОЕО
Две следующие функции применяют те же правила, что и рассмотренные выше функции, но отличаются параметрами:
Code: |
function FloatToText(Buffer: PChar; Value: Extended; Format: TFloatFormat; Precision, Digits: Integer) : Integer; |
Соответствует FloatToStrF, но выходная строка помещается в буфер Buffer (без начальной длины!), а число символов в ней возвращается самой функцией.
Code: |
function FloatToTextFmt(Buffer: PChar; Value: Extended; Format: PChar): Integer; |
Соответствует FormatFloat, но выходная строка помещается в буфер Buffer (без начальной длины!), а число символов в ней возвращается самой функцией.
Наконец, процедура:
Code: |
procedure FloatToDecimal(var Result: TFloatRec; Value: Extended; Precision, Decimals: Integer); |
Производит подготовительный анализ преобразуемого числа, занося в поля записи Result различные его характеристики.
Перейдем к рассмотрению функций преобразования текстовой строки в число. Их две — соответственно для строк типа string и PChar:
Code: |
function StrToPloat(const S: string): Extended; function TextToFloat(Buffer: PChar; var Value: Extended): Boolean; |
Общие правила для передаваемой в функцию строки таковы:
• допускаются как научный, так и фиксированный форматы;
• в качестве десятичной точки должен выступать символ, который содержится в DecimalSeparator;
• не допускаются символы-разделители тысяч (ThousandSeparator), а также символы обозначения денежньк единиц.
В случае ошибки преобразования функция StrToFloat генерирует исключительную ситуацию EConvertError, a TextToFloat — возвращает значение False.
- Подробности
- Родительская категория: Язык программирования Дельфи
- Категория: Работа с числами
Автор Александр
Code: |
{------------------------ Деньги прописью ---------------------} function TextSum(S: double): string;
function Conv999(M: longint; fm: integer): string; const
c1to9m: array[1..9] ofstring[6] = ('один', 'два', 'три', 'четыре', 'пять', 'шесть', 'семь', 'восемь', 'девять'); c1to9f: array[1..9] ofstring[6] = ('одна', 'две', 'три', 'четыре', 'пять', 'шесть', 'семь', 'восемь', 'девять'); c11to19: array[1..9] ofstring[12] = ('одиннадцать', 'двенадцать', 'тринадцать', 'четырнадцать', 'пятнадцать', 'шестнадцать', 'семнадцать', 'восемнадцать', 'девятнадцать'); c10to90: array[1..9] ofstring[11] = ('десять', 'двадцать', 'тридцать', 'сорок', 'пятьдесят', 'шестьдесят', 'семьдесят', 'восемьдесят', 'девяносто'); c100to900: array[1..9] ofstring[9] = ('сто', 'двести', 'триста', 'четыреста', 'пятьсот', 'шестьсот', 'семьсот', 'восемьсот', 'девятьсот'); var
s: string; i: longint; begin
s := ''; i := M div100; if i <> 0then s := c100to900[i] + ' '; M := M mod100; i := M div10; if (M > 10) and (M < 20) then s := s + c11to19[M - 10] + ' ' else begin if i <> 0then s := s + c10to90[i] + ' '; M := M mod10; if M <> 0then if fm = 0then 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 <> 0then begin t := t + Conv999(j, 1) + 'миллиард'; j := j mod100; if (j > 10) and (j < 20) then t := t + 'ов ' else case j mod10of 0: t := t + 'ов '; 1: t := t + ' '; 2..4: t := t + 'а '; 5..9: t := t + 'ов '; end; end;
j := i div1000000; if j <> 0then begin t := t + Conv999(j, 1) + 'миллион'; j := j mod100; if (j > 10) and (j < 20) then t := t + 'ов ' else case j mod10of 0: t := t + 'ов '; 1: t := t + ' '; 2..4: t := t + 'а '; 5..9: t := t + 'ов '; end; end;
i := i mod1000000; j := i div1000; if j <> 0then begin t := t + Conv999(j, 0) + 'тысяч'; j := j mod100; if (j > 10) and (j < 20) then t := t + ' ' else case j mod10of 0: t := t + ' '; 1: t := t + 'а '; 2..4: t := t + 'и '; 5..9: t := t + ' '; end; end;
i := i mod1000; j := i; if j <> 0then t := t + Conv999(j, 1); t := t + 'руб. ';
i := Round(Frac(S) * 100.0); t := t + Long2Str(i) + ' коп.'; TextSum := t; end; |
Code: |
unit RoubleUnit; {$D Пропись © Близнец Антон '99 https:\\anton-bl.chat.ru\delphi\} { 1000011.01->'Один миллион одинадцать рублей 01 копейка' } interface function RealToRouble(c: Extended): string; implementation uses SysUtils, math; const Max000 = 6; {Кол-во триплетов - 000} MaxPosition = Max000 * 3; {Кол-во знаков в числе } //Аналог IIF в Dbase есть в proc.pas для основных типов, частично объявлена тут для независимости function IIF(i: Boolean; s1, s2: Char): Char; overload; beginif i then result := s1 else result := s2 end; function IIF(i: Boolean; s1, s2: string): string; overload; beginif i then result := s1 else result := s2 end;
function NumToStr(s: string): string; {Возвращает число прописью} const c1000: array[0..Max000] ofstring = ('', 'тысяч', 'миллион', 'миллиард', 'триллион', 'квадраллион', 'квинтиллион');
c1000w: array[0..Max000] of Boolean = (False, True, False, False, False, False, False); w: array[False..True, '0'..'9'] ofstring[3] = (('ов ', ' ', 'а ', 'а ', 'а ', 'ов ', 'ов ', 'ов ', 'ов ', 'ов '), (' ', 'а ', 'и ', 'и ', 'и ', ' ', ' ', ' ', ' ', ' ')); function Num000toStr(S: string; woman: Boolean): string; {Num000toStr возвращает число для триплета} const c100: array['0'..'9'] ofstring = ('', 'сто ', 'двести ', 'триста ', 'четыреста ', 'пятьсот ', 'шестьсот ', 'семьсот ', 'восемьсот ', 'девятьсот '); c10: array['0'..'9'] ofstring = ('', 'десять ', 'двадцать ', 'тридцать ', 'сорок ', 'пятьдесят ', 'шестьдесят ', 'семьдесят ', 'восемьдесят ', 'девяносто '); c11: array['0'..'9'] ofstring = ('', 'один', 'две', 'три', 'четыр', 'пят', 'шест', 'сем', 'восем', 'девят'); c1: array[False..True, '0'..'9'] ofstring = (('', 'один ', 'два ', 'три ', 'четыре ', 'пять ', 'шесть ', 'семь ', 'восемь ', 'девять '), ('', 'одна ', 'две ', 'три ', 'четыре ', 'пять ', 'шесть ', 'семь ', 'восемь ', 'девять ')); begin{Num000toStr} Result := c100[s[1]] + iif((s[2] = '1') and (s[3] > '0'), c11[s[3]] + 'надцать ', c10[s[2]] + c1[woman, s[3]]); end; {Num000toStr}
var s000: string[3];
isw, isMinus: Boolean; i: integer; //Счётчик триплетов begin
Result := ''; i := 0; isMinus := (s <> '') and (s[1] = '-'); if isMinus then s := Copy(s, 2, Length(s) - 1); whilenot ((i >= Ceil(Length(s) / 3)) or (i >= Max000)) do begin s000 := Copy('00' + s, Length(s) - i * 3, 3); isw := c1000w[i]; if (i > 0) and (s000 <> '000') then//тысячи и т.д. Result := c1000[i] + w[Isw, iif(s000[2] = '1', '0', s000[3])] + Result; Result := Num000toStr(s000, isw) + Result; Inc(i) end; if Result = ''then Result := 'ноль'; if isMinus then Result := 'минус ' + Result; end; {NumToStr}
function RealToRouble(c: Extended): string;
const ruble: array['0'..'9'] ofstring[2] = ('ей', 'ь', 'я', 'я', 'я', 'ей', 'ей', 'ей', 'ей', 'ей'); Kopeek: array['0'..'9'] ofstring[3] = ('ек', 'йка', 'йки', 'йки', 'йки', 'ек', 'ек', 'ек', 'ек', 'ек');
function ending(const s: string): Char; var l: Integer; //С l на 8 байт коротче $50->$48->$3F begin//Возвращает индекс окончания l := Length(s); Result := iif((l > 1) and (s[l - 1] = '1'), '0', s[l]); end;
var rub: string[MaxPosition + 3]; kop: string[2]; begin{Возвращает число прописью с рублями и копейками}
Str(c: MaxPosition + 3: 2, Result); if Pos('E', Result) = 0then//Если число можно представить в строке <>1E+99 begin rub := TrimLeft(Copy(Result, 1, Length(Result) - 3)); kop := Copy(Result, Length(Result) - 1, 2); Result := NumToStr(rub) + ' рубл' + ruble[ending(rub)] + ' ' + kop + ' копе' + Kopeek[ending(kop)]; Result := AnsiUpperCase(Result[1]) + Copy(Result, 2, Length(Result) - 1); end; end; end. |
Редянов Денис
Code: |
function CifrToStr(Cifr: string; Pr: Integer; Padeg: Integer): string; {Функция возвращает прописью 1 цифры признак 3-единицы 2-десятки 1-сотни 4-11-19
Padeg - 1-нормально 2- одна, две } var i: Integer; begin
i := StrToInt(Cifr); if Pr = 1then case i of 1: CifrToStr := 'сто'; 2: CifrToStr := 'двести'; 3: CifrToStr := 'триста'; 4: CifrToStr := 'четыреста'; 5: CifrToStr := 'пятьсот'; 6: CifrToStr := 'шестьсот'; 7: CifrToStr := 'семьсот'; 8: CifrToStr := 'восемьсот'; 9: CifrToStr := 'девятьсот'; 0: CifrToStr := ''; end elseif Pr = 2then case i of 1: CifrToStr := ''; 2: CifrToStr := 'двадцать'; 3: CifrToStr := 'тридцать'; 4: CifrToStr := 'сорок'; 5: CifrToStr := 'пятьдесят'; 6: CifrToStr := 'шестьдесят'; 7: CifrToStr := 'семьдесят'; 8: CifrToStr := 'восемьдесят'; 9: CifrToStr := 'девяносто'; 0: CifrToStr := ''; end elseif Pr = 3then case i of 1: if Padeg = 1then CifrToStr := 'один' else CifrToStr := 'одна'; 2: if Padeg = 1then CifrToStr := 'два' else CifrToStr := 'две'; 3: CifrToStr := 'три'; 4: CifrToStr := 'четыре'; 5: CifrToStr := 'пять'; 6: CifrToStr := 'шесть'; 7: CifrToStr := 'семь'; 8: CifrToStr := 'восемь'; 9: CifrToStr := 'девять'; 0: CifrToStr := ''; end elseif Pr = 4then case i of 1: CifrToStr := 'одиннадцать'; 2: CifrToStr := 'двенадцать'; 3: CifrToStr := 'тринадцать'; 4: CifrToStr := 'четырнадцать'; 5: CifrToStr := 'пятнадцать'; 6: CifrToStr := 'шестнадцать'; 7: CifrToStr := 'семнадцать'; 8: CifrToStr := 'восемнадцать'; 9: CifrToStr := 'девятнадцать'; 0: CifrToStr := 'десять';
end; end;
function Rasryad(K: Integer; V: string): string; {Функция возвращает наименование разряда в зависимости от последних 2 цифр его} var j: Integer; begin
j := StrToInt(Copy(v, Length(v), 1)); if (StrToInt(Copy(v, Length(v) - 1, 2)) > 9) and (StrToInt(Copy(v, Length(v) - 1, 2)) < 20) then case K of 0: Rasryad := ''; 1: Rasryad := 'тысяч'; 2: Rasryad := 'миллионов'; 3: Rasryad := 'миллиардов'; 4: Rasryad := 'триллионов'; end else case K of 0: Rasryad := ''; 1: case j of 1: Rasryad := 'тысяча'; 2..4: Rasryad := 'тысячи'; else Rasryad := 'тысяч'; end; 2: case j of 1: Rasryad := 'миллион'; 2..4: Rasryad := 'миллионa'; else Rasryad := 'миллионов'; end; 3: case j of 1: Rasryad := 'миллиард'; 2..4: Rasryad := 'миллиарда'; else Rasryad := 'миллиардов'; end; 4: case j of 1: Rasryad := 'триллион'; 2..4: Rasryad := 'триллиона'; else Rasryad := 'триллионов'; end; end; end;
function GroupToStr(Group: string; Padeg: Integer): string; {Функция возвращает прописью 3 цифры} var i: Integer;
S: string; begin
S := ''; if (StrToInt(Copy(Group, Length(Group) - 1, 2)) > 9) and (StrToInt(Copy(Group, Length(Group) - 1, 2)) < 20) then begin if Length(Group) = 3then S := S + ' ' + CifrToStr(Copy(Group, 1, 1), 1, Padeg); S := S + ' ' + CifrToStr(Copy(Group, Length(Group), 1), 4, Padeg); end else for i := 1to Length(Group) do S := S + ' ' + CifrToStr(Copy(Group, i, 1), i - Length(Group) + 3, Padeg); GroupToStr := S; end;
{Функция возвращает сумму прописью} function RubToStr(Rubs: Currency; Rub, Kop: string): string; var i, j: Integer;
R, K, S: string; begin
S := CurrToStr(Rubs); S := Trim(S); if Pos(',', S) = 0then begin R := S; K := '00'; end else begin R := Copy(S, 0, (Pos(',', S) - 1)); K := Copy(S, (Pos(',', S) + 1), Length(S)); end;
S := ''; i := 0; j := 1; while Length(R) > 3do begin if i = 1then j := 2 else j := 1; S := GroupToStr(Copy(R, Length(R) - 2, 3), j) + ' ' + Rasryad(i, Copy(R, Length(R) - 2, 3)) + ' ' + S; R := Copy(R, 1, Length(R) - 3); i := i + 1; end; if i = 1then j := 2 else j := 1; S := Trim(GroupToStr(R, j) + ' ' + Rasryad(i, R) + ' ' + S + ' ' + Rub + ' ' + K + ' ' + Kop); S := ANSIUpperCase(Copy(S, 1, 1)) + Copy(S, 2, Length(S) - 1); RubToStr := S; end; |
Вот еще одно решение, присланное Олегом Клюкач.
Code: |
unit Numinwrd;
interface function sMoneyInWords(Nin: currency): string; export; function szMoneyInWords(Nin: currency): PChar; export; { Денежная сумма Nin в рублях и копейках прописью
1997, в.2.1, by О.В.Болдырев}
implementation uses SysUtils, Dialogs, Math;
type
tri = string[4]; mood = 1..2; gender = (m, f); uns = array[0..9] ofstring[7]; tns = array[0..9] ofstring[13]; decs = array[0..9] ofstring[12]; huns = array[0..9] ofstring[10]; nums = array[0..4] ofstring[8]; money = array[1..2] ofstring[5]; endings = array[gender, mood, 1..3] of tri; {окончания числительных и денег}
const
units: uns = ('', 'один ', 'два ', 'три ', 'четыре ', 'пять ', 'шесть ', 'семь ', 'восемь ', 'девять '); unitsf: uns = ('', 'одна ', 'две ', 'три ', 'четыре ', 'пять ', 'шесть ', 'семь ', 'восемь ', 'девять '); teens: tns = ('десять ', 'одиннадцать ', 'двенадцать ', 'тринадцать ', 'четырнадцать ', 'пятнадцать ', 'шестнадцать ', 'семнадцать ', 'восемнадцать ', 'девятнадцать '); decades: decs = ('', 'десять ', 'двадцать ', 'тридцать ', 'сорок ', 'пятьдесят ', 'шестьдесят ', 'семьдесят ', 'восемьдесят ', 'девяносто '); hundreds: huns = ('', 'сто ', 'двести ', 'триста ', 'четыреста ', 'пятьсот ', 'шестьсот ', 'семьсот ', 'восемьсот ', 'девятьсот '); numericals: nums = ('', 'тысяч', 'миллион', 'миллиард', 'триллион'); RusMon: money = ('рубл', 'копе'); ends: endings = ((('', 'а', 'ов'), ('ь', 'я', 'ей')), (('а', 'и', ''), ('йка', 'йки', 'ек'))); threadvar
str: string;
function EndingIndex(Arg: integer): integer; begin
if ((Arg div10) mod10) <> 1then case (Arg mod10) of 1: Result := 1; 2..4: Result := 2; else Result := 3; end else Result := 3; end;
function sMoneyInWords(Nin: currency): string; { Число Nin прописью, как функция } var // str: string;
g: gender; //род Nr: comp; {целая часть числа} Fr: integer; {дробная часть числа} i, iTri, Order: longint; {триада}
procedure Triad; var iTri2: integer; un, de, ce: byte; //единицы, десятки, сотни
function GetDigit: byte; begin Result := iTri2 mod10; iTri2 := iTri2 div10; end;
begin iTri := trunc(Nr / IntPower(1000, i)); Nr := Nr - int(iTri * IntPower(1000, i)); iTri2 := iTri; if iTri > 0then begin un := GetDigit; de := GetDigit; ce := GetDigit; if i = 1then g := f else g := m; {женского рода только тысяча}
str := TrimRight(str) + ' ' + Hundreds[ce]; if de = 1then str := TrimRight(str) + ' ' + Teens[un] else begin str := TrimRight(str) + ' ' + Decades[de]; case g of m: str := TrimRight(str) + ' ' + Units[un]; f: str := TrimRight(str) + ' ' + UnitsF[un]; end; end;
if length(numericals[i]) > 1then begin str := TrimRight(str) + ' ' + numericals[i]; str := TrimRight(str) + ends[g, 1, EndingIndex(iTri)]; end; end; //triad is 0 ?
if i = 0then Exit; Dec(i); Triad; end;
begin
str := ''; Nr := int(Nin); Fr := round(Nin * 100 + 0.00000001) mod100; if Nr > 0then Order := trunc(Log10(Nr) / 3) else begin str := 'ноль'; Order := 0 end; if Order > High(numericals) then raise Exception.Create('Слишком большое число для суммы прописью'); i := Order; Triad; str := Format('%s %s%s %.2d %s%s', [Trim(str), RusMon[1], ends[m, 2, EndingIndex(iTri)], Fr, RusMon[2], ends[f, 2, EndingIndex(Fr)]]); str[1] := (ANSIUpperCase(copy(str, 1, 1)))[1]; str[Length(str) + 1] := #0; Result := str; end;
function szMoneyInWords(Nin: currency): PChar; begin
sMoneyInWords(Nin); Result := @(str[1]); end;
end. |
Взято из Советов по Delphi от Валентина Озерова
Сборник Kuliba
Code: |
unit FullSum;
interface
uses SysUtils;
{ Функция перевода суммы, записанной цифрами в сумму прописью : например, 23.12 -> двадцать три рубля 12 копеек. переводит до 999999999 руб. 99 коп. Функция не отслеживает, правильное ли значение получено в параметре Number (т.е. положительное и округленное с точностью до сотых) - эту проверку необходимо провести до вызова функции. }
//----------------- Copyright (c) 1999 by Константин Егоров //----------------- mailto: egor vladi.elektra
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<>0then repeat PartNum:=TruncNum div D; Dec(R); D:=D div1000; until PartNum<>0 else R:=0;
// перевод рублей for i:=R downto1do begin Flag11:=False; // выделение цифры сотен NumTMP:=PartNum div100; 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 mod100) div10; case NumTMP of 1: begin NumTMP:=PartNum mod100; 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 mod10; ifnot Flag11 then begin case NumTMP of 1: if i=2then NumStr:=NumStr+'одна ' else NumStr:=NumStr+'один '; 2: if i=2then 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<>0then NumStr:=NumStr+'тысяч '; end; 1: case NumTMP of 1 : NumStr:=NumStr+'рубль '; 2,3,4: NumStr:=NumStr+'рубля '; else NumStr:=NumStr+'рублей '; end; end; end; if i>1then begin PartNum:=(TruncNum mod (D*1000)) div D; D:=D div1000; end; end;
//перевод копеек PartNum:=Round(Frac(Number)*100); if PartNum=0then begin SumNumToFull:=NumStr+'00 копеек'; Exit; end; // выделение цифры десятков NumTMP:=PartNum div10; if NumTMP=0then NumStr:=NumStr+'0'+IntToStr(PartNum)+' ' else NumStr:=NumStr+IntToStr(PartNum)+' '; // выделение цифры единиц NumTMP:=PartNum mod10; case NumTMP of 1: if PartNum<>11then 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;
end.
|
https://delphiworld.narod
DelphiWorld 6.0
Code: |
{ Преобразует трехзначное число в строку } function ConvertToWord(N: word): string; const Sot : array[1..9] ofstring[13] = ('сто','двести','триста','четыреста','пятьсот', 'шестьсот','семьсот','восемьсот','девятьсот');
Des : array[2..9] ofstring[13] = ('двадцать','тридцать','сорок','пятьдесят', 'шестьдесят','семьдесят','восемьдесят','девяносто');
Edin : array[0..19] ofstring[13] = ('','один','два','три','четыре','пять','шесть','семь', 'восемь','девять','десять','одиннадцать','двенадцать', 'тринадцать','четырнадцать','пятнадцать', 'шестнадцать','семнадцать','восемнадцать','девятнадцать');
var S: string; begin S:=''; N:=N mod1000; if N>99then begin S:=Sot[N div100]+' '; N:=N mod100; end; if N>19then begin S:=S+Des[N div10]+' '; N:=N mod10; end; Result:=S+Edin[N]; end;
{ Возвращает сумму прописью } function CenaToStr(r: Currency): string; var N, k: longint; S: string; begin N:=trunc(R); S:=''; if N<>0then begin if N>999999then begin k:=N div1000000; S:=ConvertToWord(k); if ((k-(k div100)*100)>10) and ((k-(k div100)*100)<20) then S:=S+' миллионов' else if (k mod10)=1then S:=S+' миллион' else if ((k mod10)>=2)and((k mod10)<=4) then S:=S+' миллиона' else S:=S+' миллионов'; N:=N mod1000000; end; if N>999then begin k:=N div1000; S:=S+' '+ConvertToWord(k); if ((k-(k div100)*100)>10)and((k-(k div100)*100)<20) then S:=S+' тысяч' else if (k mod10)=1then begin SetLength(S, Length(S)-2); S:=S+'на тысяча'; end else if (k mod10)=2then begin SetLength(S, length(S)-1); S:=S+'е тысячи'; end else if ((k mod10)>=3)and((k mod10)<=4) then S:=S+' тысячи' else S:=S+' тысяч'; N:=N mod1000; end; k:=N; S:=S+' '+ConvertToWord(k); if ((k-(k div100)*100)>10)and((k-(k div100)*100)<20) then S:=S+' рублей' else if (k mod10)=1then S:=S+' рубль' else if (k mod10)=2then S:=S+' рубля' else if ((k mod10)>=3)and((k mod10)<=4) then S:=S+' рубля' else S:=S+' рублей'; end; if trunc(R)<>R then begin k:=round(frac(R)*100); S:=S+' '+IntToStr(K); if ((k-(k div100)*100)>10)and((k-(k div100)*100)<20) then S:=S+' копеек' else if (k mod10)=1then begin S:=S+' копейка'; end else if (k mod10)=2then begin S:=S+' копейки'; end else if ((k mod10)>=3)and((k mod10)<=4) then S:=S+' копейки' else S:=S+' копеек'; end else S:=S+' 00 копеек'; S:=Trim(S); if S<>''then S[1]:=AnsiUpperCase(S[1])[1]; result:=S; end;
|
https://delphiworld.narod
DelphiWorld 6.0
Code: |
{ **** UBPFD *********** by delphibase.endimus **** >> Сумма прописью
Данный набор функций позволяет из суммы в числовом виде получить её представление прописью. Реализована возможность работы с рублями и долларами. Возможно добавление какой угодно валюты.
Зависимости: SysUtils Автор: fnatali, fnatali yandex.ru, Березники Copyright: Евгений Меньшенин <johnmen mail.ru> Дата: 27 апреля 2002 г. ***************************************************** }
unit SpellingD;
interface
uses SysUtils;
function SpellPic(StDbl: double; StSet: integer): string;
implementation
const Money: array[0..1] ofstring[25] = ('ь я рубл ей коп. ', 'р ра долларов цент.'); {А Б В Г Д Е Ж З И Й К Л М Н О П Р С Т У Ф Х Ц Ч Ш Щ Ъ Ы Ь Э Ю Я а б в г д } Sym: string[180] = 'одна две один два три четыре пят ь шест сем восемдевятдесят' + 'на дцатьсорокдевяно сто сти ста ьсот тысяча и миллион ' + 'ов ард ноль ь я рубл ей коп. '; Code: string[156] =
'БААВААГААДААЕААЖЗАИЙАКЙАЛЙАМЙАНЙАОЙАГПРВПРЕПРЖПРИПРКПРЛПРМПРНПРДРАЕРА' + 'СААИЙОКЙОЛЙОМЙОТУФФААВХАЕЦАЖЗЦИЧАКЧАЛЧАМЧАНЧАваАвбАвгАШЩАШЪАШААЫЬАЫЬЩ' + 'ЫЬЭЫЮАЫЮЩЫЮЭЯААдАА'; {1 2 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 30 40 50 60 70 80 90 1 2 3 4 5 6 7 8 9 РУБ -Я-ЕЙТЫС -И -ЧМ-Н-А -ВМ-Д -А -В0 коп} {0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 }
function SpellPic(StDbl: double; StSet: integer): string; {format of StNum: string[15]= 000000000000.00} const StMask = '000000000000.00'; var StNum: string; {StDbl -> StNum} PlaceNo: integer; {текущая позиция в StNum} TripletNo: integer; {позиция имени обрабатываемого разряда (им.п.ед.ч.)} StWord: string; {результат}
procedure WordAdd(CodeNo: integer); var SymNo: integer; {текущая позиция в массиве Sym} i, j: integer; begin ; Inc(CodeNo, CodeNo shl1); {* 3} for i := 1to3do begin ; Inc(CodeNo); SymNo := ord(Code[CodeNo]) - ord('Б'); if SymNo < 0then break; Inc(SymNo, SymNo shl2); {* 5} for j := 1to5do begin ; Inc(SymNo); if Sym[SymNo] = ' 'then break; StWord := StWord + Sym[SymNo]; end; end; StWord := StWord + ' '; end;
procedure Triplet; var D3: integer; {сотни текущего разряда} D2: integer; {десятки текущего разряда} D1: integer; {единицы текущего разряда} TripletPos: integer; {смещение имени разряда для разных падежей} begin ; Inc(PlaceNo); D3 := ord(StNum[PlaceNo]) - ord('0'); Inc(PlaceNo); D2 := ord(StNum[PlaceNo]) - ord('0'); Inc(PlaceNo); D1 := ord(StNum[PlaceNo]) - ord('0'); Dec(TripletNo, 3); TripletPos := 2; {рублей (род.п.мн.ч.)} if D3 > 0then WordAdd(D3 + 28); {сотни} if D2 = 1then WordAdd(D1 + 11) {10-19} else begin ; if D2 > 1then WordAdd(D2 + 19); {десятки} if D1 > 0then begin ; {единицы} if (TripletNo = 41) and (D1 < 3) then WordAdd(D1 - 1) {одна или две тысячи} else WordAdd(D1 + 1); if D1 < 5then TripletPos := 1; {рубля (род.п.ед.ч.)} if D1 = 1then TripletPos := 0; {рубль (им.п.ед.ч.)} end; end; if (TripletNo = 38) and (Length(StWord) = 0) then WordAdd(50); {ноль целых} if (TripletNo = 38) or (D1 + D2 + D3 > 0) then{имя разряда} WordAdd(TripletNo + TripletPos); end;
var i: integer; begin ; Move(Money[StSet, 1], Sym[156], 25); StNum := FormatFloat(StMask, StDbl);
PlaceNo := 0; TripletNo := 50; {47+3} StWord := ''; {будущий результат}
for i := 1to4do Triplet; {4 разряда: миллиарды, миллионы, тысячи,единицы} StWord := StWord + StNum[14] + StNum[15] + ' '; WordAdd(51);
{Upcase первая буква} SpellPic := AnsiUpperCase(StWord[1]) + Copy(StWord, 2, Length(StWord) - 2); end;
end. Пример использования:
var sumpr: string; begin // первый параметр - сумма, которую необходимо перевести в пропись, // второй параметр - валюта (0-рубли, 1- доллары). sumpr := spellpic(100, 0); ...
|
https://delphiworld.narod
DelphiWorld 6.0
Code: |
{ **** UBPFD *********** by delphibase.endimus **** >> Преобразование целого числа 0-999999999 в строку (прописью)
Я думаю, всё итак понятно, что не понятно пишите письма
Зависимости: SysUtils Автор: Алексей, ARojkov okil.ru, СПб Copyright: b0b Дата: 12 марта 2004 г. ***************************************************** }
unit UIntToStroka;
interface
uses SysUtils;
const N1: array[0..9] ofstring = ('ноль', 'один', 'два', 'три', 'четыре', 'пять', 'шесть', 'семь', 'восемь', 'девять');
const N1000: array[1..9] ofstring = ('одна', 'две', 'три', 'четыре', 'пять', 'шесть', 'семь', 'восемь', 'девять');
const N11: array[0..9] ofstring = ('десять', 'одиннадцать', 'двенадцать', 'тринадцать', 'четырнадцать', 'пятнадцать', 'шестнадцать', 'семнадцать', 'восемнадцать', 'девятнадцать');
const N2: array[1..9] ofstring = ('десять', 'двадцать', 'тридцать', 'сорок', 'пятьдесят', 'шестьдесят', 'семьдесят', 'восемьдесят', 'девяносто' );
const N3: array[1..9] ofstring = ('сто', 'двести', 'триста', 'четыреста', 'пятьсот', 'шестьсот', 'семьсот', 'восемьсот', 'девятьсот' );
const NThousand: array[1..3] ofstring = ('тысяча ', 'тысячи ', 'тысяч ');
const NMillion: array[1..3] ofstring = ('миллион ', 'миллиона ', 'миллионов ');
function IntToStroka(n: Integer): AnsiString;
implementation
function IntToStroka(n: Integer): AnsiString; var i, j, dec, j0: Integer; s: string; degt, degm: boolean; buf: string; begin degt := false; degm := false; s := IntToStr(n); Result := ''; for i := length(s) downto1do begin dec := (length(s) - i + 1); // получим разряд j := StrToInt(s[i]); // получим цифру
if j = 0then j0 := 0; if (not (j in [1..9])) and (dec <> 1) then Continue;
if Dec in [1, 4, 7, 10] then try if StrToInt(s[i - 1]) = 1then begin j0 := j; Continue; end; // подготовка к 10..19 тысяч/миллионов except end;
if Dec in [2, 5, 8, 11] then if j = 1then begin case dec of 2: Result := N11[j0] + ' '; // если 10..19 тысяч/миллионов 5: begin Result := N11[j0] + ' ' + NThousand[3] + Result; degt := true; end; 8: begin Result := N11[j0] + ' ' + NMillion[3] + Result; degm := true; end; end; Continue; end;
if DEC in [4..6] then begin if (j <> 0) and (not degt) then begin if dec = 4then case j of 1: buf := NThousand[1]; 2..4: buf := NThousand[2]; // прибавим слово тысяча если ещё не добавляли 5..9: buf := NThousand[3]; end else buf := NThousand[3]; degt := true; end; end;
if DEC in [7..9] then begin if (j <> 0) and (not degm) then begin if dec = 7then case j of 1: buf := NMillion[1]; 2..4: buf := NMillion[2]; // прибавим слово миллион если ещё не добавляли 5..9: buf := NMillion[3]; end else buf := NMillion[3]; degm := true; end; end;
Result := buf + Result;
while dec > 3do dec := dec - 3;
case Dec of 1: if j <> 0then if degt and (not degm) then Result := N1000[j] + ' ' + Result else Result := N1[j] + ' ' + Result; // 3 три 2: Result := N2[j] + ' ' + Result; // 23 двадцать три 3: Result := N3[j] + ' ' + Result; // 123 сто двадцать три end; Buf := ''; j0 := j; end; end;
end.
|
Code: |
function NumToStr(n: double; c: byte = 0): string; (*
c=0 - 21.05 -> 'Двадцать один рубль 05 копеек.' с=1 - 21.05 -> 'двадцать один' c=2 - 21.05 -> '21-05', 21.00 -> '21=' *) const
digit: array[0..9] ofstring = ('ноль', 'оди', 'два', 'три', 'четыр', 'пят', 'шест', 'сем', 'восем', 'девят'); var
ts, mln, mlrd, SecDes: Boolean; len: byte; summa: string;
function NumberString(number: string): string; var d, pos: byte;
function DigitToStr: string; begin result := ''; if (d <> 0) and ((pos = 11) or (pos = 12)) then mlrd := true; if (d <> 0) and ((pos = 8) or (pos = 9)) then mln := true; if (d <> 0) and ((pos = 5) or (pos = 6)) then ts := true; if SecDes then begin case d of 0: result := 'десять '; 2: result := 'двенадцать ' else result := digit[d] + 'надцать ' end; case pos of 4: result := result + 'тысяч '; 7: result := result + 'миллионов '; 10: result := result + 'миллиардов ' end; SecDes := false; mln := false; mlrd := false; ts := false end else begin if (pos = 2) or (pos = 5) or (pos = 8) or (pos = 11) then case d of 1: SecDes := true; 2, 3: result := digit[d] + 'дцать '; 4: result := 'сорок '; 9: result := 'девяносто '; 5..8: result := digit[d] + 'ьдесят ' end; if (pos = 3) or (pos = 6) or (pos = 9) or (pos = 12) then case d of 1: result := 'сто '; 2: result := 'двести '; 3: result := 'триста '; 4: result := 'четыреста '; 5..9: result := digit[d] + 'ьсот ' end; if (pos = 1) or (pos = 4) or (pos = 7) or (pos = 10) then case d of 1: result := 'один '; 2, 3: result := digit[d] + ' '; 4: result := 'четыре '; 5..9: result := digit[d] + 'ь ' end; if pos = 4then begin case d of 0: if ts then result := 'тысяч '; 1: result := 'одна тысяча '; 2: result := 'две тысячи '; 3, 4: result := result + 'тысячи '; 5..9: result := result + 'тысяч ' end; ts := false end; if pos = 7then begin case d of 0: if mln then result := 'миллионов '; 1: result := result + 'миллион '; 2, 3, 4: result := result + 'миллиона '; 5..9: result := result + 'миллионов ' end; mln := false end; if pos = 10then begin case d of 0: if mlrd then result := 'миллиардов '; 1: result := result + 'миллиард '; 2, 3, 4: result := result + 'миллиарда '; 5..9: result := result + 'миллиардов ' end; mlrd := false end end end;
begin result := ''; ts := false; mln := false; mlrd := false; SecDes := false; len := length(number); if (len = 0) or (number = '0') then result := digit[0] else for pos := len downto1do begin d := StrToInt(copy(number, len - pos + 1, 1)); result := result + DigitToStr end end;
function MoneyString(number: string): string; var s: string[1]; n: string; begin len := length(number); n := copy(number, 1, len - 3); result := NumberString(n); s := AnsiUpperCase(result[1]); delete(result, 1, 1); result := s + result; if len < 2then begin if len = 0then n := '0'; len := 2; n := '0' + n end; if copy(n, len - 1, 1) = '1'then result := result + 'рублей' else begin case StrToInt(copy(n, len, 1)) of 1: result := result + 'рубль'; 2, 3, 4: result := result + 'рубля' else result := result + 'рублей' end end; len := length(number); n := copy(number, len - 1, len); if copy(n, 1, 1) = '1'then n := n + ' копеек.' else begin case StrToInt(copy(n, 2, 1)) of 1: n := n + ' копейка.'; 2, 3, 4: n := n + ' копейки.' else n := n + ' копеек.' end end; result := result + ' ' + n end;
// Основная часть begin
case c of 0: result := MoneyString(FormatFloat('0.00', n)); 1: result := NumberString(FormatFloat('0', n)); 2: begin summa := FormatFloat('0.00', n); len := length(summa); if copy(summa, len - 1, 2) = '00'then begin delete(summa, len - 2, 3); result := summa + '=' end else begin delete(summa, len - 2, 1); insert('-', summa, len - 2); result := summa; end; end end; end;
|
https://delphiworld.narod
DelphiWorld 6.0
Честно, давно ждал подобного журнала в электронном виде. Решил послать своё творчество которое уже немало отработало, опять же, преобразование числа в пропись, отличающееся от опубликованных программок тем, что слова для прописи хранятся в отдельном файле (lang.cnf), по аналогии с подуктами 1C. Это позволяет изменять национальную валюту.
Если поэкспериментировать, с массивом Univer, в котором хранятся окончания, можно добиться преобразования для многих языков, не сказал ли я чего лишнего. :)
Надеюсь, моя версия Вам понравится.
С наилучшими пожеланиями,
Панченко Сергей
Казахстан, Алматы,
Code: |
unit BuchUtil;
interface
uses IniFiles, SysUtils;
function DoubleChar(ch: string): string; function NumToSampl(N: string): string; function MoneyToSampl(M: Currency): string; procedure LexemsToDim(fstr: string; var dim: arrayofstring);
var
NameNum: array[0..9, 1..4] ofstring; //массив им?н чисел Ext: array[0..4, 1..3] ofstring; //массив расшиений (тысячи, миллионы ...) Univer: array[1..9, 1..4] of integer; //массив окончаний Rubl: array[1..3] ofstring; //массив имен рублей Cop: array[1..3] ofstring; //массив имен копеек Zero: string; //название нуля One: string; //единица "одна" Two: string; //двойка "две" fFile: TIniFile; //файл, откуда загружается пропись fString: string; fDim: array[0..9] ofstring; i: integer;
implementation
{заполняет массив Dim лексемами}
procedure LexemsToDim(fstr: string; var dim: arrayofstring); var
i, j: integer; flex: string; begin
if Length(fstr) > 0then begin i := 1; j := 0; while i - 1 < Length(fstr) do begin if fstr[i] = ','then begin dim[j] := flex + ' '; inc(j); flex := ''; end else flex := flex + fstr[i]; inc(i); end; end; end;
{преобразует число в пропись
процедура использует файл lang.cnf}
function NumToSampl(N: string): string; var
k, i, i_indx: integer; number, string_num: string; index: integer; pos: integer; fl_ext: boolean; begin
fl_ext := true; i := 1; String_num := ''; number := Trim(N); k := length(number); if (k = 1) and (number = '0') then String_num := Zero else begin
pos := 0; while (k > 0) do begin if (k <> 1) and (i = 1) and (length(number) <> 1) and (copy(number, k - 1, 1) = '1') and (copy(number, k, 1) <> '0') then begin index := StrToInt(copy(number, k, 1)); dec(k); inc(i); i_indx := 4; end else begin index := StrToInt(copy(number, k, 1)); i_indx := i; end; if (NameNum[index, i_indx] <> '') and (fl_ext = true) then begin String_num := Ext[pos, Univer[index, i_indx]] + String_num; fl_ext := false; end;
if (index = 1) and (pos = 1) and (i = 1) then String_num := One + String_num elseif (index = 2) and (pos = 1) and (i = 1) then String_num := Two + String_num else String_num := NameNum[index, i_indx] + String_num; inc(i); if i = 4then begin i := 1; inc(pos); fl_ext := true end; dec(k); end; end;
if Trim(String_Num) <> ''then begin String_num[1] := CHR(ORD(String_num[1]) - 32); Result := String_num; end; end;
{Преобразует х в 0х}
function DoubleChar(ch: string): string; begin
if Length(ch) = 1then Result := '0' + ch else Result := ch; end;
{преобразует денежную сумму в пропись}
function MoneyToSampl(M: Currency): string; var
Int_Part, idx, idxIP, idxRP: integer; Int_Str, Real_Part, Sampl: string; begin
Int_Part := Trunc(Int(M)); Int_Str := IntToStr(Int_Part); Real_Part := DoubleChar(IntToStr(Trunc(Int((M - Int_Part + 0.001) * 100)))); Sampl := NumToSampl(Int_Str); idx := StrToInt(Int_Str[Length(Int_Str)]); if idx = 0then idx := 5; idxIP := Univer[idx, 1]; idx := StrToInt(Real_Part[Length(Real_Part)]); if idx = 0then idx := 5; idxRP := Univer[idx, 1]; Result := Sampl + Rubl[idxIP] + Real_Part + ' ' + Cop[idxRP]; end;
initialization
{Предположим файл находится на C:\ диске} fFile := TIniFile.Create('c:\lang.cnf'); try {Заполнение массива рублей} fString := fFile.ReadString('Money', 'Rub', ','); LexemsToDim(fString, Rubl);
{Заполнение массива копеек} fString := fFile.ReadString('Money', 'Cop', ','); LexemsToDim(fString, Cop);
{Заполнение массива чисел} fString := fFile.ReadString('Nums', 'Numbers', ','); LexemsToDim(fString, fdim); NameNum[0, 1] := ''; for i := 1to9do NameNum[i, 1] := fdim[i - 1];
{Заполнение массива десятков} fString := fFile.ReadString('Nums', 'Tens', ','); LexemsToDim(fString, fdim); NameNum[0, 2] := ''; for i := 1to9do NameNum[i, 2] := fdim[i - 1];
{Заполнение массива сотен} fString := fFile.ReadString('Nums', 'Hundreds', ','); LexemsToDim(fString, fdim); NameNum[0, 3] := ''; for i := 1to9do NameNum[i, 3] := fdim[i - 1];
{Заполнение массива чисел после десяти} fString := fFile.ReadString('Nums', 'AfterTen', ','); LexemsToDim(fString, fdim); NameNum[0, 4] := ''; for i := 1to9do NameNum[i, 4] := fdim[i - 1];
{Заполнение расширений чисел} Ext[0, 1] := ''; Ext[0, 2] := ''; Ext[0, 3] := '';
{Тысячи} fString := fFile.ReadString('Nums', 'Thou', ','); LexemsToDim(fString, fdim); for i := 1to3do Ext[1, i] := fdim[i - 1];
{Миллионы} fString := fFile.ReadString('Nums', 'Mill', ','); LexemsToDim(fString, fdim); for i := 1to3do Ext[2, i] := fdim[i - 1];
{Миллиарды} fString := fFile.ReadString('Nums', 'Bill', ','); LexemsToDim(fString, fdim); for i := 1to3do Ext[3, i] := fdim[i - 1];
{Триллион} fString := fFile.ReadString('Nums', 'Thrill', ','); LexemsToDim(fString, fdim); for i := 1to3do Ext[4, i] := fdim[i - 1];
Zero := fFile.ReadString('Nums', 'Zero', '0'); if Zero[Length(Zero)] = ','then Zero := Copy(Zero, 1, Length(Zero) - 1) + ' ';
One := fFile.ReadString('Nums', 'One', '1'); if One[Length(One)] = ','then One := Copy(One, 1, Length(One) - 1) + ' ';
Two := fFile.ReadString('Nums', 'Two', '0'); if Two[Length(Two)] = ','then Two := Copy(Two, 1, Length(Two) - 1) + ' ';
{Заполнение таблицы окончаний} Univer[1, 1] := 1; Univer[1, 2] := 2; Univer[1, 3] := 2; Univer[1, 4] := 2; Univer[2, 1] := 3; Univer[2, 2] := 2; Univer[2, 3] := 2; Univer[2, 4] := 2; Univer[3, 1] := 3; Univer[3, 2] := 2; Univer[3, 3] := 2; Univer[3, 4] := 2; Univer[4, 1] := 3; Univer[4, 2] := 2; Univer[4, 3] := 2; Univer[4, 4] := 2; Univer[5, 1] := 2; Univer[5, 2] := 2; Univer[5, 3] := 2; Univer[5, 4] := 2; Univer[6, 1] := 2; Univer[6, 2] := 2; Univer[6, 3] := 2; Univer[6, 4] := 2; Univer[7, 1] := 2; Univer[7, 2] := 2; Univer[7, 3] := 2; Univer[7, 4] := 2; Univer[8, 1] := 2; Univer[8, 2] := 2; Univer[8, 3] := 2; Univer[8, 4] := 2; Univer[9, 1] := 2; Univer[9, 2] := 2; Univer[9, 3] := 2; Univer[9, 4] := 2; finally fFile.Free; end;
end. |
Code:Lang.cnf |
[Nums] Numbers=один,два,три,четыре,пять,шесть,семь,восемь,девять, One=одна, Two=две, Tens=десять,двадцать,тридцать,сорок,пятьдесят,шестьдесят,семьдесят,восемьдесят,девяносто, Hundreds=сто,двести,триста,четыреста,пятьсот,шестьсот,семьсот,восемьсот,девятьсот, AfterTen=одиннадцать,двенадцать,тринадцать,четырнадцать,пятнадцать,шестнадцать,семнадцать,восемнадцать,девятнадцать, Zero=ноль, Thou=тысяча,тысяч,тысячи, Mill=миллион,миллионов,миллиона, Bill=миллиард,миллиардов,миллиарда, Thrill=триллион,триллионов,триллиона,
[Money] Rub=рубль,рублей,рубля, Cop=копейка,копеек,копейки, |
https://delphiworld.narod
DelphiWorld 6.0
Code: |
unit sumstr;
interface
uses SysUtils, StrUtils;
function SumToString(Value: string): string;
implementation const
a: array[0..8,0..9] ofstring=( ('','один ','два ','три ','четыре ','пять ','шесть ','семь ','восемь ','девять '), ('','','двадцать ','тридцать ','сорок ','пятьдесят ','шестьдесят ','семьдесят ','восемьдесят ','девяносто '), ('','сто ','двести ','триста ','четыреста ','пятьсот ','шестьсот ','семьсот ','восемьсот ','девятьсот '), ('тысяч ','тысяча ','две тысячи ','три тысячи ','четыре тысячи ','пять тысячь ','шесть тысячь ','семь тысячь ', 'восемь тысячь ','девять тысячь '), ('','','двадцать ','тридцать ','сорок ','пятьдесят ','шестьдесят ','семьдесят ','восемьдесят ','девяносто '), ('','сто ','двести ','триста ','четыреста ','пятьсот ','шестьсот ','семьсот ','восемьсот ','девятьсот '), ('миллионов ','один миллион ','два миллиона ','три миллиона ','четыре миллиона ','пять миллионов ', 'шесть миллионов ','семь миллионов ','восемь миллионов ','девять миллионов '), ('','','двадцать ','тридцать ','сорок ','пятьдесят ','шестьдесят ','семьдесят ','восемьдесят ','девяносто '), ('','сто ','двести ','триста ','четыреста ','пятьсот ','шестьсот ','семьсот ','восемьсот ','девятьсот '));
b: array[0..9] ofstring= ('десять ','одинадцать ','двенадцать ','тринадцать ','четырнадцать ','пятьнадцать ','шестьнадцать ', 'семьнадцать ','восемьнадцать ','девятьнадцать ');
function SumToStrin(Value: string): string; var s, t: string; p, pp, i, k: integer; begin s:=value; if s='0'then t:='Ноль ' else begin p:=length(s); pp:=p; if p>1then if (s[p-1]='1') and (s[p]>'0') then begin t:=b[strtoint(s[p])]; pp:=pp-2; end; i:=pp; while i>0do begin if (i=p-3) and (p>4) then if s[p-4]='1'then begin t:=b[strtoint(s[p-3])]+'тысяч '+t; i:=i-2; end; if (i=p-6) and (p>7) then if s[p-7]='1'then begin t:=b[strtoint(s[p-6])]+'миллионов '+t; i:=i-2; end; if i>0then begin k:=strtoint(s[i]); t:=a[p-i,k]+t; i:=i-1; end; end; end; result:=t; end;
procedure get2str(value: string; var hi, lo: string); var p: integer; begin p:=pos(',', value); lo:=''; hi:=''; if p=0then p:=pos('.', value); if p<>0then delete(value,p,1); if p=0then begin hi:=value; lo:='00'; end; if p>length(value) then begin hi:=value; lo:='00'; end; if p=1then begin hi:='0'; lo:=value; end; if (p>1) and (p then begin hi:=copy(value,1,p-1); lo:=copy(value,p,length(value)); end; end;
function sumtostring(value: string): string; var hi, lo: string; pr, er: integer; begin get2str(value,hi,lo); if (hi='') or (lo='') then begin result:=''; exit; end; val(hi,pr,er); if er<>0then begin result:=''; exit; end; hi:=sumtostrin(inttostr(pr))+'руб. '; if lo<>'00'then begin val(lo,pr,er); if er<>0then begin result:=''; exit; end; lo:=inttostr(pr); end; lo:=lo+' коп. '; hi[1]:=AnsiUpperCase(hi[1])[1]; result:=hi+lo; end;
end. |
https://delphiworld.narod
DelphiWorld 6.0
Этот алгоритм преобразует 12345 в "двенадцать тысяч триста сорок пять". Для этого создана процедура, которая преобразует трехзначные числа в слова и прибавляет к ним "тысяч" или "миллионов". Алгоритм корректен в смысле падежей и родов. Поэтому 121000 он не переведет в "сто двадцать один тысяч".
Code: |
function ShortNum(num: word; razr: integer): string; const hundreds: array [0..9] ofstring = ('', ' сто', ' двести', ' триста', ' четыреста', ' пятьсот', ' шестьсот', ' семьсот', ' восемьсот', ' девятьсот');
tens: array [0..9] ofstring = ('', '', ' двадцать', ' тридцать', ' сорок', ' пятьдесят', ' шестьдесят', ' семьдесят', ' восемьдесят', ' девяносто');
ones: array [3..19] ofstring = (' три', ' четыре', ' пять', ' шесть', ' семь', ' восемь', ' девять', ' десять', ' одиннадцать', ' двенадцать', ' тринадцать', ' четырнадцать', ' пятнадцать', ' шестнадцать', ' семнадцать', ' восемнадцать', ' девятнадцать');
razryad: array [0..6] ofstring = ('', ' тысяч', ' миллион', ' миллиард', ' триллион', ' квадриллион', ' квинтиллион');
var t: byte; // десятки o: byte; // единицы begin result := hundreds[num div100]; if num = 0then Exit; t := (num mod100) div10; o := num mod10; if t <> 1then begin result := result + tens[t]; case o of 1: if razr = 1then result := result + ' одна' else result := result + ' один'; 2: if razr = 1then result := result + ' две' else result := result + ' два'; 3..9: result := result + ones[o]; end; result := result + razryad[razr]; case o of 1: if razr = 1then result := result + 'а'; 2..4: if razr = 1then result := result + 'и' else if razr > 1then result := result + 'а'; else if razr > 1then result := result + 'ов'; end; end else begin result := result + ones[num mod100]; result := result + razryad[razr]; if razr > 1then result := result + 'ов'; end; end;
function IntToWords(s: string): string; var i, count: integer; begin if (Length(s) <= 0) or (s = '0') then begin result := 'ноль'; Exit; end; count := (Length(s) + 2) div3; if count > 7then begin result := 'Value is too large'; Exit; end; result := ''; s := '00' + s; for i := 1to count do result := ShortNum(StrToInt(copy(s, Length(s) - 3 * i + 1, 3)), i - 1) + result; if Length(result) > 0then delete(result, 1, 1); end;
procedure TForm1.Button1Click(Sender: TObject); begin Edit2.Text := IntToWords(Edit1.Text); end; |
https://delphiworld.narod.
DelphiWorld 6.0
Code: |
{ **** UBPFD *********** by delphibase.endimus**** >> Сумма и количество прописью, работа с падежами
Несколько функций для работы с строками: function SumToString(Value : String) : string;//Сумма прописью function KolToStrin(Value : String) : string;//Количество прописью function padeg(s:string):string;//Склоняет фамилию имя и отчество (кому) function padegot(s:string):string;//Склоняет фамилию имя и отчество (от кого) function fio(s:string):string;//фамилия имя и отчество сокращенно function longdate(s:string):string;//Длинная дата procedure getfullfio(s:string;var fnam,lnam,onam:string); //Получить из строки фамилию имя и отчество сокращенно
Зависимости: uses SysUtils, StrUtils,Classes; Автор: Eda, eda arhadm.net.ru, Архангельск Copyright: Eda Дата: 13 июня 20013 г. ***************************************************** }
unit sumstr;
interface uses SysUtils, StrUtils, Classes; var rub: byte; function SumToString(Value: string): string; //Сумма прописью function KolToStrin(Value: string): string; //Количество прописью function padeg(s: string): string; //Склоняет фамилию имя и отчество (кому) function padegot(s: string): string; //Склоняет фамилию имя и отчество (от кого) function fio(s: string): string; //фамилия имя и отчество сокращенно function longdate(s: string): string; //Длинная дата procedure getfullfio(s: string; var fnam, lnam, onam: string); //Получить из строки фамилию имя и отчество сокращенно
implementation const a: array[0..8, 0..9] ofstring = ( ('', 'один ', 'два ', 'три ', 'четыре ', 'пять ', 'шесть ', 'семь ', 'восемь ', 'девять '), ('', '', 'двадцать ', 'тридцать ', 'сорок ', 'пятьдесят ', 'шестьдесят ', 'семьдесят ', 'восемьдесят ', 'девяносто '), ('', 'сто ', 'двести ', 'триста ', 'четыреста ', 'пятьсот ', 'шестьсот ', 'семьсот ', 'восемьсот ', 'девятьсот '), ('тысяч ', 'одна тысяча ', 'две тысячи ', 'три тысячи ', 'четыре тысячи ', 'пять тысяч ', 'шесть тысяч ', 'семь тысяч ', 'восемь тысяч ', 'девять тысяч '), ('', '', 'двадцать ', 'тридцать ', 'сорок ', 'пятьдесят ', 'шестьдесят ', 'семьдесят ', 'восемьдесят ', 'девяносто '), ('', 'сто ', 'двести ', 'триста ', 'четыреста ', 'пятьсот ', 'шестьсот ', 'семьсот ', 'восемьсот ', 'девятьсот '), ('миллионов ', 'один миллион ', 'два миллиона ', 'три миллиона ', 'четыре миллиона ', 'пять миллионов ', 'шесть миллионов ', 'семь миллионов ', 'восемь миллионов ', 'девять миллионов '), ('', '', 'двадцать ', 'тридцать ', 'сорок ', 'пятьдесят ', 'шестьдесят ', 'семьдесят ', 'восемьдесят ', 'девяносто '), ('', 'сто ', 'двести ', 'триста ', 'четыреста ', 'пятьсот ', 'шестьсот ', 'семьсот ', 'восемьсот ', 'девятьсот ')); c: array[0..8, 0..9] ofstring = ( ('', 'одна ', 'две ', 'три ', 'четыре ', 'пять ', 'шесть ', 'семь ', 'восемь ', 'девять '), ('', '', 'двадцать ', 'тридцать ', 'сорок ', 'пятьдесят ', 'шестьдесят ', 'семьдесят ', 'восемьдесят ', 'девяносто '), ('', 'сто ', 'двести ', 'триста ', 'четыреста ', 'пятьсот ', 'шестьсот ', 'семьсот ', 'восемьсот ', 'девятьсот '), ('тысячь ', 'одна тысяча ', 'две тысячи ', 'три тысячи ', 'четыре тысячи ', 'пять тысяч ', 'шесть тысяч ', 'семь тысяч ', 'восемь тысяч ', 'девять тысяч '), ('', '', 'двадцать ', 'тридцать ', 'сорок ', 'пятьдесят ', 'шестьдесят ', 'семьдесят ', 'восемьдесят ', 'девяносто '), ('', 'сто ', 'двести ', 'триста ', 'четыреста ', 'пятьсот ', 'шестьсот ', 'семьсот ', 'восемьсот ', 'девятьсот '), ('миллионов ', 'один миллион ', 'два миллиона ', 'три миллиона ', 'четыре миллиона ', 'пять миллионов ', 'шесть миллионов ', 'семь миллионов ', 'восемь миллионов ', 'девять миллионов '), ('', '', 'двадцать ', 'тридцать ', 'сорок ', 'пятьдесят ', 'шестьдесят ', 'семьдесят ', 'восемьдесят ', 'девяносто '), ('', 'сто ', 'двести ', 'триста ', 'четыреста ', 'пятьсот ', 'шестьсот ', 'семьсот ', 'восемьсот ', 'девятьсот ')); b: array[0..9] ofstring = ('десять ', 'одинадцать ', 'двенадцать ', 'тринадцать ', 'четырнадцать ', 'пятнадцать ', 'шестнадцать ', 'семнадцать ', 'восемнадцать ', 'девятнадцать '); var pol: boolean;
function longdate(s: string): string; //Длинная дата var Pr: TDateTime; Y, M, D: Word; begin Pr := strtodate(s); DecodeDate(Pr, Y, M, D); case m of 1: s := 'Января'; 2: s := 'Февраля'; 3: s := 'Марта'; 4: s := 'Апреля'; 5: s := 'Мая'; 6: s := 'Июня'; 7: s := 'Июля'; 8: s := 'Августа'; 9: s := 'Сентября'; 10: s := 'Октября'; 11: s := 'Ноября'; 12: s := 'Декабря'; end; result := inttostr(d) + ' ' + s + ' ' + inttostr(y) end;
function SumToStrin(Value: string): string; var s, t: string; p, pp, i, k: integer; begin s := value; if s = '0'then t := 'Ноль ' else begin p := length(s); pp := p; if p > 1then if (s[p - 1] = '1') and (s[p] >= '0') then begin t := b[strtoint(s[p])]; pp := pp - 2; end; i := pp; while i > 0do begin if (i = p - 3) and (p > 4) then if s[p - 4] = '1'then begin t := b[strtoint(s[p - 3])] + 'тысяч ' + t; i := i - 2; end; if (i = p - 6) and (p > 7) then if s[p - 7] = '1'then begin t := b[strtoint(s[p - 6])] + 'миллионов ' + t; i := i - 2; end; if i > 0then begin k := strtoint(s[i]); t := a[p - i, k] + t; i := i - 1; end; end; end; result := t; end;
function kolToStrin(Value: string): string; var s, t: string; p, pp, i, k: integer; begin s := value; if s = '0'then t := 'Ноль ' else begin p := length(s); pp := p; if p > 1then if (s[p - 1] = '1') and (s[p] > '0') then begin t := b[strtoint(s[p])]; pp := pp - 2; end; i := pp; while i > 0do begin if (i = p - 3) and (p > 4) then if s[p - 4] = '1'then begin t := b[strtoint(s[p - 3])] + 'тысяча ' + t; i := i - 2; end; if (i = p - 6) and (p > 7) then if s[p - 7] = '1'then begin t := b[strtoint(s[p - 6])] + 'миллионов ' + t; i := i - 2; end; if i > 0then begin k := strtoint(s[i]); t := c[p - i, k] + t; i := i - 1; end; end; end; result := t; end;
procedure get2str(value: string; var hi, lo: string); var p: integer; begin p := pos(',', value); lo := ''; hi := ''; if p = 0then p := pos('.', value); if p <> 0then delete(value, p, 1); if p = 0then begin hi := value; lo := '00'; exit; end; if p > length(value) then begin hi := value; lo := '00'; exit; end; if p = 1then begin hi := '0'; lo := value; exit; end; begin hi := copy(value, 1, p - 1); lo := copy(value, p, length(value)); if length(lo) < 2then lo := lo + '0'; end; end;
function sumtostring(value: string): string; var hi, lo, valut, loval: string; pr, er: integer; begin get2str(value, hi, lo); if (hi = '') or (lo = '') then begin result := ''; exit; end; val(hi, pr, er); if er <> 0then begin result := ''; exit; end; if rub = 0then begin if hi[length(hi)] = '1'then valut := 'рубль '; if (hi[length(hi)] >= '2') and (hi[length(hi)] <= '4') then valut := 'рубля '; if (hi[length(hi)] = '0') or (hi[length(hi)] >= '5') or ((strtoint(copy(hi, length(hi) - 1, 2)) > 10) and (strtoint(copy(hi, length(hi) - 1, 2)) < 15)) then valut := 'рублей '; if (lo[length(lo)] = '0') or (lo[length(lo)] >= '5') then loval := ' копеек'; if lo[length(lo)] = '1'then loval := ' копейка'; if (lo[length(lo)] >= '2') and (lo[length(lo)] <= '4') then loval := ' копейки'; end else begin if (hi[length(hi)] = '0') or (hi[length(hi)] >= '5') then valut := 'долларов '; if hi[length(hi)] = '1'then valut := 'доллар '; if (hi[length(hi)] >= '2') and (hi[length(hi)] <= '4') then valut := 'доллара '; if (lo[length(lo)] = '0') or (lo[length(lo)] >= '5') then loval := ' центов'; if lo[length(lo)] = '1'then loval := ' цент'; if (lo[length(lo)] >= '2') and (lo[length(lo)] <= '4') then loval := ' цента'; end; hi := sumtostrin(inttostr(pr)) + valut; if lo <> '00'then begin val(lo, pr, er); if er <> 0then begin result := ''; exit; end; lo := inttostr(pr); end; if length(lo) < 2then lo := '0' + lo; lo := lo + loval; hi[1] := AnsiUpperCase(hi[1])[1]; result := hi + lo; end;
function pfam(s: string): string; begin if (s[length(s)] = 'к') or (s[length(s)] = 'ч') and (pol = true) then s := s + 'у'; if s[length(s)] = 'в'then s := s + 'у'; if s[length(s)] = 'а'then begin delete(s, length(s), 1); result := s + 'ой'; exit; end; if s[length(s)] = 'н'then s := s + 'у'; if s[length(s)] = 'й'then begin delete(s, length(s) - 1, 2); result := s + 'ому'; end; if s[length(s)] = 'я'then begin delete(s, length(s) - 1, 2); result := s + 'ой'; exit; end; result := s; end;
function pnam(s: string): string; begin pol := true; if s[length(s)] = 'й'then begin delete(s, length(s), 1); s := s + 'ю'; end; if s[length(s)] = 'л'then s := s + 'у'; if s[length(s)] = 'р'then s := s + 'у'; if s[length(s)] = 'м'then s := s + 'у'; if s[length(s)] = 'н'then s := s + 'у'; if s[length(s)] = 'я'then begin pol := false; delete(s, length(s), 1); s := s + 'е'; end; if s[length(s)] = 'а'then begin pol := false; delete(s, length(s), 1); s := s + 'е'; end; result := s; end;
function potch(s: string): string; begin if s[length(s)] = 'а'then begin delete(s, length(s), 1); s := s + 'е'; end; if s[length(s)] = 'ч'then s := s + 'у'; result := s; end;
function ofam(s: string): string; begin if (s[length(s)] = 'к') or (s[length(s)] = 'ч') and (pol = true) then s := s + 'а'; if s[length(s)] = 'а'then begin delete(s, length(s), 1); result := s + 'ой'; exit; end; if s[length(s)] = 'в'then s := s + 'а'; if s[length(s)] = 'н'then s := s + 'а'; if s[length(s)] = 'й'then begin delete(s, length(s) - 1, 2); result := s + 'ова'; end; if s[length(s)] = 'я'then begin delete(s, length(s) - 1, 2); result := s + 'ой'; exit; end; result := s; end;
function onam(s: string): string; begin pol := true; if s[length(s)] = 'а'then if s[length(s) - 1] = 'г'then begin pol := false; delete(s, length(s), 1); s := s + 'и'; end else begin pol := false; delete(s, length(s), 1); s := s + 'ы'; end; if s[length(s)] = 'л'then s := s + 'а'; if s[length(s)] = 'р'then s := s + 'а'; if s[length(s)] = 'м'then s := s + 'а'; if s[length(s)] = 'н'then s := s + 'а'; if s[length(s)] = 'я'then begin pol := false; delete(s, length(s), 1); s := s + 'и'; end; if s[length(s)] = 'й'then begin delete(s, length(s), 1); s := s + 'я'; end; result := s; end;
function ootch(s: string): string; begin if s[length(s)] = 'а'then begin delete(s, length(s), 1); s := s + 'ы'; end; if s[length(s)] = 'ч'then s := s + 'а'; result := s; end;
function padeg(s: string): string; var q: tstringlist; p: integer; begin if s <> ''then begin q := tstringlist.Create; p := pos(' ', s); if p = 0then p := pos('.', s); if p = 0then q.Add(s) else begin q.Add(copy(s, 1, p - 1)); delete(s, 1, p); p := pos(' ', s); if p = 0then p := pos('.', s); if p = 0then q.Add(s) else begin q.Add(copy(s, 1, p - 1)); delete(s, 1, p); p := pos(' ', s); if p = 0then p := pos('.', s); if p = 0then q.Add(s) else begin q.Add(copy(s, 1, p - 1)); delete(s, 1, p); end; end; end; if q.Count > 1then result := result + ' ' + pnam(q[1]); if q.Count > 0then result := pfam(q[0]) + result; if q.Count > 2then result := result + ' ' + potch(q[2]); q.Free; end; end;
function fio(s: string): string; var q: tstringlist; p: integer; begin if s <> ''then begin q := tstringlist.Create; p := pos(' ', s); if p = 0then p := pos('.', s); if p = 0then q.Add(s) else begin q.Add(copy(s, 1, p - 1)); delete(s, 1, p); p := pos(' ', s); if p = 0then p := pos('.', s); if p = 0then q.Add(s) else begin q.Add(copy(s, 1, 1)); delete(s, 1, p); p := pos(' ', s); if p = 0then p := pos('.', s); if p = 0then q.Add(copy(s, 1, 1)) else begin q.Add(copy(s, 1, 1)); end; end; end; if q.Count > 1then result := q[0] + ' ' + q[1] + '.'; if q.Count > 2then result := result + q[2] + '.'; q.Free; end; end;
function padegot(s: string): string; var q: tstringlist; p: integer; begin if s <> ''then begin q := tstringlist.Create; p := pos(' ', s); if p = 0then p := pos('.', s); if p = 0then q.Add(s) else begin q.Add(copy(s, 1, p - 1)); delete(s, 1, p); p := pos(' ', s); if p = 0then p := pos('.', s); if p = 0then q.Add(s) else begin q.Add(copy(s, 1, p - 1)); delete(s, 1, p); p := pos(' ', s); if p = 0then p := pos('.', s); if p = 0then q.Add(s) else begin q.Add(copy(s, 1, p - 1)); delete(s, 1, p); end; end; end; if q.Count > 1then result := result + ' ' + onam(q[1]); if q.Count > 0then result := ofam(q[0]) + result; if q.Count > 2then result := result + ' ' + ootch(q[2]); q.Free; end; end;
procedure getfullfio(s: string; var fnam, lnam, onam: string); //Получить из строки фамилию имя и отчество сокращенно begin fnam := ''; lnam := ''; onam := ''; fnam := copy(s, 1, pos(' ', s)); delete(s, 1, pos(' ', s)); lnam := copy(s, 1, pos(' ', s)); delete(s, 1, pos(' ', s)); onam := s; end;
begin rub := 0; end. Пример использования:
s := SumToString('123.00');
|
Code: |
{ **** UBPFD *********** by delphibase.endimus **** >> Конвертация денежных сумм в строковое выражение
Конвертация денежных сумм в строковое выражение впоть до додециллиона, причем легко наращивается. Небольшая по размеру.
Зависимости: System Автор: Раков Андрей, klopmail mail.ru, Курчатов Copyright: Раков А.В. Дата: 17 августа 20012 г. ***************************************************** }
function MoneyToStr(DD: string): string; {(С) Раков А.В. 05.2002 e-mail: klopmail mail.ru сайт: } type TTroyka = array[1..3] of Byte; TMyString = array[1..19] ofstring[12]; var S, OutS, S2: string; k, L, kk: Integer; Troyka: TTroyka; V1: TMyString; Mb: Byte; const V11: TMyString = ('один', 'два', 'три', 'четыре', 'пять', 'шесть', 'семь', 'восемь', 'девять', 'десять', 'одиннадцать', 'двенадцать', 'тринадцать', 'четырнадцать', 'пятнадцать', 'шестнадцать', 'семнадцать', 'восемнадцать', 'девятнадцать'); V2: array[1..8] ofstring = ('двадцать', 'тридцать', 'сорок', 'пятьдесят', 'шестьдесят', 'семьдесят', 'восемьдесят', 'девяносто'); V3: array[1..9] ofstring = ('сто', 'двести', 'триста', 'четыреста', 'пятьсот', 'шестьсот', 'семьсот', 'восемьсот', 'девятьсот'); M1: array[1..13, 1..3] ofstring = (('тысяча', 'тысячи', 'тысяч'), ('миллион', 'миллиона', 'миллионов'), ('миллиард', 'миллиарда', 'миллиардов'), ('триллион', 'триллиона', 'триллионов'), ('квадриллион', 'квадриллиона', 'квадриллионов'), ('квинтиллион', 'квинтиллиона', 'квинтиллионов'), ('секстиллион', 'секстиллиона', 'секстиллионов'), ('сентиллион', 'сентиллиона', 'сентиллионов'), ('октиллион', 'октиллиона', 'октиллионов'), ('нониллион', 'нониллиона', 'нониллионов'), ('дециллион', 'дециллиона', 'дециллионов'), ('ундециллион', 'ундециллиона', 'ундециллионов'), ('додециллион', 'додециллиона', 'додециллионов')); R1: array[1..3] ofstring = ('рубль', 'рубля', 'рублей'); R2: array[1..3] ofstring = ('копейка', 'копейки', 'копеек'); function TroykaToStr(L: ShortInt; TR: TTroyka): string; var S: string; begin S := ''; if Abs(L) = 1then begin V1[1] := 'одна'; V1[2] := 'две'; end else begin V1[1] := 'один'; V1[2] := 'два'; end; if Troyka[2] = 1then begin Troyka[2] := 0; Troyka[3] := 10 + Troyka[3]; end; if Troyka[3] <> 0then S := V1[Troyka[3]]; if Troyka[2] <> 0then S := V2[Troyka[2] - 1] + ' ' + S; if Troyka[1] <> 0then S := V3[Troyka[1]] + ' ' + S; if (L > 0) and (S <> '') then case Troyka[3] of 1: S := S + ' ' + M1[L, 1] + ' '; 2..4: S := S + ' ' + M1[L, 2] + ' '; else S := S + ' ' + M1[L, 3] + ' '; end; TroykaToStr := S; end; begin V1 := V11; L := 0; OutS := ''; kk := Pos(',', DD); if kk = 0then S := DD else S := Copy(DD, 1, kk - 1); if S = '0'then S2 := '' else S2 := S; repeat for k := 3downto1do if Length(S) > 0then begin Troyka[k] := StrToInt(S[Length(S)]); Delete(S, Length(S), 1); end else Troyka[k] := 0; OutS := TroykaToStr(L, Troyka) + OutS; if L = 0then Mb := Troyka[3]; Inc(L); until Length(S) = 0; case Mb of 0: if Length(S2) > 0then OutS := OutS + ' ' + R1[3] + ' '; 1: OutS := OutS + ' ' + R1[1] + ' '; 2..4: OutS := OutS + ' ' + R1[2] + ' '; else OutS := OutS + ' ' + R1[3] + ' '; end; S2 := ''; if kk <> 0then begin DD := Copy(DD, kk + 1, 2); if Length(DD) = 1then DD := DD + '0'; k := StrToInt(DD); Troyka[1] := 0; Troyka[2] := k div10; Troyka[3] := k mod10; S2 := TroykaToStr(-1, Troyka); case Troyka[3] of 0: if Troyka[2] = 0then S := '' else S := R2[3]; 1: S := R2[1]; 2..4: S := R2[2]; else S := R2[3]; end; end; // MoneyToStr:=OutS+IntToStr(k)+' '+S; // если копейки нужны цифрой-эту строку раскоментировать MoneyToStr := OutS + S2 + ' ' + S; // а эту закоментировать end; Пример использования:
S := MoneyToStr('76576876876976576437654365,98');
|
- Подробности
- Родительская категория: Язык программирования Дельфи
- Категория: Работа с числами
Code: |
unit uNum2Str;
// Possible enhancements // Move strings out to resource files // Put in a general num2str utility
interface
function Num2Dollars(dNum: double): string;
implementation
uses SysUtils;
function LessThan99(dNum: double): string; forward; // floating point modulus function FloatMod(i, j: double): double; begin result := i - (Int(i / j) * j); end;
function Hundreds(dNum: double): string; var workVar: double; begin if (dNum < 100) or (dNum > 999) thenraise Exception.Create('hundreds range exceeded'); result := ''; workVar := Int(dNum / 100); if workVar > 0then result := LessThan99(workVar) + ' Hundred'; end;
function OneToNine(dNum: Double): string; begin if (dNum < 1) or (dNum > 9) thenraise exception.create('onetonine: value out of range'); result := 'woops'; if dNum = 1then result := 'One'else if dNum = 2then result := 'Two'else if dNum = 3then result := 'Three'else if dNum = 4then result := 'Four'else if dNum = 5then result := 'Five'else if dNum = 6then result := 'Six'else if dNum = 7then result := 'Seven'else if dNum = 8then result := 'Eight'else if dNum = 9then result := 'Nine'; end;
function ZeroTo19(dNum: double): string; begin if (dNum < 0) or (dNum > 19) thenraise Exception.Create('Bad value in dNum'); result := ''; if dNum = 0then result := 'Zero'else if (dNum <= 1) and (dNum >= 9) then result := OneToNine(dNum) else if dNum = 10then result := 'Ten'else if dNum = 11then result := 'Eleven'else if dNum = 12then result := 'Twelve'else if dNum = 13then result := 'Thirteen'else if dNum = 14then result := 'Fourteen'else if dNum = 15then result := 'Fifteen'else if dNum = 16then result := 'Sixteen'else if dNum = 17then result := 'Seventeen' else if dNum = 18then result := 'Eighteen'else if dNum = 19then result := 'Nineteen' else result := 'woops!'; end;
function TwentyTo99(dNum: double): string; var BigNum: string; begin if (dNum < 20) or (dNum > 99) thenraise exception.Create('TwentyTo99: dNum out of range!'); BigNum := 'woops'; if dNum >= 90then BigNum := 'Ninety'else if dNum >= 80then BigNum := 'Eighty'else if dNum >= 70then BigNum := 'Seventy'else if dNum >= 60then BigNum := 'Sixty' else if dNum >= 50then BigNum := 'Fifty'else if dNum >= 40then BigNum := 'Forty' else if dNum >= 30then BigNum := 'Thirty'else if dNum >= 20then BigNum := 'Twenty'; // lose the big num dNum := FloatMod(dNum, 10); if dNum > 0.00then result := BigNum + ' ' + OneToNine(dNum) else result := BigNum; end;
function LessThan99(dNum: double): string; begin if dNum <= 19then result := ZeroTo19(dNum) else result := TwentyTo99(dNum); end;
function Num2Dollars(dNum: double): string; var centsString: string; cents: double; workVar: double; begin result := ''; if dNum < 0thenraise Exception.Create('Negative numbers not supported'); if dNum > 999999999.99then raise Exception.Create('Num2Dollars only supports up to the millions at this point!'); cents := (dNum - Int(dNum)) * 100.0; if cents = 0.0then centsString := 'and 00/100 Dollars'else if cents < 10then centsString := Format('and 0%1.0f/100 Dollars', [cents]) else centsString := Format('and %2.0f/100 Dollars', [cents]);
dNum := Int(dNum - (cents / 100.0)); // lose the cents
// deal with million's if (dNum >= 1000000) and (dNum <= 999999999) then begin workVar := dNum / 1000000; workVar := Int(workVar); if (workVar <= 9) then result := ZeroTo19(workVar) else if (workVar <= 99) then result := LessThan99(workVar) else if (workVar <= 999) then result := Hundreds(workVar) else result := 'mill fubar'; result := result + ' Million'; dNum := dNum - (workVar * 1000000); end;
// deal with 1000's if (dNum >= 1000) and (dNum <= 999999.99) then begin // doing the two below statements in one line of code yields some really // freaky floating point errors workVar := dNum / 1000; workVar := Int(workVar); if (workVar <= 9) then result := ZeroTo19(workVar) else if (workVar <= 99) then result := LessThan99(workVar) else if (workVar <= 999) then result := Hundreds(workVar) else result := 'thou fubar'; result := result + ' Thousand'; dNum := dNum - (workVar * 1000); end;
// deal with 100's if (dNum >= 100.00) and (dNum <= 999.99) then begin result := result + ' ' + Hundreds(dNum); dNum := FloatMod(dNum, 100); end;
// format in anything less than 100 if (dNum > 0) or ((dNum = 0) and (Length(result) = 0)) then begin result := result + ' ' + LessThan99(dNum); end; result := result + ' ' + centsString; end;
end. |
Code: |
function HundredAtATime(TheAmount: Integer): string; var
TheResult: string; begin
TheResult := ''; TheAmount := Abs(TheAmount); while TheAmount > 0do begin if TheAmount >= 900then begin TheResult := TheResult + 'Nine hundred '; TheAmount := TheAmount - 900; end; if TheAmount >= 800then begin TheResult := TheResult + 'Eight hundred '; TheAmount := TheAmount - 800; end; if TheAmount >= 700then begin TheResult := TheResult + 'Seven hundred '; TheAmount := TheAmount - 700; end; if TheAmount >= 600then begin TheResult := TheResult + 'Six hundred '; TheAmount := TheAmount - 600; end; if TheAmount >= 500then begin TheResult := TheResult + 'Five hundred '; TheAmount := TheAmount - 500; end; if TheAmount >= 400then begin TheResult := TheResult + 'Four hundred '; TheAmount := TheAmount - 400; end; if TheAmount >= 300then begin TheResult := TheResult + 'Three hundred '; TheAmount := TheAmount - 300; end; if TheAmount >= 200then begin TheResult := TheResult + 'Two hundred '; TheAmount := TheAmount - 200; end; if TheAmount >= 100then begin TheResult := TheResult + 'One hundred '; TheAmount := TheAmount - 100; end; if TheAmount >= 90then begin TheResult := TheResult + 'Ninety '; TheAmount := TheAmount - 90; end; if TheAmount >= 80then begin TheResult := TheResult + 'Eighty '; TheAmount := TheAmount - 80; end; if TheAmount >= 70then begin TheResult := TheResult + 'Seventy '; TheAmount := TheAmount - 70; end; if TheAmount >= 60then begin TheResult := TheResult + 'Sixty '; TheAmount := TheAmount - 60; end; if TheAmount >= 50then begin TheResult := TheResult + 'Fifty '; TheAmount := TheAmount - 50; end; if TheAmount >= 40then begin TheResult := TheResult + 'Fourty '; TheAmount := TheAmount - 40; end; if TheAmount >= 30then begin TheResult := TheResult + 'Thirty '; TheAmount := TheAmount - 30; end; if TheAmount >= 20then begin TheResult := TheResult + 'Twenty '; TheAmount := TheAmount - 20; end; if TheAmount >= 19then begin TheResult := TheResult + 'Nineteen '; TheAmount := TheAmount - 19; end; if TheAmount >= 18then begin TheResult := TheResult + 'Eighteen '; TheAmount := TheAmount - 18; end; if TheAmount >= 17then begin TheResult := TheResult + 'Seventeen '; TheAmount := TheAmount - 17; end; if TheAmount >= 16then begin TheResult := TheResult + 'Sixteen '; TheAmount := TheAmount - 16; end; if TheAmount >= 15then begin TheResult := TheResult + 'Fifteen '; TheAmount := TheAmount - 15; end; if TheAmount >= 14then begin TheResult := TheResult + 'Fourteen '; TheAmount := TheAmount - 14; end; if TheAmount >= 13then begin TheResult := TheResult + 'Thirteen '; TheAmount := TheAmount - 13; end; if TheAmount >= 12then begin TheResult := TheResult + 'Twelve '; TheAmount := TheAmount - 12; end; if TheAmount >= 11then begin TheResult := TheResult + 'Eleven '; TheAmount := TheAmount - 11; end; if TheAmount >= 10then begin TheResult := TheResult + 'Ten '; TheAmount := TheAmount - 10; end; if TheAmount >= 9then begin TheResult := TheResult + 'Nine '; TheAmount := TheAmount - 9; end; if TheAmount >= 8then begin TheResult := TheResult + 'Eight '; TheAmount := TheAmount - 8; end; if TheAmount >= 7then begin TheResult := TheResult + 'Seven '; TheAmount := TheAmount - 7; end; if TheAmount >= 6then begin TheResult := TheResult + 'Six '; TheAmount := TheAmount - 6; end; if TheAmount >= 5then begin TheResult := TheResult + 'Five '; TheAmount := TheAmount - 5; end; if TheAmount >= 4then begin TheResult := TheResult + 'Four '; TheAmount := TheAmount - 4; end; if TheAmount >= 3then begin TheResult := TheResult + 'Three '; TheAmount := TheAmount - 3; end; if TheAmount >= 2then begin TheResult := TheResult + 'Two '; TheAmount := TheAmount - 2; end; if TheAmount >= 1then begin TheResult := TheResult + 'One '; TheAmount := TheAmount - 1; end; end; HundredAtATime := TheResult; end;
function Real2CheckAmount(TheAmount: Real): string; var IntVal: LongInt; TmpVal: Integer; TmpStr, RetVal: string; begin
TheAmount := Abs(TheAmount);
{ центы } TmpVal := Round(Frac(TheAmount) * 100); IntVal := Trunc(TheAmount); TmpStr := HundredAtATime(TmpVal); if TmpStr = ''then TmpStr := 'Zero '; RetVal := TmpStr + 'cents'; if IntVal > 0then RetVal := 'dollars and ' + RetVal;
{ сотни } TmpVal := Round(Frac((IntVal * 1.0) / 1000.0) * 1000); IntVal := Trunc((IntVal * 1.0) / 1000.0); TmpStr := HundredAtATime(TmpVal); RetVal := TmpStr + RetVal;
{ тысячи } TmpVal := Round(Frac((IntVal * 1.0) / 1000.0) * 1000); IntVal := Trunc((IntVal * 1.0) / 1000.0); TmpStr := HundredAtATime(TmpVal); if TmpStr <> ''then RetVal := TmpStr + 'Thousand ' + RetVal;
{ миллионы } TmpVal := Round(Frac((IntVal * 1.0) / 1000.0) * 1000); IntVal := Trunc((IntVal * 1.0) / 1000.0); TmpStr := HundredAtATime(TmpVal); if TmpStr <> ''then RetVal := TmpStr + 'Million ' + RetVal;
{ миллиарды } TmpVal := Round(Frac((IntVal * 1.0) / 1000.0) * 1000); IntVal := Trunc((IntVal * 1.0) / 1000.0); TmpStr := HundredAtATime(TmpVal); if TmpStr <> ''then RetVal := TmpStr + 'Billion ' + RetVal;
Real2CheckAmount := RetVal; end; |
Хммммм...вроде бы работает, но как все громоздко и неуклюже....добавьте в код немного рекурсии и вы получите более элегантную программу..: )))
Code: |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;
type
TForm1 = class(TForm) num: TEdit; spell: TEdit; Button1: TButton; procedure Button1Click(Sender: TObject); private { Private declarations } function trans9(num: integer): string; function trans19(num: integer): string; function trans99(num: integer): string; function IntToSpell(num: integer): string; public { Public declarations } end;
var
Form1: TForm1;
implementation
{$R *.DFM} function TForm1.IntToSpell(num: integer): string; var
spell: string; hspell: string; hundred: string; thousand: string; tthousand: string; hthousand: string; million: string; begin
if num ≶ 10then spell := trans9(num); {endif} if (num < 20) and (num > 10) then spell := trans19(num); {endif} if (((num < 100) and (num > 19)) or (num = 10)) then begin hspell := copy(IntToStr(num), 1, 1) + '0'; spell := trans99(StrToInt(hspell)); hspell := copy(IntToStr(num), 2, 1); spell := spell + ' ' + IntToSpell(StrToInt(hspell)); end;
if (num < 1000) and (num > 100) then begin hspell := copy(IntToStr(num), 1, 1); hundred := IntToSpell(StrToInt(hspell)); hspell := copy(IntToStr(num), 2, 2); hundred := hundred + ' hundred and ' + IntToSpell(StrToInt(hspell)); spell := hundred; end;
if (num < 10000) and (num > 1000) then begin hspell := copy(IntToStr(num), 1, 1); thousand := IntToSpell(StrToInt(hspell)); hspell := copy(IntToStr(num), 2, 3); thousand := thousand + ' thousand ' + IntToSpell(StrToInt(hspell)); spell := thousand; end;
if (num < 100000) and (num > 10000) then begin hspell := copy(IntToStr(num), 1, 2); tthousand := IntToSpell(StrToInt(hspell)); hspell := copy(IntToStr(num), 3, 3); tthousand := tthousand + ' thousand ' + IntToSpell(StrToInt(hspell)); spell := tthousand; end;
if (num < 1000000) and (num > 100000) then begin hspell := copy(IntToStr(num), 1, 3); hthousand := IntToSpell(StrToInt(hspell)); hspell := copy(IntToStr(num), 4, 3); hthousand := hthousand + ' thousand and ' + IntToSpell(StrToInt(hspell));
spell := hthousand; end;
if (num < 10000000) and (num > 1000000) then begin hspell := copy(IntToStr(num), 1, 1); million := IntToSpell(StrToInt(hspell)); hspell := copy(IntToStr(num), 2, 6); million := million + ' million and ' + IntToSpell(StrToInt(hspell)); spell := million; end;
IntToSpell := spell;
end;
function TForm1.trans99(num: integer): string; var
spell: string; begin
case num of 10: spell := 'ten'; 20: spell := 'twenty'; 30: spell := 'thirty'; 40: spell := 'fourty'; 50: spell := 'fifty'; 60: spell := 'sixty'; 70: spell := 'seventy'; 80: spell := 'eighty'; 90: spell := 'ninty'; end; trans99 := spell; end; function TForm1.trans19(num: integer): string; var
spell: string; begin
case num of 11: spell := 'eleven'; 12: spell := 'twelve'; 13: spell := 'thirteen'; 14: spell := 'fourteen'; 15: spell := 'fifteen'; 16: spell := 'sixteen'; 17: spell := 'seventeen'; 18: spell := 'eighteen'; 19: spell := 'nineteen'; end; trans19 := spell; end; function TForm1.trans9(num: integer): string; var
spell: string; begin
case num of 1: spell := 'one'; 2: spell := 'two'; 3: spell := 'three'; 4: spell := 'four'; 5: spell := 'five'; 6: spell := 'six'; 7: spell := 'seven'; 8: spell := 'eight'; 9: spell := 'nine'; end; trans9 := spell; end; procedure TForm1.Button1Click(Sender: TObject); var
numb: integer; begin
spell.text := IntToSpell(StrToInt(num.text)); end; |
Взято из Советов по Delphi от Валентина Озерова
Сборник Kuliba
- Подробности
- Родительская категория: Язык программирования Дельфи
- Категория: Работа с числами
Code: |
unit UkrRecog; {копирайт непомню чей. Был для русских циферок, а я переделал под украинские} {если кто что найдет пришлите
} {by Andrew Tkachenko, proektwo netcity.ru, Ukraine,
} interface
const
UkrMonthString: array[1..12] ofstring[9] = ( 'січня', 'лютого', 'березня', 'квiтня', 'травня', 'червня', 'липня', 'серпня', 'вересня', 'жовтня', 'листопада', 'грудня');
function UkrRecognizeAmount(Amount: real; CurrName, CurrSubname: string): string;
implementation uses Sysutils;
function UkrRecognizeAmount(Amount: real; CurrName, CurrSubname: string): string; {* CurrName in [грн.]
CurrSubName in [коп.] Распознается число <= 999 999 999 999.99*} const suffBL: string = ' ';
suffDCT: string = 'дцять'; suffNA: string = 'надцять '; suffDCM: string = 'десят'; suffMZ: string = 'ь'; sot: string = 'сот'; st: string = 'ст'; aa: string = 'а'; ee: string = 'и'; {e} ii: string = 'і'; {и} oo: string = 'о'; ov: string = 'ів'; {ов} C2: string = 'дв'; C3: string = 'тpи'; C4: string = 'чотир'; C5: string = 'п''ят'; C6: string = 'шіст'; C7: string = 'сім'; C8: string = 'вісім'; C9: string = 'дев''ят'; var
i: byte; sAmount, sdInt, sdDec: string; IsMln, IsTha {,IsDcm}, IsRange1019: boolean; currNum, endMlx, sResult: string; begin
if (amount <= 0) or (amount > 999999999999.99) then begin Result := '<<<< Ошибка в диапазоне >>>>'; Exit; end; STR(Amount: 16: 2, sAmount); sdInt := Copy(sAmount, 1, 13); sdDec := Copy(sAmount, 15, 2); IsMln := false; //IsDcm:=false; IsTha := false; IsRange1019 := false; sResult := ''; for i := 1to13do begin currNum := Copy(sdInt, i, 1);
if currNum <> suffBL then begin case i of 5, 6, 7: if currNum <> '0'then IsMln := true; 8, 9, 10: if currNum <> '0'then IsTha := true; end;
if i in [2, 5, 8, 11] then{сотни} begin if currNum = '1'then sResult := sResult + st + oo + suffBL; if currNum = '2'then sResult := sResult + C2 + ii + st + ii + suffBL; if currNum = '3'then sResult := sResult + C3 + st + aa + suffBL; if currNum = '4'then sResult := sResult + C4 + ee + st + aa + suffBL; if currNum = '5'then sResult := sResult + C5 + sot + suffBL; if currNum = '6'then sResult := sResult + C6 + sot + suffBL; if currNum = '7'then sResult := sResult + C7 + sot + suffBL; if currNum = '8'then sResult := sResult + C8 + sot + suffBL; if currNum = '9'then sResult := sResult + C9 + sot + suffBL; end; if i in [3, 6, 9, 12] then{десятки} begin if currNum = '1'then IsRange1019 := true; if currNum = '2'then sResult := sResult + C2 + aa + suffDCT + suffBL; if currNum = '3'then sResult := sResult + C3 + suffDCT + suffBL; if currNum = '4'then sResult := sResult + 'соpок '; if currNum = '5'then sResult := sResult + C5 + suffMZ + suffDCM + suffBL;
if currNum = '6'then sResult := sResult + C6 + suffMZ + suffDCM + suffBL;
if currNum = '7'then sResult := sResult + C7 + suffMZ + suffDCM + suffBL;
if currNum = '8'then sResult := sResult + C8 + suffMZ + suffDCM + suffBL;
if currNum = '9'then sResult := sResult + 'дев''ян' + oo + st + oo + suffBL;
end; if i in [4, 7, 10, 13] then{единицы} begin if (currNum = '0') then if IsRange1019 then sResult := sResult + suffDCM + suffMZ + suffBL; if (currNum = '1') then begin if (i = 13) and (not IsRange1019) then sResult := sResult + 'одна ' else begin if (i = 10) and (IsRange1019) then sResult := sResult + 'оди' elseif (i = 10) and (not IsRange1019) then sResult := sResult + 'одна ' else sResult := sResult + 'один'{ин};
if IsRange1019 and (i = 13) then sResult := sResult + 'адцять' + suffBL elseif IsRange1019 then sResult := sResult + suffNA else sResult := sResult + suffBL; end; end; if (currNum = '2') then begin sResult := sResult + C2; if (i = 10) and (IsRange1019 = False) then sResult := sResult + ii elseif (i = 10) or (IsRange1019) then sResult := sResult + aa else sResult := sResult + {aa} ii; if IsRange1019 then sResult := sResult + suffNA else sResult := sResult + suffBL; end; if (currNum = '3') then begin sResult := sResult + C3; if IsRange1019 then sResult := sResult + suffNA else sResult := sResult + suffBL; end; if (currNum = '4') then begin sResult := sResult + C4; if IsRange1019 then sResult := sResult + suffNA else sResult := sResult + ee + suffBL; end; if (currNum = '5') then begin sResult := sResult + C5; if IsRange1019 then sResult := sResult + suffNA else sResult := sResult + suffMZ + suffBL; end; if (currNum = '6') then begin sResult := sResult + C6; if IsRange1019 then sResult := sResult + suffNA else sResult := sResult + suffMZ + suffBL; end; if (currNum = '7') then begin sResult := sResult + C7; if IsRange1019 then sResult := sResult + suffNA else sResult := sResult + suffBL; end; if (currNum = '8') then begin sResult := sResult + C8; if IsRange1019 then sResult := sResult + suffNA else sResult := sResult + suffBL; end; if (currNum = '9') then begin sResult := sResult + C9; if IsRange1019 then sResult := sResult + suffNA else sResult := sResult + suffMZ + suffBL; end; end;
endMlx := ''; case i of 4: begin if IsRange1019 then endMlx := ov + suffBL elseif currNum = '1'then endMlx := suffBL elseif (currNum = '2') or (currNum = '3') or (currNum = '4') then endMlx := aa + suffBL else endMlx := ov + suffBL; sResult := sResult + 'мiльярд' + endMlx; end; 7: if IsMln then begin if IsRange1019 then endMlx := ov + suffBL elseif currNum = '1'then endMlx := suffBL elseif (currNum = '2') or (currNum = '3') or (currNum = '4') then endMlx := aa + suffBL else endMlx := ov + suffBL; sResult := sResult + 'мiльйон' + endMlx; end; 10: if IsTha then begin if IsRange1019 then endMlx := suffBL elseif currNum = '1'then endMlx := aa + suffBL elseif (currNum = '2') or (currNum = '3') or (currNum = '4') then endMlx := ii + suffBL else endMlx := suffBL; sResult := sResult + 'тисяч' + endMlx; end; end; {case} if i in [4, 7, 10, 13] then IsRange1019 := false; end; {IF} end; {FOR}
sResult := sResult + CurrName + ',' + suffBL + sdDec + suffBL + CurrSubname; sResult := AnsiUpperCase(sResult[1]) + Copy(sResult, 2, length(sResult) - 1); Result := sResult; end;
end. |
С уважением,
Andrew Tkachenko
ООО "Проект ВО"
Украина, г.Харьков
- Подробности
- Родительская категория: Язык программирования Дельфи
- Категория: Работа с числами
Страница 2 из 2