投稿
  1. 首页
  2. IT百科

Delphi中怎么加入OCX控件？

海南三亚地图 • 2023-5-16 • IT百科 • 阅读 2

Delphi中怎么加入OCX控件？,第1张

首先创建一个新的VCL工程用于测试（方法大家都会），现在开始安装OCX控件，方法有点繁琐首先单击File▶New▶Package 创建一个控件包，然后保存这个工程（注意这一步很关键），然后单击Component▶Import Component▶Import ActiveX Control，在列表中选一个已注册的OCX控件或直接导入一个ocx文件，然后单击Next直到出现Add unit to....那一项（记住一定要选择这个项，最后点击Finish完成，最后用右键单击工程列表中的已创建的那个包文件（也就是后缀名为bpl的文件）在出现的列表中选择Install即可。

首先，您要了解：

•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.在接下来d出的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): HResultstdcall

function GetClientSite(out clientSite: IOleClientSite): HResultstdcall

function SetHostNames(szContainerApp: POleStrszContainerObj: POleStr): HResultstdcall

function Close(dwSaveOption: Longint): HResultstdcall

function SetMoniker(dwWhichMoniker: Longintconst mk: IMoniker): HResultstdcall

function GetMoniker(dwAssign: LongintdwWhichMoniker: Longintout mk: IMoniker): HResultstdcall

function InitFromData(const dataObject: IDataObjectfCreation: BOOLdwReserved: Longint): HResultstdcall

function GetClipboardData(dwReserved: Longintout dataObject: IDataObject): HResultstdcall

function DoVerb(iVerb: Longintmsg: PMsgconst activeSite: IOleClientSitelindex: LonginthwndParent: HWNDconst posRect: TRect): HResultstdcall

function EnumVerbs(out enumOleVerb: IEnumOleVerb): HResultstdcall

function Update: HResultstdcall

function IsUpToDate: HResultstdcall

function GetUserClassID(out clsid: TCLSID): HResultstdcall

function GetUserType(dwFormOfType: Longintout pszUserType: POleStr): HResultstdcall

function SetExtent(dwDrawAspect: Longintconst size: TPoint): HResultstdcall

function GetExtent(dwDrawAspect: Longintout size: TPoint): HResultstdcall

function Advise(const advSink: IAdviseSinkout dwConnection: Longint): HResultstdcall

function Unadvise(dwConnection: Longint): HResultstdcall

function EnumAdvise(out enumAdvise: IEnumStatData): HResultstdcall

function GetMiscStatus(dwAspect: Longintout dwStatus: Longint): HResultstdcall

function SetColorScheme(const logpal: TLogPalette): HResultstdcall

//在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

endfunction TWebPrint.GetClientSite(out clientSite: IOleClientSite): HResult

begin

ClientSite := FOleClientSite

Result := S_OK

endfunction TWebPrint.SetHostNames(szContainerApp: POleStr  szContainerObj: POleStr): HResult

begin

Result := S_OK

endfunction TWebPrint.Close(dwSaveOption: Longint): HResult

begin

Result := E_NOTIMPL

endfunction TWebPrint.SetMoniker(dwWhichMoniker: Longintconst mk: IMoniker): HResult

begin

Result := E_NOTIMPL

endfunction TWebPrint.GetMoniker(dwAssign: LongintdwWhichMoniker: Longint  out mk: IMoniker): HResult

begin

Result := E_NOTIMPL

endfunction TWebPrint.InitFromData(const dataObject: IDataObjectfCreation: BOOL  dwReserved: Longint): HResult

begin

Result := E_NOTIMPL

endfunction TWebPrint.GetClipboardData(dwReserved: Longint  out dataObject: IDataObject): HResult

begin

Result := E_NOTIMPL

endfunction TWebPrint.DoVerb(iVerb: Longintmsg: PMsgconst activeSite: IOleClientSite  lindex: LonginthwndParent: HWNDconst posRect: TRect): HResult

begin

Result := E_NOTIMPL

endfunction TWebPrint.EnumVerbs(out enumOleVerb: IEnumOleVerb): HResult

begin

Result := OleRegEnumVerbs(Factory.ClassID, enumOleVerb)

endfunction TWebPrint.Update: HResult

begin

Result := S_OK

endfunction TWebPrint.IsUpToDate: HResult

begin

Result := S_OK

endfunction TWebPrint.GetUserClassID(out clsid: TCLSID): HResult

begin

clsid := Factory.ClassID

Result := S_OK

endfunction TWebPrint.GetUserType(dwFormOfType: Longintout pszUserType: POleStr): HResult

begin

Result := OleRegGetUserType(Factory.ClassID, dwFormOfType, pszUserType)

endfunction TWebPrint.SetExtent(dwDrawAspect: Longintconst size: TPoint): HResult

begin

Result := E_NOTIMPL

endfunction TWebPrint.GetExtent(dwDrawAspect: Longintout size: TPoint): HResult

begin

Result := E_NOTIMPL

endfunction TWebPrint.Advise(const advSink: IAdviseSinkout dwConnection: Longint): HResult

begin

Result := E_NOTIMPL

endfunction TWebPrint.Unadvise(dwConnection: Longint): HResult

begin

Result := E_NOTIMPL

endfunction TWebPrint.EnumAdvise(out enumAdvise: IEnumStatData): HResult

begin

Result := E_NOTIMPL

endfunction TWebPrint.GetMiscStatus(dwAspect: Longintout dwStatus: Longint): HResult

begin

Result := E_NOTIMPL

endfunction TWebPrint.SetColorScheme(const logpal: TLogPalette): HResult

begin

Result := E_NOTIMPL

