很急的问题,关于TCollection,不惜分数请教 (200分)

  • 主题发起人 主题发起人 awing
  • 开始时间 开始时间
A

awing

Unregistered / Unconfirmed
GUEST, unregistred user!
下面这段代码是我在大富翁上看到的,可用,一点问题也没有。现在我想有个类似
DataModule的界面,所以我将注明为“关键的地方”改为
TMyComponent = class(TDataModule)
并注册为模版,当我在设计的时候选中这个模版,点击属性Items调出Collection Editor
新增Item,并为Item的属性赋值等等都没有问题
但是我将程序编译后我的实例.Items.Count无论我在设计期间添加了多少个Item都是为0;
而如果是运行期间通过Items.Add的,Count则会增加。不知道到底哪里不对

我的目的是要为DataModule增加一个属性为Items,在设计期可以调出Collection Editor
来新增Item,运行的时候通过Item来访问这些Item

unit Collec1;

interface

// Note: TCollection and TCollectionItem are defined in Classes.Pas.

uses Classes;

type

TMyComponent = class;

TMyCollectionItem = class(TCollectionItem)
private
FText: string;
FMoreStuff: LongInt;
function GetDisplayName: string; override;
procedure SetText(const Value: string);
procedure SetMoreStuff(const Value: LongInt);
public
published
property Text: string read FText write SetText;
property MoreStuff: LongInt read FMoreStuff write SetMoreStuff;
end;

TMyCollection = class(TCollection)
private
FMyComponent: TMyComponent;
function GetItem(Index: Integer): TMyCollectionItem;
procedure SetItem(Index: Integer; Value: TMyCollectionItem);
protected
function GetOwner: TPersistent; override;
public
constructor Create(MyComponent: TMyComponent);
function Add: TMyCollectionItem;
property Items[Index: Integer]: TMyCollectionItem
read GetItem write SetItem; default;
end;

TMyComponent = class(TComponent)//关键的地方
private
FItems: TMyCollection;
procedure SetItems(Value: TMyCollection);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Items: TMyCollection read FItems write SetItems;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Sample', [TMyComponent]);
end;


{ TMyCollectionItem }


// Note: Inherited default behavior of GetDisplayName is to
// return the classname.

function TMyCollectionItem.GetDisplayName: string;
begin
Result := Text;
if Result = '' then Result := inherited GetDisplayName;
end;

procedure TMyCollectionItem.SetText(const Value: string);
begin
if FText <> Value then
FText := Value;
end;

procedure TMyCollectionItem.SetMoreStuff(const Value: LongInt);
begin
if FMoreStuff <> Value then
FMoreStuff:= Value;
end;


{ TMyCollection }

constructor TMyCollection.Create(MyComponent: TMyComponent);
begin
inherited Create(TMyCollectionItem);
FMyComponent := MyComponent;
end;

function TMyCollection.Add: TMyCollectionItem;
begin
Result := TMyCollectionItem(inherited Add);
end;

function TMyCollection.GetItem(Index: Integer): TMyCollectionItem;
begin
Result := TMyCollectionItem(inherited GetItem(Index));
end;

procedure TMyCollection.SetItem(Index: Integer;
Value: TMyCollectionItem);
begin
inherited SetItem(Index, Value);
end;

// Note: You must override GetOwner in Delphi 3.x to get
// correct streaming behavior.
function TMyCollection.GetOwner: TPersistent;
begin
Result := FMyComponent;
end;


{ TMyComponent }

constructor TMyComponent.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FItems := TMyCollection.Create(Self);
end;

destructor TMyComponent.Destroy;
begin
FItems.Free;
inherited Destroy;
end;

procedure TMyComponent.SetItems(Value: TMyCollection);
begin
FItems.Assign(Value);
end;

end.
 
是不是这里的问题:
procedure TMyComponent.SetItems(Value: TMyCollection);
begin
[red] FItems.Assign(Value);[/red]
end;
改为:
FItems.add;
FItems.Assign(Value);
 
To:Windbell
我试了一下,问题一样还是存在
 
你的代码太长,没时间看了,给你下面的代码仅供参考
{*******************************************************}
{ }
{ 编码类 }
{ 作者:antic_ant }
{ }
{ 日期:2002.10.29 }
{ 软件系统中所有编码的实现 }
{ }
{ }
{*******************************************************}
unit Code;

interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, CheckLst,ADODB, ComCtrls,DBTables ;

type

TCustomCode=class;

TCodeItem = class (TCollectionItem)
private

FLength: Integer;
FCaption: string;

public
constructor Create(collection:TCollection);override;
destructor Destroy; override;
published
property Length: Integer read FLength write FLength;
property Caption: string read FCaption write FCaption;
end;


TCodeItems = class(TCollection)
private
FCode: TCustomCode;
function GetItem(index:integer):TCodeItem;
procedure SetItem(index:integer;Value:TCodeItem);
public
constructor Create(Code:TCustomCode);
destructor Destroy; override;
function Add: TCodeItem;
property Items[index:integer]: TCodeItem read GetItem write SetItem;default;
end;

