还是关于控件的升级的问题(from D3 to D5)(100分)

在不久前我提过上面的问题但是已经结束了讨论。(实际上问题本没有解决，本着认真的
态度，现在我将原程序提供).
问题是:动态创建没有问题(D3,D5),在D3下注册没有问题.但是在D5下面不能成功
注册!
-------------------------------------------------------------------------------

unit rptmxctl;


interface

uses Messages, Windows, SysUtils, CommCtrl, Classes, Controls, Forms,
Menus, Graphics, StdCtrls;

type
Trptmxctrl = class;
Tcol = class(TCollectionItem)
private
Ftitle: string;
FWidth: Integer;
FAlignment: TAlignment;
Factive:boolean;
Ffield:string;
Fissum:boolean;//是否合计项
Fispasum:boolean;//是否打印合计
Fsumdec:integer;//小计与合计小数点位数
function GetDisplayName: string; override;
procedure SetAlignment(Value: TAlignment);
procedure Settitle(const Value: string);
procedure SetWidth(Value: Integer);
procedure setactive(value:boolean);
procedure setfield(value:string);
procedure setissum(value:boolean);
procedure setispasum(value:boolean);
procedure setsumdec(value:integer);
public
constructor Create(Collection: TCollection); override;
procedure Assign(Source: TPersistent); override;
published
property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
property title: string read Ftitle write Settitle;
property field:string read ffield write setfield;
property Width: Integer read FWidth write SetWidth;
property active:boolean read factive write setactive;
property issum:boolean read Fissum write setissum;
property ispasum:boolean read Fispasum write setispasum;
property sumdec:integer read fsumdec write setsumdec;
end;

Tcols = class(TCollection)
private
Frptmxctrl: Trptmxctrl;
function GetItem(Index: Integer): Tcol;
procedure SetItem(Index: Integer; Value: Tcol);
protected
function GetOwner: TPersistent; override;
public
constructor Create(rptmxctrl: Trptmxctrl);
function Add: Tcol;
property Items[Index: Integer]: Tcol read GetItem write SetItem; default;
end;
//报表标题项定义
Tmxbtnode=class(TCollectionItem)
private
Fbtbh:string;
Fbtcap:string;
Ffldname:string;
Ffldwidth:integer;//包括打印的间隔horigap
Fbtlevel:integer;//标题行从0开始
Fbtalign:string;
Fbtprblan:boolean;
procedure setbtbh(value:string);
procedure setbtcap(value:string);
procedure setfldname(value:string);
procedure setfldwidth(value:integer);
procedure setbtlevel(value:integer);
procedure setbtalign(value:string);
procedure setbtprblan(value:boolean);
protected
public
constructor create(collection:Tcollection);override;
procedure assign(Source:TPersistent);override;
published
property btbh:string read Fbtbh write setbtbh;
property btcap:string read Fbtcap write setbtcap;
property fldname:string read Ffldname write setfldname;
property fldwidth:integer read Ffldwidth write setfldwidth;
property btlevel:integer read Fbtlevel write setbtlevel;
property btalign:string read fbtalign write setbtalign;
property btprblan:boolean read Fbtprblan write setbtprblan;
end;
//报表标题列表定义
Tmxbtlist=class(Tcollection)
Frptmxctrl: Trptmxctrl;
function GetItem(Index: Integer): Tmxbtnode;
procedure SetItem(Index: Integer; Value: Tmxbtnode);
protected
function GetOwner: TPersistent; override;
public
constructor Create(rptmxctrl: Trptmxctrl);
function Add:Tmxbtnode;
property Items[Index: Integer]: Tmxbtnode read GetItem write SetItem; default;
end;
//报表明细定义
Trptmxctrl = class(TCustomControl)
private
Fhorigap:integer;
Fvertgap:integer;
Flines:integer;
Fgdfont:tfont;
Ffldlist: Tcols; //报表明细字段列表
Fmxbtlist:Tmxbtlist;//报表标题列表
Fmxbtrows:integer;//报表明细标题行数
Fisprxj:boolean;
Fisprhj:boolean;
Fisprxh:boolean;
vertlines:array [0..100] of integer;
procedure sethorigap(value:integer);
procedure setvertgap(value:integer);
procedure setlines(value:integer);
procedure setfldlist(value:tcols);
procedure setmxbtlist(value:Tmxbtlist);
procedure setgdfont(value:tfont);
procedure setmxbtrows(value:integer);
procedure setisprxj(value:boolean);
procedure setisprhj(value:boolean);
procedure setisprxh(value:boolean);
function calwidth:integer;
function calheight(isbt:boolean):integer;
{画明细标题部分}
procedure drawheader;
{画横线}
procedure drawhline;
{画竖线}
procedure drawvline;
{标题打印方式及位置}
function setpralign(align:string; left, right:longint):longint;
protected
public
procedure paint;override;
constructor Create(Aowner:Tcomponent); override;
destructor Destroy; override;
published
property horigap:integer read Fhorigap write sethorigap;
property vertgap:integer read Fvertgap write setvertgap;
property lines:integer read Flines write setlines;
property fldlist:Tcols read Ffldlist write Setfldlist;
property mxbtlist:Tmxbtlist read Fmxbtlist write setmxbtlist;
property gdfont:tfont read Fgdfont write setgdfont;
property mxbtrows:integer read Fmxbtrows write setmxbtrows;
property isprxj:boolean read Fisprxj write setisprxj;
property isprhj:boolean read Fisprhj write setisprhj;
property isprxh:boolean read fisprxh write setisprxh;
property font;
property color;
property visible;
end;
procedure register;
implementation
{ Tcol }

