How to use VCL form as exception dialog

// See also: https://pastebin.com/rvsPpWpf - "how to create custom error dialog"
// See also: https://pastebin.com/BFhcdsnh - "how to replace dialog icon"
// See also: https://pastebin.com/jrEcvkkv - "how to change format of bug report file"
// See also: https://pastebin.com/46QkwZNi - "how to convert call stack to text"

// IMPORTANT NOTE

// We consider using VCL/FMX forms as exception dialogs to be bad practice for the following reasons:
// - VCL is not thread safe. You won't be able to show exception dialog for each background thread. Exception info must be send back to main thread in order to show dialog.
// - VCL is a complex library. If you get some exception which damages VCL - then you won't be able to show exception dialog built with VCL.
// For the above reason, EurekaLog does not use VCL or FMX, but implements exception dialogs with naked WinAPI.
// Consider yourself warned.

// You can implement EurekaLog 7 exception dialog in the same style as in EurekaLog 6: by utilizing event handler.
// Just add EEvents unit to uses, register your own OnExceptionNotify handler
// ( http://www.eurekalog.com/help/eurekalog/topic_type_eevents_televexceptionnotifymeth.php ),
// and show your form.
// This, however, is not recommended approach,
// as you won't get access to any of already written dialog code
// and won't be able to use many helper routines.
// But the plus side is that your old code from EurekaLog 6 will remain mostly unmodified.
// Best approach would be to implement dialog in EurekaLog 7 style - by declaring your own dialog class:

unit UnitExceptionDialog;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,

  EDialog,    // for TBaseDialog and RegisterDialogClass
  EException, // for TEurekaExceptionInfo
  EClasses,   // for TEurekaModuleOptions
  ETypes;     // for TResponse and other simple EurekaLog types

