unit UnitFrmDebug;

interface

uses
  Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TFrmDebug = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Memo1: TListBox;
    Label1: TLabel;
    procedure FormShow(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
        procedure DumpLog(filename : string);
        function LogToString : string;
  protected
        procedure CreateParams(var Params: TCreateParams); override;
  public
    { Public declarations }
        procedure AppendLog( s : string; IncludeLastError : boolean = false);
        procedure ApplicationException(Sender: TObject; E: Exception);
        procedure EmergencyDump;
  end;



var
  FrmDebug: TFrmDebug;

implementation

{$R *.dfm}

uses Windows, UnitMisc, Generics.collections, clipbrd, math, UnitFocusManager;

var
    AppendCount : integer;
    AppendStr : string;
    sl : TList<string>;

procedure TFrmDebug.CreateParams(var Params: TCreateParams);
begin
    inherited CreateParams(Params);
    // allow context taskbar context menu and
    // show me on the taskbar - independant of main form
    with Params do begin
        ExStyle := ExStyle or WS_EX_APPWINDOW;
        WndParent := GetDesktopwindow;
    end;
end;

procedure TFrmDebug.FormShow(Sender: TObject);
var i : integer;
begin
    TFocusManager.ForceForeground(self.Handle);
    memo1.Clear;
    for i := 0 to min(200,sl.Count-1) do begin
        memo1.Items.Add(sl[i])
    end;
end;


// NOTE:
// This routine is safe to call even before the form is created
procedure TFrmDebug.AppendLog( s : string; IncludeLastError : boolean = false);
    function Prefix : string;
    begin
        if assigned(FrmDebug) then begin
            result := TimeToStr(Now) + ': ';
        end else begin
            result := TimeToStr(Now) + ':(x) ';
        end;
    end;
var i : integer;
begin
    if (sl=nil) then sl := TList<string>.create;

    if (IncludeLastError) then begin
        i := getLastError;
        s := s + ' :('+IntToStr(i)+') ' + SysErrorMessage(i);
    end;
    AppendStr := Prefix + s;

    sl.Insert(0, AppendStr); // first is newest, last is oldest

    if sl.Count > 20000 then begin
        sl.Delete(sl.Count-1);
    end;

    if assigned(FrmDebug) and (frmdebug.Visible) then begin
        if FrmDebug.memo1.items.Count > 1000 then begin
            FrmDebug.memo1.items.Delete(FrmDebug.memo1.items.Count-1);
        end;
        frmdebug.Memo1.items.Insert(0, AppendStr)
    end;
end;



procedure TFrmDebug.ApplicationException(Sender: TObject; E: Exception);
begin
    AppendLog(e.Message);
    DumpLog('Debug.txt');

    Windows.SetLastError(ERROR_SUCCESS);
    ShowMessage(
        e.Message + #13#10 +
        '[Debug.txt] log created.'
    );
end;

procedure TFrmDebug.EmergencyDump;
begin
    DumpLog('Debug.txt');
end;

function TFrmDebug.LogToString : string;
var i : integer;
begin
    for i := 0 to sl.Count-1 do begin
        result := result + sl.Items[i] + #13#10;
    end;
end;

procedure TFrmDebug.Button1Click(Sender: TObject);
var s : string;
    i : integer;
begin
    clipboard.SetTextBuf(pwidechar(self.LogToString));
end;

procedure TFrmDebug.Button2Click(Sender: TObject);
begin
    DumpLog('Debug.txt');
    ShowMessage('Debug.txt Created');
end;

procedure TFrmDebug.DumpLog(filename : string);
var i : integer;
    backup : string;
    s : string;
    sw : TStringWriter;
begin
    filename := UnitMisc.GetAppPath + filename;

    if FileExists(filename) then begin
        i := 1;

        repeat
            backup := filename + '.bak' + IntToStr(i);
            inc(i);
        until not FileExists(backup);
        RenameFile(filename, backup);
    end;


    with TStreamWriter.Create(filename, false, TEncoding.Unicode) do begin
        Write(LogToString);
        Free();
    end;
end;


initialization
begin
    AppendCount := 0;
    AppendStr := '';
end;

end.
