Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Delphi: Общие вопросы > Помощь по работе с DLL

Автор: Maximus 13.8.2002, 21:50

У меня возникла такая проблема. Хорошо знаю VB, а Delphi недавно изучаю. Так вот. Мне необходимо из VB передать в DLL двумерный массив. В Dll этот массив преобразовывается по некорому алгоритму (например алгоритм взятия обратной матрицы). В DLL должна быть функция которая может в VB вернуть этот преобразованный массив.

Помогите. Время поджимает!!! Горю!!! :notify

Автор: Vit 13.8.2002, 23:28

Взять одной функцией, а вернуть другой не получиться. Выходов 3:

1) Если входной и выходной массивы одинаковые по структуре то функция описывается так:

Procedure MyProc(var MyArr:TMyArray);

Тогда выполнив процедуру у тебя результат будет в том же массиве

2) Если входной и выходной массивы разные по структуре то функция описывается так:

Procedure MyProc(MyArr1:TMyArray1;var MyArr2:TMyArray2);

3) Если же надо непременно использовать разные процедуры, то тогда пиши свой ActiveX или свой класс, и зашивай его в DLL

Автор: Maximus 15.8.2002, 01:21

Ладно, начнем с простого:
вот содержание моей DLL:

//------------------------------------------------------------------

library cholecky;

uses
SysUtils,Math;

function chol (var A: array of real ;m: integer): real; stdcall;
var
r: integer;
b: real;
begin;
For r:=0 to m do
begin
b:=b+A[r];
end;
chol:=b;
end;

exports chol index 1;

begin
end.

//------------------------------------------------------------------

А вот код в котором я вызываю функцию chol из cholecky.dll:

//------------------------------------------------------------------
program Project1;

uses
Forms;

{$R *.res}
var
u: array[0..3] of real;
i: real;
function chol(var A:array of real; m: integer):real ;external 'cholecky.dll' index 1;

begin
u[0]:=1;
u[1]:=2;
u[2]:=3;
u[3]:=4;

i:=chol(u,3);

writeln (i);
readln;

end.
//------------------------------------------------------------------

И не чего не работает. А из VB тем более!!!!!!!!!!!!!! Пишет типа:
не в ту странцу памяти лезешь и т.д. и т.п.

Автор: Mikel 15.8.2002, 01:54

Возможно это поможет:
укажи в программе функцию как stdcall
массив задан как статический, а в процедуре- динамический.
А может это глупости.

Автор: Maximus 15.8.2002, 16:50

Нарооод!
Ну есть же среди Вас настоящие профессионалы дельфийского искусства!
Набросайте пару строк! Да и дело с концом!
Всем будет хорошо. А то так можно до нового года обрывками фраз перебрасываться!
HELP!SOS! :dg

Автор: Mikel 15.8.2002, 18:20

Ладно, так уж и быть

uses
Forms;
- ты что хотел этим сказать? Что у тебя форма? А это что
writeln (i);
readln;

?
Если ты уж так хочешь сделать из Delphi Pascal, то New->Console Application
и перенеси все туда.

А если по-нормальному, то оставь форму, а вместо writeln (i);
readln;
пиши ShowMessage(FloatToStr(i));

И все. Проблема не в DLL.

Автор: Maximus 17.8.2002, 02:18

Ладно с этим я уже сам разобрался еще вчера вечером!
Теперь у меня вот такой код:

Dll
------------------------------------------------------
library cholecky;

uses
SysUtils,Math;
type TMultyDimArray = array of array of real;

procedure chol (var A: TMultyDimArray; m: integer; n: integer); stdcall;

var
i: integer;
j: integer;
b: real;
begin;
For i:= 0 to m do
begin
for j:= 0 to n do
begin
A[i,j]:=A[i,j]*2;
end;
end;
end;

exports chol ;

begin
end.

--------------------------------------------------------
А вот программка откудая я ее вызываю:
(кстати она консольная)
--------------------------------------------------------

