Сумма прописью.

отредактировано 16:21 Раздел: FastReport 3.0
PascalScript
Вызов: Propis(124.34)
переделано.
Сам код:
function Propis(Value0: extended): string;
var
  Rend: boolean;
  ValueTemp, ValueOst,value, value1,value2: longint;

  procedure Num(Value: byte);
  begin
    case Value of
      1: if Rend = true then Result := Result + 'один ' else Result := Result + 'одна ';
      2: if Rend = true then Result := Result + 'два ' else Result := Result + 'две ';
      3: Result := Result + 'три ';
      4: Result := Result + 'четыре ';
      5: Result := Result + 'пять ';
      6: Result := Result + 'шесть ';
      7: Result := Result + 'семь ';
      8: Result := Result + 'восемь ';
      9: Result := Result + 'девять ';
      10: Result := Result + 'десять ';
      11: Result := Result + 'одиннадцать ';
      12: Result := Result + 'двенадцать ';
      13: Result := Result + 'тринадцать ';
      14: Result := Result + 'четырнадцать ';
      15: Result := Result + 'пятнадцать ';
      16: Result := Result + 'шестнадцать ';
      17: Result := Result + 'семнадцать ';
      18: Result := Result + 'восемнадцать ';
      19: Result := Result + 'девятнадцать ';
    end
  end;

  procedure Num10(Value: byte);
  begin
    case Value of
      2: Result := Result + 'двадцать ';
      3: Result := Result + 'тридцать ';
      4: Result := Result + 'сорок ';
      5: Result := Result + 'пятьдесят ';
      6: Result := Result + 'шестьдесят ';
      7: Result := Result + 'семьдесят ';
      8: Result := Result + 'восемьдесят ';
      9: Result := Result + 'девяносто ';
    end;
  end;

  procedure Num100(Value: byte);
  begin
    case Value of
      1: Result := Result + 'сто ';
      2: Result := Result + 'двести ';
      3: Result := Result + 'триста ';
      4: Result := Result + 'четыреста ';
      5: Result := Result + 'пятьсот ';
      6: Result := Result + 'шестьсот ';
      7: Result := Result + 'семьсот ';
      8: Result := Result + 'восемьсот ';
      9: Result := Result + 'девятьсот ';
    end
  end;

  procedure Num00;
  begin
    Num100(ValueTemp div 100);
    ValueTemp := ValueTemp mod 100;
    if ValueTemp < 20 then Num(ValueTemp)
    else
    begin
      Num10(ValueTemp div 10);
      ValueTemp := ValueTemp mod 10;
      Num(ValueTemp);
    end;
  end;

  procedure NumMult(Mult: longint; s1, s2, s3: string);
  var ValueRes:longint;
  begin
    if Value >= Mult then
    begin
      ValueTemp := Value div Mult;
      ValueRes := ValueTemp;
      Num00;
      if ValueTemp = 1 then Result := Result + s1
      else if (ValueTemp > 1) and (ValueTemp < 5) then Result := Result + s2
      else Result := Result + s3;
      Value := Value - Mult * ValueRes;
    end;
  end;

function pr(Value:longint):string;
begin


end;
begin
  Result:='';
  value1:=trunc(Value0);
  value2:=trunc(frac(Value0)*100);
  value:=value1;
    if (Value = 0) then Result := 'ноль'
  else
  begin
    Rend := true;
    NumMult(1000000000000, 'триллион ', 'триллиона ', 'триллионов ');
    NumMult(1000000000, 'миллиард ', 'миллиарда ', 'миллиардов ');
    NumMult(1000000, 'миллион ', 'миллиона ', 'миллионов ');
    Rend := false;
    NumMult(1000, 'тысяча ', 'тысячи ', 'тысяч ');
    Rend := true;
    ValueTemp := Value;
    Num00;
  end;
  result:=result+' '+Rub(value1,'рубль;рубля;рублей')+' ';
  value:=value2;
 if (Value = 0) then Result :=Result+'ноль';
  ValueTemp := Value;
    Num00;
  Result:=result+' '+Kop(value2,'копейка;копейки;копеек');
end;

procedure Fst(S: string; Var  S1: string; Var  S2: string; Var  S3: string);
var
  pos: integer;
begin
  S1 := '';
  S2 := '';
  S3 := '';

  pos := 1;

  while ((pos <= Length(S))and(S[pos] <> ';'))do
  begin
    S1 := S1 + S[pos];
    inc(pos);
  end;
  inc(pos);

  while ((pos <= Length(S))and(S[pos] <> ';'))do
  begin
    S2 := S2 + S[pos];
    inc(pos);
  end;
  inc(pos);

  while ((pos <= Length(S))and(S[pos] <> ';'))do
  begin
    S3 := S3 + S[pos];
    inc(pos);
  end;
  inc(pos);
end;

function Rub(Value: longint; Skl: string): string;
var
  hk10, hk20: integer;
  Skl1,Skl2,Skl3: string;
