Карта сайта Kansoftware
НОВОСТИУСЛУГИРЕШЕНИЯКОНТАКТЫ
Разработка программного обеспечения
KANSoftWare

Число прописью 11

Delphi , Синтаксис , Текст и Строки

Сумма прописью - Способ 11

Автор: Панченко Сергей

Честно, давно ждал подобного журнала в электронном виде. Решил послать своё творчество которое уже немало отработало, опять же, преобразование числа в пропись, отличающееся от опубликованных программок тем, что слова для прописи хранятся в отдельном файле (lang.cnf), по аналогии с подуктами 1C. Это позволяет изменять национальную валюту.

Если поэкспериментировать, с массивом Univer, в котором хранятся окончания, можно добиться преобразования для многих языков, не сказал ли я чего лишнего. :)

Надеюсь, моя версия Вам понравится.

С наилучшими пожеланиями,

Панченко Сергей

Казахстан, Алматы,

BuchUtil.pas


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: array of string);

var

  NameNum: array[0..9, 1..4] of string; //массив им?н чисел
  Ext: array[0..4, 1..3] of string; //массив расшиений (тысячи, миллионы ...)
  Univer: array[1..9, 1..4] of integer; //массив окончаний
  Rubl: array[1..3] of string; //массив имен рублей
  Cop: array[1..3] of string; //массив имен копеек
  Zero: string; //название нуля
  One: string; //единица "одна"
  Two: string; //двойка "две"
  fFile: TIniFile; //файл, откуда загружается пропись
  fString: string;
  fDim: array[0..9] of string;
  i: integer;

implementation

{заполняет массив Dim лексемами}

procedure LexemsToDim(fstr: string; var dim: array of string);
var

  i, j: integer;
  flex: string;
begin

  if Length(fstr) > 0 then
  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
      else if (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 = 4 then
      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) = 1 then
    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 = 0 then
    idx := 5;
  idxIP := Univer[idx, 1];
  idx := StrToInt(Real_Part[Length(Real_Part)]);
  if idx = 0 then
    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 := 1 to 9 do
      NameNum[i, 1] := fdim[i - 1];

    {Заполнение массива десятков}
    fString := fFile.ReadString('Nums', 'Tens', ',');
    LexemsToDim(fString, fdim);
    NameNum[0, 2] := '';
    for i := 1 to 9 do
      NameNum[i, 2] := fdim[i - 1];

    {Заполнение массива сотен}
    fString := fFile.ReadString('Nums', 'Hundreds', ',');
    LexemsToDim(fString, fdim);
    NameNum[0, 3] := '';
    for i := 1 to 9 do
      NameNum[i, 3] := fdim[i - 1];

    {Заполнение массива чисел после десяти}
    fString := fFile.ReadString('Nums', 'AfterTen', ',');
    LexemsToDim(fString, fdim);
    NameNum[0, 4] := '';
    for i := 1 to 9 do
      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 := 1 to 3 do
      Ext[1, i] := fdim[i - 1];

    {Миллионы}
    fString := fFile.ReadString('Nums', 'Mill', ',');
    LexemsToDim(fString, fdim);
    for i := 1 to 3 do
      Ext[2, i] := fdim[i - 1];

    {Миллиарды}
    fString := fFile.ReadString('Nums', 'Bill', ',');
    LexemsToDim(fString, fdim);
    for i := 1 to 3 do
      Ext[3, i] := fdim[i - 1];

    {Триллион}
    fString := fFile.ReadString('Nums', 'Thrill', ',');
    LexemsToDim(fString, fdim);
    for i := 1 to 3 do
      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.

Lang.cnf


[Nums]
Numbers=один,два,три,четыре,пять,шесть,семь,восемь,девять,
One=одна,
Two=две,
Tens=десять,двадцать,тридцать,сорок,пятьдесят,шестьдесят,семьдесят,восемьдесят,девяносто,
Hundreds=сто,двести,триста,четыреста,пятьсот,шестьсот,семьсот,восемьсот,девятьсот,
AfterTen=одиннадцать,двенадцать,тринадцать,четырнадцать,пятнадцать,шестнадцать,семнадцать,восемнадцать,девятнадцать,
Zero=ноль,
Thou=тысяча,тысяч,тысячи,
Mill=миллион,миллионов,миллиона,
Bill=миллиард,миллиардов,миллиарда,
Thrill=триллион,триллионов,триллиона,

[Money]
Rub=рубль,рублей,рубля,
Cop=копейка,копеек,копейки,

Статья Число прописью 11 раздела Синтаксис Текст и Строки может быть полезна для разработчиков на Delphi и FreePascal.


Комментарии и вопросы


:: 2015-09-03 14:46:53 :: re:Число прописью 910042020308150

пользователь: Людмила.

Делаю с внуком уроки ,5 класс, задание написать число 910042020308150 прописью


Ваше мнение или вопрос к статье в виде простого текста (Tag <a href=... Disabled). Все комментарии модерируются, модератор оставляет за собой право удалить непонравившейся ему комментарий.

заголовок

e-mail

Ваше имя

Сообщение

Введите код




Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.



:: Главная :: Текст и Строки ::


реклама



©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007
Top.Mail.Ru Rambler's Top100
20.04.2024 05:51:56/0.037345886230469/2