Hilfroutinen für Komponenten

[shmia]

Komponenten sind ja so gebaut, das sie eventuell einen Owner (Besitzer) haben,
als auch der Besitzer von mehreren Komponenten sein dürfen. => Baumstruktur

In folgender Unit gibt es 3 interessante Funktionen, um mit Komponenten und deren Beziehungen zueinander umzugehen.

So ist es damit z.B. möglich, alle Komponenten einer Anwendung aufzulisten.
   DumpComponents(Application, Memo1.Lines); Wenn man einen entsprechenden Eventhandler schreibt, könnte man z.B. eine Datei mit allen
Komponenten der Anwendung + alle published Properties erzeugen.

Delphi-Quellcode:

unit ComponentUtils;

interface

uses Classes;

// liefert den vollen Namen einer Komponenten; einschliesslich allen Owner
function ComponentFullName(comp:TComponent) : string;

// dito. + zusätzlich mit dem Klassenname der Komponente
function ComponentFullNameAndClass(comp:TComponent) : string;

// schreibt die Namen aller Komponenten und Unterkomponenten nach list
procedure DumpComponents(comp:TComponent; list: TStrings);overload;

// ruft für alle Komponenten und Unterkomponenten einen Eventhandler auf
procedure DumpComponents(comp:TComponent; event:TNotifyEvent);overload;

function CloneComponent(const source: TComponent):TComponent;



implementation

uses SysUtils, Controls;

function ComponentFullName(comp:TComponent) : string;
var
  myself : TComponent;
begin
  Result := comp.Name;

   // wenn die Komponenten keinen Namen hat, dann zumindest einen Index
  if Result = '' then
    Result := '#'+IntToStr(comp.ComponentIndex);

  myself := comp;

  // nach "oben" zu den Ownern
  while myself.Owner <> nil do
  begin
    myself := myself.Owner;
    if Length(myself.Name) > 0 then
      Result := myself.Name+'.'+Result;
  end;
end;

function ComponentFullNameAndClass(comp:TComponent) : string;
begin
  Result := ComponentFullName(comp)+': '+comp.Classname;
end;

procedure DumpComponents(comp:TComponent; list: TStrings);
var
  i : Integer;
begin
  if Assigned(comp) then
  begin
    list.Add(ComponentFullNameAndClass(comp));

    for i := 0 to comp.ComponentCount-1 do
    begin
      // rekusiver Aufruf
      DumpComponents(comp.Components[i], list);
    end;
  end;
end;


procedure DumpComponents(comp:TComponent; event:TNotifyEvent);
var
  i : Integer;
begin
  if Assigned(comp) then
  begin
    event(comp);
    for i := 0 to comp.ComponentCount-1 do
    begin
      // rekusiver Aufruf
      DumpComponents(comp.Components[i], event);
    end;
  end;
end;




function CloneComponent(const source: TComponent):TComponent;
var
  mstream: TMemoryStream;
  oldname : string;
begin
  mstream := TMemoryStream.Create;
  oldname := source.Name;
  try
    source.Name := '';
    mstream.WriteComponent(source);
    source.Name := oldname;

    // der Trick: die aktuelle Klasse wird nach TComponentClass gecastet
    // und dann mit Create eine neue, leere Instanz erzeugt
    if source is TControl then
      Result := (TControlClass(source.ClassType)).Create(source.Owner)
    else
      Result := (TComponentClass(source.ClassType)).Create(source.Owner);

    mstream.Position := 0;
    // jetzt werden die gespeicherten Properties auf das neue Control übertragen
    mstream.ReadComponent(Result);
  finally
    mstream.Free
  end;
end;


end.

[edit=flomei] *wuppdi* Ab in die Code-Lib... Mfg, flomei[/edit]
[edit=Matze]Code formatiert. Mfg, Matze[/edit]