Browse Source

handling global exceptions

johann 5 years ago
parent
commit
a2b85ab5b9

+ 56 - 0
lazpaint/lazpaint.lpr

@@ -62,6 +62,11 @@ type
   TMyLazPaintInstance = class(TLazPaintInstance)
   TMyLazPaintInstance = class(TLazPaintInstance)
     FMyOnlineUpdater: TLazPaintOnlineUpdater;
     FMyOnlineUpdater: TLazPaintOnlineUpdater;
     function GetOnlineUpdater: TLazPaintCustomOnlineUpdater; override;
     function GetOnlineUpdater: TLazPaintCustomOnlineUpdater; override;
+    constructor Create; override;
+    constructor Create(AEmbedded: boolean); override;
+    destructor Destroy; override;
+  private
+    procedure ApplicationException(Sender: TObject; E: Exception);
   end;
   end;
 
 
 var
 var
@@ -91,6 +96,57 @@ begin
   end;
   end;
 end;
 end;
 
 
+constructor TMyLazPaintInstance.Create;
+begin
+  inherited Create;
+  Application.OnException:=@ApplicationException;
+end;
+
+constructor TMyLazPaintInstance.Create(AEmbedded: boolean);
+begin
+  inherited Create(AEmbedded);
+  Application.OnException:=@ApplicationException;
+end;
+
+destructor TMyLazPaintInstance.Destroy;
+begin
+  if Application.OnException = @ApplicationException then
+    Application.OnException:= nil;
+  inherited Destroy;
+end;
+
+procedure TMyLazPaintInstance.ApplicationException(Sender: TObject; E: Exception);
+var
+  I: Integer;
+  Frames: PPointer;
+  Report: string;
+begin
+  if Initialized then
+    Report := 'Unhandled exception!' + LineEnding
+  else
+    Report := 'Error initializing application!' + LineEnding;
+  Report += LineEnding;
+  if E <> nil then
+  begin
+    if E.ClassName <> 'Exception' then
+      Report += 'Exception class: ' + E.ClassName + LineEnding;
+    Report += 'Message: ' + E.Message + LineEnding;
+  end;
+  Report += 'Stacktrace:' + LineEnding;
+  Report := Report + '  ' + BackTraceStrFunc(ExceptAddr) + LineEnding;
+  Frames := ExceptFrames;
+  for I := 0 to ExceptFrameCount - 1 do
+    Report := Report + '  ' + BackTraceStrFunc(Frames[I]) + LineEnding;
+  Report += LineEnding;
+  if Initialized then
+    Report += 'It is recommanded to save a backup and restart the application.'
+  else
+    Report += 'Application will now close.';
+  ShowError(rsLazPaint, Report);
+  if not Initialized then
+    Halt; // End of program execution
+end;
+
 {$R *.res}
 {$R *.res}
 
 
 {$IFDEF DARWIN}{$IFDEF DEBUG}
 {$IFDEF DARWIN}{$IFDEF DEBUG}

+ 7 - 0
lazpaint/lazpaintinstance.pas

@@ -29,6 +29,7 @@ type
   private
   private
     FScriptName: String;
     FScriptName: String;
 
 
+    function GetInitialized: boolean;
     function GetMainFormVisible: boolean;
     function GetMainFormVisible: boolean;
     procedure OnLayeredBitmapLoadStartHandler(AFilenameUTF8: string);
     procedure OnLayeredBitmapLoadStartHandler(AFilenameUTF8: string);
     procedure OnLayeredBitmapLoadProgressHandler(APercentage: integer);
     procedure OnLayeredBitmapLoadProgressHandler(APercentage: integer);
@@ -214,6 +215,7 @@ type
     procedure UpdateEditPicture(ADelayed: boolean); override;
     procedure UpdateEditPicture(ADelayed: boolean); override;
     procedure AddColorToPalette(AColor: TBGRAPixel); override;
     procedure AddColorToPalette(AColor: TBGRAPixel); override;
     procedure RemoveColorFromPalette(AColor: TBGRAPixel); override;
     procedure RemoveColorFromPalette(AColor: TBGRAPixel); override;
+    property Initialized: boolean read GetInitialized;
   end;
   end;
 
 
 implementation
 implementation
@@ -584,6 +586,11 @@ begin
     result := false;
     result := false;
 end;
 end;
 
 
+function TLazPaintInstance.GetInitialized: boolean;
+begin
+  result := Assigned(FMain) and FMain.Initialized;
+end;
+
 procedure TLazPaintInstance.PythonScriptCommand(ASender: TObject; ACommand,
 procedure TLazPaintInstance.PythonScriptCommand(ASender: TObject; ACommand,
   AParam: UTF8String; out AResult: UTF8String);
   AParam: UTF8String; out AResult: UTF8String);
 var
 var

+ 6 - 5
lazpaint/lazpaintmainform.pas

