Komponente mit dynamischem Array und PropertyEditor

[Sora]

Hallo liebe Delphi-Praxis-Gemeinde,

ich bin neu und hoffe, dass ich das Thema im richtigen Subforum erstelle.

Ich möchte eine Komponente vom Typ tWorld schreiben, die auf die Form im Entwicklungsmodus gezogen werden kann. Diese World soll ein Unterobjekt list vom Typ tComponentList besitzen, wobei tMyComps eine Klasse aus TComponent ist und als Eigenschaft ein dynamisches Array + Zugriffsroutinen enthält. Dieses dynamische Array hat als Feldtyp tComp, ebenfalls aus TComponent mit Id und Name.

Mein Ziel ist es einen PropertyEditor für TComponentList zu schreiben, sodass alle Unterkomponenten ebenfalls gespeichert werden. Das möchte ich vlt. über TFileStream.WriteComponentRes realisieren. Im Editor sollen dann über Buttons (Add, Remove) und eine ComboBox die Unterkomponenten verwaltet werden. Es wäre auch schön, wenn die Unterkomponenten vom Typ tComp als Subkomponenten der World in der Objekt-Hierarchie angezeigt würden. Ich weiß aber nicht, wie das geht. Ich wäre dankbar, wenn mir auch hier geholfen werden könnte.

Leider habe ich ein Problem:

Nachdem ich die Unit UWorld in dclusr70.bpl kompiliert habe und nun meine World-Komponente auf das Formular ziehen will, kommt eine Fehlermeldung à la Zugriffsverletzung bei Adresse 510069D0 in Modul 'dclusr70.bpl'. Lesen von Adresse 00000000.

Ich hoffe, dass ihr mir helfen könnt. Wahrscheinlich bin ich nur unsagbar blöd.

Meine Quelltexte:

UWorld:

Delphi-Quellcode:

unit UWorld;

interface

uses
  SysUtils, Classes, UDataTypes;

type
  TWorld = class(TComponent)
  private
  protected
    { Protected-Deklarationen }
  public
    list: tComponentList;
    constructor Create(AOwner: TComponent); override;
  published
    { Published-Deklarationen }
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Beispiele', [TWorld]);
end;

constructor TWorld.Create(AOwner: TComponent);
begin
  inherited;
  Self.list.Create(Self);
end;

end.

UDataTypes:

Delphi-Quellcode:

unit UDataTypes;

interface
uses Classes;

type
  tComp = class(TComponent)
    private
      Id: word;
      Name: String;
    public
      constructor Create(anId: word; aName: String); overload;
  end;

  tComponentList = class(TComponent)
    private
      MyComps: array of tComp;
      function IssetComp(CompId : Word) : BOOLEAN;
    public
      function GetCompById(CompId : WORD) : tComp;
      function GetCompByName(CompName : String) : tComp;
      procedure AddComp(AComp : tComp);
      procedure DelComp(CompId : WORD);
      function CompCount: integer;
  end;

implementation