constructor Tcol.Create(Collection: TCollection);
begin
FWidth := 50;
inherited Create(Collection);
end;

procedure Tcol.Assign(Source: TPersistent);
begin
if Source is Tcol then
begin
title := Tcol(Source).Title;
Width := Tcol(Source).Width;
Alignment := Tcol(Source).Alignment;
active:=Tcol(source).active;
field:=Tcol(source).field;
issum:=Tcol(source).issum;
ispasum:=Tcol(source).ispasum;
sumdec:=Tcol(source).sumdec;
Exit;
end;
inherited Assign(Source);
end;

function Tcol.GetDisplayName: string;
begin
Result := title;
if Result = '' then Result := inherited GetDisplayName;
end;

procedure Tcol.SetAlignment(Value: TAlignment);
begin
if FAlignment <> Value then
begin
FAlignment := Value;
end;
end;
procedure Tcol.Settitle(const Value: string);
begin
if FTitle <> Value then
begin
FTitle := Value;
end;
end;

procedure Tcol.SetWidth(Value: Integer);
begin
if FWidth <> Value then
begin
FWidth := Value;
end;
end;
procedure Tcol.setactive(value:boolean);
begin
if factive<>value then
begin
factive:=value;
end;
end;
procedure Tcol.setfield(value:string);
begin
if ffield<>value then
begin
ffield:=value;
end;
end;
procedure Tcol.setissum(value:boolean);
begin
if Fissum<>value then
begin
Fissum:=value;
end;
end;
procedure Tcol.setispasum(value:boolean);
begin
if Fispasum<>value then
begin
Fispasum:=value;
end;
end;
procedure Tcol.setsumdec(value:integer);
begin
if fsumdec<>value then fsumdec:=value;
end;

{ Tcols }

constructor Tcols.Create(rptmxctrl: Trptmxctrl);
begin
inherited Create(Tcol);
Frptmxctrl := rptmxctrl;
end;

function Tcols.Add: Tcol;
begin
Result := Tcol(inherited Add);
end;

function Tcols.GetItem(Index: Integer): Tcol;
begin
Result := Tcol(inherited GetItem(Index));
end;

function Tcols.GetOwner: TPersistent;
begin
Result := Frptmxctrl;
end;

procedure Tcols.SetItem(Index: Integer; Value: Tcol);
begin
inherited SetItem(Index, Value);
end;


{ Trptmxctrl }

constructor Trptmxctrl.Create(AOwner: TComponent);
begin
inherited create(aowner);
ffldlist:=Tcols.Create(self);
fmxbtlist:=Tmxbtlist.Create(self);
Fgdfont:=tfont.Create;
horigap:=5;
vertgap:=5;
lines:=10;
width:=200;
height:=100;
canvas.brush.Style:=bsclear;
canvas.Pen.Color:=clblack;
gdfont.Name:='宋体';
gdfont.Size:=9;
font.Name:='宋体';
font.Size:=9;
end;

