//wartet 1 Sekunde und zeigt dann synchronized die Box an
TThread.Exec(
procedure begin Sleep(1000);
end,
procedure begin ShowMessage('
1 Sekunde gewartet');
end,
true);
//Führt die Funktion "EineLangeBerechnung" threaded aus und gibt deren Resultat synchronized an "ZeigeResultat" weiter
function EineLangeBerechnung: Int64;
begin
Result := 1;
end;
procedure ZeigeResultat(AResult : Int64);
begin
ShowMessage(IntToStr(AResult));
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
TThread.Exec<Int64>(EineLangeBerechnung, ZeigeResultat, true);
end;
//Eine TNotify-Prozedur threaded aufrufen
procedure TForm1.Button1Click(Sender: TObject);
begin
if GetCurrentThreadId = MainThreadID
then
ShowMessage('
Click')
else
ShowMessage('
Du altes Ferkel! Du greifst mit Thread ' + IntToStr(MyExecThread.ThreadID) + '
auf die VCL zu!');
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
TThread.Exec(Button1Click,
nil,
procedure begin Caption := '
Klick erledigt';
end);
end;
//sucht rekursiv alle Dateien unterhalb eines Ordners, fügt die gefundenen Dateien in
//eine Listbox ein und zeigt die aktuelle Anzahl in der Caption des Forms and
procedure CallBack(AList : TStringList);
begin
Form61.ListBox1.items.BeginUpdate;
try
Form61.ListBox1.items.AddStrings(AList);
finally
Form61.ListBox1.items.EndUpdate;
AList.Free;
end;
Form61.Caption := IntToStr(Form61.ListBox1.Items.Count);
end;
function Search(ADir :
String) : TStringList;
var
sr : TSearchRec;
lst : TStringList;
begin
lst := TStringList.Create;
if FindFirst(ADir + '
\*.*', faAnyFile, sr) = 0
then
begin
repeat
if (sr.
Name <> '
.')
and (sr.
Name <> '
..')
then
begin
if faDirectory
and sr.Attr = faDirectory
then
begin
MyExecThread.Synchronize(MyExecThread,
procedure begin CallBack(lst)
end);
lst := Search(ADir + '
\' + sr.
Name);
end
else
lst.Add(ADir + '
\' + sr.
Name);
end;
until FindNext(sr) <> 0;
FindClose(sr);
end;
Result := lst;
end;
procedure TForm61.Button4Click(Sender: TObject);
begin
tthread.Exec<TStringList>(
function : TStringList
begin
Result := Search('
c:\Program Files');
end, CallBack);
end;
//sucht rekursiv alle Dateien unterhalb eines Ordners wobei jeder Ordner von einem eigenen Thread durchsucht wird
//zugegebenermaßen wird das Suchen durchs Multithreading nicht wirklich schneller ... aber man kanns ja mal versuchen :)
procedure CallBack(AList : TStringList);
begin
//Dateiliste weiterverabeiten
Alist.Free;
end;
function Search(ADir :
String) : TFunc<TStringList>;
begin
Result :=
function : TStringList
var
sr : TSearchRec;
begin
Result := TStringList.Create;
if FindFirst(ADir + '
\*.*', faAnyFile, sr) = 0
then
begin
repeat
if (sr.
Name <> '
.')
and (sr.
Name <> '
..')
then
begin
if faDirectory
and sr.Attr = faDirectory
then
tthread.Exec<TStringList>(Search(ADir + '
\' + sr.
Name), CallBack)
else
Result.Add(ADir + '
\' + sr.
Name);
end;
until FindNext(sr) <> 0;
FindClose(sr);
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
TThread.Exec<TStringList>(Search('
c:\temp'), CallBack);
end;