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;