Italian community of Lazarus and Free Pascal

procedure TForm1.FormCreate(Sender: TObject);
begin

  bftoolbox := TBaseForm_ToolBox.Create;
  bftoolbox.Exception_ShowMessage:=TRUE;
  {$IFDEF LINUX}
  bftoolbox.LogPath := '/tmp';
  {$ENDIF}
  {$IFDEF WINDOWS}
  bftoolbox.LogPath := 'c:\tmp';
  {$ENDIF}
  lbLog.Caption:=bftoolbox.LogPath ;

  Caption := bftoolbox.LogPath;
  if not ForceDirectoriesUTF8(bftoolbox.LogPath) then
     ShowMessage('Directory' + LineEnding + Caption + LineEnding + 'non creata!');

end;

procedure TfmBaseForm.DoConfirm;
var SaveGuiMode: TBaseForm_GuiMode;
    BFCR: TBaseForm_BFCR;
begin
   SaveGuiMode := GuiMode;
   try
      // create record for intermethod communications
      with BFCR do begin
        Test.result:=TRUE;
        Test.CanForce:= FALSE;
        Test.MsgTestFailed:='';
        Test.MsgToForce:='';
      end;

      // test
      if Assigned(OnConfirmTest) then
         try
            if Assigned(FEventLog) then
               FEventLog.Log('DoConfirm / OnConfirmTest');
            OnConfirmTest(Self, BFCR);
            if not BFCR.Test.result then
               if Assigned(FEventLog) then
                  FEventLog.Log('DoConfirm / OnConfirmTest / Test Failed');
               if BFCR.Test.CanForce then begin
                  if MessageDlg('ATTENTION', BFCR.Test.MsgTestFailed + #10#10 + BFCR.Test.MsgToForce,
                                mtConfirmation, [mbYES, mbNo], 0)  mrYes then
                     exit;
                  if Assigned(FEventLog) then
                     FEventLog.Log('DoConfirm / OnConfirmTest / Execution Forced');
               end else begin
                  if BFCR.Test.MsgTestFailed  '' then
                     ShowMessage(BFCR.Test.MsgTestFailed);
                  exit;
               end;
         except
            on e: exception do begin
               raise TBaseForm_Exception_ConfirmTest.Create('Where: TEST FOR CONFIRM' + #10 + e.Message);
            end;
         end;

      // set gui
      case SaveGuiMode of
         bfgmInsert: GuiMode := bfgmConfirmInsertInProgress;
         bfgmEdit  : GuiMode := bfgmConfirmEditInProgress;
      end;

      // before Confirm
      if Assigned(OnConfirmBefore) then
         try
            if Assigned(FEventLog) then
               FEventLog.Log('DoConfirm / OnConfirmBefore');
            OnConfirmBefore(Self, BFCR);
         except
            on e: exception do begin
               raise TBaseForm_Exception_ConfirmBefore.Create('Where: BEFORE CONFIRM' + #10 + e.Message);
            end;
         end;

      // Confirm
      if Assigned(OnConfirmExecute) then
         try
            if Assigned(FEventLog) then
               FEventLog.Log('DoConfirm / OnConfirmExecute');
            OnConfirmExecute(Self, BFCR);
         except
            on e: exception do begin
               raise TBaseForm_Exception_ConfirmExecute.Create('Where: EXECUTE CONFIRM' + #10 + e.Message);
            end;
         end;

      // after Confirm
      if Assigned(OnConfirmAfter) then
         try
            if Assigned(FEventLog) then
               FEventLog.Log('DoConfirm / OnConfirmAfter');
            OnConfirmAfter(Self, BFCR);
         except
            on e: exception do begin
               raise TBaseForm_Exception_ConfirmAfter.Create('Where: AFTER CONFIRM' + #10 + e.Message);
            end;
         end;

      GuiMode := bfgmBrowse;

   except
      on e: exception do begin
         ManageException(e);
         GuiMode := SaveGuiMode;
      end;
   end;
end;

type
  TBaseForm_Behavior = (..., bfb_InstanceLog, bfb_ClassLog, ...);



procedure TfmBaseForm.UpdateBehavior;
begin

   ...

  if (bfb_InstanceLog in FBehavior)
     or
     (bfb_ClassLog in FBehavior) then begin

     if not Assigned(FEventLog) then begin
        FEventLog := TEventLog.Create(self);
        FEventLog.LogType := ltFile;
        FEventLog.Active := FALSE;
     end;

     if Assigned(ToolBox) then begin
        ForceDirectoriesUTF8(ToolBox.LogPath);
        FEventLog.FileName := ToolBox.LogPath;
        if RightStr(FEventLog.FileName, 1)  PathDelim then
           FEventLog.FileName := FEventLog.FileName + PathDelim;
        FEventLog.FileName := FEventLog.FileName + ClassName;
        if bfb_InstanceLog in FBehavior then
           FEventLog.FileName := FEventLog.FileName + FormatDateTime('yyyy-mm-dd_hhnnss', Now);
        FEventLog.FileName := FEventLog.FileName + '.log';
        FEventLog.Active := TRUE;
        FEventLog.Log('UpdateBehavior / Log Activate');
     end;

   ...

  end;

function TBaseForm_ToolBox.DumpExceptionCallStack(E: Exception): string;
var
  I: Integer;
  Frames: PPointer;
  Report: string;
begin
  Report := 'Program exception! ' + LineEnding +
    'Stacktrace (ToolBox):' + LineEnding + LineEnding;
  if E  nil then begin
    Report := Report + 'Exception class: ' + E.ClassName + LineEnding +
    'Message: ' + E.Message + LineEnding;
  end;
  Report := Report + BackTraceStrFunc(ExceptAddr);
  Frames := ExceptFrames;
  for I := 0 to ExceptFrameCount - 1 do
    Report := Report + LineEnding + BackTraceStrFunc(Frames[I]);
  result := Report;
end;