DLL直接返回对象

来源:互联网 发布:家庭理财软件哪个好用 编辑:程序博客网 时间:2024/05/29 19:34

DLL直接返回对象时是有可能出错的,这是因为程序和DLL用了不同的VCL,就是相当于一个接口的不同实例,所以只要是从DLL里返回VCL相关的对象都会出错。
有两种方法可以解决:
1、在Controls单元的implementation前面声明一个GetControlAtom方法
{...}
implementation

function GetControlAtom: Pointer;
begin
  Result := @ControlAtom;
end;
然后在DLL里实现并导出以下两个过程
procedure DLLInitialize(App : TApplication; Scr : TScreen; RealControlAtom :Integer);
var
  x : pointer;
  p : ^Word;
begin
  If (OldApp = Nil) Then
  Begin     // store away the current application, screen and control atom     
    OldApp := Application;
    OldScreen := Screen;
    p := GetControlAtom;
    OldControlAtom := p^;     // Assign the EXE's application, screen and control atom     
    Application := App;     
    Screen := Scr;     
    p^ := RealControlAtom;   
  end;   
end;

procedure DLLFinalize;
var
  p: ^Word; 
begin   // restore the DLL's application, screen and control atom  
  p := GetControlAtom;  
  p^ := OldControlAtom;   
  Screen := OldScreen;   
  Application := OldApp; 
end;

这两个过程的作用,一个是初始化DLL时将宿主程序与DLL的全局原子ControlAtom同步,另一个是DLL释放前还原相关内容。
然后你就可以在DLL里用函数返回VCL对象了,此方法也适用于在DLL里创建窗体在Dock到宿主的Panel里,反正最关键的是ControlAtom同步。

2、不使用VCL对象作为返回值
很简单,可以用内存来做交换,例如转换图像后,申请一块内存,将转换后的图像写入这块内存,方法就不多说了,用流操作或Move都可以,关键是返回指针地址和长度。
function bmp2jpg(filename: PChar; var Ptr: Pointer; var Size: Integer): Boolean;
var stream: TmemoryStream;
begin
  try
  {转换}
  except
    result := false;
    exit;
  end;
  Stream := TMemoryStream.Create;
  jpg.saveToStream(Stream);
  Size := Stream.Size;
  GetMem(Ptr, Size);
  Stream.Position := 0;
  Stream.Read(Ptr^, Size);
  Stream.Free;
  Result := True;
end;

在DLL里声明全局变量
var
  OldApp : TApplication;
  OldScreen : TScreen;
  OldControlAtom : TAtom; 

exprots ....;

begin
  OldApp := nil;
  OldScreen := nil;
  OldControlAtom := 0;
end;  


 

 

$R *.dfm}
function bmpfromjpg(jpgf:string):Tbitmap;stdcall;
external'jpgtobmp.dll';//静态调用
procedure TForm1.Button1Click(Sender: TObject); 
var
  myb:TBitmap;
  i,w1,h1:integer;
begin
  myb:=TBitmap.Create ;
  try
  myb:=bmpfromjpg('g:/tupian/funiu.jpg');
  for i:=0 to 30 do        //打开窗帘特效
  begin
    ......
  end;
  finally
   myb.Free ;
  end;
end;

0 0
原创粉丝点击