destructor Trptmxctrl.Destroy;
begin
ffldlist.Free;
fmxbtlist.Free;
fgdfont.Free;
inherited Destroy;
end;
procedure Trptmxctrl.setfldlist(value:tcols);
begin
ffldlist.assign(value);
end;
procedure Trptmxctrl.setmxbtlist(value:Tmxbtlist);
begin
Fmxbtlist.Assign(value);
end;
procedure Trptmxctrl.setlines(value:integer);
begin
if Flines<>value then
begin
Flines:=value;
changed;
end;
end;
procedure Trptmxctrl.setgdfont(value:tfont);
begin
if assigned(value) then
begin
Fgdfont.assign(value);
changed;
end;
end;
procedure Trptmxctrl.sethorigap(value:integer);
begin
if Fhorigap<>value then Fhorigap:=value;
end;
procedure Trptmxctrl.setvertgap(value:integer);
begin
if Fvertgap<>value then Fvertgap:=value;
end;
procedure Trptmxctrl.setmxbtrows(value:integer);
begin
if Fmxbtrows<>value then fmxbtrows:=value;
end;
procedure Trptmxctrl.setisprxj(value:boolean);
begin
if Fisprxj<>value then Fisprxj:=value;
end;
procedure Trptmxctrl.setisprhj(value:boolean);
begin
if Fisprhj<>value then fisprhj:=value;
end;
procedure Trptmxctrl.setisprxh(value:boolean);
begin
if fisprxh<>value then fisprxh:=value;
end;

