paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-06 05:38:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: WidgetSet.BeginMessageProcess/EndMessageProcess added

Browse Source
This commit is contained in:
rich2014 2023-08-26 23:48:04 +08:00
parent 5aab1a7b18
commit 2d1027253f
3 changed files with 35 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
lcl/include/application.inc
View File

@ -416,13 +416,20 @@ end;
TApplication ProcesssMessages "Enter the messageloop and process until empty"
------------------------------------------------------------------------------}
procedure TApplication.ProcessMessages;
var
context: TLCLHandle;
begin
if Self=nil then begin
// when the programmer did a mistake, avoid getting strange errors
raise Exception.Create('Application=nil');
end;
WidgetSet.AppProcessMessages;
ProcessAsyncCallQueue;
context := WidgetSet.BeginMessageProcess;
try
WidgetSet.AppProcessMessages;
ProcessAsyncCallQueue;
finally
WidgetSet.EndMessageProcess(context);
end;
end;
{------------------------------------------------------------------------------
@ -1267,9 +1274,16 @@ end;
Handles all messages first then the Idle
------------------------------------------------------------------------------}
procedure TApplication.HandleMessage;
var
context: TLCLHandle;
begin
WidgetSet.AppProcessMessages; // process all events
if not Terminated then Idle(true);
context := WidgetSet.BeginMessageProcess;
try
WidgetSet.AppProcessMessages; // process all events
if not Terminated then Idle(true);
finally
WidgetSet.EndMessageProcess(context);
end;
end;
function TApplication.HelpContext(Context: THelpContext): Boolean;

9
lcl/include/interfacebase.inc
View File

@ -84,6 +84,15 @@ procedure TWidgetSet.AppSetupMainForm(AMainForm: TObject); //e.g. handle widge
begin
end;
function TWidgetSet.BeginMessageProcess: TLCLHandle;
begin
Result := 0;
end;
procedure TWidgetSet.EndMessageProcess(context: TLCLHandle);
begin
end;
function TWidgetSet.GetLCLCapability(ACapability: TLCLCapability): PtrUInt;
begin
case ACapability of

9
lcl/interfacebase.pp
View File

@ -147,7 +147,14 @@ type
function AppRestoreStayOnTopFlags(const ASystemTopAlso: Boolean = False): Boolean; virtual;
procedure AppSetMainFormOnTaskBar(const DoSet: Boolean); virtual;
procedure AppSetupMainForm(AMainForm: TObject); virtual;
// Begin/End processing messages, which can be used to acquire/release
// resources during message processing.
// for example, on Cocoa, it needs to be used to release AutoReleasePool
// to avoid resource leaks.
function BeginMessageProcess: TLCLHandle; virtual;
procedure EndMessageProcess(context: TLCLHandle); virtual;
function LCLPlatform: TLCLPlatform; virtual; abstract;
function GetLCLCapability(ACapability: TLCLCapability): PtrUInt; virtual;