unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TForm1 =
class(TForm)
Button1: TButton;
Button2: TButton;
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private-Deklarationen }
SL : TStringList;
procedure OnException (Sender: TObject; E:
Exception);
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
if SL.Strings[0] = '
'
then
exit;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if SL.Strings[1] = '
'
then
exit;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnException := OnException;
SL := TStringList.Create;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
SL.Free;
end;
procedure TForm1.OnException(Sender: TObject; E:
Exception);
var
TmpStr :
String;
TmpLongWord : LongWord;
TmpPointer : Pointer;
begin
if not (csDesigning
in ComponentState)
then
begin
TmpStr := '
OnException: ' + E.
Message;
if Assigned (Sender)
then
begin
TmpStr := TmpStr + '
- ClassName: ' + Sender.ClassName;
end;
TmpPointer := ExceptAddr;
Move (TmpPointer, TmpLongWord, SizeOf(TmpLongWord));
TmpStr := TmpStr + '
-ExceptADDR: ' + IntToStr (TmpLongWord);
ShowMessage('
OnException:' + TmpStr);
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
if SL.Strings[2] = '
'
then
exit;
end;
end.