function Trptmxctrl.calwidth:integer;
var
totalwidth:integer;
i:integer;
begin
result:=width;
totalwidth:=0;
for i:=0 to fldlist.Count-1 do
begin
totalwidth:=totalwidth+fldlist.items.width+2*horigap;
end;
result:=totalwidth;
end;
function Trptmxctrl.calheight(isbt:boolean):integer;
var
btheight,mxheight:integer;
fontheight:integer;
i:integer;
begin
result:=height;
btheight:=0;
for i:=1 to mxbtrows do
begin
canvas.Font.assign(gdfont);
fontheight:=canvas.TextHeight('M');
btheight:=btheight+fontheight+2*vertgap;
end;
mxheight:=0;
canvas.Font.Assign(font);
fontheight:=canvas.TextHeight('M');
for i:=1 to lines do
begin
mxheight:=mxheight+fontheight+2*vertgap;
end;
if isprxj then
begin
mxheight:=mxheight+fontheight+2*vertgap;
end;
if isprhj then
begin
mxheight:=mxheight+fontheight+2*vertgap;
end;
if isbt then
begin
result:=btheight;
end else
begin
result:=mxheight+btheight;
end;
end;
{画明细标题部分}
procedure Trptmxctrl.drawheader;
procedure drawarow(x,y,abtlevel:integer);
{
x,y:为当前标题行的左上角坐标
btlevel:为标题级数,第一级标题为0;
}
var
i:integer;
tmpx:integer;
tmpbtwidth:integer;
arect:trect;
fontheight:integer;
tmpbtcap:string;
tmpalign:string;
prx:integer;//打印横坐标
begin
canvas.Font.assign(gdfont);
fontheight:=canvas.TextHeight('M');
tmpx:=x;
with mxbtlist do
begin
for i:=0 to Count-1 do
begin
if items.btlevel=abtlevel then
begin
if not items.btprblan then
begin
tmpbtcap:=items.btcap;
end else
begin
tmpbtcap:='';
end;
tmpalign:=items.btalign;
tmpbtwidth:=items.fldwidth;
arect.Left:=tmpx+horigap div 2;
arect.Top:=y+vertgap div 2;
arect.Right:=arect.Left+tmpbtwidth-horigap;
arect.Bottom:=arect.top+fontheight+vertgap div 2;
prx:=setpralign(tmpalign,arect.left,arect.Right);
canvas.pen.Width:=1;
canvas.textrect(arect,prx,arect.top,tmpbtcap);
if tmpx+tmpbtwidth<width-3 then
begin
canvas.MoveTo(tmpx+tmpbtwidth,y);
canvas.LineTo(tmpx+tmpbtwidth,y+fontheight+2*vertgap-1);
end;
tmpx:=tmpx+tmpbtwidth;
end;
end;
end;
end;
var
i:integer;
tmpx,tmpy:integer;
gdfontheight:integer;
mxrect:trect;
tmpwidth,tmpheight:integer;
prx:integer;
begin
//画自定义标题
canvas.Font.Assign(gdfont);
gdfontheight:=canvas.TextHeight('M');
tmpx:=1;
tmpy:=1;
if mxbtrows>=2 then
begin
for i:=0 to mxbtrows-2 do
begin
drawarow(tmpx,tmpy,i);
tmpy:=tmpy+gdfontheight+2*vertgap;
end;
end;
//画明细字段部分标题
tmpwidth:=1;
tmpheight:=tmpy;
for i:=0 to fldlist.count-1 do
begin
with canvas do
begin
vertlines:=tmpwidth+fldlist.items.width+2*horigap;
mxrect.Left:=tmpwidth+horigap div 2;
mxrect.Top:=tmpheight+vertgap div 2;
mxrect.Right:=mxrect.Left+fldlist.items.width+horigap div 2;
mxrect.Bottom:=mxrect.Top+gdfontheight+vertgap div 2;
//mxrect:=rect(tmpwidth,tmpheight,
// tmpwidth+fldlist.items.width,tmpheight+gdfontheight+2*vertgap);
prx:=setpralign('CENTER',mxrect.left,mxrect.right);
textrect(mxrect,prx,mxrect.top,fldlist.items.title);
end;
tmpwidth:=tmpwidth+fldlist.items.width+2*horigap;
end;
end;
{画横线}
procedure Trptmxctrl.drawhline;
var
i:integer;
fontheight:integer;
tmpheight:integer;
arect:trect;
prx:integer;
begin
with canvas do
begin
pen.Width:=1;
Font.Assign(gdfont);
fontheight:=TextHeight('M');
//画标题横线
//tmpheight:=0;
tmpheight:=2*vertgap+fontheight;
for i:=1 to mxbtrows-1 do
begin
moveto(1,tmpheight);
lineto(width-1,tmpheight);
tmpheight:=tmpheight+2*vertgap+fontheight;
end;
//tmpheight:=tmpheight+2*vertgap+fontheight;
Font.Assign(self.font);
fontheight:=TextHeight('M');
for i:=1 to lines do
begin
moveto(1,tmpheight);
lineto(width-1,tmpheight);
tmpheight:=tmpheight+2*vertgap+fontheight;
end;
if isprxj then
begin
moveto(1,tmpheight);
lineto(width-1,tmpheight);
arect.left:=1+horigap div 2;
arect.Top:=tmpheight+vertgap div 2;
arect.Right:=arect.Left+fldlist.Items[0].width+horigap div 2;
arect.Bottom:=arect.Top+fontheight+vertgap div 2;
prx:=setpralign('CENTER',arect.left,arect.right);
textrect(arect,prx,arect.top,'小计');
end;
if isprhj then
begin
tmpheight:=tmpheight+2*vertgap+fontheight;
moveto(1,tmpheight);
lineto(width-1,tmpheight);
arect.left:=1+horigap div 2;
arect.Top:=tmpheight+vertgap div 2;
arect.Right:=arect.Left+fldlist.Items[0].width+horigap div 2;
arect.Bottom:=arect.Top+fontheight+vertgap div 2;
prx:=setpralign('CENTER',arect.left,arect.right);
textrect(arect,prx,arect.top,'合计');
end;
end;
end;
{画竖线}
procedure Trptmxctrl.drawvline;
var
i:integer;
btheight:integer;
fontheight:integer;
begin
canvas.font.Assign(gdfont);
fontheight:=canvas.textheight('M');
if mxbtlist.Count>=2 then
begin
btheight:=calheight(true);
btheight:=btheight-fontheight-2*vertgap;
end else
begin
btheight:=1;
end;
canvas.font.Assign(font);
with canvas do
begin
for i:=0 to fldlist.count-2 do
begin
moveto(vertlines,btheight);
lineto(vertlines,height-1);
end;
end;
end;
{标题打印方式及位置}
function Trptmxctrl.setpralign(align:string; left, right:longint):longint;
var
posx: longint;
begin
posx := 0;
with canvas do
begin
if align='LEFT' then
begin
settextalign(handle, ta_left);
posx := left ;
end else
if align='RIGHT' then
begin
settextalign(handle, ta_right);
posx := right;
end else
if align='CENTER' then
begin
settextalign(handle, ta_center);
posx := left + round((right - left) / 2);
end;
end;
result:= posx;
end;

