寻动态调用VC制作的DLL控件的实例 ( 积分: 200 )

  • 主题发起人 主题发起人 任远
  • 开始时间 开始时间

任远

Unregistered / Unconfirmed
GUEST, unregistred user!
要求:
  DLL是VC创建的,能在Delphi的FormCreate中动态调用,并在Form中创建一个控件(显示广告),希望有的朋友不要吝啬,:)
  注:我这里有一个在做的实例,不过能调用成功,但不能创建,现无法确定是不是DLL的原因,下载:http://www.renyuansoft.com/temp/hbhap.rar
 
要求:
  DLL是VC创建的,能在Delphi的FormCreate中动态调用,并在Form中创建一个控件(显示广告),希望有的朋友不要吝啬,:)
  注:我这里有一个在做的实例,不过能调用成功,但不能创建,现无法确定是不是DLL的原因,下载:http://www.renyuansoft.com/temp/hbhap.rar
 
难道没人有吗?
 
实在没有,哪位兄弟能帮忙写一个Delhpi做的DLL创建控件的实例吗?
 
这个我也没有做过, 看看吧>
 
你的Dll是给VC用的,在Delphi中无法使用 
void CreateAdWindow(CWnd* pParentWnd);
CWnd*是MFC对象,不是HWND,Delphi中没有与之对应的数据类型.
 
没有做过,帮拟顶一把
 
DLL是一个公司的程序员用VC写的,原意是给共享软件调用广告的,不过他们不用Delphi,所以出现这个问题现在没辙了
 
你只有找原来的程序员把接口改成 Windows 兼容的数据类型,否则没戏。
 
你如果想用的话估计要用VC再包装一次了[:(]
 
据写这个DLL的程序员讲,他们在内部判断了是否传入的是指针还是句柄,有处理
 
如果把CreateAdWindow 的参数改为句柄也有问题。
void CreateAdWindow(HWND pParentWndXX)
请大家提供一个动态调用Dll实例,而这个Dll,它包含控件,Delphi动态加载并显示控件。
 
帮楼主顶一下,
用VC再包装一次,估计简单点儿就只好这么来了
别的,数据类型不一致,还能有什么好办法,重新改一下源代码
 
:》只能帮楼主顶一下,
帮不上忙。
 
觉得楼主这个问题挺有意思,花了一些时间,写了一个,基本实现了。
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; AFileName:PChar):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; AFileName:PChar):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;
 
谢谢 smokingroom
 
出现新情况,装载ActivieX 控件 CWebBrowser2 不成功。
请问哪位大哥动态装载过ActivieX 控件?
提供相关实例不胜感激!
 
后退
顶部