type
  // My exception dialog
  TMyExeptionDialog = class(TBaseDialog)
  protected
    function ShowModalInternal: TResponse; override;
  public
    class function ThreadSafe: Boolean; override;
  end;

  // Form for my exception dialog
  TMyExeptionDialogForm = class(TForm)
    URLLabel: TLabel;
    ListBox: TListBox;
    CopyButton: TButton;
    TryButton: TButton;
    ExitButton: TButton;
    SendAndTry: TButton;
    procedure FormCreate(Sender: TObject);
    procedure SendAndTryClick(Sender: TObject);
    procedure TryButtonClick(Sender: TObject);
    procedure ExitButtonClick(Sender: TObject);
    procedure CopyButtonClick(Sender: TObject);
    procedure URLLabelClick(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  private
    FDialog: TMyExeptionDialog;
    FExceptionInfo: TEurekaExceptionInfo;
    FOptions: TEurekaModuleOptions;
  protected
    property Dialog: TMyExeptionDialog read FDialog;
    property ExceptionInfo: TEurekaExceptionInfo read FExceptionInfo;
    property Options: TEurekaModuleOptions read FOptions;
  public
    constructor Create(const ADialog: TMyExeptionDialog); reintroduce;
  end;

implementation

uses
  Clipbrd,

  ECore,       // for ShellExec
  EDebugInfo,  // for LocationToStr
  EInfoFormat, // for various FmtXYZ functions
  ESysInfo,    // for various GetXYZ functions
  EModules;    // for CurrentEurekaLogOptions

{$R *.dfm}

{ TMyExeptionDialog }

function TMyExeptionDialog.ShowModalInternal: TResponse;
var
  fmExceptionDialogForm: TMyExeptionDialogForm;
begin
  try
    // Create form and setup form
    fmExceptionDialogForm := TMyExeptionDialogForm.Create(Self { <- important } );
    try
      // Show form
      case fmExceptionDialogForm.ShowModal of
        mrYes: // see TMyExeptionDialogForm.SendAndTryClick below
        begin
          // Set result, which means "all is OK, send bug report (if that is set in options)"
          Finalize(Result);
          FillChar(Result, SizeOf(Result), 0);
          Result.SendResult := srSent;
        end;
        mrOK:  // see TMyExeptionDialogForm.TryClick below
        begin
          // Set result, which means "all is OK, but do not send bug report"
          Finalize(Result);
          FillChar(Result, SizeOf(Result), 0);
          Result.SendResult := srCancelled;
        end;
        mrCancel: // see TMyExeptionDialogForm.ExitButtonClick below
        begin
          RestartApplication; // <- to restart application immediately
          // TerminateApplication; // <- to terminate application immediately
          // SetTerminateApplication(True); // <- you can use this in CheckBox.OnClick - for delayed termination on exit
        end;
      else
        begin
          // Set default result
          Finalize(Result);
          FillChar(Result, SizeOf(Result), 0);
          Result.SendResult := srSent;
        end;
      end;

      // You may also try other options:
      // Result.SendResult := srRestart; // <- "show me another dialog, please"
      // Options.ExceptionDialogType := edtEurekaLogDetailed; // <- dialog to show (in this case: detailed EurekaLog dialog with bug report and call stack)
      // Options.CustomField[difDetailsFallbackClass] := ClassName; // <- remember this dialog, if edtEurekaLogDetailed will revert back
      // Options.CustomFieldInt[difOldSendResult] := Ord(srSent); // <- what is result for current dialog, srSent or srCancelled

      // The above could be replaced with simple:
      // ShowDetails; // <- this will setup FResponse with the above code
      // Result := FResponse;

      // You can also use the following:
      // ShowAskReproduce;  // <- this will switch dialog to "ask steps to reproduce" dialog
      // Result := FResponse;

    finally
      FreeAndNil(fmExceptionDialogForm);
    end;
  except
    on E: Exception do
    begin
      // Indicate that dialog failed:
      Finalize(Result);
      FillChar(Result, SizeOf(Result), 0);
      Result.SendResult := srUnknownError;
      if E is EOSError then
        Result.ErrorCode := EOSError(E).ErrorCode
      else
        Result.ErrorCode := ERROR_GEN_FAILURE;
      Result.ErrorMessage := E.Message;
    end;
  end;
end;

class function TMyExeptionDialog.ThreadSafe: Boolean;
begin
  Result := False; // VCL is not thread safe, indicate this
end;

{ TMyExeptionDialogForm }

constructor TMyExeptionDialogForm.Create(const ADialog: TBaseDialog);
begin
  FDialog := ADialog;
  FExceptionInfo := FDialog.ExceptionInfo;
  FOptions := FDialog.Options;
  inherited Create(nil);
end;

procedure TMyExeptionDialogForm.FormCreate(Sender: TObject);
var
  I, C: Integer;
  Error: Exception;
begin
  // Get exception object - in case you want to use it (not used in this example, though)
  if Assigned(ExceptionInfo.ExceptionObject) and ExceptionInfo.ExceptionNative then
    Error := Exception(ExceptionInfo.ExceptionObject)
  else
    Error := nil; // will be nil for, say, ANSI exceptions from DLL caught in UNICODE exe

  ListBox.Clear;

  // Add some exception information:
  ListBox.Items.Add(FmtPointerToStr(ExceptionInfo.Address));
  ListBox.Items.Add(ExceptionInfo.ClassName);
  ListBox.Items.Add(ExceptionInfo.ExceptionMessage);

  // Add at most 5 items with line numbers from call stack
  C := 0;
  for I := 0 to ExceptionInfo.CallStack.Count - 1 do
    if ExceptionInfo.CallStack[I].Location.LineNumber > 0 then
    begin
      ListBox.Items.Add(LocationToStr(ExceptionInfo.CallStack[I].Location, False, False, False, False, False, True));
      Inc(C);
      if C > 5 then
        Break;
    end;

  // Add some system information from bug report
  ListBox.Items.Add(Format('%s: %s', [Options.CustomizedExpandedTexts[mtLog_OSType], GetOSTypeStr]));
  ListBox.Items.Add(Format('%s: %s', [Options.CustomizedExpandedTexts[mtLog_OSBuildN], GetOSBuild]));
  ListBox.Items.Add(Format('%s: %s', [Options.CustomizedExpandedTexts[mtLog_OSUpdate], GetOSUpdate]));
  ListBox.Items.Add(Format('%s: %s (%s)', [Options.CustomizedExpandedTexts[mtLog_OSLanguage], GetOSNonUnicodeLanguage, GetOSCharset]));
  ListBox.Items.Add(Format('%s: %s', [Options.CustomizedExpandedTexts[mtLog_CmpTotalMemory], FmtSize(GetTotalMemory)]));
  ListBox.Items.Add(Format('%s: %s', [Options.CustomizedExpandedTexts[mtLog_CmpFreeMemory], FmtSize(GetFreeMemory)]));
  ListBox.Items.Add(Format('%s: %s', [Options.CustomizedExpandedTexts[mtLog_CmpTotalDisk], FmtSize(GetTotalDisk)]));

  // Add some custom information
  ListBox.Items.Add('Application License: ' + {$IFDEF ENTERPRISE}'ENT'{$ELSE}'STD'{$ENDIF});
end;

procedure TMyExeptionDialogForm.URLLabelClick(Sender: TObject);
begin
  // Open your web-site and (optionally) supply exception's BugID
  ShellExec(Format('http://www.example.com/feedback.php?BugID=%s', [ExceptionInfo.BugIDStr]));
end;

procedure TMyExeptionDialogForm.SendAndTryClick(Sender: TObject);
begin
  ModalResult := mrYes; // any value, which you want to analyze in TMyExeptionDialog.ShowModalInternal
  Hide;
end;

procedure TMyExeptionDialogForm.TryButtonClick(Sender: TObject);
begin
  ModalResult := mrOk; // any value, which you want to analyze in TMyExeptionDialog.ShowModalInternal
  Hide;
end;

procedure TMyExeptionDialogForm.ExitButtonClick(Sender: TObject);
begin
  TerminateProcess(GetCurrentProcess, ExceptionInfo.ExceptionCode);
  // Alternatively, you may try (see also above):
  // ModalResult := mrCancel; // any value, which you want to analyze in TMyExeptionDialog.ShowModalInternal
  // Hide;
end;

procedure TMyExeptionDialogForm.CopyButtonClick(Sender: TObject);
begin
  Clipboard.AsText := ListBox.Items.Text;
  // You may also try:
  // Dialog.CopyReportToClipboard; // <- copies full bug report into clipboard (in 2 forms: one as simple text, other is as file)
  // Clipboard.AsText := ExceptionInfo.CallStack.ToString; // <- copies call stack only
end;

procedure TMyExeptionDialogForm.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  // Don't forget to set the Form's KeyPreview property to true, or this won't trap the key
  if Key = VK_F1 then
    Application.HelpSystem.ShowTopicHelp('RefInternalError', Application.CurrentHelpFile);
end;

initialization
  // Register your dialog, so it can be used by EurekaLog
  RegisterDialogClass(TMyExeptionDialog);
  // Switch to your dialog
  CurrentEurekaLogOptions.ExceptionDialogType := TMyExeptionDialog.ClassName;

  // You may keep RegisterDialogClass in this unit,
  // but move chaging CurrentEurekaLogOptions.ExceptionDialogType somewhere else

end.

// Please note that dialog class have TONS of useful methods. Call them, don't be shy.