procedure Trptmxctrl.paint;
var
arect:trect;
begin
inherited;
if fldlist.Count>0 then
begin
width:=calwidth;
height:=calheight(false);
arect:=ClientRect;
arect.Left:=arect.Left+1;
arect.Top:=arect.Top+1;
arect.Right:=arect.Right-1;
arect.Bottom:=arect.Bottom-1;
canvas.pen.Width:=2;
canvas.Rectangle(arect.left,arect.top,arect.Right,arect.Bottom);
//
drawheader;
drawhline;
drawvline;
end else
begin
canvas.Font.Size:=20;
canvas.TextOut(10,10,'报表明细部分定义');
end;
end;
{Tmxbtnode}
constructor Tmxbtnode.create(collection:Tcollection);
begin
inherited create(collection);
end;
procedure Tmxbtnode.Assign(Source: TPersistent);
begin
if Source is Tmxbtnode then
begin
btbh:= Tmxbtnode(Source).btbh;
btcap:= Tmxbtnode(Source).btcap;
fldname:= Tmxbtnode(Source).fldname;
Exit;
end;
inherited Assign(Source);
end;
procedure Tmxbtnode.setbtbh(value:string);
begin
if fbtbh<>value then Fbtbh:=value;
end;
procedure Tmxbtnode.setbtcap(value:string);
begin
if fbtcap<>value then fbtcap:=value;
end;
procedure Tmxbtnode.setfldname(value:string);
begin
if ffldname<>value then Ffldname:=value;
end;
procedure Tmxbtnode.setfldwidth(value:integer);
begin
if Ffldwidth<>value then ffldwidth:=value;
end;
procedure Tmxbtnode.setbtlevel(value:integer);
begin
if fbtlevel<>value then fbtlevel:=value;
end;
procedure Tmxbtnode.setbtalign(value:string);
begin
if fbtalign<>value then fbtalign:=value;
end;
procedure Tmxbtnode.setbtprblan(value:boolean);
begin
if Fbtprblan<>value then fbtprblan:=value;
end;

{Tmxbtlist}
constructor Tmxbtlist.Create(rptmxctrl: Trptmxctrl);
begin
inherited Create(Tmxbtnode);
Frptmxctrl := rptmxctrl;
end;

function Tmxbtlist.Add: Tmxbtnode;
begin
Result := Tmxbtnode(inherited Add);
end;

function Tmxbtlist.GetItem(Index: Integer): Tmxbtnode;
begin
Result := Tmxbtnode(inherited GetItem(Index));
end;

function Tmxbtlist.GetOwner: TPersistent;
begin
Result := Frptmxctrl;
end;

procedure Tmxbtlist.SetItem(Index: Integer; Value: Tmxbtnode);
begin
inherited SetItem(Index, Value);
end;

procedure Register;
begin
RegisterComponents('rpttool',[Trptmxctrl]);
end;


end.

上次帖子是我结束的！本着认真的态度，一个半月前你就应该贴上代码了！

估计他出差了

对不起朋友们：
前阵开发项目太紧张，没有时间。再次向朋友们致歉！

colorstone:如果还想接着讨论请定期提前自己的帖子，如果不想继续讨论请结束帖子。

colorstone:如果还想接着讨论请定期提前自己的帖子，如果不想继续讨论请结束帖子。

来自：wjiachun 时间：00-10-25 13:00:37 ID:375731
上次帖子是我结束的！本着认真的态度，一个半月前你就应该贴上代码了！


你好意思说自己“本着认真的态度”？？？出差？？2月份你还进来过，不过没有自觉提前！