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


unit sumstr;

interface

uses
  SysUtils, StrUtils;

function SumToString(Value: string): string;

implementation
const

a: array[0..8,0..9] of string=(
('','один ','два ','три ','четыре ','пять ','шесть ','семь ','восемь ','девять '),
('','','двадцать ','тридцать ','сорок ','пятьдесят ','шестьдесят ','семьдесят ','восемьдесят ','девяносто '),
('','сто ','двести ','триста ','четыреста ','пятьсот ','шестьсот ','семьсот ','восемьсот ','девятьсот '),
('тысяч ','тысяча ','две тысячи ','три тысячи ','четыре тысячи ','пять тысячь ','шесть тысячь ','семь тысячь ',
'восемь тысячь ','девять тысячь '),
('','','двадцать ','тридцать ','сорок ','пятьдесят ','шестьдесят ','семьдесят ','восемьдесят ','девяносто '),
('','сто ','двести ','триста ','четыреста ','пятьсот ','шестьсот ','семьсот ','восемьсот ','девятьсот '),
('миллионов ','один миллион ','два миллиона ','три миллиона ','четыре миллиона ','пять миллионов ',
'шесть миллионов ','семь миллионов ','восемь миллионов ','девять миллионов '),
('','','двадцать ','тридцать ','сорок ','пятьдесят ','шестьдесят ','семьдесят ','восемьдесят ','девяносто '),
('','сто ','двести ','триста ','четыреста ','пятьсот ','шестьсот ','семьсот ','восемьсот ','девятьсот '));

b: array[0..9] of string=
('десять ','одинадцать ','двенадцать ','тринадцать ','четырнадцать ','пятьнадцать ','шестьнадцать ',
'семьнадцать ','восемьнадцать ','девятьнадцать ');

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>1 then
      if (s[p-1]='1') and (s[p]>'0') then
      begin
        t:=b[strtoint(s[p])];
        pp:=pp-2;
      end;
    i:=pp;
    while i>0 do
    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>0 then
      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=0 then
    p:=pos('.', value);
  if p<>0 then
    delete(value,p,1);
  if p=0 then
  begin
    hi:=value;
    lo:='00';
  end;
  if p>length(value) then
  begin
    hi:=value;
    lo:='00';
  end;
  if p=1 then
  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<>0 then
  begin
    result:='';
    exit;
  end;
  hi:=sumtostrin(inttostr(pr))+'руб. ';
  if lo<>'00' then
  begin
    val(lo,pr,er);
    if er<>0 then
    begin
      result:='';
      exit;
    end;
    lo:=inttostr(pr);
  end;
  lo:=lo+' коп. ';
  hi[1]:=AnsiUpperCase(hi[1])[1];
  result:=hi+lo;
end;

end.

Проект Delphi World © Выпуск 2002 - 2004
Автор проекта: ___Nikolay