TCustomCode = class(TComponent)
private
FLength:integer;
FCodeItems: TCodeItems;
FTableName: string;
FField: string;
FFieldName: string;
procedure SetField(value:string);

public

constructor Create(AOwner:TComponent);override;
destructor Destroy; override;

published
property FieldName: string read FField write SetField;
property CodeItems: TCodeItems read FCodeItems write FCodeItems;
property TableName: string read FTableName write FTableName;
property Length :integer read FLength write FLength;

end;


TADOCode = class(TCustomCode)
private
FSql_Str:TStrings;
FConnectObj:TADOConnection;
procedure SetSql_Str(value:TStrings);
procedure SetConnect(value: TADOConnection);
public
FQry:Tadoquery;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Save;
published
property ConnectObj:TADOConnection read FConnectObj write SetConnect;
property Sql:TStrings read FSql_Str write FSql_Str;
end;

TBDECode = class(TCustomCode)
private
FSql_Str:TStrings;
FDataBase:TDataBase;
procedure SetSql_Str(value:TStrings);
procedure SetDataBase(value: TDataBase);
public
FQry:TQuery;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Save;
published
property DataBase:TDataBase read FDataBase write SetDataBase;
property Sql:TStrings read FSql_Str write FSql_Str;
end;


procedure Register;

implementation

procedure Register;
begin
RegisterComponents('syz_component', [TADOCode,TBDECode]);
end;


{ TADOCode }

constructor TADOCode.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FSql_Str := TStringList.Create;
end;

destructor TADOCode.Destroy;
begin
FSql_Str.Free;
inherited;
end;

procedure TADOCode.Save;
begin
try
FQry:=TAdoQuery.Create(nil);
FQry.Connection:=FConnectObj;
if FSql_Str.Count<=0 then
begin
MessageDlg('请先设置Sql属性!', mtInformation, [mbOk], 0);
exit;
end;
FQry.SQL:=FSql_Str;
FQry.ExecSQL;
FQry.Free;
except
MessageDlg('更新失败!', mtError, [mbOk], 0);
FQry.Free;
end;
end;

procedure TADOCode.SetConnect(value: TADOConnection);
begin
if Value<>FConnectObj then
begin
FConnectObj := Value;
end;
end;



procedure TADOCode.SetSql_Str(value: TStrings);
begin
FSql_Str.Assign(value);
end;

{ TCodeItem }

constructor TCodeItem.Create(collection: TCollection);
begin
inherited create(Collection);

end;

destructor TCodeItem.Destroy;
begin

inherited;
end;

{ TCodeItems }

function TCodeItems.Add: TCodeItem;
begin
Result:=TCodeItem(inherited Add)
end;

constructor TCodeItems.Create(Code: TCustomCode);
begin
inherited create(TCodeItem);
FCode:=Code;
end;

destructor TCodeItems.Destroy;
begin

inherited;
end;

function TCodeItems.GetItem(index: integer): TCodeItem;
begin
Result:=TCodeItem(inherited GetItem(index));
end;

procedure TCodeItems.SetItem(index: integer; Value: TCodeItem);
begin
inherited SetItem(index,value);
end;

{ TCustomCode }

constructor TCustomCode.Create(AOwner: TComponent);
begin
inherited create(AOwner);
FCodeItems:=TCodeItems.Create(self);

end;

destructor TCustomCode.Destroy;
begin
FCodeItems.Free;
inherited;
end;

procedure TCustomCode.SetField(value: string);
begin
FField:=Value;
end;

{ TBDECode }

constructor TBDECode.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FSql_Str := TStringList.Create;
end;

destructor TBDECode.Destroy;
begin
FSql_Str.Free;
inherited;
end;

procedure TBDECode.Save;
begin
try
FQry:=TQuery.Create(nil);
FQry.Database.Assign(FDatabase) ;
if FSql_Str.Count<=0 then
begin
MessageDlg('请先设置Sql属性!', mtInformation, [mbOk], 0);
exit;
end;
FQry.SQL:=FSql_Str;
FQry.ExecSQL;
FQry.Free;
except
MessageDlg('更新失败!', mtError, [mbOk], 0);
FQry.Free;
end;
end;

procedure TBDECode.SetDataBase(value: TDataBase);
begin
if Value<>FDataBase then
begin
FDataBase := Value;
end;
end;

procedure TBDECode.SetSql_Str(value: TStrings);
begin
FSql_Str.Assign(value);
end;

end.
 
谢谢,但是我希望继承的是TDataModule而不是继承TComponent,如果我继承的是TDataModule
运行时在Create的时候出错,如果是继承TComponent编写成一个控件则没有问题,我是想
把写的类作为模版集成到IDE中。
 
好像没有那里不对,我用你的代码试过,不论设计期间还是运行期间增加都是正确的。
是不是你在show出count的时候代码写错了。
 
问题我自己解决了,分数还是送给大家吧
 
后退
顶部