program Project1;

uses
Forms; <--- Это сама делфи ставит, так что не ко мне вопросы

??
type TMultyDimArray = array of array of real;

{$R *.res}
Procedure chol(var A:TMultyDimArray; m: integer; n: integer);stdcall; external 'cholecky.dll' index 1;
var
u: TMultyDimArray;
I: integer;
J: integer;
otvet: real;
mm: integer;
nn: integer;
begin
mm:=4;
nn:=4;
SetLength(u, mm);
writeln('Was');
for I := Low(u) to High(u) do
begin
SetLength(u[I], nn);
for J := Low(u[I]) to High(u[I]) do
begin
u[I,J] := 3;
writeln(u[I,J]);
end;
writeln;
end;

chol(u,3,3);
readln;
writeln('Will be');
for I := Low(u) to High(u) do
begin
for J := Low(u[I]) to High(u[I]) do
begin
writeln(u[I,J]);
end;
writeln;
end;

readln;
end.

------------------------------------------

Так вот, все работает, как видите двумерный массив заполняется цифрами 3, а затем они функцией dll-ки перобразуются в 6-ки.

А в VB это не работает а мне надо!! очень!!

Вот код из VB
---------------------------------------------------
На форме есть две кнопки Command1 и Command2 и компонент RichTextBox1 (типа мемо в дельфи).

' Самое главное это объявление ниже
Private Declare Sub chol Lib "cholecky.dll" (ByRef b() As Double, ByVal m As Integer, ByVal n As Integer)

Dim a() As Double
Dim v As Integer

Private Sub Command1_Click()
ReDim a(1, 1)

a(0, 0) = 1
a(0, 1) = 2
a(1, 0) = 3
a(1, 1) = 4

For i = 0 To 1
For j = 0 To 1
Text1 = Text1 & CStr(a(i, j)) & " "
Next j
Text1 = Text1 & vbCrLf
Next i
RichTextBox1.Text = Text1

End Sub

Private Sub Command2_Click()
chol a, 1, 1 <- А это вызов моей злосчастной функции
Text1 = "New" & vbCrLf
For i = 0 To 1
For j = 0 To 1
Text1 = Text1 & CStr(a(i, j)) & " "
Next j
Text1 = Text1 & vbCrLf
Next i
RichTextBox1.Text = Text1
End Sub

С наилучшими пожеланиями Maximus!
P.S. Спасибо за живой диалог Ж

Автор: Fantasist 17.8.2002, 13:15

Мне вообще такой подход претит. Ведь очень вероятно, что динамические массивы манипулируются VB совсем не так как в Delphi. Что надо делать - это передавать указатель. И лучше всего указатель на структуру (класс был бы еще лучше, но опять же нет гарантии одинакового создания объекта в разных языках).Либо используй Variant array - фактически будет то же самое, что и с указателем, только обрабатывать не ты будешь. А про эти динамические массивы вообще забудь, если думаешь об универсальности. Незнаю, как в VB, но в Delphi это бы выглядело примерно так:

Код


type
   
   TMyIntDynArray=record
      m,n:LongInt;
      arr:pointer;
   end;

procedure SetDynArr(arr:^TMyIntDynArray;x,y:integer;Value:integer);
var
  p:^LongInt;
begin
  if (x>arr^.m) or (y>arr^.n) then
    exit;
  p:=arr^.arr;
  inc(p,x*arr^.m+y);
  p^:=Value;
end;

function GetDynArr(arr:^TMyIntDynArray;x,y:integer):integer;
var
  p:^LongInt;
begin
  if (x>arr^.m) or (y>arr^.n) then
    exit;
  p:=arr^.arr;
  inc(p,x*arr^.m+y);
  Result:=p^;
end;

procedure SetMyDynArraySize(arr:^TMyIntDynArray;m,n:integer);
begin
  FreeMem(arr^.arr,Arr^.m*Arr^.n);
  GetMem(arr^.arr,m*n);