begin
 Result :='';
  Fst(Skl,Skl1,Skl2,Skl3);
  hk10 := Value mod 10;
  hk20 := Value mod 100;
  if (hk20 > 10) and (hk20 < 20) then result := result + Skl3
  else if (hk10 = 1) then result := result + Skl1
  else if (hk10 > 1) and (hk10 < 5) then result := result + Skl2
  else result := result + Skl3;
end;

function Kop(Value: longint; Skp: string): string;
var
  hk10, hk20: integer;
  Skp1,Skp2,Skp3: string;
begin
 Result :='';
  Fst(Skp,Skp1,Skp2,Skp3);
  hk10 := Value mod 10;
  hk20 := Value mod 100;


  if (hk20 > 10) and (hk20 < 20) then result := result + Skp3
  else
  if (hk10 = 1) then result := result + Skp1
  else if (hk10 > 1) and (hk10 < 5) then result := result + Skp2
  else result := result + Skp3;
end;

begin

end.

Комментарии

  • отредактировано 16:21
    Довольно громозкий код
  • отредактировано 16:21
    Типичный пример для дельфи
    function IntToWords64(k:int64):string;
    VAR
    Value: Int64;
    i100, i10, i1: Integer;
    V, p, n: Integer;
    res:string;
    begin
    try
    res:='';
    Value :=k;
    n := 0;
    {Обработка отрицательного значения и нуля}
    if Value < 0 then
    begin
    Value := -Value;
    res:='минус';
    end
    else
    if Value = 0 then
    res:='ноль'+res;

    repeat
    {Разбивка на триады с конца}
    V := Value mod 1000;
    Value := Value div 1000;
    {Обработка}
    if (V > 0) or (n = 0) then
    begin
    i100 := V div 100;
    V := V-(i100*100);
    if V >= 20 then
    begin
    i1 := V mod 10;
    V := V div 10;
    i10 := V mod 10;
    end
    else begin
    i1 := V;
    i10 := 0;
    end;
    case i1 of
    1: p := 0;
    2..4: p := 1;
    else p := 2;
    end;
    {Изменение в зависимости от женского или мужского рода}
    if (A0[n,3] = '0') and ((i1 = 1) or (i1 = 2)) then
    res:=A100[i100]+A10[i10]+A11[i1]+A0[n,p]+' '+res
    else res:=A100[i100]+A10[i10]+A1[i1]+A0[n,p]+' '+res;
    end;
    Inc(n);
    {Проверка выхода за максимальное количество триад}
    if n > MAX3 then Exit;
    until Value <= 0;
    except
    res:='Ошибка';
    end;
    result:=res;
    end;

    //для Inttoworda64
    MAX3 = 5; {Максимальное количество триад}
    A11: ARRAY[1..2] OF STRING[20] = ('одна ', 'две ');
    A1: ARRAY[0..19] OF STRING [20] = ('', 'один ', 'два ','три ', 'четыре ', 'пять ', 'шесть ', 'семь ', 'восемь ', 'девять ', 'десять ', 'одиннадцать ', 'двенадцать ', 'тринадцать ', 'четырнадцать ', 'пятнадцать ', 'шестнадцать ', 'семнадцать ', 'восемнадцать ', 'девятнадцать ');
    A10: ARRAY[0..9] OF STRING [20] = ('', 'десять ', 'двадцать ', 'тридцать ', 'сорок ', 'пятьдесят ', 'шестьдесят ', 'семьдесят ', 'восемьдесят ', 'девяносто ');
    A100: ARRAY[0..9] OF STRING[20]= ('', 'сто ', 'двести ', 'триста ', 'четыреста ', 'пятьсот ', 'шестьсот ', 'семьсот ', 'восемьсот ', 'девятьсот ');
    {четвертым параметром является обозначение мужского или женского рода,
    где '0' - женский род;
    '1' - мужской род.
    Это дает возможность, например, изменяя "рубли" на "штуки" просто поменять '1' на '0' не меняя кода.}
    A0: ARRAY[0..MAX3-1, 0..3] OF STRING[20]= (('рубль', 'рубля', 'рублей', '1'),
    ('тысяча', 'тысячи', 'тысяч', '0'),
    ('миллион', 'миллиона', 'миллионов', '1'),
    ('миллиард', 'миллиарда', 'миллиардов', '1'),
    ('триллион', 'триллиона', 'триллионов', '1'));

  • отредактировано April 2006
    А забыл добавить копейки отдельно форматируются, но там совсем просто

Оставить комментарий

Многофункциональный текстовый редактор. Чтобы отредактировать стиль параграфа, нажмите TAB, чтобы перейти к меню абзаца. Там вы можете выбрать стиль. По умолчанию не выбран ни один стиль. Когда вы выберете текст, появится встроенное меню форматирования. Нажмите TAB, чтобы войти в него. Некоторые элементы, такие как многофункциональные вставки ссылок, картинок, индикаторов загрузки и сообщений об ошибок могут быть вставлены в редактор. Вы можете перемещаться по ним, используя стрелки внутри редактора и удалять с помощью клавиш delete или backspace.