TThread - Sleep

[ChrisE]

Delphi-Quellcode:

TMyThreadContainer = class
private
  FCSResults: TCriticalSection;
  FResults: TStringList;
  FInfoHandle: HWnd;
  FInfoMessage: Cardinal;
  //...
public
  procedure Start(AInfoFormHandle: Handle; AMessage: Cardinal); 
  procedure AddResult(AString: string);
  function HasMoreResults: Boolean;
  function GetResult: string;
  //...
end;

//...

procedure TMyThreadContainer.Start(AInfoFormHandle: HWnd; AMessage: Cardinal);
begin
  // ...
  FInfoHandle := AInfoFormHandle;
  FInfoMessage := AMessage; 
  // ...
end;

procedure TMyThreadContainer.AddResult(AString: string);
begin
  FCSResults.Enter;
  try
    FResults.Add(AString); // immer oben drauf
  finally
    FResults.Leave;
  end;
  // Sperrung der Section so kurz wie möglich halten
  PostMessage(FInfoHandle, FInfoMessage, 0, 0);
end;

procedure TMyThreadContainer.HasMoreResults: Boolean;
begin
  FCSResults.Enter;
  try
    result := FResults.Count > 0;
  finally
    FResults.Leave;
  end;  
end;

procedure TMyThreadContainer.GetResult: string;
begin
  FCSResults.Enter;
  try
    result := FResults[0];
    // UPS -> hier noch löschen :-)
    FResults.Delete(0);
  finally
    FResults.Leave;
  end;  
end;

//....
const WM_NEW_RESULTS = WM_USER +1;


type
TForm1 = class(TForm)
  procedure WMNewResults(msg: TMessage);message WM_NEW_RESULTS;
//...
end;

procedure TForm1.DoStart;
begin
  // ....
  MyThreadContainer.Start(Self.Handle, WM_NEW_RESULTS);

  // ....
end;

procedure TForm1.WMNewResults(msg: TMesssage);
begin
  Listbox1.Items.BeginUpdate;
  try
    while MyThreadContainer.HasMoreResults do
    begin
      ListBox1.Items.Add(MyThreadContainer.GetResult);
    end;
  finally
    ListBox1.Items.EndUpdate;
  end;
end;

Ungetestet

Greez, Chris