paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-10-01 03:29:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: detect wincontrol destroy during WindProc / fixes issue #0028404

Browse Source 
git-svn-id: trunk@63507 -
This commit is contained in:
martin 2020-07-04 17:28:40 +00:00
parent 98c551c630
commit d031209b99
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

@ -323,6 +323,8 @@ type
{ TWindowProcHelper }
TWindowProcHelper = record
private
procedure SetlWinControl(AValue: TWinControl);
private
// WindowProc parameters
Window: HWnd; // DWord / QWord
@ -332,7 +334,7 @@ type
// Other variables
LMessage: TLMessage;
PLMsg: PLMessage;
lWinControl: TWinControl;
FlWinControl: TWinControl;
WinProcess: Boolean;
NotifyUserInput: Boolean;
WindowInfo: PWin32WindowInfo;
@ -399,7 +401,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
@ -518,6 +529,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;
@ -1955,6 +1978,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;
@ -1975,6 +2006,7 @@ const
WM_DPICHANGED = $02E0;
{$ENDIF}
begin
try
FillChar(LMessage, SizeOf(LMessage), 0);
PLMsg := @LMessage;
WinProcess := True;
@ -1987,6 +2019,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
@ -2702,6 +2735,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;
{------------------------------------------------------------------------------
@ -2732,6 +2769,7 @@ begin
Helper.LParam := LParam;
Helper.NMHdr := PNMHdr(LParam);
Result := Helper.DoWindowProc;
Helper.lWinControl := nil;
end;
{$ifdef MSG_DEBUG}