dll窗体问题 ( 积分: 100 )

将一个窗体做成DLL，如何在主窗体中调用该DLL窗体并且使该DLL窗体随着主窗体的移动而移动。DLL窗体与主窗体帖着。像WINAMP那样。

将一个窗体做成DLL，如何在主窗体中调用该DLL窗体并且使该DLL窗体随着主窗体的移动而移动。DLL窗体与主窗体帖着。像WINAMP那样。

http://www.2ccc.com　上有很多實例下載。

我的方法,供参考:

例如DLL中定义一个返回窗体的函数供主窗体单元调用:
funtion GetAForm :TForm;
.....
funtion GetAForm :TForm;
begin
result :=TForm.Create;
end;

主窗体中调用函数GetAForm,
在主窗体中声明一个变量 aForm :TForm;(或TWinControl类)用于获取DLL窗体
implementation
function GetAForm :TForm;external 'Project1.dll';
......
procedure TForm1.FormCreate(Sender: TObject);
begin
aForm :=GetAForm;
aForm.show;
end;

然后关键在 private 中续写方法 WMMove:
private
procedure WMMove(var Message: TWMMove); message WM_MOVE;
......
procedure TForm1.WMMove(var Message: TWMMove); //实现
begin
inherited;
if aForm <> nil then
begin
aForm.Top :=self.Top + self.Height;
aForm.Left :=self.Left; //此处为贴着主窗体下部移动
end;
end;

主程序：工程文件
-----------------------------------------------------------
program Project1;

uses
Forms,
Unit1 in 'Unit1.pas' {Form1};

{$R *.RES}

begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

主程序：主窗体
-----------------------------------------------------------
unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure WMMove(var Message: TWMMove); message WM_MOVE;
end;

var
Form1: TForm1;
Form2: TForm;
implementation

{$R *.DFM}

function GetForm(App:TApplication):TForm; external 'Project2.dll';

procedure TForm1.Button1Click(Sender: TObject);
begin
Form2:=GetForm(Application);
Form2.Top:=Self.Top+Self.Height+1;
Form2.Left:=Self.Left;
Form2.Show;
end;

procedure TForm1.WMMove(var Message: TWMMove);
begin
inherited;

if Assigned(Form2) then
begin
Form2.Top:=Self.Top+Self.Height+1;
Form2.Left:=Self.Left;
end;
end;

end.

DLL：工程文件
-----------------------------------------------------------
library Project2;

uses
SysUtils,
Windows,
Forms,
Classes,
Unit2 in 'Unit2.pas' {Form2};

exports
GetForm;

var DLLApplication:TApplication;
SaveProcointer;
SaveExitointer;

procedure DLL_Main(dwReasonWORD);
begin //DLL主处理程序
case dwReason of
DLL_PROCESS_DETACH:
begin //DLL从当前调用的进程空间地址释放（可以释放先前分配的资源）
Application:=DLLApplication; //还原 DLL 的 Application 对象
end;
end;
end;

procedure DLL_Free;
begin //DLL释放处理程序
DLLProc:=SaveProc;
ExitProc:=SaveExit;
end;

begin
DLLApplication:=Application; //记录 DLL 的 Application 对象

SaveProc:=DLLProc;
SaveExit:=ExitProc;

DLLProc:=@DLL_Main; //指定 DLL 主处理程序
ExitProc:=@DLL_Free; //指定 DLL 释放处理程序
end.


DLL：窗体
-----------------------------------------------------------
unit Unit2;

interface

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

type
TForm2 = class(TForm)
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }
end;

function GetForm(App:TApplication):TForm; export;

var
Form2: TForm2;

implementation

{$R *.DFM}

function GetForm(App:TApplication):TForm;
begin
Application:=App;
Form2:=TForm2.Create(App);
Result:=Form2;
end;

procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action:=caFree;
end;

end.

多人接受答案了。