Odwołanie się do komponentu na dynamicznej formie

0

Cześć, opisując pokrótce problem: tworzę dynamicznie formularz, na nim obiekt TMemo. Na pewno tworzy się prawidłowo bo po TForm.Show TMemo jest widoczny. Niestety Potem FindComponent go nie znajduje...
Fragment kodu:

procedure ShowDebugWindow;
var
  mMemo:TMemo;
begin
  try
    try
      if not Assigned(fDebug) then
      begin
        fDebug := TForm.Create(nil);
        with fDebug do
        begin
          OnClose := CloseDebugWindow;
          Caption := self.ClassName + ' - debug statistics';
          Width := 900;
          Height := 600;
          Position := poScreenCenter;
        end;

        mMemo := TMemo.CreateParented(fDebug.Handle);
        with mMemo do
        begin
          Name := 'memoLog';
          Parent := fDebug;
          Align := alClient;
          ReadOnly := True;
          Font.Name := 'Consolas';
          Font.Color := clMenuBar;
          Font.Size := 8;
          Color := clWindowFrame;
          BorderStyle := bsNone;
          Clear;
        end;
        fDebug.Show;
      end
      else
      begin
        fDebug.Show;
        fDebug.BringToFront;
      end;
    finally

    end;
  except
    on e:exception do ServeException(e, 'ShowDebugWindow');
  end;
end;

Poszukiwanie wspomnianego memo:

procedure AddDebugInfo(Info:string; Method:string='');
var
  Memo:TMemo;
begin
  if Assigned(fDebug) then
  begin
    fDebug.ComponentCount; // <- zwraca 0

    if (fDebug.FindComponent('memoLog') is TMemo) then // <- nie zwraca nic
    begin
      memo := fDebug.FindComponent('memoLog') as TMemo;
      if Method <> '' then
        Memo.Lines.Insert(0, Format('%s: %s -> %s',[FormatDateTime('hh:nn:ss.zzz', Now), method, info]))
      else
        Memo.Lines.Insert(0, Format('%s: %s',[FormatDateTime('hh:nn:ss.zzz', Now), info]));
    end;
  end;
end;

Dlaczego tak się dzieje?

3

dlaczego tam jest CreateParented?

0

Faktycznie, mój błąd. Nawet nie zwróciłem uwagi co podstawił intellisense.
Swoją drogą do czego służy ten konstruktor skoro obiekt vcl się tworzy lecz nie można uzyskać do niego referencji?

0

Namieszałeś, dlatego podeślę Ci cały kod źródłowy.
Jest napisany ciut inaczej niż Twój, moim zdaniem lepiej ;-)

unit Unit22;

interface

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

type
  TForm22 = class(TForm)
    procedure FormShow(Sender : TObject);
  strict private
    FDebugForm : TForm;
    function GetDebugForm : TForm;
  private
    procedure CloseDebugWindow(Sender : TObject; var Action : TCloseAction);
  protected
    property DebugForm : TForm read GetDebugForm;
  public
    procedure ShowDebugWindow;
    procedure AddDebugInfo(Info : string; Method : string = '');
  end;

var
  Form22 : TForm22;

implementation

{$R *.dfm}

const
  cMemoDebugName = 'memoLog';

procedure TForm22.AddDebugInfo(Info, Method : string);
var
  lMemo : TControl;
begin
  lMemo := DebugForm.FindChildControl(cMemoDebugName);
  if Assigned(lMemo) and (lMemo is TMemo) then
  with TMemo(lMemo) do
    if Method <> '' then
      Lines.Insert(0, Format('%s: %s -> %s', [FormatDateTime('hh:nn:ss.zzz', Now), Method, Info]))
    else
      Lines.Insert(0, Format('%s: %s', [FormatDateTime('hh:nn:ss.zzz', Now), Info]));
end;

procedure TForm22.CloseDebugWindow(Sender : TObject; var Action : TCloseAction);
begin

end;

procedure TForm22.FormShow(Sender : TObject);
begin
  ShowDebugWindow;
  AddDebugInfo('Info testowe', 'metoda testowa');
end;

function TForm22.GetDebugForm : TForm;
begin
  if not Assigned(FDebugForm) then
  begin
    FDebugForm := TForm.Create(Application);
    with FDebugForm do
    begin
      OnClose  := CloseDebugWindow;
      Caption  := self.ClassName + ' - debug statistics';
      Width    := 900;
      Height   := 600;
      Position := poScreenCenter;
      Visible  := true;
    end;

    with TMemo.Create(FDebugForm) do
    begin
      Parent      := FDebugForm;
      Name        := cMemoDebugName;
      Parent      := FDebugForm;
      Align       := alClient;
      ReadOnly    := true;
      Font.Name   := 'Consolas';
      Font.Color  := clMenuBar;
      Font.Size   := 8;
      Color       := clWindowFrame;
      BorderStyle := bsNone;
      Clear;
    end;
  end;
  Result := FDebugForm;
