用delphi制作无界面的activex控件
首先,您要了解:
•COM的基本原理
•能被网页调用的非可视ActiveX控件必须是一种至少实现了IOleObject接口的TAutoObject组件
•利用Delphi向导生成的ActiveX控件必须继承自WinControl,所以您不能用Delphi向导生成非可视的ActiveX控件 以下例子,实现了一个非可视ActiveX,调用此控件的exeWB,相当于调用IE的打印,预览,页面设置等功能。再此基础上,还可以扩展其它的功能。 制作步骤: .打开delphi,新建一个ActiveX包。 File|new|other...|ActiveX|AxtiveX library .利用delphi向导,添加一个Automation Object。 File|new|other...|ActiveX|Automation Object 我这个项目叫WebPrint .在接下来弹出的TLB编辑窗口里面定义自己需要的接口函数 我添加需要的接口IWebPrint.print(),IWebPrint.preview()等 .实现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; .实现您自己定义的接口函数功能 {ITWebPrint} procedure TWebPrint.exeWB(cmdID:TOleEnum);
var
spDoc:IHTMLDocument2;
spContainer:IOleContainer;
spIE:IWebBrowser2;
begin
FOleClientSite.GetContainer(spContainer);
if not Assigned(spContainer) then
begin
messagebox(,'此对象必须作为OLE对象使用','使用方法错误',);
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)= then
spIE.ExecWB(cmdID, OLECMDEXECOPT_DODEFAULT,EmptyParam,EmptyParam);
end
else
begin
messagebox(,'请使用IE5.5以上版本','运行环境不正确',);
exit;
end;
end
else
begin
messagebox(,'找不到网页内容','使用方法错误',);
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(,'此对象必须作为OLE对象使用','使用方法错误',);
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)= then
spIE.ExecWB(cmdID, OLECMDEXECOPT_DODEFAULT,EmptyParam,EmptyParam);
end
else
begin
messagebox(,'请使用IE5.5以上版本','运行环境不正确',);
exit;
end;
end
else
begin
messagebox(,'找不到网页内容','使用方法错误',);
exit;
end; end;
用delphi制作无界面的activex控件的更多相关文章
- VC++ 带界面的ActiveX控件
一.新建MFC ActiveX工程OleHasInterface: 二.新建一个对话框资源,ID为 IDD_FORMVIEW,关联类CActXInterfaceDlg,基类CDialog: 三.设计对 ...
- 解决CPC撰写文档报错问题“无法获取“AxforApplication”控件的窗口句柄。不支持无窗口的 ActiveX 控件”
最近公司需要把官方CPC电子申请移植到项目中,在移植完成后,撰写文档总是出现“无法获取“AxforApplication”控件的窗口句柄.不支持无窗口的 ActiveX 控件”,另楼主头疼很久,网上寥 ...
- 用ATL写简单的ActiveX控件 .
我正在做的项目需要用读卡器来读数据,由于系统是B/S架构的所以只能把读卡器的驱动封装成一个无界面的ActiveX控件,这样web页面中的js代码才能访问读卡器其实做起来也挺简单的,我用的环境是VS20 ...
- Delphi发布ActiveX控件 制作CAB包 数字签名相关
文件: SignTool.rar 大小: 84KB 下载: 下载 最近我正在研究ActiveX技术.我使用Delphi 7创建了一个具有ActiveForm的ActiveX控件应用程序.这个控件产生一 ...
- C#制作ActiveX控件及部署升级(摘自网络)
使用C#开发ActiveX控件 控件开发.制作CAB包.签名.部署 ActiveX控件以前也叫做OLE控件,它是微软IE支持的一种软件组件或对象,可以将其插入到Web页面中,实现在浏览器端执行动态程序 ...
- Delphi第三方组件安装DCU.PAS.DPK.BPL.ActiveX控件
不是由BORLAND提供的组件叫第三方组件:安装方法:南山古桃(nsgtao)首先提醒一下:最好把要安装的文件先复制到Delphi安装目录的Lib目录下再执行下面的操作!就目前常见的各种形式的组件的安 ...
- Delphi 开发ActiveX控件(非ActiveForm)
Delphi 开发ActiveX控件(非ActiveForm) Q:为什么不采用ActiveForm工程?通过它可以快速开发带窗体控件,创建过程也非常简单(都不用考虑安全接口问题),很省事! A:如果 ...
- Delphi 编写ActiveX控件(OCX控件)的知识和样例(有详细步骤)
一.ActiveX应用情况简介: ActiveX控件也就是一般所说的OCX控件,它是 ActiveX技术的一部分.ActiveX是微软公司推出的基于组件对象模型COM的技术,包括对Windows 32 ...
- C# 制作ActiveX控件并添加到网页
1.创建ActiveX控件——按钮 2.定义一个接口,并在控件中实现 3.部署安装 4.CAB打包 5.添加到网页中进行测试 一. 创建ActiveX控件——按钮 1.新建一个Window窗体控件库项 ...
随机推荐
- Android ImageView 的scaleType 属性图解
ImageView 是 Android 中最常用的控件之一,而在使用ImageView时,必不可少的会使用到它的scaleType属性.该属性指定了你想让ImageView如何显示图片,包括是否进行缩 ...
- HTTP协议 (1)
HTTP协议是Hyper Text Transfer Protocol(超文本传输协议)的缩写,是用于从万维网(WWW:World Wide Web )服务器传输超文本到本地浏览器的传送协议. HTT ...
- AdvStringGrid 标题头 加粗的问题
当AdvStringGrid1.RowCount = 1的时候,会是下面这样: 当AdvStringGrid1.RowCount = 2 时 才是正确的:
- PyCharm更改字体和界面样式
更改主题 File → Settings → Appearance & Behavior → Appearance → Theme 结果: 更改字体大小 File → Settings → E ...
- python 全栈开发,Day30(第一次面向对象考试)
月考题: python 全栈11期月考题 一 基础知识:(70分) 1.文件操作有哪些模式?请简述各模式的作用(2分) 2.详细说明tuple.list.dict的用法,以及它们的特点(3分) 3.解 ...
- charAt和String的用法
package charpter2; import java.util.Scanner; public class Test { public static void main(String[] ar ...
- POJ 3262 Protecting the Flowers 【贪心】
题意:有n个牛在FJ的花园乱吃.所以FJ要赶他们回牛棚.每个牛在被赶走之前每秒吃Di个花朵.赶它回去FJ来回要花的总时间是Ti×2.在被赶走的过程中,被赶走的牛就不能乱吃 思路: 先赶走破坏力大的牛假 ...
- 关键字super和this的使用及区别
"this"作为一个特殊的关键字,它的规则如下: 1.可以表示构造函数传递.this(a,b)表示调用另外一个构造函数.这里面的this就是一个特殊语法,不是变量,没有什么类型. ...
- Ubuntu 下wifi掉线
http://blog.csdn.net/sean_xyz/article/details/51141063
- window.jQuery || document...
window是浏览器端的全部数据变量的引用.比如 window.window === window window.jQuery 就是浏览器中的全局变量里的jQuery那为什么不写 jQuery 而是写 ...