Unit Unit1;
Interface
Uses
Winapi.Windows,
Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics,
Vcl.Controls,
Vcl.Forms,
Vcl.Dialogs,
Vcl.StdCtrls,
Vcl.AppEvnts;
Type
TForm1 =
Class(TForm)
Button1: TButton;
ApplicationEvents1: TApplicationEvents;
Procedure Button1Click(Sender: TObject);
Procedure ApplicationEvents1Exception(Sender: TObject; E:
Exception);
Private
{ Private-Deklarationen }
Public
{ Public-Deklarationen }
Procedure WillRaiseAnException(Sender: TObject);
End;
Var
Form1: TForm1;
Implementation
{$R *.dfm}
Type
TTestThread =
Class(TThread)
Private
FException:
Exception;
Procedure SyncCallEvent;
Procedure HandleException;
Procedure DoHandleException;
Protected
Procedure Execute;
Override;
Public
OnDoSomeThing: TNotifyEvent;
End;
Procedure TForm1.ApplicationEvents1Exception(Sender: TObject; E:
Exception);
Begin
showmessage('
Catched an Exception : ' + E.
Message);
// Die Exception landet nicht hier, sondern wird direkt angezeigt -> man kann sie nicht "ungesehen" behandeln.
End;
Procedure TForm1.Button1Click(Sender: TObject);
Var
t: TTestThread;
Begin
t := TTestThread.Create(true);
t.FreeOnTerminate := false;
t.OnDoSomeThing := WillRaiseAnException;
t.Start;
// Warten bis Thread Fertig ist.
While Not t.Terminated
Do Begin
sleep(1);
Application.HandleMessage;
End;
t.Free;
showmessage('
Finished.');
End;
{ TTestThread }
Procedure TTestThread.DoHandleException;
Begin
Application.ShowException(FException);
End;
Procedure TTestThread.Execute;
Begin
sleep(1000);
Try
Synchronize(SyncCallEvent);
Except
HandleException;
End;
sleep(1000);
Terminate;
End;
Procedure TForm1.WillRaiseAnException(Sender: TObject);
Begin
caption := '
Hallo';
Raise Exception.Create('
Siehst du mich ?');
// -- Das hier funktioniert nicht, warum ?
// showmessage('Hallo'); -- Ist erlaubt und Funktioniert, da WillRaiseAnException im Context des Hauptthreads läuft
caption := '
Hallo du';
End;
Procedure TTestThread.HandleException;
Begin
FException :=
Exception(ExceptObject);
Try
Synchronize(DoHandleException);
Finally
FException :=
Nil;
End;
End;
Procedure TTestThread.SyncCallEvent;
Begin
If assigned(OnDoSomeThing)
Then Begin
OnDoSomeThing(self);
End;
End;
End.