end;

procedure TForm22.ShowDebugWindow;
begin
  try
    DebugForm.Show;
    DebugForm.BringToFront;
  except
    on e : exception do
      Raise;
  end;
end;

end.
0

A tu wersja 2 z podejściem bardziej obiektowym:

unit Unit22;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls;

type
  TDebugForm = class(TForm)
  strict private
    FLogMemo : TMemo;
    function GetLogMemo : TMemo;
  strict protected
    property LogMemo : TMemo read GetLogMemo;
  public
    procedure AddDebugInfo(const AInfo : string; const AMethod : string = '');
  end;

  TForm22 = class(TForm)
    procedure btnAddDebugInfoClick(Sender: TObject);
  strict private
    FDebugForm : TDebugForm;
    FpcDebug: TPageControl;
    function GetDebugForm : TDebugForm;
    function GetpcDebug: TPageControl;
  private
    procedure CloseDebugWindow(Sender : TObject; var Action : TCloseAction);
    procedure CreateControls;
  protected
    property DebugForm : TDebugForm read GetDebugForm;
    property pcDebug: TPageControl read GetpcDebug;
  public
    procedure AfterConstruction; override;
  end;

var
  Form22 : TForm22;

implementation

{$R *.dfm}

const
  cMemoDebugName = 'memoLog';

procedure TForm22.AfterConstruction;
begin
  inherited;
  CreateControls;
end;

procedure TForm22.btnAddDebugInfoClick(Sender: TObject);
begin
  DebugForm.AddDebugInfo('Info testowe', 'metoda testowa');
end;

procedure TForm22.CloseDebugWindow(Sender : TObject; var Action : TCloseAction);
begin

end;

procedure TForm22.CreateControls;
var
  btnAddDebugInfo : TButton;
begin
  btnAddDebugInfo := TButton.Create(Self);
  with btnAddDebugInfo do
  begin
    Name     := 'btnAddDebugInfo';
    Parent   := Self;
    Left     := 8;
    Top      := 8;
    Width    := 137;
    Height   := 25;
    Caption  := 'Add Debug Info';
    TabOrder := 1;
    OnClick  := btnAddDebugInfoClick;
  end;
end;

function TForm22.GetDebugForm : TDebugForm;
begin
  if not Assigned(FDebugForm) then
  begin
    FDebugForm := TDebugForm.CreateNew(Application);
    with FDebugForm do
    begin
      OnClose  := CloseDebugWindow;
      Caption  := Self.ClassName + ' - debug statistics';
      Width    := 900;
      Height   := 600;
      Position := poScreenCenter;
      ManualDock(pcDebug, nil, alBottom);
      Show;
    end;
  end;
  Result := FDebugForm;
end;

function TForm22.GetpcDebug: TPageControl;
var
  splDebug : TSplitter;
begin
  if not Assigned(FpcDebug) then
  begin
    FpcDebug := TPageControl.Create(Self);
    with FpcDebug do
    begin
      Name     := 'pcDebug';
      Parent   := Self;
      Left     := 0;
      Height   := 193;
      Align    := alBottom;
      TabOrder := 0;
    end;

    splDebug := TSplitter.Create(Self);
    with splDebug do
    begin
      Name        := 'splDebug';
      Parent      := Self;
      Top         := pcDebug.Height + 4;
      Height      := 3;
      Cursor      := crVSplit;
      Align       := alBottom;
      Beveled     := True;
      ResizeStyle := rsUpdate;
    end;
  end;
  Result := FpcDebug;
end;

procedure TDebugForm.AddDebugInfo(const AInfo : string; const AMethod : string = '');
begin
  with LogMemo do
    if AMethod <> '' then
      Lines.Insert(0, Format('%s: %s -> %s', [FormatDateTime('hh:nn:ss.zzz', Now), AMethod, AInfo]))
    else
      Lines.Insert(0, Format('%s: %s', [FormatDateTime('hh:nn:ss.zzz', Now), AInfo]));
end;

function TDebugForm.GetLogMemo : TMemo;
begin
  if not Assigned(FLogMemo) then
  begin
    FLogMemo := TMemo.Create(Self);
    with FLogMemo do
    begin
      Parent      := Self;
      Name        := cMemoDebugName;
      Align       := alClient;
      ReadOnly    := True;
      Font.Name   := 'Consolas';
      Font.Color  := clMenuBar;
      Font.Size   := 8;
      Color       := clWindowFrame;
      BorderStyle := bsNone;
      Clear;
    end;
  end;
  Result := FLogMemo;
end;

end.

1 użytkowników online, w tym zalogowanych: 0, gości: 1