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

LCL win: detect wincontrol destroy during WindProc / fixes Issue #28404

Browse Source 
git-svn-id: branches/fixes_2_0@64007 -
This commit is contained in:
mattias 2020-10-15 11:16:16 +00:00
parent 7b2dec7cc7
commit 0c525d9222
1 changed files with 39 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
lcl/interfaces/win32/win32callback.inc
View File

@ -294,6 +294,8 @@ type
TAccessCustomEdit = class(TCustomEdit);
TWindowProcHelper = class
private
procedure SetlWinControl(AValue: TWinControl);
private
// WindowProc parameters
Window: HWnd; // DWord / QWord
@ -303,7 +305,7 @@ type
// Other variables
LMessage: TLMessage;
PLMsg: PLMessage;
lWinControl: TWinControl;
FlWinControl: TWinControl;
WinProcess: Boolean;
NotifyUserInput: Boolean;
WindowInfo: PWin32WindowInfo;
@ -370,7 +372,16 @@ type
procedure UpdateLMMovePos(X, Y: Smallint);
procedure UpdateUIState(CharCode: Word);
function DoWindowProc: LResult; // Called from the actual WindowProc.
property lWinControl: TWinControl read FlWinControl write SetlWinControl;
end;
PWindowProcHelper = ^TWindowProcHelper;
{ TWindProcNotificationReceiver }
TWindProcNotificationReceiver = class
procedure ReceiveDestroyNotify(Sender: TObject);
end;
// Implementation of TWindowProcHelper
@ -489,6 +500,18 @@ begin
{$endif}
end;
procedure TWindowProcHelper.SetlWinControl(AValue: TWinControl);
begin
if FlWinControl = AValue then Exit;
if FlWinControl <> nil then
FlWinControl.RemoveHandlerOnBeforeDestruction(@TWindProcNotificationReceiver(@Self).ReceiveDestroyNotify);
FlWinControl := AValue;
if FlWinControl <> nil then
FlWinControl.AddHandlerOnBeforeDestruction(@TWindProcNotificationReceiver(@Self).ReceiveDestroyNotify);
end;
procedure TWindowProcHelper.CalcClipRgn(PaintRegion: HRGN);
var
nSize: DWORD;
@ -1926,6 +1949,14 @@ begin
end;
end;
{ TWindProcNotificationReceiver }
procedure TWindProcNotificationReceiver.ReceiveDestroyNotify(Sender: TObject);
begin
assert(PWindowProcHelper(Self)^.FlWinControl = Sender, 'TWindProcNotificationReceiver.ReceiveDestroyNotify: PWindowProcHelper(Self)^.FlWinControl = Sender');
PWindowProcHelper(Self)^.lWinControl := nil;
end;
// This is called from the actual WindowProc.
function TWindowProcHelper.DoWindowProc: LResult;
@ -1945,6 +1976,7 @@ const
WM_DPICHANGED = $02E0;
{$ENDIF}
begin
try
FillChar(LMessage, SizeOf(LMessage), 0);
PLMsg := @LMessage;
WinProcess := True;
@ -1957,6 +1989,7 @@ begin
end else begin
lWinControl := WindowInfo^.WinControl;
end;
if (IgnoreNextCharWindow <> 0) and ((Msg = WM_CHAR) or (Msg = WM_SYSCHAR)) then
begin
if IgnoreNextCharWindow = Window then
@ -2643,6 +2676,10 @@ begin
else if PLMsg = @LMNotify then Result := LMNotify.Result
else if PLMsg = @LMMouseEvent then Result := LMMouseEvent.Result
else Result := PLMsg^.Result;
finally
lWinControl := nil;
end;
end;
{------------------------------------------------------------------------------
@ -2677,6 +2714,7 @@ begin
finally
Helper.Free;
end;
Helper.lWinControl := nil;
end;
{$ifdef MSG_DEBUG}