end5.实现您自己定义的接口函数功能{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

网页链接

ActiveX技术虽然是一项古老的技术，但是却有着广泛的应用，支付宝的密码输入控件，各大银行的密码输入控件，网页聊天室中的截屏功能，网页播放器中的p2p播放...甚至Flash,Silverlight等等，在IE中都表现为ActiveX。虽然C#也能开发"用于网页的com应用"，能达到类似ActiveX的效果，但是有一个要命的问题是必须得安装几百M的.net Framework框架，如果仅仅为了安全的输入一个密码，而要用户下载几百M的安装程序，这是很多人不能接受的，Delphi做为win32下的原生开发工具，能很好的支持微软各种"古老"的经典技术。(再做点小广告:delphi的kyrix版本还能编译跨平台的应用哦！)

ok，开工吧:

开发工具:推荐用delphi 2010(d7也可以，不过添加属性，方法等过程要手动，稍微麻烦点)　

1.启用delphi2010-->File->New->Other-->Active Library

2.项目命名为MyActiveX

3.File-->Save All 全部保存

实际上这样就能编译了，不过只是空的dll

4.File-->New-->Other-->Active Form

改名为MyForm

将对应的单元文件，保存为UMyForm.pas

5.打开MyAcitveX.ridl文件，切换到design视图，选中IMyForm接口，右击New-->Property

添加一个属性Msg

将Msg属性的Type改为BSTR 即WideString类型

完了之后，点击工具栏中的Refresh

Implementation(即上图中工具栏中圈起来的部分)--这一步很重要，点击之后，它将自动生成属性Msg对应的声明和实现代码模板

6.打开UMyForm.pas--即ActiveForm对应的单元，找到Set_Msg以及Get_Msg的实现部分，补充代码如下:

function　TMyForm.Get_Msg:　WideString

begin

result:=_msg

end

procedure　TMyForm.Set_Msg(const　Value:　WideString)

begin

_msg　:=　value

end

当然TMyForm的private部分，得先加一个私有成员　

type

TMyForm　=　class(TActiveForm,　IMyForm)

private

{　Private　declarations　}

_msg:WideString

...

这样我们就为即将生成的ActiveX控件，添加了一个字符串类型的属性Msg，下面来测试一下:

7.编译项目，会生成一个MyActiveX.ocx，在运行栏里输入

regsvr32 C:\Users\jimmy.yang\Desktop\Delphi_activex\MyActiveX\MyActiveX.ocx

注:这里ocx的路径，请各位根据自己的实际路径修改

这样就完成了ocx的注册。

8.放到html里测试一下：

<OBJECT　ID='x'　name='x'　CLASSID='CLSID:52D17094-0687-4A2F-B2DB-30F3189AC659'　align=center　hspace=0　vspace=0　></OBJECT>

<script　type='text/JavaScript'>

var　x　=　document.getElementById("x")

alert(x.Msg)

</script>

关于CLSID在哪里查看，打开:MyActiveX_TLB.pas文件，定位到下面这里:

const

//　TypeLibrary　Major　and　minor　versions

MyActiveXMajorVersion　=　1

MyActiveXMinorVersion　=　0

LIBID_MyActiveX:　TGUID　=　'{49138437-8265-4B1A-9EAE-D0F615D68464}'

IID_IMyForm:　TGUID　=　'{54A20855-29A3-4C92-85DE-A419DA457C7A}'

DIID_IMyFormEvents:　TGUID　=　'{60BBC967-E1E6-4E98-BAE5-776BFD06E9CC}'

CLASS_MyForm:　TGUID　=　'{52D17094-0687-4A2F-B2DB-30F3189AC659}'

其中 CLASS_MyForm: TGUID对应的就是ClassID

运行后，除了d出一个空白的警告框，暂时看不到其它:)（可不就是这样么？Msg属性没给任何初始值，当然是空字符串，所以d出一个空的警告框是正常的)

9.我们再来添加一些控件和方法，以验证刚才设置的属性确实有效

在MyForm上添加一个文件框，一个按钮

按钮的事件如下:

procedure　TMyForm.Button1Click(Sender:　TObject)

begin

_msg:=　self.Edit1.Text

end

即把文本框的值赋给属性Msg

再继续定位到Set_Msg,略做修改

procedure　TMyForm.Set_Msg(const　Value:　WideString)

begin

_msg　:=　value

self.Edit1.Text　:=　_msg

end

即设置Msg属性时，同时也把值显示在文本框里，以便等会儿我们好测试在js中给activeX属性赋值的效果

ok了，再来测试一下，编译一下，如果通不过，请先运行

regsvr32 C:\Users\jimmy.yang\Desktop\Delphi_activex\MyActiveX\MyActiveX.ocx /u

将刚才注册的ocx反注册，同时关掉浏览器，不然该ocx文件一直被占用，无法更新.

修改一下html的代码:

<OBJECT　ID='x'　name='x'　CLASSID='CLSID:52D17094-0687-4A2F-B2DB-30F3189AC659'　align=center　hspace=0　vspace=0　></OBJECT>

<hr　/>

<input　type='button'　value='显示Msg属性的值'　onclick='ShowMsg()'/>

<input　type='button'　value='设置Msg属性的值'　onclick='SetMsg()'/>

<script　type='text/JavaScript'>

var　x　=　document.getElementById("x")

var　ShowMsg　=　function(){

alert(x.Msg)

}

var　SetMsg　=　function(){

x.Msg　=　'js传过来的值'

}

</script>

欢迎分享，转载请注明来源：内存溢出

原文地址: http://outofmemory.cn/bake/11432518.html

赞 (0)
打赏 微信扫一扫 微信扫一扫 支付宝扫一扫 支付宝扫一扫
海南三亚地图 海南三亚地图 一级用户组
0 0
上一篇 2023-05-16
下一篇 2023-05-16

发表评论

登录后才能评论

评论列表（0条）

保存