Delphi World - Сумма прописью - Способ 11
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Сумма прописью - Способ 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=копейка,копеек,копейки,

Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования