首先,您要了解:
- COM的基本原理
- 能被网页调用的非可视ActiveX控件必须是一种至少实现了IOleObject接口的TAutoObject组件
- 利用Delphi向导生成的ActiveX控件必须继承自WinControl,所以您不能用Delphi向导生成非可视的ActiveX控件
以下例子,实现了一个非可视ActiveX,调用此控件的exeWB,相当于调用IE的打印,预览,页面设置等功能。再此基础上,还可以扩展其它的功能。
制作步骤:
1.打开delphi,新建一个ActiveX包。
File|new|other...|ActiveX|AxtiveX library
2.利用delphi向导,添加一个Automation Object。
File|new|other...|ActiveX|Automation Object
我这个项目叫WebPrint
3.在接下来弹出的TLB编辑窗口里面定义自己需要的接口函数
我添加需要的接口IWebPrint.print(),IWebPrint.preview()等
4.实现IOleObject接口,将代码改成如下形式,红色为修改部分
将Windows添加到uses引用
uses
ComObj, ActiveX, Project1_TLB, Windows;
修改
TWebPrint = class(TAutoObject,IWebPrint)
为
TWebPrint = class(TAutoObject,IOleObject , IWebPrint)
添加下段代码到TWebPrint的private段
private
FOleClientSite: IOleClientSite;
添加下段代码到TWebPrint的public段
public
{IOleObject}
function SetClientSite(const clientSite: IOleClientSite): HResult;
stdcall;
function GetClientSite(out clientSite: IOleClientSite): HResult;
stdcall;
function SetHostNames(szContainerApp: POleStr;
szContainerObj: POleStr): HResult; stdcall;
function Close(dwSaveOption: Longint): HResult; stdcall;
function SetMoniker(dwWhichMoniker: Longint; const mk: IMoniker): HResult;
stdcall;
function GetMoniker(dwAssign: Longint; dwWhichMoniker: Longint;
out mk: IMoniker): HResult; stdcall;
function InitFromData(const dataObject: IDataObject; fCreation: BOOL;
dwReserved: Longint): HResult; stdcall;
function GetClipboardData(dwReserved: Longint;
out dataObject: IDataObject): HResult; stdcall;
function DoVerb(iVerb: Longint; msg: PMsg; const activeSite: IOleClientSite;
lindex: Longint; hwndParent: HWND; const posRect: TRect): HResult;
stdcall;
function EnumVerbs(out enumOleVerb: IEnumOleVerb): HResult; stdcall;
function Update: HResult; stdcall;
function IsUpToDate: HResult; stdcall;
function GetUserClassID(out clsid: TCLSID): HResult; stdcall;
function GetUserType(dwFormOfType: Longint; out pszUserType: POleStr): HResult;
stdcall;
function SetExtent(dwDrawAspect: Longint; const size: TPoint): HResult;
stdcall;
function GetExtent(dwDrawAspect: Longint; out size: TPoint): HResult;
stdcall;
function Advise(const advSink: IAdviseSink; out dwConnection: Longint): HResult;
stdcall;
function Unadvise(dwConnection: Longint): HResult; stdcall;
function EnumAdvise(out enumAdvise: IEnumStatData): HResult; stdcall;
function GetMiscStatus(dwAspect: Longint; out dwStatus: Longint): HResult;
stdcall;
function SetColorScheme(const logpal: TLogPalette): HResult; stdcall;
在implementation段实现IOleObject的函数功能
implementation
{IOleObject}
function TWebPrint.SetClientSite(const ClientSite: IOleClientSite): HResult;
begin
if ClientSite <> nil then
begin
if FOleClientSite <> nil then
begin
Result := E_FAIL;
Exit;
end;
FOleClientSite := ClientSite;
end else
begin
FOleClientSite := nil;
end;
Result := S_OK;
end;
function TWebPrint.GetClientSite(out clientSite: IOleClientSite): HResult;
begin
ClientSite := FOleClientSite;
Result := S_OK;
end;
function TWebPrint.SetHostNames(szContainerApp: POleStr;
szContainerObj: POleStr): HResult;
begin
Result := S_OK;
end;
function TWebPrint.Close(dwSaveOption: Longint): HResult;
begin
Result := E_NOTIMPL;
end;
function TWebPrint.SetMoniker(dwWhichMoniker: Longint; const mk: IMoniker): HResult;
begin
Result := E_NOTIMPL;
end;
function TWebPrint.GetMoniker(dwAssign: Longint; dwWhichMoniker: Longint;
out mk: IMoniker): HResult;
begin
Result := E_NOTIMPL;
end;
function TWebPrint.InitFromData(const dataObject: IDataObject; fCreation: BOOL;
dwReserved: Longint): HResult;
begin
Result := E_NOTIMPL;
end;
function TWebPrint.GetClipboardData(dwReserved: Longint;
out dataObject: IDataObject): HResult;
begin
Result := E_NOTIMPL;
end;
function TWebPrint.DoVerb(iVerb: Longint; msg: PMsg; const activeSite: IOleClientSite;
lindex: Longint; hwndParent: HWND; const posRect: TRect): HResult;
begin
Result := E_NOTIMPL;
end;
function TWebPrint.EnumVerbs(out enumOleVerb: IEnumOleVerb): HResult;
begin
Result := OleRegEnumVerbs(Factory.ClassID, enumOleVerb);
end;
function TWebPrint.Update: HResult;
begin
Result := S_OK;
end;
function TWebPrint.IsUpToDate: HResult;
begin
Result := S_OK;
end;
function TWebPrint.GetUserClassID(out clsid: TCLSID): HResult;
begin
clsid := Factory.ClassID;
Result := S_OK;
end;
function TWebPrint.GetUserType(dwFormOfType: Longint; out pszUserType: POleStr): HResult;
begin
Result := OleRegGetUserType(Factory.ClassID, dwFormOfType, pszUserType);
end;
function TWebPrint.SetExtent(dwDrawAspect: Longint; const size: TPoint): HResult;
begin
Result := E_NOTIMPL;
end;
function TWebPrint.GetExtent(dwDrawAspect: Longint; out size: TPoint): HResult;
begin
Result := E_NOTIMPL;
end;
function TWebPrint.Advise(const advSink: IAdviseSink; out dwConnection: Longint): HResult;
begin
Result := E_NOTIMPL;
end;
function TWebPrint.Unadvise(dwConnection: Longint): HResult;
begin
Result := E_NOTIMPL;
end;
function TWebPrint.EnumAdvise(out enumAdvise: IEnumStatData): HResult;
begin
Result := E_NOTIMPL;
end;
function TWebPrint.GetMiscStatus(dwAspect: Longint; out dwStatus: Longint): HResult;
begin
Result := E_NOTIMPL;
end;
function TWebPrint.SetColorScheme(const logpal: TLogPalette): HResult;
begin
Result := E_NOTIMPL;
end;
5.实现您自己定义的接口函数功能
{ITWebPrint}
procedure TWebPrint.exeWB(cmdID:TOleEnum);
var
spDoc:IHTMLDocument2;
spContainer:IOleContainer;
spIE:IWebBrowser2;
begin
FOleClientSite.GetContainer(spContainer);
if not Assigned(spContainer) then
begin
messagebox(0,'此对象必须作为OLE对象使用','使用方法错误',0);
exit;
end;
if spContainer.QueryInterface(IID_IHTMLDocument2,spDoc)=S_OK then
begin
if (spDoc.parentWindow as IServiceprovider).QueryService(IWebbrowserApp, IWebBrowser2, spIE)=S_OK then
begin
if spIE.QueryStatusWB(cmdID)=3 then
spIE.ExecWB(cmdID, OLECMDEXECOPT_DODEFAULT,EmptyParam,EmptyParam);
end else
begin
messagebox(0,'请使用IE5.5以上版本','运行环境不正确',0);
exit;
end;
end else begin
messagebox(0,'找不到网页内容','使用方法错误',0);
exit;
end;
end;
全部源码如下:
unit Unit1;
{$WARN SYMBOL_PLATFORM OFF}
interface
uses
ComObj, ActiveX, Project1_TLB, Windows;
type
TWebPrint = class(TAutoObject,IOleObject , IWebPrint)
private
FOleClientSite: IOleClientSite;
public
{IOleObject}
function SetClientSite(const clientSite: IOleClientSite): HResult;
stdcall;
function GetClientSite(out clientSite: IOleClientSite): HResult;
stdcall;
function SetHostNames(szContainerApp: POleStr;
szContainerObj: POleStr): HResult; stdcall;
function Close(dwSaveOption: Longint): HResult; stdcall;
function SetMoniker(dwWhichMoniker: Longint; const mk: IMoniker): HResult;
stdcall;
function GetMoniker(dwAssign: Longint; dwWhichMoniker: Longint;
out mk: IMoniker): HResult; stdcall;
function InitFromData(const dataObject: IDataObject; fCreation: BOOL;
dwReserved: Longint): HResult; stdcall;
function GetClipboardData(dwReserved: Longint;
out dataObject: IDataObject): HResult; stdcall;
function DoVerb(iVerb: Longint; msg: PMsg; const activeSite: IOleClientSite;
lindex: Longint; hwndParent: HWND; const posRect: TRect): HResult;
stdcall;
function EnumVerbs(out enumOleVerb: IEnumOleVerb): HResult; stdcall;
function Update: HResult; stdcall;
function IsUpToDate: HResult; stdcall;
function GetUserClassID(out clsid: TCLSID): HResult; stdcall;
function GetUserType(dwFormOfType: Longint; out pszUserType: POleStr): HResult;
stdcall;
function SetExtent(dwDrawAspect: Longint; const size: TPoint): HResult;
stdcall;
function GetExtent(dwDrawAspect: Longint; out size: TPoint): HResult;
stdcall;
function Advise(const advSink: IAdviseSink; out dwConnection: Longint): HResult;
stdcall;
function Unadvise(dwConnection: Longint): HResult; stdcall;
function EnumAdvise(out enumAdvise: IEnumStatData): HResult; stdcall;
function GetMiscStatus(dwAspect: Longint; out dwStatus: Longint): HResult;
stdcall;
function SetColorScheme(const logpal: TLogPalette): HResult; stdcall;
{IWebPrint}
procedure exeWB(cmdID:TOleEnum);
implementation
{IOleObject}
function TWebPrint.SetClientSite(const ClientSite: IOleClientSite): HResult;
begin
if ClientSite <> nil then
begin
if FOleClientSite <> nil then
begin
Result := E_FAIL;
Exit;
end;
FOleClientSite := ClientSite;
end else
begin
FOleClientSite := nil;
end;
Result := S_OK;
end;
function TWebPrint.GetClientSite(out clientSite: IOleClientSite): HResult;
begin
ClientSite := FOleClientSite;
Result := S_OK;
end;
function TWebPrint.SetHostNames(szContainerApp: POleStr;
szContainerObj: POleStr): HResult;
begin
Result := S_OK;
end;
function TWebPrint.Close(dwSaveOption: Longint): HResult;
begin
Result := E_NOTIMPL;
end;
function TWebPrint.SetMoniker(dwWhichMoniker: Longint; const mk: IMoniker): HResult;
begin
Result := E_NOTIMPL;
end;
function TWebPrint.GetMoniker(dwAssign: Longint; dwWhichMoniker: Longint;
out mk: IMoniker): HResult;
begin
Result := E_NOTIMPL;
end;
function TWebPrint.InitFromData(const dataObject: IDataObject; fCreation: BOOL;
dwReserved: Longint): HResult;
begin
Result := E_NOTIMPL;
end;
function TWebPrint.GetClipboardData(dwReserved: Longint;
out dataObject: IDataObject): HResult;
begin
Result := E_NOTIMPL;
end;
function TWebPrint.DoVerb(iVerb: Longint; msg: PMsg; const activeSite: IOleClientSite;
lindex: Longint; hwndParent: HWND; const posRect: TRect): HResult;
begin
Result := E_NOTIMPL;
end;
function TWebPrint.EnumVerbs(out enumOleVerb: IEnumOleVerb): HResult;
begin
Result := OleRegEnumVerbs(Factory.ClassID, enumOleVerb);
end;
function TWebPrint.Update: HResult;
begin
Result := S_OK;
end;
function TWebPrint.IsUpToDate: HResult;
begin
Result := S_OK;
end;
function TWebPrint.GetUserClassID(out clsid: TCLSID): HResult;
begin
clsid := Factory.ClassID;
Result := S_OK;
end;
function TWebPrint.GetUserType(dwFormOfType: Longint; out pszUserType: POleStr): HResult;
begin
Result := OleRegGetUserType(Factory.ClassID, dwFormOfType, pszUserType);
end;
function TWebPrint.SetExtent(dwDrawAspect: Longint; const size: TPoint): HResult;
begin
Result := E_NOTIMPL;
end;
function TWebPrint.GetExtent(dwDrawAspect: Longint; out size: TPoint): HResult;
begin
Result := E_NOTIMPL;
end;
function TWebPrint.Advise(const advSink: IAdviseSink; out dwConnection: Longint): HResult;
begin
Result := E_NOTIMPL;
end;
function TWebPrint.Unadvise(dwConnection: Longint): HResult;
begin
Result := E_NOTIMPL;
end;
function TWebPrint.EnumAdvise(out enumAdvise: IEnumStatData): HResult;
begin
Result := E_NOTIMPL;
end;
function TWebPrint.GetMiscStatus(dwAspect: Longint; out dwStatus: Longint): HResult;
begin
Result := E_NOTIMPL;
end;
function TWebPrint.SetColorScheme(const logpal: TLogPalette): HResult;
begin
Result := E_NOTIMPL;
end;
{ITWebPrint}
procedure TWebPrint.exeWB(cmdID:TOleEnum);
var
spDoc:IHTMLDocument2;
spContainer:IOleContainer;
spIE:IWebBrowser2;
begin
FOleClientSite.GetContainer(spContainer);
if not Assigned(spContainer) then
begin
messagebox(0,'此对象必须作为OLE对象使用','使用方法错误',0);
exit;
end;
if spContainer.QueryInterface(IID_IHTMLDocument2,spDoc)=S_OK then
begin
if (spDoc.parentWindow as IServiceprovider).QueryService(IWebbrowserApp, IWebBrowser2, spIE)=S_OK then
begin
if spIE.QueryStatusWB(cmdID)=3 then
spIE.ExecWB(cmdID, OLECMDEXECOPT_DODEFAULT,EmptyParam,EmptyParam);
end else
begin
messagebox(0,'请使用IE5.5以上版本','运行环境不正确',0);
exit;
end;
end else begin
messagebox(0,'找不到网页内容','使用方法错误',0);
exit;
end;
end;