unit Unit1;
interface
uses
Winapi.Windows,
Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics,
Vcl.Controls,
Vcl.Forms,
Vcl.Dialogs,
Vcl.StdCtrls;
type
TForm1 =
class( TForm )
Edit1: TEdit;
Label1: TLabel;
procedure Edit1Change( Sender: TObject );
procedure FormCreate( Sender: TObject );
private
FSucheNach :
string;
FSuchThread: TThread;
FNeueSuche : Boolean;
procedure StartSuche(
const SucheNach:
string );
procedure SucheCallback( AResult: TObject );
public
end;
type
EOperationCanceled =
class(
Exception )
end;
type
TSuchResult =
class
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Edit1Change( Sender: TObject );
begin
FSucheNach := Edit1.Text;
if Assigned( FSuchThread )
then
begin
FNeueSuche := true;
FSuchThread.Terminate;
end
else
begin
StartSuche( FSucheNach );
end;
end;
procedure TForm1.FormCreate( Sender: TObject );
begin
ReportMemoryLeaksOnShutdown := true;
end;
procedure TForm1.StartSuche(
const SucheNach:
string );
var
callback: TProc<TObject>;
begin
if SucheNach = '
'
then
begin
Label1.Caption := '
';
exit;
end;
Label1.Caption := '
suchen ...';
callback := SucheCallback;
FNeueSuche := False;
FSuchThread := TThread
{} .CreateAnonymousThread(
procedure
var
I: Integer;
r: TObject;
begin
try
try
for I := 1
to 10
do
begin
// Ich tu mal so, als ob ich suchen würde
Sleep( 250 );
// Bin ich abgebrochen worden?
if TThread.Current.CheckTerminated
then
raise EOperationCanceled.Create( '
Fehlermeldung' );
end;
// Ergebnis
r := TSuchResult.Create;
except
// Exception
r := AcquireExceptionObject( );
end;
// Callback aufrufen
TThread.Synchronize(
nil,
procedure
begin
callback( r );
end );
finally
callback :=
nil;
r.Free;
end;
end );
FSuchThread.Start;
end;
procedure TForm1.SucheCallback( AResult: TObject );
begin
FSuchThread :=
nil;
if FNeueSuche
then // wir müssen nochmal suchen
StartSuche( FSucheNach )
else if AResult
is TSuchResult
then // wir haben ein Ergebnis
begin
Label1.Caption := '
gefunden!';
end
else if AResult
is EOperationCanceled
then // wir wurden unterbrochen
begin
Label1.Caption := '
abgebrochen!';
end
else if AResult
is Exception
then // es gab einen Fehler
begin
Label1.Caption := '
FEHLER: ' +
Exception( AResult ).
Message;
end
else // wer weiß, was hier jetzt gekommen ist :o)
begin
Label1.Caption := '
Unbekannter Fehler!';
end;
end;
end.