觉得楼主这个问题挺有意思,花了一些时间,写了一个,基本实现了。
DLL代码如下:
library AdAgent;
uses
Windows,
Messages,
SysUtils,
Classes,
StdCtrls,
Graphics;
{$R *.res}
type
TWindowProc=function(hwnd:HWND;uMsg:UINT;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
type
TAdWindow=class
private
FHandle:THandle;
FBitmap:TBitmap;
FCanvas:TCanvas;
FOldWndProc:TWindowProc;
FClientRect:TRect;
procedure SetClientRect(const Value: TRect);
public
constructor Create(ParentHandle:THandle);
destructor Destroy;override;
procedure Paint;
property ClientRect:TRect read FClientRect write SetClientRect;
end;
TAdWindowList=class(TList)
public
function IndexOf(AHandle:THandle): Integer;
destructor Destroy;override;
end;
var
AdWindowList:TAdWindowList;
function NewWindowProc(hwnd:HWND;uMsg:UINT; wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
var
I:Integer;
begin
if uMsg=WM_PAINT then
begin
Result:=0;
I:=AdWindowList.IndexOf(hwnd);
if I>-1 then
TAdWindow(AdWindowList
).Paint;
end else
Result:=DefWindowProc(hwnd,uMsg,wParam,lParam);
end;
{ TAdWindow }
constructor TAdWindow.Create;
begin
FClientRect:=Rect(0,0,479,59);
FHandle:=CreateWindowEx(0,'STATIC','AStatic',WS_CHILD or WS_VISIBLE or SS_CENTERIMAGE,FClientRect.Left,FClientRect.Top,FClientRect.Right-FClientRect.Left,FClientRect.Bottom-FClientRect.Top,ParentHandle,0,HInstance,nil);
FOldWndProc:=Pointer(SetWindowLong(FHandle,GWL_WNDPROC,DWORD(@NewWindowProc)));
FBitmap:=TBitmap.Create;
FBitmap.LoadFromFile('c:/test.bmp');
FCanvas:=TCanvas.Create;
FCanvas.Brush.Color:=clBtnFace;
end;
destructor TAdWindow.Destroy;
begin
FBitmap.Free;
FCanvas.Free;
DestroyWindow(FHandle);
inherited;
end;
procedure TAdWindow.Paint;
var
dc:HDC;
ps:tagPAINTSTRUCT;
begin
dc:=BeginPaint(FHandle,ps);
try
with FCanvas do
begin
Handle:=dc;
FillRect(FClientRect);
FCanvas.CopyRect(FClientRect,FBitmap.Canvas,FClientRect);
end;
finally
EndPaint(FHandle,ps);
ReleaseDC(dc,FHandle);
end;
end;
procedure TAdWindow.SetClientRect(const Value: TRect);
begin
SetWindowPos(FHandle,0,Value.Left,Value.Top,Value.Right-Value.Left,Value.Bottom-Value.Top,0);
FClientRect := Value;
end;
{ TAdWindowList }
destructor TAdWindowList.Destroy;
var
I:Integer;
begin
for I:=Count-1 downto 0 do
TAdWindow(Items).Free;
inherited;
end;
function TAdWindowList.IndexOf(AHandle: THandle): Integer;
var
I:Integer;
begin
Result:=-1;
for I:=0 to Count-1 do
if TAdWindow(List).FHandle=AHandle then
Result:=I;
end;
function CreateAdWindow(AParentHandle:THandle):THandle;stdcall;export;
var
AdWindow:TAdWindow;
begin
Result:=INVALID_HANDLE_VALUE;
try
AdWindow:=TAdWindow.Create(AParentHandle);
AdWindowList.Add(AdWindow);
Result:=AdWindow.FHandle;
except
end;
end;
function SetAdWindowRect(AHandle:THandle; ARect:TRect):Boolean;stdcall;export;
var
I:Integer;
begin
Result:=False;
I:=AdWindowList.IndexOf(AHandle);
if I>-1 then
begin
TAdWindow(AdWindowList).ClientRect:=ARect;
Result:=True;
end;
end;
function SetBmpFile(AHandle:THandle; AFileNameChar):Boolean;stdcall;export;
var
I:Integer;
begin
Result:=False;
I:=AdWindowList.IndexOf(AHandle);
if I>-1 then
begin
TAdWindow(AdWindowList).FBitmap.LoadFromFile(AFileName);
Result:=True;
end;
end;
procedure DllMain(dwReason : DWORD);
begin
case dwReason of
DLL_PROCESS_ATTACH:
begin
AdWindowList:=TAdWindowList.Create;
end;
DLL_PROCESS_DETACH:
begin
AdWindowList.Free;
end;
end;
end;
exports
CreateAdWindow,
SetAdWindowRect,
SetBmpFile;
begin
DLLProc:=@DLLMain;
DLLMain(DLL_PROCESS_ATTACH);
end.
调用代码如下:
var
FHandle:THandle;
function CreateAdWindow(AHandle:THandle):THandle;stdcall;external 'AdAgent.dll';
function SetAdWindowRect(AHandle:THandle; ARect:TRect):Boolean;stdcall; external 'AdAgent.dll';
function SetBmpFile(AHandle:THandle; AFileNameChar):Boolean;stdcall; external 'AdAgent.dll';
procedure TForm1.Button1Click(Sender: TObject);
begin
FHandle:=CreateAdWindow(Handle);
if FHandle<>INVALID_HANDLE_VALUE then
begin
SetAdWindowRect(FHandle, Rect(0,0,180,200));
SetBmpFile(FHandle,'C:/test1.bmp');
end;
end;