Функция, представляющая вещественные числа словамиDelphi , Синтаксис , ПреобразованияФункция, представляющая вещественные числа словами
Автор: Елисеев Леонид { **** UBPFD *********** by delphibase.endimus.com **** >> Функция, представляющая вещественные числа словами Набор функций, преобразующих целые и вещественные числа в текстовое представление (с единицами измерения и без). function FloatToText(R: Double; Precision: Integer): string; Преобразует вещественное число в текстовое представление с точностью до Precision <= 4 знаков после запятой. function AmountOfUnits(AUnit: TRusWord; R: Double; Precision: Integer; Options: TNumberToTextOptions): string; То же, что и FloatToText, но с учётом единицы измерения и опциями: ntoExplicitZero: "ноль целых" ntoMinus, ntoPlus: "минус", "плюс". ntoNotReduceFrac: "пятьдесят сотых" вместо "пяти десятых". function CountOfUnits(AUnit: TRusWord; N: Int64; Options: TNumberToTextOptions): string; То же для целых чисел. Все функции модуля реализованы через неё. function CurrencyToText(ASum: Currency): string; ещё одна реализация суммы прописью. Зависимости: SysUtils Автор: reonid, reonid@yahoo.com, ICQ:104985721, Москва Copyright: Елисеев Леонид Дата: 15 июля 2002 г. ***************************************************** } unit Num2Text; interface type TNumberToTextOptions = set of (ntoExplicitZero, ntoMinus, ntoPlus, ntoDigits, ntoNotReduceFrac); TGender = (genNeuter, genMasculine, genFeminine); // Род: нейтральный, мужской, женский TRusWord = record Gender: TGender; Base: string; End1: string; End2: string; End5: string; end; const MaxPrecision = 4; // до десятитысячных WD_EMPTY: TRusWord = ( Gender: genMasculine; Base: ''; End1: ''; End2: ''; End5: ''; ); {разряды} WD_THOUSEND: TRusWord = ( Gender: genFeminine; Base: 'тысяч'; End1: 'а'; End2: 'и'; End5: ''; ); WD_MILLION: TRusWord = ( Gender: genMasculine; Base: 'миллион'; End1: ''; End2: 'а'; End5: 'ов'; ); WD_MILLIARD: TRusWord = ( Gender: genMasculine; Base: 'миллиард'; End1: ''; End2: 'а'; End5: 'ов'; ); {Дробная часть} WD_INT: TRusWord = ( Gender: genFeminine; Base: 'цел'; End1: 'ая'; End2: 'ых'; End5: 'ых'; ); WD_FRAC: array[1..4] of TRusWord = ( (Gender: genFeminine; Base: 'десят'; End1: 'ая'; End2: 'ых'; End5: 'ых'; ), (Gender: genFeminine; Base: 'coт'; End1: 'ая'; End2: 'ых'; End5: 'ых'; ), (Gender: genFeminine; Base: 'тысячн'; End1: 'ая'; End2: 'ых'; End5: 'ых'; ), (Gender: genFeminine; Base: 'десятитысячн'; End1: 'ая'; End2: 'ых'; End5: 'ых'; ) ); {Рубли, копейки} WD_RUBLE: TRusWord = ( Gender: genMasculine; Base: 'рубл'; End1: 'ь'; End2: 'я'; End5: 'ей'; ); WD_KOPECK: TRusWord = ( Gender: genFeminine; Base: 'копе'; End1: 'йка'; End2: 'йки'; End5: 'ек'; ); function CurrencyToText(ASum: Currency): string; function FloatToText(R: Double; Precision: Integer): string; function CountOfUnits(AUnit: TRusWord; N: Int64; Options: TNumberToTextOptions): string; function AmountOfUnits(AUnit: TRusWord; R: Double; Precision: Integer; Options: TNumberToTextOptions): string; implementation uses SysUtils; const TenIn: array[1..4] of Integer = (10, 100, 1000, 10000); type {------------------------------------------------------------------------------} TNumberAnalyser = class private FUnitWord: TRusWord; FNumber: Integer; FFirstLevel: Integer; FSecondLevel: Integer; FThirdLevel: Integer; function GetLevels(I: Integer): Integer; procedure SetNumber(AValue: Integer); function GetNumberInWord(N, Level: Integer): string; function GetGender: TGender; function Convert: string; public property Gender: TGender read GetGender; property Levels[I: Integer]: Integer read GetLevels; property Number: Integer read FNumber write SetNumber; property UnitWord: TRusWord read FUnitWord write FUnitWord; function UnitWordInRightForm: string; function ConvertToText(AUnit: TRusWord; ANumber: Integer): string; end; var NumberAnalyser: TNumberAnalyser; {------------------------------------------------------------------------------} function CurrencyToText(ASum: Currency): string; var RubSum, KopSum: Int64; s: string; begin RubSum := Trunc(ASum); KopSum := Round(Frac(ASum) * 100); Result := CountOfUnits(WD_RUBLE, RubSum, [{ntoExplicitZero, ntoMinus}]) + ' ' + CountOfUnits(WD_KOPECK, KopSum, [ntoDigits]); // Копейки в цифрах if Result <> '' then Result[1] := AnsiUpperCase(Result[1])[1]; // С большой буквы end; {------------------------------------------------------------------------------} function FloatToText(R: Double; Precision: Integer): string; begin Result := AmountOfUnits(WD_EMPTY, R, Precision, [ntoExplicitZero, ntoMinus]); end; {------------------------------------------------------------------------------} function AmountOfUnits(AUnit: TRusWord; R: Double; Precision: Integer; Options: TNumberToTextOptions): string; var n_int, n_frac: Integer; begin // опция ntoDigits не используется за ненадобностью // Количество цифр после запятой if Precision < 0 then Precision := 0; if Precision > MaxPrecision then Precision := MaxPrecision; if (R > 0) and (ntoPlus in Options) then Result := 'плюс '; if (R < 0) and (ntoMinus in Options) then Result := 'минус '; R := Abs(R); // Если Precision = 0, т.е. без дробной части, округляется в большую сторону if Precision > 0 then n_int := Trunc(R) else n_int := Round(R); // Дробная часть n_frac := Round((R - n_int) * TenIn[Precision]); // Отбрасывание нулей в дробной части // опция ntoNotReduceFrac не работает при n_frac = 0 (т.е. не будет "ноль сотых") if not (ntoNotReduceFrac in Options) then while (n_frac mod 10 = 0) and (Precision > 0) do begin n_frac := n_frac div 10; Dec(Precision); end; // Явная запись нуля if n_int = 0 then if n_frac = 0 then begin // При отсутствии дробной части "ноль" добавляется вне зависимости от опции ntoExplicitZero Result := {Result +} 'ноль ' + AUnit.Base + AUnit.End5; // "Result +" отброшено, чтобы избежать "минус ноль" // при очень маленькой дробной части за пределами точности Exit; end else if (ntoExplicitZero in Options) then Result := Result + 'ноль целых '; if {Precision = 0} n_frac = 0 then Result := Result + CountOfUnits(AUnit, n_int, []) // N единиц else Result := Result + CountOfUnits(WD_INT, n_int, []); // столько-то целых if {(Precision = 0)}(n_frac = 0) then Exit; Result := Result + CountOfUnits(WD_FRAC[Precision], n_frac, []); // N десятых, сотых... Result := Result + AUnit.Base + AUnit.End2; end; {------------------------------------------------------------------------------} function CountOfUnits(AUnit: TRusWord; N: Int64; Options: TNumberToTextOptions): string; var Mrd, Mil, Th, Un: Integer; begin Result := ''; if (N = 0) and not (ntoExplicitZero in Options) then Exit; if not (ntoDigits in Options) then begin if (N < 0) and (ntoMinus in Options) then Result := 'минус ' else if (N > 0) and (ntoPlus in Options) then Result := 'плюс ' else if (N = 0) then begin Result := 'ноль ' + AUnit.Base + AUnit.End5; Exit; end; end else begin if (N < 0) and (ntoMinus in Options) then Result := '-' else if (N > 0) and (ntoPlus in Options) then Result := '+'; end; N := Abs(N); if ntoDigits in Options then begin NumberAnalyser.Number := N; NumberAnalyser.UnitWord := AUnit; Result := Result + Format('%d %s', [N, NumberAnalyser.UnitWordInRightForm]); end else begin with NumberAnalyser do begin Mrd := (N div 1000000000) mod 1000; Mil := (N div 1000000) mod 1000; Th := (N div 1000) mod 1000; Un := (N) mod 1000; Result := Result + ConvertToText(WD_MILLIARD, Mrd) + ConvertToText(WD_MILLION, Mil) + ConvertToText(WD_THOUSEND, Th); if Un > 0 then Result := Result + ConvertToText(AUnit, Un) else Result := Result + AUnit.Base + AUnit.End5; end; end; end; {------------------- TNumberAnalyser ------------------------------------------} function TNumberAnalyser.GetLevels(I: Integer): Integer; begin case I of 1: Result := FFirstLevel; 2: Result := FSecondLevel; 3: Result := FThirdLevel; end; end; procedure TNumberAnalyser.SetNumber(AValue: Integer); begin if FNumber <> AValue then begin FNumber := AValue; FFirstLevel := FNumber mod 10; FSecondLevel := (FNumber div 10) mod 10; FThirdLevel := (FNumber div 100) mod 10; if FSecondLevel = 1 then begin FFirstLevel := FFirstLevel + 10; FSecondLevel := 0; end; end; end; function TNumberAnalyser.GetGender: TGender; begin Result := FUnitWord.Gender; end; function TNumberAnalyser.GetNumberInWord(N, Level: Integer): string; begin if Level = 1 then case N of 0: Result := ''; 1: if Gender = genMasculine then Result := 'один' else if Gender = genFeminine then Result := 'одна' else if Gender = genNeuter then Result := 'одно'; 2: if Gender = genMasculine then Result := 'два' else if Gender = genFeminine then Result := 'две' else if Gender = genNeuter then Result := 'два'; 3: Result := 'три'; 4: Result := 'четыре'; 5: Result := 'пять'; 6: Result := 'шесть'; 7: Result := 'семь'; 8: Result := 'восемь'; 9: Result := 'девять'; 10: Result := 'десять'; 11: Result := 'одиннадцать'; 12: Result := 'двенадцать'; 13: Result := 'тринадцать'; 14: Result := 'четырнадцать'; 15: Result := 'пятнадцать'; 16: Result := 'шестнадцать'; 17: Result := 'семнадцать'; 18: Result := 'восемнадцать'; 19: Result := 'девятнадцать'; end else if Level = 2 then case N of 0: Result := ''; 1: Result := 'десять'; 2: Result := 'двадцать'; 3: Result := 'тридцать'; 4: Result := 'сорок'; 5: Result := 'пятьдесят'; 6: Result := 'шестьдесят'; 7: Result := 'семьдесят'; 8: Result := 'восемьдесят'; 9: Result := 'девяносто'; end else if Level = 3 then case N of 0: Result := ''; 1: Result := 'сто'; 2: Result := 'двести'; 3: Result := 'триста'; 4: Result := 'четыреста'; 5: Result := 'пятьсот'; 6: Result := 'шестьсот'; 7: Result := 'семьсот'; 8: Result := 'восемьсот'; 9: Result := 'девятьсот'; end; end; function TNumberAnalyser.UnitWordInRightForm: string; begin Result := UnitWord.Base; case Levels[1] of 0, 5..19: Result := Result + UnitWord.End5; 1: Result := Result + UnitWord.End1; 2..4: Result := Result + UnitWord.End2; end; end; function TNumberAnalyser.Convert: string; var i: Integer; s: string; begin if FNumber = 0 then Result := '' else begin Result := ''; for i := 3 downto 1 do begin s := GetNumberInWord(Levels[i], i); if s <> '' then Result := Result + s + ' '; end; Result := Result + UnitWordInRightForm + ' '; end; end; function TNumberAnalyser.ConvertToText(AUnit: TRusWord; ANumber: Integer): string; begin UnitWord := AUnit; Number := ANumber; Result := Convert; end; {------------------------------------------------------------------------------} initialization NumberAnalyser := TNumberAnalyser.Create; finalization NumberAnalyser.Free; end. Пример использования: str := FloatToText(3.14, 2); // три целых четырнадцать coтых const WD_METRE: TRusWord = ( Gender: genMasculine; Base: 'метр'; End1: ''; End2: 'а'; End5: 'ов'; ); str := AmountOfUnits(WD_METRE, 3.1, 2, [ntoExplicitZero, ntoMinus]); // три целых одна десятая метра Статья Функция, представляющая вещественные числа словами раздела Синтаксис Преобразования может быть полезна для разработчиков на Delphi и FreePascal. Комментарии и вопросыМатериалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта. :: Главная :: Преобразования ::
|
||||
©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007 |