// Quelle: http://edn.embarcadero.com/article/10452
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
btn1: TButton;
procedure btn1Click(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
TMyThread = class(TThread)
private
FException: Exception;
procedure DoHandleException;
protected
procedure Execute; override;
procedure HandleException; virtual;
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.btn1Click(Sender: TObject);
begin
// Create an instance of the TMyThread
with TMyThread.Create(True) do
begin
FreeOnTerminate := True;
Resume;
end;
end;
{ TMyThread }
procedure TMyThread.DoHandleException;
begin
// Cancel the mouse capture
if GetCapture <> 0 then SendMessage(GetCapture, WM_CANCELMODE, 0, 0);
// Now actually show the exception
if FException is Exception then
Application.ShowException(FException)
else
SysUtils.ShowException(FException, nil);
end;
procedure TMyThread.Execute;
var
a: Integer;
b: Integer;
begin
inherited;
FException := nil;
try
// raise an Exception
b := 0;
a := 42 div b;
Messagebox(0, PansiChar(IntToStr(a)), 'fehler', 0)
//raise Exception.Create('I raised an exception');
except
HandleException;
end;
end;
procedure TMyThread.HandleException;
begin
// This function is virtual so you can override it
// and add your own functionality.
FException := Exception(ExceptObject);
try
// Don't show EAbort messages
if not (FException is EAbort) then
Synchronize(DoHandleException);
finally
FException := nil;
end;
end;
end.