end;

Это, конечно, набросок, но идея понятна. Хотя все-таки надо OLE Variant array использовать , но об этом в следующий раз.

Автор: Maximus 19.8.2002, 02:16

Вообщем-то суть понятна. Спасибо, но почемуто не работает

.
На первом же значке ^, в объявлении процедуры ....SetDynArr(arr:^TM....
пишет: " Identifier expected but '^' found ". И не компилируется!
Напишите пожалуйста, как воспользоваться этим всем из Dll и из проги ее вызывающей.

Автор: Mikel 19.8.2002, 03:22

Напиши до этого
type PMyIntDynArray=^TMyIntDynArray;

А где надо ^TMyIntDynArray- замени на PMyIntDynArray

Автор: Fantasist 19.8.2002, 03:29

Хм... Мне, кажется, что объяснить это тебе, для меня будет долговато. Кажется у тебя пока не хватает некоторых знаний. В общем, я тебе привел функции для работы (запись/чтение/установка размера) с придуманным на ходу мною динамическим массивом, который представляет из себя структуру содержащую три переменные: указатель на начало некоторой области памяти, и две переменные(высота и ширина, условно говоря), которые указывают как эту область понимать. Функции эти оперируют с указателем на такую структуру. Запись: ^TMyIntDynArray - это есть тип - указатель на эту структуру. Ошибка при компилировании возникает либо от моего незнания, как записать в параметре такую вещь, либо из-за ограничености компилятора. В С++ я записываю именно так. Здесь же можно переписать это в виде:

type

TMyIntDynArray=record
m,n:LongInt;
arr:pointer;
end;

pMyIntDynArray=^TMyIntDynArray;

И везде вместо ^TMyIntDynArray записать pMyIntDynArray.
Теперь тебе надо эти функции доработать, чтобы они не глючили, переписать свою chol примерно так:

Код


procedure chol(p:pointer);stdcall; external 'cholecky.dll' index 1;
var
  arr:pMyIntDynArray;
begin
  arr:=pMyIntDynArray(p);
  ...
  ...
end;

и дальше в этой функции работать с arr, в VB описать точно такую же структуру как TMyIntDynArray, и потом в функцию chol из VB передавать указатель на эту структуру.

Это, на самом деле, не грамотный путь, но будет работать. Более грамотный это работать с OleVariant в Delphi есть поддержка:

Код


var
  v:OleVariant;
begin
 v:=VarArrayCreate([0,4,0,3],varInteger);
 v[1,1]:=4;
 v[3,2]:=5;
end;

и если такой variant array принадлежит к Automatation types, то поддержка есть и VB, но этого я пока не знаю. Еще однин грамотный путь - это как Vit сказал, написать COM объект. Если в VB поддержка работы с интерфейсами присутсвует, или хотя бы виртуальные таблицы там создаются точно также(это почти наверняка) и с ними можно нормально работать, то необязательно даже полностью писать ActiveX, можно просто написать интерфейсный объект, который ты запихнешь в dll и будешь сам его создавать.

Автор: Maximus 19.8.2002, 22:16

Еще не получив ответа от Fantasista, я написал программку. Но компилятор тоже ворчит!!!!

Вот код моей программки!

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

type
TMyIntDynArray=record
m,n:LongInt;
arr:pointer;
end;

type PMyIntDynArray=^TMyIntDynArray; <- Написал как вы советовали!

var
Form1: TForm1;
myarr: PMyIntDynArray;
a,b: integer;

implementation

{$R *.dfm}

{ Вот здесь начинаются ваши процедуры и функции
В их заголовках я изменил ^TMyIntDynArray на PMyIntDynArray
}

procedure SetDynArr(arr:PMyIntDynArray;x,y:integer;Value:integer);
var
p:^LongInt;
begin
if (x>arr^.m) or (y>arr^.n) then
exit;
p:=arr^.arr;
inc(p,x*arr^.m+y);
p^:=Value;
end;

function GetDynArr(arr:PMyIntDynArray;x,y:integer):integer;
var
p:^LongInt;
begin
if (x>arr^.m) or (y>arr^.n) then
exit;
p:=arr^.arr;
inc(p,x*arr^.m+y);
Result:=p^;
end;

procedure SetMyDynArraySize(arr:PMyIntDynArray;m,n:integer);
begin
GetMem(arr^.arr,m*n);
FreeMem(arr^.arr,Arr^.m*Arr^.n);
end;

{Здесь заканчивается ваш код и начинается мой}

{
На форме находится кнопка и мемо.
После нажатия на кнопку, хотел что бы в Memo1
у меня напечаталось содержимое myarr массива,
который я объявляю тоже как PMyIntDynArray
в глобальном VAR (см. выше.)

}

procedure TForm1.Button1Click(Sender: TObject);
var
j,i: integer;
begin
SetMyDynArraySize(myarr,3,3); <- Как я понял это выделение
памяти под массив.

b:=3;
for i:= 0 to 3 do
begin
for j:= 0 to 3 do
begin
SetDynArr(myarr,i,j,b); <- Задаю значения элементов массива.
a:=getdynarr(myarr,i,j); <- Здесь чтобы проверить
предыдущую операцию
извлекаю из массива значение элемента.
memo1.Lines.Add(floattostr(a)); <-Это все оформление.
end;
end;

end;

end.

Автор: Fantasist 20.8.2002, 06:37

Я же написал, что эти функции доработать надо. Я их написал только как демонстрацию идеи, а не как рабочий код. Тут, кстати, у меня не так:

Код


procedure SetMyDynArraySize(arr:PMyIntDynArray;m,n:integer);
begin
GetMem(arr^.arr,m*n);
FreeMem(arr^.arr,Arr^.m*Arr^.n);
end;

А вот так:

Код


procedure SetMyDynArraySize(arr:PMyIntDynArray;m,n:integer);
begin 
  FreeMem(arr^.arr,Arr^.m*Arr^.n);
  GetMem(arr^.arr,m*n);
end;

Но и это не правильно потому что надо так:

Код


procedure SetMyDynArraySize(arr:PMyIntDynArray;m,n:integer);
begin 
  FreeMem(arr^.arr,4*Arr^.m*Arr^.n);
  GetMem(arr^.arr,4*m*n);
end;

И опять же это не совсем верно, потому как вначале при не инициализированном массиве, может случиться, будет пытаться освободиться память, которая не занята, или занята не тобой.

Что касается вашего кода, то неплохо бы написать, что за ошибка у вас, иначе тяжело ответить. Да и может быть вы сами можете эту ошибку выявить и исправить?

Автор: Maximus 20.8.2002, 19:23

Вобщем-то все понятно, и почему на 4 умножено в тоже понятно
....4*Arr^.m*Arr^.n.... ( т.к. под значение типа Integer выделяется 4 байта).
Немного не понял фразу: "при не инициализированном массиве, может случиться,
будет пытаться освободиться память, которая не занята, или занята не тобой".
И тогда интересно все-таки, с чего начать определние памяти под массив,
если я не знаю занята ли эта область памяти кем-то или чем-то.

А вот компилятор выдает следующее ругательство:

" Project Project1.exe raised exception class EAccessViolation
with message 'Access violation at address 0044FCB9 in module
'PROJECT1.EXE'. Read of address FFFFFFFF'. Process stopped.
Use Step or Run to continue. "

Автор: Fantasist 21.8.2002, 11:08

Цитата

И тогда интересно все-таки, с чего начать определние памяти под массив,
если я не знаю занята ли эта область памяти кем-то или чем-то.

А это на твое усмотрение. Например, можно сделать так:

Код


procedure SetMyDynArraySize(arr:PMyIntDynArray;m,n:integer);
begin 
 if arr^.arr<>nil then
   FreeMem(arr^.arr,Arr^.m*Arr^.n);
 GetMem(arr^.arr,m*n);
end;

Но тогда надо точно быть уверенным, что новый экземпляр TMyIntDynArray будет иметь значение для nil для члена arr.

Цитата

А вот компилятор выдает следующее ругательство:

" Project Project1.exe raised exception class EAccessViolation
with message 'Access violation at address 0044FCB9 in module
'PROJECT1.EXE'. Read of address FFFFFFFF'. Process stopped.
Use Step or Run to continue. "

Это выдает не компилятор, а программа. Это так называемая run-time ошибка.
EAccessViolation возникает при обращении к памяти, с которой ты не можешь работать. Бери и смотри под отладчиком.

Автор: Maximus 22.8.2002, 03:39

Народ!
Я конечно понимаю, что вы гуру в своем деле, а может просто повыпендриваться на форум пришли, хотя вроде бы не похоже. Но тем не менее. Вот уже как две недели я чувствую себя пятилетним пареньком перед которым поставили вареньице на самую высокую точку кухни, и хочется, и вот вроде бы оно рядом, и не как не достать.!!!!
Когда я решил пойти на форум мне мои собратья по счастливой и несчастной моей жизни предостерегли, что на форумах ты ответа не найдешь! Что мол, там тебя попинают справа налево да ты и сам выкатишься от туда, как картофелина из кухонного комбайна!
Когда же мне посыпалось столько ответов я был просто рад, по человечески рад!
Но вот, как я уже заметил, прошло почти две недели, а результата нет. Если бы советы были тупыми, то все понятно. Но тут все ответы к месту, и в тему. И я вижу, что скоро вот-вот и наступит день счастливого прозрения. Но он не наступает. А вы ребята по-русски говоря мудитесь. Так бы и сказали сразу, вроде того, что ты парень тупой, и далек ты от цели, и помогать тебе мы не будем. Но нет, тут идет тонкая психологическая атака, или же лень общечеловеческого характера! В другое время я бы наоборот сказал всем Вам спасибо, что не даете сразу результата, а заставляете мой неугомонный мозг развиваться по Дарвину. Но сейчас я в другой ситуации, я сгораю, мне надо это сделать. Поймите, отругайте и пожалейте меня пожалуйста братья по разуму!!!!!

С уважением ко всем форум-людям Maximus.

Автор: Vit 22.8.2002, 04:30

Ребята, я смотрю на эти рассуждения и мне всё больше и больше кажеться что это тупиковый вариант, просто детали реализации массивов от языка к языку разные, тем более двумерных массивов. Я предлагаю идти другим путём - выделить необходимый кусок памяти, сделать процедуры для перевода массива в память и обратно, а в DLL и обратно передавать только адрес на этот участок памяти и его размер - так работают все API, так оно будет работать в любой среде, главное чтобы процедуры трансформации данных были написанны правильно и делали тождественные преобразования и в DLL и в приложении... только не надо напрямую массив считать куском памяти, вряд ли это будет всегда стабильно работать.

Автор: Fantasist 22.8.2002, 12:57

Цитата(Vit @ 21.8.2002, 21:30)

Ну это не сильно другой путь. Я предлагаю реализовать процедуры чтения/записи, а ты процедуры перевода туда/обратно. Сказать что лучше на мой взгляд проблематично.

Цитата

только не надо напрямую массив считать куском памяти, вряд ли это будет всегда стабильно работать.

А вот это не понял.

Автор: Fantasist 22.8.2002, 13:09

To Maximus: Отлично! Замечательно! Очень красочно написанно! Это мне нравиться! Честно.

Конечно, ты прав. Извиняюсь и постораюсь исправиться. Просто я надеялся, что ты все-таки сам возмешся, посидишь над отладчиком, и все в конце концов сделаешь. Я напишу тебе код для Делфи, а ты, его внимательно изучешь и сделаешь точно такой же в VB.

Автор: Fantasist 22.8.2002, 14:31

Вот это то, что тебе надо реализовать в VB. Структура для хранения массива, и класс-обертка для работы с ним. Дело в том, что VB я знаю смутно, но для тебя недолжно быть проблемы реализовать это там. Я его более менее отладил - работает.

Примичание: LongInt имеет размер 4 байта, как и указатель

Код



  TMyIntDynArray_Struct=record
     m,n:LongInt;
     arr:pointer;
  end;

  pMyIntDynArray_Struct=^TMyIntDynArray_Struct;

  TMyIntDynArray=class
  protected
    fArray:pMyIntDynArray_Struct;
  public
    constructor Create(m,n:LongInt);
    procedure SetValue(m,n,Value:LongInt);
    function GetValue(m,n:LongInt):LongInt;
    procedure SetSize(m,n:LongInt);
    procedure DestroyArray;
    function GetStructPointer:pMyIntDynArray_Struct;
    procedure SetStructPointer(p:pMyIntDynArray_Struct);
    function m:LongInt;
    function n:LongInt;
  end;

implementation

procedure TMyIntDynArray.SetValue(m,n,Value:LongInt);
var
 p:^LongInt;
begin
 if (m>=fArray^.m) or (n>=fArray^.n) or (m<0) or (n<0) or (fArray^.arr=nil) then
   exit;
 p:=fArray^.arr;
 inc(p,m*fArray^.n+n);
 p^:=Value;
end;

function TMyIntDynArray.GetValue(m,n:LongInt):LongInt;
var
 p:^LongInt;
begin
 Result:=0;
 if (m>=fArray^.m) or (n>=fArray^.n)  or (m<0) or (n<0) or (fArray^.arr=nil) then
   exit;
 p:=fArray^.arr;
 inc(p,m*fArray^.n+n);
 Result:=p^;
end;

procedure TMyIntDynArray.SetSize(m,n:LongInt);
begin
 if fArray^.arr<>nil then
   FreeMem(fArray^.arr,4*fArray^.m*fArray^.n);
 fArray^.m:=m;
 fArray^.n:=n;
 GetMem(fArray^.arr,4*m*n);
end;

constructor TMyIntDynArray.Create(m, n: Integer);
begin
 new(fArray);
 fArray^.arr:=nil;
 SetSize(m,n);
end;

procedure TMyIntDynArray.DestroyArray;
begin
 if fArray^.arr<>nil then
   FreeMem(fArray^.arr,4*fArray^.m*fArray^.n);
 dispose(fArray);
end;

function TMyIntDynArray.GetStructPointer: pMyIntDynArray_Struct;
begin
  Result:=fArray;
end;

procedure TMyIntDynArray.SetStructPointer(p: pMyIntDynArray_Struct);
begin
  DestroyArray;
  fArray:=p;
end;

function TMyIntDynArray.m: LongInt;
begin
  Result:=fArray.m;
end;

function TMyIntDynArray.n: LongInt;
begin
  Result:=fArray.n;
end;

А вот твоя процедура chol:

Код


procedure chol(pMyArray:LongInt);
var
  i: integer;
  j: integer;
  tmpArr:TMyIntDynArray;
begin
  tmpArr:=TMyIntDynArray.Create(0,0); // временный класс-обертка
  tmpArr.SetStructPointer(pMyIntDynArray_Struct(pMyArray));   //  задаем указатель на данные
  For i:=0 to tmpArr.m-1 do
    for j:=0 to tmpArr.n-1 do
      tmpArr.SetValue(i,j,3);
  tmpArr.Free;
end;

В нее передается указатель на TMyIntDynArray_Struct, но что-бы не было никаких вопросов по поводу типов, этот указатель передается как 4-х байтное целое.

А вот как ее надо вызывать:

Код


var
  a:TMyIntDynArray; //переменная класса-обертки

begin
 // создаешь объект класса
  a:=TMyIntDynArray.Create(5,4);
   
 // что-то делаешь

 chol(LongInt(a.GetStructPointer));  //ВЫЗОВ

 //eще что-то делаешь

 // незабудь освободить память
  a.DestroyArray;
 // и удалить объект
  a.Free;
end;

Тут, конечно, ошибки никак не обрабатываются. У меня кое-где есть проверки на допустимые значения, но по ним происходит только выход из процедуры, и никак не узнаешь в чем ошибка. Но это потом...

Автор: Maximus 27.8.2002, 17:21

Все понял! Все усвоил! Большое спасибо! Сижу перевариваю. С бейсиком все намого сложнее, либо тоже не хватает знаний. Но если разберусь то выложу здесь. Если кому интересно дальнейшее развитие событий этого forum-сериала то приходите. Я думаю не раньше чем через недельку.

Отдельное спасибо Fantasist'у, за то что внял мой мольбы и дал мне священный код.

Удачи. Maximus.

Автор: Maximus 1.9.2002, 02:16

Привет всем, кто следил за этой темой.
Наконец-то я разобрался во всех животрепещущих проблемах данной темы и облазив добрую часть интернета, все же нашел решение. Все народ вот Вам на суд исходник Dll-ки, написанной на Delphi и исходник VB-программки, которая работает с этой Dll-кой. Хочу сразу предупредить, что реализацию придумал не я. В общем на http://ourworld.compuserve.com/homepages/JDebord/tpmath.htm я нашел набор математических функций и процедур. К этому пакету прикладывался код Dll-дельфи для обмена данными с VBA-Приложениями (в часности там все экспорт функции были для работы с Excel ). Многое урезав, я выкладываю вас исходник Dll-ки работающий с массивами типа Variant. Кому надо полный код могут сходить по указанному выше урлу, либо написать мне на [email protected].

А вот и код:

Dll:

// ****************************************

library DelToBasic;

uses
SysUtils,
Classes,
ComObj,
Variants,
Windows;

const
MAX_FLT = 16382;
MAX_VEC = 16382; { Максимальное кол-во строк и столбцов}

type
Float = Double;

TVector = array[0..MAX_FLT] of Float;
PVector = ^TVector;

TMatrix = array[0..MAX_VEC] of PVector;
PMatrix = ^TMatrix;

procedure DimMatrix(var A : PMatrix; Ubound1, Ubound2 : Integer);
var
I, J : Integer;
RowSize : Word;
begin
if (Ubound1 < 0) or (Ubound1 > MAX_VEC) or
(Ubound2 < 0) or (Ubound2 > MAX_FLT) then
begin
A := nil;
Exit;
end;

{ Выделяем память, елси не хватило, то выход }
GetMem(A, Succ(Ubound1) * SizeOf(PVector));
if A = nil then Exit;

{ Кол-во ячеек памяти на столбец }
RowSize := Succ(Ubound2) * SizeOf(Float);

{ Кол-во ячеек памяти на всю матрицу }
for I := 0 to Ubound1 do
begin
GetMem(A^[I], RowSize);
if A^[I] = nil then
begin
A := nil;
Exit;
end;
end;

{ Инициализация матрицы }
for I := 0 to Ubound1 do
for J := 0 to Ubound2 do
A^[I]^[J] := 0.0;
end;

function GetBasicData(var V: Variant; var A: PMatrix;
var Rows, Cols: integer): boolean;
{
Это главная функция, она переносит из бейсиковского массива значения элементов в массив типа PMatrix
}
var
NewV : Variant;
i, j : integer;
NoErrors : boolean;
begin
NoErrors := TRUE;

try
Rows := VarArrayHighBound(V, 1);
Cols := VarArrayHighBound(V, 2);
DimMatrix(A, Rows, Cols);
for i := 0 to Rows do for j := 0 to Cols do
if varType(V[i, j]) = varDouble then
A^[i]^[j] := V[i, j]
else
NoErrors := FALSE;
except on E: Exception do
NoErrors := FALSE;
end;
result := NoErrors;
end;

procedure PMatrixToV(A: PMatrix; var V: Variant; Rows, Cols: integer);
{
Это функция переносит значения элементов массива PMatrix
из Delphi обратно в Basic.
}
var
i, j : integer;
begin
for i := 0 to Rows do
for j := 0 to Cols do
V[i, j] := A^[i]^[j]
end;

procedure DelMatrix(var A : PMatrix; Ubound1, Ubound2 : Integer);
{
Процедура освобождает память выделенную
под временную матрицу, функцией DimMatrix
}
var
I : Integer;
RowSize : Word;
begin
if A <> nil then
begin
RowSize := Succ(Ubound2) * SizeOf(Float);
for I := Ubound1 downto 0 do
FreeMem(A^[I], RowSize);
FreeMem(A, Succ(Ubound1) * SizeOf(PVector));
A := nil;
end;
end;

{
А это экспортируемая функция. Ее суть - все элмента входящего массива увеличивает в двое.
}

function chol(var V: Variant): Variant; stdcall;
var
A : PMatrix;
rows : integer;
cols : integer;
i,j : integer;
begin

if GetBasicData(V,A,rows,cols) then

for i := 0 to Rows do
begin
for j := 0 to Cols do
begin
A^[i]^[j] :=A^[i]^[j]*2;
end;
end;
PMatrixToV(A,V,rows,cols);
Result := V;
DelMatrix(A, Rows, Rows);
end;

exports
chol;

begin
end.

// ****************************************

А вот и вызывающая программка на бейсике:

' ****************************************

' Бросьте на форму одну кнопку и один RichTextBox1

Private Declare Function chol Lib _
"DelToBasic.dll" (ByRef Matrix As Variant) As Variant
' Обратите внимание на объявление внешней функции
' она полностью под властью Variant - без этого работать не будет!

Dim b() As Double ' создаем динамический массив
' ну это так, чтобы вы видели, что массив может быть
' определен и как динамический.

Private Sub Command1_Click()
Dim c As String

ReDim b(2, 2) As Double ' определяем размерности динамического массива b()

' В общем-то тут в основном оформление, но

c = ""
For i = 0 To 2
For j = 0 To 2
b(i, j) = 3 ' здесь заносим в массив b() значения элементов
c = c & " " & CStr(b(i, j))
Next j
c = c & vbCrLf
Next i

c = c & vbCrLf

result = chol(b) ' Вызываем нашу функцию, которая должна увеличить значения
' элементов массива b() в два раза
For i = 0 To 2
For j = 0 To 2
c = c & " " & CStr(result(i, j))
Next j
c = c & vbCrLf
Next i

RichTextBox1.Text = c ' Выводим на RichTextBox1
End Sub

' ****************************************

Удачи всем. Maximus.

Автор: Fantasist 1.9.2002, 02:53

Ха! Бэйсик определяет динамический массив как OleVariant! Кто бы мог подумать. Я, кстати, тоже предлагал использовать Variant, но Maximus вроде как этот вариант изначально проигнорировал.
Непонятно, зачем в выше приведенном коде делается перевод из Variant в PMatrix, а потом обратно. Delphi очень неплохо поддерживает работу с Variant. Да и реализация динамического массив на основе TMatrix/PMatrix хуже чем та, которую предложил я.

Автор: Илья 8.7.2003, 23:36

Народ помогите с такой проблемой. Вообщем задали написать прогу на летней практике, прога состоит из 2х частей самой проги и DLL ки. Суть в том что когда я в DLL пишу процедуру и указываю массив например как A: array of integer, а затем с помошью 2х циклов присваиваю этому массиву переменные например I,j т.е A[i,j]:=.... компилятор матюгается и пишет Array type of reqired т.е хочет чтоб я переопределил тип массива. Но как ему обьяснить что массив 2х мерный. Заранее спасибо