Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Delphi: Для новичков > Сумма из dll


Автор: Anakin 9.8.2011, 14:49
Добрый день.
Прочитал литературу и решил вывести функцию в dll которая переводит цифры в пропись.
Но при попытке использовать функцию в программе выходит ошибка.

Вот описание dll
Код

library summdll;

uses
  SysUtils,
  Classes,
  Wintypes,
  WinProcs,
  Dialogs;


Var
rub: byte;
pol: boolean;

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

// Начало Суммы прописью

function SumToStrin(Value: string): string; stdcall;
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])] + 'mie ' + 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])] + 'Mill ' + 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;

function kolToStrin(Value: string): string; stdcall;
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])] + 'Mill ' + t;
          i := i - 2;
        end;
      if i > 0 then
      begin
        k := strtoint(s[i]);
        t := c[p - i, k] + t;
        i := i - 1;
      end;
    end;
  end;
  result := t;
end;

procedure get2str(value: string; var hi, lo: string); stdcall;
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';
    exit;
  end;
  if p > length(value) then
  begin
    hi := value;
    lo := '00';
    exit;
  end;
  if p = 1 then
  begin
    hi := '0';
    lo := value;
    exit;
  end;
  begin
    hi := copy(value, 1, p - 1);
    lo := copy(value, p, length(value));
    if length(lo) < 2 then
      lo := lo + '0';
  end;
end;

function SumToString(value: string): string; stdcall;
var
  hi, lo, valut, loval: 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;
  if rub = 0 then
  begin
    if hi[length(hi)] = '1' then
      valut := 'рублей ';
    if (hi[length(hi)] >= '2') and (hi[length(hi)] <= '4') then
      valut := 'рублей ';
    if (hi[length(hi)] = '0') or (hi[length(hi)] >= '5') or
    ((strtoint(copy(hi, length(hi) - 1, 2)) > 10) and (strtoint(copy(hi,
      length(hi) - 1, 2)) < 15)) then
      valut := 'рублей ';
    if (lo[length(lo)] = '0') or (lo[length(lo)] >= '5') then
      loval := ' копеек';
    if lo[length(lo)] = '1' then
      loval := ' копеек';
    if (lo[length(lo)] >= '2') and (lo[length(lo)] <= '4') then
      loval := ' копеек';
  end
  else
  begin
    if (hi[length(hi)] = '0') or (hi[length(hi)] >= '5') then
      valut := 'долларов ';
    if hi[length(hi)] = '1' then
      valut := 'доллар ';
    if (hi[length(hi)] >= '2') and (hi[length(hi)] <= '4') then
      valut := 'доллара ';
    if (lo[length(lo)] = '0') or (lo[length(lo)] >= '5') then
      loval := ' центов';
    if lo[length(lo)] = '1' then
      loval := ' цент';
    if (lo[length(lo)] >= '2') and (lo[length(lo)] <= '4') then
      loval := ' цента';
  end;
  hi := sumtostrin(inttostr(pr)) + valut;
  if lo <> '00' then
  begin
    val(lo, pr, er);
    if er <> 0 then
    begin
      result := '';
      exit;
    end;
    lo := inttostr(pr);
  end;
  if length(lo) < 2 then
    lo := '0' + lo;
  lo := lo + loval;
  hi[1] := AnsiUpperCase(hi[1])[1];
  result := hi + lo;
end;




exports SumToString,get2str,kolToStrin,SumToStrin;
begin
end.


Вызываю так
Код

function SumToString(Value: string): string; external './dll/'+'summdll.dll';


Код

procedure Tfrm226312.E9Change(Sender: TObject);
Var
s:String;
begin

s:=SumToString(e1.Text+e2.Text+e3.Text+e4.Text+e5.Text+e6.Text+e7.Text+e0.Text+e9.Text+e10.Text);
lb_summ.Caption:=s;


Что я делаю не так ?
Подскажите пожалуйста.
Заранее спасибо.

Автор: bems 9.8.2011, 20:11
чтобы узнать о передаче и возврате строк, читай комментарий, который среда вставляет в пустой проект длл.

Добавлено через 1 минуту и 15 секунд
ну и путь к длл в external это ересь

Автор: northener 10.8.2011, 00:10
Цитата(Anakin @  9.8.2011,  14:49 Найти цитируемый пост)
Прочитал литературу и решил вывести функцию в dll которая переводит цифры в пропись.

Ну и ССЗБ!

Автор: Anakin 10.8.2011, 01:03
Цитата(bems @ 9.8.2011,  20:11)
чтобы узнать о передаче и возврате строк, читай комментарий, который среда вставляет в пустой проект длл.

Добавлено @ 20:13
ну и путь к длл в external это ересь


Спасибо поместил ShareMem первым и всё заработало.
По поводу external и пути может это и ересь но это рабочая ересь ))

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)