Einzelnen Beitrag anzeigen

4dk2

Registriert seit: 4. Sep 2007
176 Beiträge
 
#1

[VCL] TCustomControl, Welche Methode für Komponente um empfangsbereit zu sein?

  Alt 3. Apr 2017, 09:08
Delphi-Version: 10 Berlin
Guten morgen zusammen,


Ich habe ne Art Logging Komponente, die Thread-safe Log-Ereignisse empfangen kann, in einer oder mehreren Dateien hinterlegen kann, und an mehreren
Stellen anzeigen kann.

Die Komponente, die die Ereignisse Live anzeigt, bereitet mir im Moment ein paar Kopfschmerzen.

Und Zwar dann, wenn Ereignisse zur Create Phase der Anwendung passieren.
Ich habe mal eine Demo erstellt (siehe Anhang)

Aber Grundsätzlicht, habe ich eine TCustomPanel, auf der Eine Listbox erstellt wird, und dort werden per
AddLog Meldungen eingetragen.

im Addlog habe ich eine Sperre, das erst Meldungen angenommen werden, wenn die Komponente dazu bereit ist,
weil ohne Sperre kommen sehr merkwürdige Windows Fehler.
Mein Aktueller "Workarround" ist es, erst nach dem Aufruf vom Paint, Meldungen zu erlauben (FAddAllowed=true).

Ich würde euch jetzt gerne Fragen, wie ich am besten die Sperre aufhebe,
sozusagen, wann kann gefahrlos eingetragen werden?
Und wann kann sicher SendMessage() aufgerufen werden für den Autoscroll?

(Es geht gar nicht darum das evtl. Daten verloren gehen, in meiner eigentlichen Komponente wird das berücksichtigt.


Delphi-Quellcode:
unit uFMain;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls,SyncObjs, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, JvExStdCtrls, JvListBox;



type
  TTestLog=class(TCustomPanel)
  private
    FAddAllowed:boolean;
    FListBox:TListBox;
    FCS_Add:TCriticalSection;
    FWorkaroundActive: boolean;
  protected
    procedure Paint; override;


  public
    property WorkaroundActive:boolean read FWorkaroundActive write FWorkaroundActive;
    procedure AddLog(Amessage:string);
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

  end;

  TTestThread=class(TThread)
  private
    FLog:TTestLog;
  protected
    procedure Execute; override;
  public
    constructor Create(ALog:TTestLog);
    destructor Destroy; override;
    class procedure SicherFreigeben(var threadObjekt: TTestThread); static;

  end;

  TFMain = class(TForm)
    pb1: TPanel;
    btnStart: TButton;
    btnStop: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnStartClick(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    FLog:TTestLog;
    FT:array[0..100] of TTestThread;

    { Public-Deklarationen }
  end;

var
  FMain: TFMain;

CONST MAXTHREADS=10;


implementation

{$R *.dfm}

{ TTestLog }

procedure TTestLog.AddLog(Amessage: string);
begin
  FCS_Add.Enter;
  try
    if FAddAllowed or not FWorkaroundActive then
    begin
      FListBox.Items.Add(Amessage);

      SendMessage(FListBox.Handle, LB_SETTOPINDEX, FListBox.Items.Count-1, 0);
      FListBox.Update;
      self.Update;
    end;
  finally
    FCS_Add.Leave;
  end;
end;

constructor TTestLog.Create(AOwner: TComponent);
begin
  inherited;
  FCS_Add:=TCriticalSection.Create;
  FListBox:=TListBox.Create(self);
  FListBox.Parent:=self;
  FListBox.Align:=alClient;
  FListBox.Color:=clBlack;
  FListBox.Font.Color:=clWhite;
end;

destructor TTestLog.Destroy;
begin
  FCS_Add.Free;
  FListBox.Free;
  inherited;
end;

procedure TTestLog.Paint;
begin
  inherited;
  if FWorkaroundActive then
    FAddAllowed:=true;
end;


{ TTestThread }



constructor TTestThread.Create(ALog: TTestLog);
begin
  inherited Create(false);

  FLog:=ALog;

end;

destructor TTestThread.Destroy;
begin
  FLog:=nil;
  inherited;
end;

procedure TTestThread.Execute;
begin

  while not Terminated do
  begin
    if Assigned(FLog) then
      FLog.AddLog('THREAD: '+inttostr(ThreadID)+' TESTLOG');
    sleep(100);
  end;

end;

class procedure TTestThread.SicherFreigeben(var threadObjekt: TTestThread);
begin
  if assigned(threadObjekt) then
  begin
    threadObjekt.Terminate;
    threadObjekt.WaitFor;
    threadObjekt.free;
    threadObjekt:=nil;
  end;
end;


procedure TFMain.btnStartClick(Sender: TObject);
var
  I: Integer;
begin
  for I := low(ft) to MAXTHREADS-1 do
    FT[i]:=TTestThread.Create(FLog);


end;

procedure TFMain.btnStopClick(Sender: TObject);
var
  I: Integer;
begin
  for I := low(ft) to MAXTHREADS-1 do
  begin
    FT[i].SicherFreigeben(FT[i]);
  end;

end;
procedure TFMain.FormCreate(Sender: TObject);
begin
 //
 FLog:=TTestLog.Create(self);
 FLog.Parent:=self;
 FLog.Align:=alClient;

 //Hier ist mein aktueller Workaround:
 //Wenn True, darf erst was hinzugefügt werden, wenn Paint aufgerufen wurde
 //auf False setzen um die Windows Fehler zu sehen ;)
 FLog.WorkaroundActive:=true;

 btnStartClick(self);
end;

procedure TFMain.FormDestroy(Sender: TObject);
begin
 btnStopClick(self);
end;

end.
Angehängte Dateien
Dateityp: zip DpLogTest.zip (53,9 KB, 1x aufgerufen)
  Mit Zitat antworten Zitat