{##############################################################################}
{############################ tMyComp-Routinen ################################}
{##############################################################################}

constructor tComp.Create(anId: word; aName: String);
begin
  Self.ID:=anId;
  Self.Name:=aName;
end;

{##############################################################################}
{########################### tComponentList-Routinen ##########################}
{##############################################################################}

procedure TComponentList.AddComp(AComp: tComp);
begin
  SetLength(Self.MyComps,Length(Self.MyComps)+1);
  MyComps[High(MyComps)]:=AComp;
  Self.Owner.InsertComponent(AComp);
end;

procedure TComponentList.DelComp(CompId: word);
var i: integer;
begin
  Self.Owner.RemoveComponent(Self.GetCompById(CompId));
  for i:=CompId to CompCount-2 do
  begin
    Self.MyComps[i].Free;
    Self.MyComps[i]:=tComp.Create(Self.GetCompById(i+1).Id,Self.GetCompById(i+1).Name);
  end;
  Self.MyComps[CompCount-1].Free;
  SetLength(Self.MyComps,CompCount-1);
end;

function TComponentList.IssetComp(CompId: word): Boolean;
var
  i : word;
  tmpBool : boolean;
BEGIN
  tmpBool:=false;
  if(Self.CompCount <> 0) THEN
  Begin
    i := 0;
    repeat
      if(Self.MyComps[i].Id = CompId) THEN tmpBool:=TRUE;
      inc(i);
    until ((i>=Self.CompCount-1) OR (tmpBool = TRUE));
   End;

  IssetComp:=tmpBool;
END;

function TComponentList.CompCount: Integer;
begin
  Result:=Length(Self.MyComps);
end;

function TComponentList.GetCompById(CompId: word): tComp;
begin
  if( IssetComp(CompId) ) THEN
    GetCompById:=Self.MyComps[CompId]
  else
    GetCompById:=nil;
end;

function TComponentList.GetCompByName(CompName: String): tComp;
VAR
  i : WORD;
  tmpBool : BOOLEAN;
  tmpComp: tComp;
BEGIN
  tmpBool:=FALSE;
  tmpComp:=nil;
  if(Self.CompCount <> 0) THEN
  Begin
    i := 0;
    repeat
      if(Self.MyComps[i].Name = CompName) THEN
      Begin
        tmpBool:=TRUE;
        tmpComp := Self.MyComps[i];
      End
      else tmpComp := nil;
      inc(i);
    until ((i>=CompCount-1) OR (tmpBool = TRUE));
   End;
   GetCompByName:=tmpComp;
END;

end.

Liebe Grüße,

Sora

[Christian Seehase]

Moin Sora,

erst einmal herzlich willkommen hier in der Delphi-PRAXiS.

Ich hab' mir jetzt nicht den ganzen Code durchgelesen, aber das hier

Delphi-Quellcode:

constructor TWorld.Create(AOwner: TComponent);
begin
  inherited;
  Self.list.Create(Self); // <== die Zeile meine ich
end;

muss schiefgehen. Probier's mal so:

Delphi-Quellcode:

constructor TWorld.Create(AOwner: TComponent);
begin
  inherited;
  Self.list := TComponentList.Create(Self);
end;

[mkinzler]

Und das Self kannst du auch weglassen

[Sir Rufo]

Sollte die Klasse nicht besser so deklariert werden:

Delphi-Quellcode:

unit UWorld;

interface

uses
  SysUtils, Classes, UDataTypes;

type
  TWorld = class(TComponent)
  private
    FList : TComponentList;
  protected
    { Protected-Deklarationen }
  public
    property list: tComponentList read FList;
    constructor Create(AOwner: TComponent); override;
  published
    { Published-Deklarationen }
  end;

Denn ansonsten kann man mit TWorld(foo).list := Nil; ein schönes Speicherleck produzieren.

[Sora]

Vielen Dank für die schnelle Antwort!

Ich habe diesen dummen (und er ist wirklich dumm, aber ich hab ihn nicht gefunden...) Fehler beseitigt und noch Getter- und Setter-Methoden für tComp und einen Add- und einen Delete-Button auf der Form eingeführt. Adden funktioniert zwar, beim Löschen kommt aber eine Zugriffsverletzung, deren Grund ich nicht verstehe.

UMainform:

Delphi-Quellcode:

unit UMainform;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, UWorld, StdCtrls, UDatatypes;

type
  TForm1 = class(TForm)
    ButtonAdd: TButton;
    ButtonDelete: TButton;
    LabelCount: TLabel;
    World1: TWorld;
    procedure ButtonAddClick(Sender: TObject);
    procedure ButtonDeleteClick(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.ButtonAddClick(Sender: TObject);
begin
  World1.List.AddComp(tComp.Create(0,''));
  LabelCount.Caption:=inttostr(World1.List.CompCount);
end;

procedure TForm1.ButtonDeleteClick(Sender: TObject);
begin
  World1.List.DelComp(0);
  LabelCount.Caption:=inttostr(World1.List.CompCount);
end;

end.

UDataTypes:

Delphi-Quellcode:

unit UDataTypes;

interface
uses Classes;

type
  tComp = class(TComponent)
    private
      Id: word;
      Name: String;
    public
      function GetId: Word;
      procedure SetId(Value: Word);
      function GetName: String;
      procedure SetName(Value: String);
      constructor Create(anId: word; aName: String); overload;
  end;

  tComponentList = class(TComponent)
    private
      MyComps: array of tComp;
      function IssetComp(CompId : Word) : BOOLEAN;
    public
      function GetCompById(CompId : WORD) : tComp;
      function GetCompByName(CompName : String) : tComp;
      procedure AddComp(AComp : tComp);
      procedure DelComp(CompId : WORD);
      function CompCount: integer;
  end;

implementation

{##############################################################################}
{############################ tMyComp-Routinen ################################}
{##############################################################################}

constructor tComp.Create(anId: word; aName: String);
begin
  Self.SetId(anId);
  Self.SetName(aName);
end;

function tComp.GetId: Word;
begin
  GetId:=Self.Id;
end;

procedure tComp.SetId(Value: Word);
begin
  Self.Id:=Value;
end;

function tComp.GetName: String;
begin
  GetName:=Self.Name;
end;

procedure tComp.SetName(Value: String);
begin
  Self.Name:=Value;
end;

{##############################################################################}
{########################### tComponentList-Routinen ##########################}
{##############################################################################}

procedure TComponentList.AddComp(AComp: tComp);
begin
  SetLength(Self.MyComps,Length(Self.MyComps)+1);
  MyComps[High(MyComps)]:=AComp;
  Self.Owner.InsertComponent(AComp);
end;

procedure TComponentList.DelComp(CompId: word);
var i: integer;
begin
  if (IssetComp(CompId)) then
  begin
    Self.Owner.RemoveComponent(Self.GetCompById(CompId));
    for i:=CompId to CompCount-2 do
    begin
      Self.MyComps[i].Free;
      Self.MyComps[i]:=tComp.Create(Self.GetCompById(i+1).GetId,Self.GetCompById(i+1).GetName);
    end;
    Self.MyComps[CompCount-1].Free;
    SetLength(Self.MyComps,CompCount-1);
  end;
end;

function TComponentList.IssetComp(CompId: word): Boolean;
var
  i : word;
  tmpBool : boolean;
BEGIN
  tmpBool:=false;
  if(Self.CompCount <> 0) THEN
  Begin
    i := 0;
    repeat
      if(Self.MyComps[i].GetId = CompId) THEN tmpBool:=TRUE;
      inc(i);
    until ((i>=Self.CompCount-1) OR (tmpBool = TRUE));
   End;

  IssetComp:=tmpBool;
END;

function TComponentList.CompCount: Integer;
begin
  Result:=Length(Self.MyComps);
end;

function TComponentList.GetCompById(CompId: word): tComp;
begin
  if( IssetComp(CompId) ) THEN
    GetCompById:=Self.MyComps[CompId]
  else
    GetCompById:=nil;
end;

function TComponentList.GetCompByName(CompName: String): tComp;
VAR
  i : WORD;
  tmpBool : BOOLEAN;
  tmpComp: tComp;
BEGIN
  tmpBool:=FALSE;
  tmpComp:=nil;
  if(Self.CompCount <> 0) THEN
  Begin
    i := 0;
    repeat
      if(Self.MyComps[i].GetName = CompName) THEN
      Begin
        tmpBool:=TRUE;
        tmpComp := Self.MyComps[i];
      End
      else tmpComp := nil;
      inc(i);
    until ((i>=CompCount-1) OR (tmpBool = TRUE));
   End;
   GetCompByName:=tmpComp;
END;

end.

UWorld:

Delphi-Quellcode:

unit UWorld;

interface

uses
  SysUtils, Classes, UDataTypes;

type
  TWorld = class(TComponent)
  private
    FList: tComponentList;
  protected
    { Protected-Deklarationen }
  public
    property List: tComponentList read FList write FList;
    constructor Create(AOwner: TComponent); override;
  published
    { Published-Deklarationen }
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Beispiele', [TWorld]);
end;

constructor TWorld.Create(AOwner: TComponent);
begin
  inherited;
  List:=tComponentList.Create(Self);
end;

end.

Ich hoffe, dass ihr mir hier noch mal helft.

Liebe Grüße,

Sora

[mkinzler]

In welcher Zeile?

[Sora]

Der Fehler kommt bei GetName.

Liebe Grüße

EDIT:

Ich habe das Problem jetzt selbst gelöst. Beim Löschen habe ich aus

Delphi-Quellcode:

Self.MyComps[i].Free;
Self.MyComps[i]:=tComp.Create(Self.GetCompById(i+1).GetId,Self.GetCompById(i+1).GetName);

Delphi-Quellcode:

if IssetComp(i+1)
then
begin
  Self.MyComps[i].Free;
  Self.MyComps[i]:=tComp.Create(i,Self.GetCompById(i+1).GetNameValue);
end;

gemacht.

Liebe Grüße

[Sora]

Zwar ist das Problem gelöst, aber nun möchte ich einen Property-Editor für die Komponentenliste schreiben.
Sobald die Edit-Prozedur aufgerufen wird, kommt aber eine Fehlermeldung, eine erneute Zugriffsverletzung:

Delphi-Quellcode:

FUNCTION tCompListProperty.GetAttributes: TPropertyAttributes;
BEGIN
  GetAttributes := [paDialog, paRevertable];
END;

PROCEDURE tCompListProperty.Edit;
var Stream: TMemoryStream;
    ol: tComponentList;
    Dlg: TCompListDialog;
begin
  inherited;
  Stream:=TMemoryStream.Create;

  //Stream:=TMemoryStream(GetValue);
  //Stream.ReadComponentRes(ol);

  showMessage('');
  Dlg:=TCompListDialog.Create(Application);
  try
    showMessage('');
    Dlg.World:=tWorld(GetComponent(0));
    showMessage('');
    Dlg.ShowModal;
  finally
    showMessage('');
    If Dlg.Res=false
    then Revert;
    showMessage('');
    Dlg.Release;
  end;


  Stream.Clear;
  //Stream.WriteComponentRes(ol.Name, ol);
  //SetStrValue(String(Stream));
  Stream.Free;
  modified;
END;

FUNCTION tCompListProperty.GetValue: String;
BEGIN
  result:=GetStrValue;
END;

PROCEDURE tCompListProperty.SetValue(const Value: String);
BEGIN
  SetStrValue(Value);
END;

Zur Erklärung:

Der Stream soll später den Wert der als Eigenschaftswert für die CompList in der Welt gespeichert ist lesen und per ReadComponentRes in die Komponente umwandeln und umgekehrt mittels WriteComponentRes. Die showMessages dienen der Abgrenzung der einzelnen Anweisungen, damit der Fehler lokalisiert werden kann. Der liegt momentan beim Erschaffen des Dialogs. Es kommt die übliche Zugriffsverletzung. Ich vermute, dass es an dem Application liegt, wüsste aber keinen Ersatz, da ja ein Owner angegeben werden muss.
Falls ich mit meiner Dialog-Idee auf dem Holzweg sein sollte, bitte ich euch mich zu korrigieren, weil es das erste Mal ist, dass ich einen Property-Editor für ein dynamisches Array of TComponent schreibe und ich leider hierzu auch keine Tutorials gefunden habe.

Ich hoffe, dass ihr mir helfen könnt und ich danke euch für eure bisherige (und hoffentlich auch zukünftige) Hilfe.

Liebe Grüße

Sora