paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-12-04 23:57:33 +01:00
Code Issues Packages Projects Releases Wiki Activity

lcl: preserve extra fields when passing lm_mousewheel message to child controls (issue #0014063)

Browse Source 
git-svn-id: trunk@27086 -
This commit is contained in:
paul 2010-08-13 02:52:11 +00:00
parent 21afcaf45f
commit 7dbd789466
3 changed files with 25 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
lcl/controls.pp
View File

@ -1330,7 +1330,7 @@ type
function GetTextBuf(Buffer: PChar; BufSize: Integer): Integer; virtual;
function GetTextLen: Integer; virtual;
procedure SetTextBuf(Buffer: PChar); virtual;
function Perform(Msg:Cardinal; WParam: WParam; LParam: LParam): LRESULT;
function Perform(Msg: Cardinal; WParam: WParam; LParam: LParam): LRESULT;
function ScreenToClient(const APoint: TPoint): TPoint;
function ClientToScreen(const APoint: TPoint): TPoint;
function ScreenToControl(const APoint: TPoint): TPoint;
@ -1828,7 +1828,7 @@ type
function GetClientRect: TRect; override;
function GetControlOrigin: TPoint; override;
function GetDeviceContext(var WindowHandle: HWND): HDC; override;
function IsControlMouseMsg(var TheMessage: TLMMouse): Boolean;
function IsControlMouseMsg(var TheMessage): Boolean;
procedure CreateHandle; virtual;
procedure CreateParams(var Params: TCreateParams); virtual;
procedure CreateWnd; virtual; //creates the window

3
lcl/include/control.inc
View File

@ -1014,7 +1014,7 @@ end;
TControl.Perform
------------------------------------------------------------------------------}
function TControl.Perform(Msg:Cardinal; WParam: WParam; LParam: LParam): LRESULT;
function TControl.Perform(Msg: Cardinal; WParam: WParam; LParam: LParam): LRESULT;
var
Message : TLMessage;
begin
@ -2225,7 +2225,6 @@ procedure TControl.WMMouseWheel(var Message: TLMMouseEvent);
var
MousePos: TPoint;
begin
Assert(False, Format('Trace: [TControl.LMMouseWheel] %s', [ClassName]));
DoBeforeMouseMessage;
MousePos.X := Message.X;

33
lcl/include/wincontrol.inc
View File

@ -4527,8 +4527,10 @@ end;
{------------------------------------------------------------------------------
TWinControl IsControlMouseMsg
------------------------------------------------------------------------------}
function TWinControl.IsControlMouseMsg(var TheMessage: TLMMouse) : Boolean;
function TWinControl.IsControlMouseMsg(var TheMessage): Boolean;
var
MouseMessage: TLMMouse absolute TheMessage;
MouseEventMessage: TLMMouseEvent;
Control: TControl;
ScrolledOffset, P: TPoint;
ClientBounds: TRect;
@ -4545,7 +4547,7 @@ begin
else
begin
// do query wincontrol childs, in case they overlap
Control := ControlAtPos(SmallPointToPoint(TheMessage.Pos),
Control := ControlAtPos(SmallPointToPoint(MouseMessage.Pos),
[capfAllowWinControls]);
if Control is TWinControl then
begin
@ -4561,16 +4563,16 @@ begin
if Control <> nil then
begin
// map mouse coordinates to control
ScrolledOffset:=GetClientScrollOffset;
ScrolledOffset := GetClientScrollOffset;
P.X := TheMessage.XPos - Control.Left + ScrolledOffset.X;
P.Y := TheMessage.YPos - Control.Top + ScrolledOffset.Y;
P.X := MouseMessage.XPos - Control.Left + ScrolledOffset.X;
P.Y := MouseMessage.YPos - Control.Top + ScrolledOffset.Y;
if (Control is TWinControl) and TWinControl(Control).HandleAllocated then
begin
// map coordinates to client area of control
LCLIntf.GetClientBounds(TWinControl(Control).Handle,ClientBounds);
dec(P.X,ClientBounds.Left);
dec(P.Y,ClientBounds.Top);
LCLIntf.GetClientBounds(TWinControl(Control).Handle, ClientBounds);
dec(P.X, ClientBounds.Left);
dec(P.Y, ClientBounds.Top);
{$IFDEF VerboseMouseBugfix}
DebugLn(['TWinControl.IsControlMouseMsg ',Name,' -> ',Control.Name,
' MsgPos=',TheMessage.Pos.X,',',TheMessage.Pos.Y,
@ -4581,8 +4583,17 @@ begin
);
{$ENDIF}
end;
TheMessage.Result := Control.Perform(TheMessage.Msg, WParam(TheMessage.Keys),
LParam(Integer(PointToSmallPoint(P))));
if MouseMessage.Msg = LM_MOUSEWHEEL then
begin
MouseEventMessage := TLMMouseEvent(TheMessage);
MouseEventMessage.X := P.X;
MouseEventMessage.Y := P.Y;
Dispatch(MouseEventMessage);
MouseMessage.Result := MouseEventMessage.Result;
end
else
MouseMessage.Result := Control.Perform(MouseMessage.Msg, WParam(MouseMessage.Keys),
LParam(Integer(PointToSmallPoint(P))));
Result := True;
end;
end;
@ -5158,7 +5169,7 @@ begin
DebugLn('TWinControl.WndPRoc A ',Name,':',ClassName);
{$ENDIF}
//if Message.Msg=LM_RBUTTONUP then begin DebugLn(['TWinControl.WndProc ',DbgSName(Self)]); DumpStack end;
if IsControlMouseMSG(TLMMouse(Message)) then
if IsControlMouseMSG(Message) then
Exit
else
begin