自定义FindControl函数，跨进程使用。

跨进程实例化对象，就要自定义FindControl函数。非原创，来源于网络加以修改。

 

Project2.dll

library Project2; uses SysUtils, Windows, Dialogs, Forms, TLHelp32, StdCtrls, Controls, Classes, Unit1 in 'Unit1.pas'; var hFrm:TForm; h:HWND; ControlAtom: TAtom; ControlAtomString: string; RM_GetObjectInstance: DWORD; // registered window message {$R *.res} function FindControlNew(Handle: HWnd): TWinControl; var OwningProcess: DWORD; begin Result := nil; if (Handle <> 0) and (GetWindowThreadProcessID(Handle, OwningProcess) <> 0) and (OwningProcess = GetCurrentProcessId) then begin if GlobalFindAtom(PChar(ControlAtomString)) = ControlAtom then Result := Pointer(GetProp(Handle, MakeIntAtom(ControlAtom))) else Result := Pointer(SendMessage(Handle, RM_GetObjectInstance, 0, 0)); end; end; begin ControlAtomString := Format('ControlOfs%.8X%.8X', [GetModuleHandle(nil), GetCurrentThreadID]); ControlAtom := GlobalAddAtom(PChar(ControlAtomString)); RM_GetObjectInstance := RegisterWindowMessage(PChar(ControlAtomString)); h:=FindWindow(nil,'Form1'); hFrm:=TForm(FindControlNew(h)); ShowMessage(hFrm.Caption); GlobalDeleteAtom(ControlAtom); ControlAtomString := ''; end.

 

Project1

unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TForm1 = class(TForm) Button: TButton; Button2: TButton; procedure ButtonClick(Sender: TObject); procedure Button2Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.ButtonClick(Sender: TObject); var hFrm:TForm; h:HWND; begin {问题:} {为什么本Application工程中这样可以找得到窗体实例，而在DLL工程中这样使用却不行?} {请各位前辈指导，谢谢！} h:=FindWindow(nil,'Form1'); hFrm:=TForm(FindControl(h)); ShowMessage(hFrm.Caption); end; procedure TForm1.Button2Click(Sender: TObject); begin LoadLibrary('Project2.dll'); end; end.