From 2e0cb2cfbfda3030de7f498d3d144621d3371f9e Mon Sep 17 00:00:00 2001
From: Bart <9132501-flyingsheep@users.noreply.gitlab.com>
Date: Mon, 28 Apr 2025 22:54:30 +0200
Subject: [PATCH] LCL: Implement Application.OnLog. Resolves issue #40913.

---
 lcl/forms.pp                | 4 ++++
 lcl/include/application.inc | 6 ++++++
 2 files changed, 10 insertions(+)

diff --git a/lcl/forms.pp b/lcl/forms.pp
index 6f640f44a4..67bd31c985 100644
--- a/lcl/forms.pp
+++ b/lcl/forms.pp
@@ -1321,6 +1321,7 @@ type
   TIdleEvent = procedure (Sender: TObject; var Done: Boolean) of object;
   TOnUserInputEvent = procedure(Sender: TObject; Msg: Cardinal) of object;
   TDataEvent = procedure (Data: PtrInt) of object;
+  TLogMessageEvent = Procedure (Sender : TObject; EventType : TEventType; Const Msg : String) of Object;
 
   // application hint stuff
   TCMHintShow = record
@@ -1526,6 +1527,7 @@ type
     FOnShortcut: TShortcutEvent;
     FOnShowHint: TShowHintEvent;
     FOnUserInput: TOnUserInputEvent;
+    FOnLog: TLogMessageEvent;
     FAsyncCall: TAsyncCallQueues;
     FShowHint: Boolean;
     FShowMainForm: Boolean;
@@ -1597,6 +1599,7 @@ type
     procedure ReleaseComponents;
     procedure DoBeforeFinalization;
     function GetParams(Index: Integer): string; override;
+    Procedure DoLog(EventType : TEventType; const Msg : String); override;
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
@@ -1770,6 +1773,7 @@ type
     property OnShortcut: TShortcutEvent read FOnShortcut write FOnShortcut;
     property OnShowHint: TShowHintEvent read FOnShowHint write FOnShowHint;
     property OnUserInput: TOnUserInputEvent read FOnUserInput write FOnUserInput;
+    property OnLog: TLogMessageEvent read FOnLog write FOnLog;
     property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
     property OnCircularException: TExceptionEvent read FOnCircularException write FOnCircularException;
     property ShowButtonGlyphs: TApplicationShowGlyphs read FShowButtonGlyphs write SetShowButtonGlyphs default sbgAlways;
diff --git a/lcl/include/application.inc b/lcl/include/application.inc
index 5a8452c352..af66a6e3f7 100644
--- a/lcl/include/application.inc
+++ b/lcl/include/application.inc
@@ -1131,6 +1131,12 @@ begin
   Result:=ParamStrUTF8(Index);
 end;
 
+procedure TApplication.DoLog(EventType: TEventType; const Msg: String);
+begin
+  if Assigned(FOnLOg) then
+    FOnLog(Self, EventType, Msg);
+end;
+
 procedure TApplication.IconChanged(Sender: TObject);
 var
   i: integer;