我创建了一个继承TStatusBar的类，包含进度条，下拉列表框等控件，怎么才能把这个类封装成ocx呢，奇怪的是：TStatusBar存在于面板上，怎么在New ActiveX Control窗口中怎么不能选择TStatusBar
代码如下：
unit utMyStatusBar;interfaceuses
Windows, Messages,
Activex, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, shellapi,GIFImage,
StdCtrls, ActnList, ComObj, Variants, ExtCtrls, ComCtrls, OleCtrls, utProgress;Type
TMyStatusBar = class(TStatusBar)
private
{ Private declarations }
FStep : integer; //进度条的进度
public
{ Public declarations }
cbReferFrm : TComboBox; //坐标系TComboBox
prbProcess : TProgressBar; //进度条 imgProcess : TImage; //可以显示gif文件
GifFileName : String; //gif文件全路径和文件全名 constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure InitGifImage(GifFile: string); procedure AddReferFrm(ReferFrmName: string); //增加坐标系名称 procedure DelReferFrm(Index: Integer); //删除坐标系名称 //创建进度条，并赋最大值Max（与进度条显示进度有关）
procedure InitProgressBar(Max: Integer);
//显示进度，Step为增量
procedure ProgressStep(Step: Integer = 1);
//清除进度条的显示，并释放
procedure ClearProgressStep; //播放动画
procedure PlayAnimate;
//停止动画
procedure StopAnimate; procedure SetScale(Scale: double); //设置比例尺 procedure SetCoordinate(X, Y: double); //设置X, Y坐标值 procedure AddProgressBar(ProgressBarName:TControl); //增加进度条 protected
//事件过程定义
procedure cbChange(Sender: TObject); //改变坐标系事件过程 procedure SbResize(Sender: TObject); //状态栏改变大小，同时加入gif
published end;
implementationconstructor TMyStatusBar.Create(AOwner: TComponent);
var
StatusPanel: TStatusPanel;
i: integer;
begin
inherited Create(AOwner);
ControlStyle:= ControlStyle + [csAcceptsControls];//可以在Panel添加其他控件
cbReferFrm := TComboBox.Create(Nil);
imgProcess := TImage.Create(Nil); for i:=0 to 3 do
begin
StatusPanel := TStatusPanel.Create(Panels); //创建Panels
self.Panels.AddItem(StatusPanel,i);
end; //设置控件和Panel的宽度和文字显示 ，默认为50
Panels[0].Width := 150;
Panels[0].Text := '坐标系：';
Panels[1].Width := 150;
Panels[1].Text := '比例尺：';
Panels[2].Width := 200;
Panels[2].Text := 'X坐标： Y坐标： '; //self.OnDrawPanel := DrawPanel; //加入下拉列表框
with cbReferFrm do
begin
Top:= 2;
Left:= 50;
Width:= 100;
Height:= self.Height;
Visible:= True;
Parent:= self;
end; //添加事件过程
cbReferFrm.OnChange := cbChange;
self.OnResize := SbResize;
end;destructor TMyStatusBar.Destroy;
begin
inherited Destroy;
end;procedure TMyStatusBar.InitGifImage(GifFile: string);
begin
GifFileName := GifFile;
imgProcess.Picture.LoadFromFile(GifFileName);
TGIFImage(imgProcess.Picture.Graphic).Animate := false;
end;procedure TMyStatusBar.addReferFrm(ReferFrmName: string);
begin
cbReferFrm.Items.Add(ReferFrmName);
end;procedure TMyStatusBar.DelReferFrm(Index: Integer);
begin
cbReferFrm.Items.Delete(Index);
end;procedure TMyStatusBar.InitProgressBar(Max: Integer);
begin
prbProcess := TProgressBar.Create(Nil);
with prbProcess do
begin
Top:= 2;
Left:= 502;
Width:= self.Width - 30 - 502;
Height:= 21;
Visible:= True;
Parent:= self;
end; prbProcess.Min := 0;
prbProcess.Max := Max;
FStep := 0;
end;procedure TMyStatusBar.ProgressStep(Step: Integer = 1);
begin
if Step = 1 then
inc(FStep)
else
FStep := FStep + Step;
Application.ProcessMessages;
prbProcess.Position := FStep;
end;procedure TMyStatusBar.ClearProgressStep;
begin
FStep := 0;
prbProcess.Position := 0;
prbProcess.Free;
end;procedure TMyStatusBar.PlayAnimate;
begin
if TGifImage(imgProcess.Picture.Graphic) <> Nil then
begin
TGifImage(imgProcess.Picture.Graphic).Animate := true;
TGifImage(imgProcess.Picture.Graphic).PaintResume;
end;
end;procedure TMyStatusBar.StopAnimate;
begin
if TGifImage(imgProcess.Picture.Graphic) <> Nil then
TGifImage(imgProcess.Picture.Graphic).PaintPause;
end;procedure TMyStatusBar.SetScale(Scale: double);
begin
Panels[1].Text := '比例尺： 1:' + FloatToStr(Scale);
end;procedure TMyStatusBar.SetCoordinate(X, Y: double);
begin
Panels[2].Text := 'X坐标：' + FloatToStr(X) + ' Y坐标：' + FloatToStr(Y);
end;procedure TMyStatusBar.AddProgressBar(ProgressBarName: TControl);
begin
with ProgressBarName do
begin
Top:= 2;
Left:= 502;
Width:= self.Width - 30 - 502;
Height:= 21;
Visible:= True;
Parent:= self;
end;
end;procedure TMyStatusBar.cbChange(Sender: TObject);
begin
//showmessage('cbChange');
end;procedure TMyStatusBar.SbResize(Sender: TObject);
begin
with imgProcess do
begin
Top:= 7;
Left := self.Width - 25;
Parent:= self;
end;
end;initializationfinalization
end.
代码如下：
unit utMyStatusBar;interfaceuses
Windows, Messages,
Activex, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, shellapi,GIFImage,
StdCtrls, ActnList, ComObj, Variants, ExtCtrls, ComCtrls, OleCtrls, utProgress;Type
TMyStatusBar = class(TStatusBar)
private
{ Private declarations }
FStep : integer; //进度条的进度
public
{ Public declarations }
cbReferFrm : TComboBox; //坐标系TComboBox
prbProcess : TProgressBar; //进度条 imgProcess : TImage; //可以显示gif文件
GifFileName : String; //gif文件全路径和文件全名 constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure InitGifImage(GifFile: string); procedure AddReferFrm(ReferFrmName: string); //增加坐标系名称 procedure DelReferFrm(Index: Integer); //删除坐标系名称 //创建进度条，并赋最大值Max（与进度条显示进度有关）
procedure InitProgressBar(Max: Integer);
//显示进度，Step为增量
procedure ProgressStep(Step: Integer = 1);
//清除进度条的显示，并释放
procedure ClearProgressStep; //播放动画
procedure PlayAnimate;
//停止动画
procedure StopAnimate; procedure SetScale(Scale: double); //设置比例尺 procedure SetCoordinate(X, Y: double); //设置X, Y坐标值 procedure AddProgressBar(ProgressBarName:TControl); //增加进度条 protected
//事件过程定义
procedure cbChange(Sender: TObject); //改变坐标系事件过程 procedure SbResize(Sender: TObject); //状态栏改变大小，同时加入gif
published end;
implementationconstructor TMyStatusBar.Create(AOwner: TComponent);
var
StatusPanel: TStatusPanel;
i: integer;
begin
inherited Create(AOwner);
ControlStyle:= ControlStyle + [csAcceptsControls];//可以在Panel添加其他控件
cbReferFrm := TComboBox.Create(Nil);
imgProcess := TImage.Create(Nil); for i:=0 to 3 do
begin
StatusPanel := TStatusPanel.Create(Panels); //创建Panels
self.Panels.AddItem(StatusPanel,i);
end; //设置控件和Panel的宽度和文字显示 ，默认为50
Panels[0].Width := 150;
Panels[0].Text := '坐标系：';
Panels[1].Width := 150;
Panels[1].Text := '比例尺：';
Panels[2].Width := 200;
Panels[2].Text := 'X坐标： Y坐标： '; //self.OnDrawPanel := DrawPanel; //加入下拉列表框
with cbReferFrm do
begin
Top:= 2;
Left:= 50;
Width:= 100;
Height:= self.Height;
Visible:= True;
Parent:= self;
end; //添加事件过程
cbReferFrm.OnChange := cbChange;
self.OnResize := SbResize;
end;destructor TMyStatusBar.Destroy;
begin
inherited Destroy;
end;procedure TMyStatusBar.InitGifImage(GifFile: string);
begin
GifFileName := GifFile;
imgProcess.Picture.LoadFromFile(GifFileName);
TGIFImage(imgProcess.Picture.Graphic).Animate := false;
end;procedure TMyStatusBar.addReferFrm(ReferFrmName: string);
begin
cbReferFrm.Items.Add(ReferFrmName);
end;procedure TMyStatusBar.DelReferFrm(Index: Integer);
begin
cbReferFrm.Items.Delete(Index);
end;procedure TMyStatusBar.InitProgressBar(Max: Integer);
begin
prbProcess := TProgressBar.Create(Nil);
with prbProcess do
begin
Top:= 2;
Left:= 502;
Width:= self.Width - 30 - 502;
Height:= 21;
Visible:= True;
Parent:= self;
end; prbProcess.Min := 0;
prbProcess.Max := Max;
FStep := 0;
end;procedure TMyStatusBar.ProgressStep(Step: Integer = 1);
begin
if Step = 1 then
inc(FStep)
else
FStep := FStep + Step;
Application.ProcessMessages;
prbProcess.Position := FStep;
end;procedure TMyStatusBar.ClearProgressStep;
begin
FStep := 0;
prbProcess.Position := 0;
prbProcess.Free;
end;procedure TMyStatusBar.PlayAnimate;
begin
if TGifImage(imgProcess.Picture.Graphic) <> Nil then
begin
TGifImage(imgProcess.Picture.Graphic).Animate := true;
TGifImage(imgProcess.Picture.Graphic).PaintResume;
end;
end;procedure TMyStatusBar.StopAnimate;
begin
if TGifImage(imgProcess.Picture.Graphic) <> Nil then
TGifImage(imgProcess.Picture.Graphic).PaintPause;
end;procedure TMyStatusBar.SetScale(Scale: double);
begin
Panels[1].Text := '比例尺： 1:' + FloatToStr(Scale);
end;procedure TMyStatusBar.SetCoordinate(X, Y: double);
begin
Panels[2].Text := 'X坐标：' + FloatToStr(X) + ' Y坐标：' + FloatToStr(Y);
end;procedure TMyStatusBar.AddProgressBar(ProgressBarName: TControl);
begin
with ProgressBarName do
begin
Top:= 2;
Left:= 502;
Width:= self.Width - 30 - 502;
Height:= 21;
Visible:= True;
Parent:= self;
end;
end;procedure TMyStatusBar.cbChange(Sender: TObject);
begin
//showmessage('cbChange');
end;procedure TMyStatusBar.SbResize(Sender: TObject);
begin
with imgProcess do
begin
Top:= 7;
Left := self.Width - 25;
Parent:= self;
end;
end;initializationfinalization
end.
转贴：
如何在VB中使用Delphi的控件 南京南自总厂开发中心 张玉洲 南京理工大学98研
王静 ----
用过Delphi的编程爱好者们都知道，Delphi中Visual Component Library(VCL)中具有大
量的组件，尤其是第三方设计的VCL，如Ahm系列，LMD系列，VenusPro等，在程序中适当
的使用它们会让你的程序在界面上或者功能上增色不少，这让许多VB迷们馋的掉口水，
因为毕竟免费的并且功能强大的ActiveX控件太少了，本文就是为那些到处找控件的VB迷
写的。 ---- 为方便讲述，以Delphi4 中Samples 标签下的ColorGrid组件为例，
描述如何将ColorGrid导出成ActiveX控件。 ---- 1、打开delphi4，运行File- >New，
弹出NewItems对话框，点取"ActiveX"标签，选择ActivexControl，选择"OK" ----
2、在出现的ActiveX Control Wizard的对话框中，有如下选择： ----
VCL Class Name：选择要导出的或继承的VCL组件(注意非TwinControl继承的VCL不
再列表中，之后再讨论)，选择TColorGrid ---- New Activex Name：要导出的ActiveX控
件名，取默认值ColorGridX即可 ---- Implementation Unit：实现单元，取缺省名称
---- Project Name：创建的工程名，取缺省名称 ---- Thread Model：线程模式，
详看Delphi帮助，这里取默认值Apartment（单线程） ---- Include Design-Time
License：是否包含使用许可信息 ---- Include About Box：是否包含"About"对话框
---- Include Version Informaion：是否包含版本信息 ---- 单击"OK"，此时Delphi
为我们创建了三个文件： ---- 库文件 ColorGridXControl1 ---- 实现单元
ColorGridImpl1 ---- 类型文件 ColorGridXControl1_TLB ----
3、选择菜单Run->Register ActiveX Server，会出现注册成功的信息：
"Successfully Registered ActiveX Server,'...\ColorGridControl1.ocx'
"---- 这里的ColorGridXControl1.ocx就是你所需要的颜色选取控件。
---- 现用VB6对其进行测试： ---- 1、新建一VB6工程，选取菜单"工程->部件"，在
出现的对话框中选中ColorGridXControl1 Library，选"确定"。 ---- 2、在窗体Form1上
放置控件ColorGridX，取默认名称"ColorGridX1"。 ---- 3、如何利用它的属性和方法：
以获得选取
颜色为例，在它的OnClick事件中添加监视ColorGridX1，发现其属性Object返回对Delphi
控件的引用，ForegroundColor属性值代表选中的颜色，虽然在"ColorGridX1.Object."后
没有代码提示，但仍然可以用ColorGridX1.Object.ForegroundColor可得到颜色值。 ----
如果你想完善这个控件，在键入"ColorGridX1."后直接得到ForegroundColor的属性提示，
那就必须手工在Delphi中为ColorGridX填加属性/方法，步骤如下： ---- 1、选中实现单元
ColorGridImpl1，选菜单"Edit->Add To Interface",在出现的对话框中的Declaration填
写"Property ForegroundColor:integer"，选"OK"，这时Delphi自动为你填加了两个过程框架： procedure TColorGridX.Set_ForeColor(Value: Integer);function TColorGridX.
Get_ForeColor: Integer;2、在Get_ForeColor中添加代码result:=FDelphiControl.
ForegroundColor;由于ColorGrid的ForegroundColor属性为只读，Set_ForeColor过程
不用写了。---- 3、编译执行，Run->Register ActiveX Server，会出现注册成功的信
息。再到VB中，会发现控件ColorGridX新增了ForeColor属性，代表选中的颜色值。
---- 依此类推，可以增加其它有用的属性供VB等显式调用。用这种办法，可以把
大多数由TWinControl继承下来的组件导出，那么非TWinControl的组件以及没有列
出的组件怎么导出呢？且看下文。 ---- 前面提到创建ActiveX控件时，
在ActiveX Control Wizard的对话框的VCLClassName下拉列表中找不到想导
出的VCL组件，这是因为该组件不是由TwinControl继承下来的，属"Windowless"那一种，这时我们可以用ActiceForm的形式把它导出来，以第三方控件TColorPickerButton
为例： ---- 1、选菜单"File->New",在出现的"New Items"对话框中选择"ActiveX"标签,
选中ActiveXForm,选择"OK" ---- 2、在出现的"ActiveForm Wizard"的"New ActiveX Name"
中填写输出的控件名"ColorPicker",选择"OK" ---- 3、在Delphi为我们创建的窗体上放
置TColorPickerButton组件，名为"ColorPickerButton1",将窗体调整到合适大小，选菜单"Edit->Add To Interface",为它添加属性：Property SelectColor:integer，
选择"OK" ---- 4、在Delphi提供的框架中写下类似代码： ---- 读取颜色:
function TColorPicker.Get_SelectColor: Integer; begin
result:=ColorPickerButton1.SelectionColor;end;设置颜色:
procedure TColorPicker.Set_SelectColor(Value: Integer);
beginColorPickerButton1.SelectionColor:=Value; end;----
5、编译执行，Run->Register ActiveX Server，会得到注册成功的消息。
---- 6、用前面讲述的方法在VB6下实验，获得成功。
---- 关于添加属性的两点说明：
---- 1、原形为"Property {属性/方法名}:数值类型",其中数值类型有：
WordBool、WideString、Integer等 ---- 2、如果出现"SafeCall function
Requires a HResult return type"的错误提示，说明你添加的属性/方法名已经存在
，换个名字即可。 ---- 至此，我们已经成功导出了GridColor(属TWinControl继承类)
和ColorPicker(属"Windowless")，写此文仅为抛砖引玉，
还有许多功能强大的"For Delphi"的第三方控件的我们可以转化，
提醒一点，并不是所有的VCL组件都能转成ActiveX,如Delphi的通用对话对话框。
现在我们可以制作自己的ActiveX控件而不受限制了，最大的优点在于：
强大&免费!现在，你也能利用自己导出的ActiveX控件用VB写出漂亮的程序来了，
而且不用担心注册号之类的困绕！
谢谢jinjazz，但是你的帖子不能解决我的问题