Exception in Synchronisierter Thread Routine nicht sichtbar

[Corpsman]

Sodale jetzt hab ichs raus

Für alle die sich mim Selben Rumschlagen hier meine Lösung :

Delphi-Quellcode:

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);
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
  If assigned(Application.OnException) Then Begin
    Application.OnException(self, FException);
  End Else Begin
    Application.ShowException(FException);
  End;
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.