Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 11.10.2011, 13:58   #1
ranif
Новичок
Джуниор
 
Регистрация: 18.09.2011
Сообщений: 1
По умолчанию Сумма прописью

Помогите пожалуйста как сделать?
Сумму вводишь в Edit1, чтобы рубли выходили отдельно в Edit1, а копейки выходили отдельно в Edit2.
вот сама функция
Код:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, math;
  function sMoneyInWords(Nin: currency): string; export;
  function szMoneyInWords(Nin: currency): PChar; export;
type
tri = string[4];
  mood = 1..2;
  gender = (m, f);
  uns = array[0..9] of string[7];
  tns = array[0..9] of string[13];
  decs = array[0..9] of string[12];
  huns = array[0..9] of string[10];
  nums = array[0..4] of string[8];
  money = array[1..2] of string[5];
  endings = array[gender, mood, 1..3] of tri; {окончания числительных и денег}
  TForm1 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    procedure Edit2Change(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  str: string;
const
  units: uns = ('', 'один ', 'два ', 'три ', 'четыре ', 'пять ',
    'шесть ', 'семь ', 'восемь ', 'девять ');
  unitsf: uns = ('', 'одна ', 'две ', 'три ', 'четыре ', 'пять ',
    'шесть ', 'семь ', 'восемь ', 'девять ');
  teens: tns = ('десять ', 'одиннадцать ', 'двенадцать ', 'тринадцать ',
    'четырнадцать ', 'пятнадцать ', 'шестнадцать ',
    'семнадцать ', 'восемнадцать ', 'девятнадцать ');
  decades: decs = ('', 'десять ', 'двадцать ', 'тридцать ', 'сорок ',
    'пятьдесят ', 'шестьдесят ', 'семьдесят ', 'восемьдесят ',
    'девяносто ');
  hundreds: huns = ('', 'сто ', 'двести ', 'триста ', 'четыреста ',
    'пятьсот ', 'шестьсот ', 'семьсот ', 'восемьсот ',
    'девятьсот ');
  numericals: nums = ('', 'тысяч', 'миллион', 'миллиард', 'триллион');
  RusMon: money = ('рубл', 'копе');
  ends: endings = ((('', 'а', 'ов'), ('ь', 'я', 'ей')),
    (('а', 'и', ''), ('йка', 'йки', 'ек')));
implementation

{$R *.dfm}
function EndingIndex(Arg: integer): integer;
begin

  if ((Arg div 10) mod 10) <> 1 then
    case (Arg mod 10) of
      1: Result := 1;
      2..4: Result := 2;
    else
      Result := 3;
    end
  else
    Result := 3;
end;

function sMoneyInWords(Nin: currency): string;
  { Число Nin прописью, как функция }
var
  //  str: string;

  g: gender; //род
  Nr: comp; {целая часть числа}
  Fr: integer; {дробная часть числа}
  i, iTri, Order: longint; {триада}

  procedure Triad;
  var
    iTri2: integer;
    un, de, ce: byte; //единицы, десятки, сотни

    function GetDigit: byte;
    begin
      Result := iTri2 mod 10;
      iTri2 := iTri2 div 10;
    end;

  begin
    iTri := trunc(Nr / IntPower(1000, i));
    Nr := Nr - int(iTri * IntPower(1000, i));
    iTri2 := iTri;
    if iTri > 0 then
    begin
      un := GetDigit;
      de := GetDigit;
      ce := GetDigit;
      if i = 1 then
        g := f
      else
        g := m; {женского рода только тысяча}

      str := TrimRight(str) + ' ' + Hundreds[ce];
      if de = 1 then
        str := TrimRight(str) + ' ' + Teens[un]
      else
      begin
        str := TrimRight(str) + ' ' + Decades[de];
        case g of
          m: str := TrimRight(str) + ' ' + Units[un];
          f: str := TrimRight(str) + ' ' + UnitsF[un];
        end;
      end;

      if length(numericals[i]) > 1 then
      begin
        str := TrimRight(str) + ' ' + numericals[i];
        str := TrimRight(str) + ends[g, 1, EndingIndex(iTri)];
      end;
    end; //triad is 0 ?

    if i = 0 then
      Exit;
    Dec(i);
    Triad;
  end;

begin

  str := '';
  Nr := int(Nin);
  Fr := round(Nin * 100 + 0.00000001) mod 100;
  if Nr > 0 then
    Order := trunc(Log10(Nr) / 3)
  else
  begin
    str := 'ноль';
    Order := 0
  end;
  if Order > High(numericals) then
    raise Exception.Create('Слишком большое число для суммы прописью');
  i := Order;
  Triad;
  str :=
    Format('%s %s%s %.2d %s%s', [Trim(str), RusMon[1], ends[m, 2,
      EndingIndex(iTri)],
    Fr, RusMon[2], ends[f, 2, EndingIndex(Fr)]]);
  str[1] := (ANSIUpperCase(copy(str, 1, 1)))[1];
  str[Length(str) + 1] := #0;
  Result := str;
end;

function szMoneyInWords(Nin: currency): PChar;
begin

  sMoneyInWords(Nin);
  Result := @(str[1]);
end;


___________
Код нужно оформлять по правилам:
тегом [CODE]..[/СODE] (это кнопочка с решёточкой #)
Не забывайте об этом!
Модератор.

Последний раз редактировалось Serge_Bliznykov; 11.10.2011 в 14:53.
ranif вне форума Ответить с цитированием
Старый 11.10.2011, 14:24   #2
fbus
Форумчанин
 
Аватар для fbus
 
Регистрация: 23.10.2008
Сообщений: 460
По умолчанию

)) я даже догадываюсь с какого сайта содрал.
у самого-то какие соображения?
от функции явно надо уходить
или прям в ней в edit'ы пихать, а если так то это уже не функцию а процедуру надо, ибо результат, который возвращает функция тебе будет не нужен.

Последний раз редактировалось fbus; 11.10.2011 в 14:28.
fbus вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Сумма Прописью olegwolf Microsoft Office Excel 4 11.05.2010 11:45
Сумма прописью Averess Microsoft Office Excel 1 13.02.2009 11:13
Сумма прописью LX Da Mad Microsoft Office Excel 5 27.06.2008 01:54
Сумма прописью в 1С Aleksandr Свободное общение 2 27.08.2007 15:59
Сумма прописью Fainder Microsoft Office Excel 6 17.03.2007 10:43