Бывалый
Профиль
Группа: Участник
Сообщений: 192
Регистрация: 25.9.2006
Репутация: нет
Всего: нет
|
Добрый день. Прочитал литературу и решил вывести функцию в 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;
|
Что я делаю не так ? Подскажите пожалуйста. Заранее спасибо. |
Сумма из dll, Функция суммы в длл не вызываетса 
Загрузка ...
