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.