paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-14 13:19:52 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: Implement Application.OnLog. Resolves issue #40913.

Browse Source
This commit is contained in:
Bart 2025-04-28 22:54:30 +02:00
parent 5188131074
commit 2e0cb2cfbf
2 changed files with 10 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
lcl/forms.pp
View File

@ -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;

6
lcl/include/application.inc
View File

@ -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;