用delphi制作无界面的activex控件

最新推荐文章于 2023-02-19 12:40:22 发布
最新推荐文章于 2023-02-19 12:40:22 发布
阅读量2.4k 收藏 4
点赞数
分类专栏： 编程开发 文章标签： delphi 控件 ocx


首先，您要了解：

  • 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;

zi_wu_xian
关注
专栏目录
delphi制作复合控件
09-11
很简单的复合控件实例，初始化控件，加载属性，调用方法等
Delphi创建ActiveX控件，实现安全接口及无界面代码
ljz9425的专栏
11-29 3211
Delphi创建OCX控件非常的方便，但IE调用时弹出的安全认证非常麻烦，有时OCX也不需要界面，IE调用时需要隐藏，非常不方便。在DELPHI中创建OCX实现安全接口和创建事件中修改部分代码实现安全接口 继承：IObjectSafety 重载方法： function GetInterfaceSafetyOptions(const IID: TIID; pdwSupportedOptions, //安全接口 pdwEnabledOptions: PDWORD)
关于delphi7 ActiveX的创建
找个地方放一下
09-21 1142
步骤: 1、先创建ActiveX工程文件；  2、注册ActiveX文件(ocx文件) ； 3、编写相应调用ActiveX文件(.ocx文件)的html文件. 具体操作流程如下： 步骤1： a、选择File->New->Other ，ActiveX页面，选择ActiveX Form ； b、填写New ActiveX Name：
在Delphi中编写控件的基本方法
zou5655的专栏
12-09 1617
 在Delphi中编写控件的基本方法　　作为Delphi程序员，要想进一步提高编程水平就必须掌握控件的编写方法，本篇文章将通过一个简单的例子来为初学者介绍编写控件的一些基本方法和模式。 　　这个例子控件叫TLeiLabel，是在TLabel的基础上增加两个实用的功能：一是使文字具有立体形状，二是使文字具有超链接属性。下面就让我们一步步来实现这些功能。 　　一、使文字具有立体形状 　　首先定义类型T
使用Delphi快速开发ActiveX控件
08-25
### 使用Delphi快速开发ActiveX控件 在IT领域中，随着B/S应用的增多，ActiveX控件的使用频率也随之增加。对于开发者而言，掌握如何利用Delphi进行ActiveX控件开发变得尤为重要。本文将深入探讨Delphi与ActiveX控件...
用Delphi制作以浏览器为界面的应用程序.rar_delphi 浏览器_delphi 界面_浏览器_浏览器 delphi_界面
09-22
首先，"用Delphi制作以浏览器为界面的应用程序"这个标题暗示了我们将使用Delphi中的TWebBrowser组件。TWebBrowser是Delphi IDE中的一个标准组件，它基于Internet Explorer引擎（早期版本）或Chromium Embedded ...
精通Delphi ActiveX控件：从入门到实战
最新发布
06-23
2. **可视化编程**：Delphi IDE包括一个可视化编程工具，允许开发者通过拖放组件来设计用户界面。 3. **本地代码编译**：Delphi使用自己的编译器将Pascal源代码编译成本地机器代码，这通常可以生成高性能的应用程序...
Delphi.zip_Delphi控件源码_Delphi_
08-11
2. AXPrjlite.bkm：同样，这可能是另一个单元的备份文件，可能与设备驱动或组件有关，名字中的"AX"通常表示ActiveX，可能涉及到与ZK4000设备的ActiveX控件通信。 3. AXPrjlite.cfg：这可能是项目的配置文件，存储了...
delphi制作无窗体无界面的后台程序.zip
01-11
delphi制作无窗体无界面的后台程序.zip
html网页与delphi编写的ActiveX(OCX)插件通讯的例子
02-24
html传值于delphi编写的ActiveX插件
在Delphi中编写控件的基本方法(1) (转)
cuiji1279的博客
05-12 97
在Delphi中编写控件的基本方法(1) (转)[@more@]在Delphi中编写控件的基本方法(1) [ 作者: 雷小园 添加时间: 2001-5-5 18:01:08 ]来源：www.cci.NET.com　　作为De...
delphi 编写自定义控件
aldsot0997的博客
06-27 1334
1.File - new componet 2.选择要继承的控件 3.填写自定义控件的名称和控件在控件面板上的位置。 4.编写自定义控件代码，定义了PFaddress 属性。 unit mybutton; interface uses Windows, Messages, System.SysUtils, System.Classes, ...
Delphi控件开发浅入深出 六七
11-06 403
Delphi控件开发浅入深出（六） 对话框控件的制作 Delphi中有很多对话框组件，例如TopenDialog、TfontDialog等。这些控件的特点就是虽然是不可视控件，但是在运行时都有一个可视化的效果，比如TopenDialog的可视化效果就是一个打开对话框。我们这次将开发一个日期对话框控件，当我们调用控件的Execute方法（不一定非要使用Execute方法，不过大部分对话框控件
做delphi控件的笔记
weixin_30594001的博客
08-10 66
首先要弄明白你要写的OCX是用在客户端还是用在服务器端假如用在客户端：1、创建打开delphi 7，选择菜单“new”－>“other”－>“activex”－>“active form”－>输入项目名称，系统自动给你创建了3个文件，一个是项目文件，一个是form的单元文件，还有一个后缀带TLB的文件。这三个文件中的你只需要更改form的单元文件，项目文件一般不需要写什么，...
Delphi如何开发没有界面的程序
迷路的指南针的专栏
07-07 2074
最近突发奇想：如何开发出一个没有界面的Delphi程序。原谅我，我可不是想开发出木马
DELPHI编写控件的高级技巧
s13596191285的博客
02-19 447
在DELPHI中编写控件，如何定义一个新的属性类型，来实现自己的目的？例如有的控件在DELPHI的IDE中的属性窗口中加上作者的信息或者双击控件弹出关于窗口等。下面就以“关于”窗口来说明该技巧的实现方法。 先定义一个新的控件“TTestComponent”。所有代码均在里面加入。 1、让我们先定义一个新的属性类型“TTestAbout”。 type TTestAbout = class(TPropertyEditor) public procedure Edit; override; function Ge
使用Delphi开发IE控件ActiveX：打印控件实践
本文将详细介绍如何使用Delphi开发一个IE控件，特别是针对打印功能的ActiveX控件。首先，我们需要安装Delphi7以及相关的插件，如FastReport报表打印控件和Delphi7WebDeploy发布工具。FastReport是一款强大的报表生成...
评论
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值