@@ -722,7 +722,7 @@ type
     FInTextFont, FInTextAlign, FInTextShadow,
     FInTextFont, FInTextAlign, FInTextShadow,
     FInPerspective, FInGridNb: Boolean;
     FInPerspective, FInGridNb: Boolean;
     FOnlineUpdater: TLazPaintCustomOnlineUpdater;
     FOnlineUpdater: TLazPaintCustomOnlineUpdater;
-    initialized: boolean;
+    FInitialized: boolean;
     shouldArrangeOnResize: boolean;
     shouldArrangeOnResize: boolean;
     btnLeftDown, btnRightDown, btnMiddleDown: boolean;
     btnLeftDown, btnRightDown, btnMiddleDown: boolean;
     spacePressed, altPressed, snapPressed, shiftPressed: boolean;
     spacePressed, altPressed, snapPressed, shiftPressed: boolean;
@@ -883,6 +883,7 @@ type
     property UseImageBrowser: boolean read GetUseImageBrowser;
     property UseImageBrowser: boolean read GetUseImageBrowser;
     property CurrentPressure: single read GetCurrentPressure;
     property CurrentPressure: single read GetCurrentPressure;
     property DarkTheme: boolean read GetDarkTheme write SetDarkTheme;
     property DarkTheme: boolean read GetDarkTheme write SetDarkTheme;
+    property Initialized: boolean read FInitialized;
   end;
   end;
 
 
 implementation
 implementation
@@ -900,7 +901,7 @@ const PenWidthFactor = 10;
 
 
 procedure TFMain.FormCreate(Sender: TObject);
 procedure TFMain.FormCreate(Sender: TObject);
 begin
 begin
-  initialized := false;
+  FInitialized := false;
 
 
   FLayout := TMainFormLayout.Create(self);
   FLayout := TMainFormLayout.Create(self);
   FImageView := nil;
   FImageView := nil;
@@ -959,7 +960,7 @@ begin
   {$ENDIF}
   {$ENDIF}
 
 
   FLayout.OnPictureAreaChange := @LayoutPictureAreaChange;
   FLayout.OnPictureAreaChange := @LayoutPictureAreaChange;
-  initialized := true;
+  FInitialized := true;
   FirstPaint := true;
   FirstPaint := true;
 end;
 end;
 
 
@@ -1059,7 +1060,7 @@ end;
 
 
 procedure TFMain.Init;
 procedure TFMain.Init;
 begin
 begin
-  initialized := false;
+  FInitialized := false;
   Config := LazPaintInstance.Config;
   Config := LazPaintInstance.Config;
   CreateMenuAndToolbar;
   CreateMenuAndToolbar;
 
 
@@ -1141,7 +1142,6 @@ begin
   end;
   end;
   if Config.DefaultToolboxWindowVisible and (FLayout.DefaultToolboxDocking <> twWindow) then
   if Config.DefaultToolboxWindowVisible and (FLayout.DefaultToolboxDocking <> twWindow) then
     FLayout.ToolBoxVisible := true;
     FLayout.ToolBoxVisible := true;
-  initialized := true;
 
 
   RegisterScripts(True);
   RegisterScripts(True);
 
 
@@ -1150,6 +1150,7 @@ begin
   Image.Zoom := Zoom;
   Image.Zoom := Zoom;
   UpdateWindowCaption;
   UpdateWindowCaption;
   Image.OnCurrentFilenameChanged := @ImageCurrentFilenameChanged;
   Image.OnCurrentFilenameChanged := @ImageCurrentFilenameChanged;
+  FInitialized := true;
 end;
 end;
 
 
 procedure TFMain.FormShow(Sender: TObject);
 procedure TFMain.FormShow(Sender: TObject);

+ 3 - 3
lazpaint/maintoolbar.inc

@@ -651,8 +651,8 @@ procedure TFMain.UpdateBrushList;
 var oldInit: boolean;
 var oldInit: boolean;
   i: Integer;
   i: Integer;
 begin
 begin
-  oldInit:= initialized;
-  initialized := false;
+  oldInit:= FInitialized;
+  FInitialized := false;
   try
   try
     Panel_PenWidthPreview.Invalidate;
     Panel_PenWidthPreview.Invalidate;
     ComboBox_BrushSelect.Clear;
     ComboBox_BrushSelect.Clear;
@@ -665,7 +665,7 @@ begin
     on ex:exception do
     on ex:exception do
       LazPaintInstance.ShowError(rsLazPaint,ex.Message);
       LazPaintInstance.ShowError(rsLazPaint,ex.Message);
   end;
   end;
-  initialized := oldInit;
+  FInitialized := oldInit;
 end;
 end;
 
 
 procedure TFMain.SpinEdit_ShapeAltitudeChange(Sender: TObject; AByUser: boolean);
 procedure TFMain.SpinEdit_ShapeAltitudeChange(Sender: TObject; AByUser: boolean);