Hi Comm,
habe ein Problem beim "Nachempfinden" von Components oder controls.
Propertys sollen in eine Generics.collections.tlist<tcontrol> eingeschrieben und verwaltet werden
Die Propertys werden unter bestimmten umständen nicht "gelöscht".
Funktionierendes Beispiel:
Delphi-Quellcode:
type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
FormRiched: TRichEdit;
Formmemo: TMemo;
DelformRiched: TButton;
DelFormMemo: TButton;
RichEdit2: TRichEdit;//zum Anzeigen
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure DelformRichedClick(Sender: TObject);
procedure DelFormMemoClick(Sender: TObject);
private
FList: Tlist<tcontrol>;
{ Private-Deklarationen }
property List: Tlist<tcontrol> read FList write FList;
public
{ Public-Deklarationen }
procedure showListinfos;
end;
//erzeugen der Liste
procedure TForm1.FormCreate(Sender: TObject);
begin
list:=tlist<tcontrol>.Create;
list.Add(FormRiched);
list.Add(FormMemo);
end;
//freigeben der Liste
procedure TForm1.FormDestroy(Sender: TObject);
begin
freeandnil(flist);
end;
procedure TForm1.DelformRichedClick(Sender: TObject);
begin
if assigned(list.items[0]) then
begin
list.items[0].free; //freeandnil(list.items[0]) geht nicht
list.items[0]:=nil; //sonst zeigt der Listeneintrag noch auf "Etwas" ?, beim Erneuten aufrufen dieser Procedure Fehler
end;
showListinfos;
end;
procedure TForm1.DelFormMemoClick(Sender: TObject);
begin
if assigned(list.items[1]) then
begin
list.items[1].free; //freeandnil(list.items[0]) geht nicht
list.items[1]:=nil;
end;
showlistinfos;
end;
// zeigt, was noch assigned ist
procedure TForm1.showListinfos;
var
I: Integer;
begin
RichEdit2.Clear;
for I := 0 to list.count-1 do
begin
if Assigned(list.items[i]) then
richedit2.Lines.add('Eintrag '+inttostr(i)+' is ASSIGNEd' ) else
richedit2.Lines.add('Eintrag '+inttostr(i)+' is NOT ASSIGNEd' )
end;
if assigned(FormRiched) then
richedit2.Lines.add('FormRiched '+' is ASSIGNEd' ) else
richedit2.Lines.add('FormRiched '+' is NOT ASSIGNEd' );
if assigned(Formmemo) then
richedit2.Lines.add('FormMemo is ASSIGNEd' ) else
richedit2.Lines.add('FormeMemo is NOT ASSIGNEd' )
end;
Ich schreibe FormRichEd und FormMemo ein eine Liste und lösche sie dann per Button. Wenn ich beide Buttons betätigt habe, zeigt procedure TForm1.showListinfos folgendes:
Eintrag 0 is NOT ASSIGNEd
Eintrag 1 is NOT ASSIGNEd
FormRiched is NOT ASSIGNEd
FormeMemo is NOT ASSIGNEd
würde ich in der liste die Einträge nicht =NIL setzen, sieht es so aus:
Eintrag 0 is ASSIGNEd
Eintrag 1 is ASSIGNEd
FormRiched is NOT ASSIGNEd
FormeMemo is NOT ASSIGNEd
also die Liste zeigt noch auf etwas. (wenn man über die Liste auf die Propertys versuchen würde, zu zugreifen - ist ja assigned - gibt's Fehler) Aber die Propertays FormRichEd und Formmemo wurden ordnungsgemäß freigegeben und von wem auch immer auf nil gesetzt.
Nun Der PROBLEMFALL als verkürztes Beispiel: Ein z.b. tRichedit soll als Propertys einen tRichedit und ein tmemo verwalten. Und diese sollen auch über eine eigenen Liste verwaltet werden
Delphi-Quellcode:
type
tShowOpt_UA =(ShowOwnRichEd_UA, ShowOwnMemo_UA,ShowOwnHeadContr_UA,ShowOwnstatBar_UA, ShowDeleteOwnComps_UA);
tShowOpts_UA = set of tShowOpt_UA;
TTestRich_UA = class(TRichedit)
private
{ private declarations }
FOwnRichEd: trichedit;
FOwnMemo: tmemo;
FOwnControlList: tlist<TControl>;// geht so nicht zum löschen?
protected
{ protected declarations }
procedure SetParent(AParent: TWinControl); override;//hier wird Parent Von testrich gesetzt und und man kann z.b. Top und left von den Own-Komponenten setzen
public
{ public declarations }
property OwnControlList: tlist<TControl> read FOwnControlList write FOwnControlList;//die Verwaltungsliste
published
{ published declarations }
property OwnRichEd: trichedit read FOwnRichEd write FOwnRichEd;
property OwnMemo: tmemo read FOwnMemo write FOwnMemo;
constructor Create(AOwner:TComponent);override;
procedure CreateOwnComps(SO: tshowopt_UA);virtual;//hier wird je nach Anforderung OwnRiched und OwnMemo erzeugt
procedure CreateOwnRichEd;virtual;// Routine für OwnRiched
procedure CreateOwnMemo;virtual;// Routine für OwnMemo
destructor destroy;override;//die Liste wieder löschen
procedure expresscontrols;virtual;//Onwriched und OwnMemo Parent zuteilen - Darstellung auf der Form
procedure SetParentDepOwnProps(SO: tshowopt_UA);virtual;//das Berechnen, was vor dem Setzen von Riched.parent nicht mgl. war
end;
{ TTestRich_UA }
constructor TTestRich_UA.Create(AOwner: TComponent);
var so:tshowopt_UA;
I: Integer;
begin
inherited;
OwnControlList:=tlist<TControl>.create;
OwnRichEd:=nil;
OwnMemo:=nil;
for so := Low(tshowopt_UA) to High(tshowopt_UA) do
CreateOwnComps(so);
for I := 0 to componentcount-1 do
if components[i] is tcontrol then
OwnControlList.add(tcontrol(components[i]));
{
entspricht oben
with OwnControlList do
begin
add(FOwnRichEd);
add(FOwnMemo);
end;
}
end;
procedure TTestRich_UA.CreateOwnComps(SO: tshowopt_UA);
begin
case so of
ShowOwnRichEd_UA: CreateOwnRichEd;
ShowOwnMemo_UA: CreateOwnMemo;
end;
end;
procedure TTestRich_UA.CreateOwnMemo;
begin
if not Assigned(OwnMemo) then
begin
OwnMemo:=tmemo.create(self);
with OwnMemo do
begin
name:='OwnMemo';
SetSubComponent(true);
width:=Width div 2;
Height:=height;
if self.parent=nil then parent:=self else
begin
parent:=self.parent; //zur laufzeit erzeugt
SetParentDepOwnProps(ShowOwnMemo_UA);//dann auch top und left berechnen
end;
Show;
end;
end else OwnMemo.show;
end;
procedure TTestRich_UA.CreateOwnRichEd;
begin
if not Assigned(OwnRichEd) then
begin
OwnRichEd:=trichedit.create(self);
with OwnRichEd do
begin
name:='OwnRiched';
SetSubComponent(true);
width:=Width div 2;
Height:=height;
if self.parent=nil then parent:=self else
begin
parent:=self.parent; //zur laufzeit erzeugt
SetParentDepOwnProps(ShowOwnRichEd_UA);//dann auch top und left berechnen
end;
Show;
end;
end else ownriched.show;
end;
destructor TTestRich_UA.destroy;
begin
freeandnil(fOwnControlList);
inherited;
end;
procedure TTestRich_UA.expresscontrols;
var i:integer;
begin
for I := 0 to componentcount-1 do
begin
if components[i] is tcontrol then
begin
tcontrol(components[i]).parent:=self.parent;
SetParentDepOwnProps(tshowopt_UA(i));
end;
end;
end;
procedure TTestRich_UA.SetParent(AParent: TWinControl);
begin
inherited;//parent wird gestzt
if not (csDestroying in ComponentState) then // wenn nicht gerade in in auflösung
expresscontrols;
end;
procedure TTestRich_UA.SetParentDepOwnProps(SO: tshowopt_UA);
Procedure CalcOwnrichEd;
begin
if assigned(OwnRichEd) then
with OwnRichEd do
begin
top:=self.top;
left:=self.left+self.Width;
end;
end;
Procedure CalcOwnMemo;
begin
if assigned(OwnMemo) then
with Ownmemo do
begin
top:=self.top;
left:=self.left-Width;
end;
end;
begin
case so of
ShowOwnRichEd_UA: CalcOwnrichEd;
ShowOwnMemo_UA: CalcOwnMemo;
end;
Wenn ich nun wie im funktionierenden Beispiel OwnRiched und OwnMemo via FOwnControlLis lösche und Nil setze,
Delphi-Quellcode:
procedure TForm1.Button3Click(Sender: TObject);
begin
if assigned(TestRich_UA1.OwnControlList.items[0]) then
begin
TestRich_UA1.OwnControlList.items[0].free;
TestRich_UA1.OwnControlList.items[0]:=nil;// ohne Nil setzen zeigt der Listeneintrag noch auf etwas
end;
showOwnListinfos;
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
if assigned(TestRich_UA1.OwnControlList.items[1]) then
begin
TestRich_UA1.OwnControlList.items[1].free;
TestRich_UA1.OwnControlList.items[1]:=nil;// ohne Nil setzen zeigt der Listeneintrag noch auf etwas
end;
showOwnListinfos;
end;
ergibt die Prüfung auf Assigned folgendes:
Eintrag 0 is NOT ASSIGNEd
Eintrag 1 is NOT ASSIGNEd
ownRiched is ASSIGNEd
ownMemo is ASSIGNEd
D. h, die Propertys werden nicht gelöscht (?) oder zumindestens nicht Nil gesetzt.
Wenn ich z. B. dann auf die
procedure CreateOwnRichEd;virtual;
procedure CreateOwnMemo;virtual;
zugreife, gelten die propertys als assigned, und es wird .show angewendet. Allerdings zeigen sich die beiden nicht wieder, aber es wird auch kein Fehler ausgelöst.
Woran liegt das - unterschiedliche Owner und Parent - Parent als Tform verhindert irgendwas?
Bin gespannt
Grüße Uwe