скрыть

скрыть

  Форум  

Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



Google  
 

Сумма прописью - Способ 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.






Copyright © 2004-2016 "Delphi Sources". Delphi World FAQ




Группа ВКонтакте   Ссылка на Twitter   Группа на Facebook