paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2026-02-19 18:36:42 +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 GetTextBuf(Buffer: PChar; BufSize: Integer): Integer; virtual;
function GetTextLen: Integer; virtual; function GetTextLen: Integer; virtual;
procedure SetTextBuf(Buffer: PChar); 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 ScreenToClient(const APoint: TPoint): TPoint;
function ClientToScreen(const APoint: TPoint): TPoint; function ClientToScreen(const APoint: TPoint): TPoint;
function ScreenToControl(const APoint: TPoint): TPoint; function ScreenToControl(const APoint: TPoint): TPoint;
@ -1828,7 +1828,7 @@ type
function GetClientRect: TRect; override; function GetClientRect: TRect; override;
function GetControlOrigin: TPoint; override; function GetControlOrigin: TPoint; override;
function GetDeviceContext(var WindowHandle: HWND): HDC; override; function GetDeviceContext(var WindowHandle: HWND): HDC; override;
function IsControlMouseMsg(var TheMessage: TLMMouse): Boolean; function IsControlMouseMsg(var TheMessage): Boolean;
procedure CreateHandle; virtual; procedure CreateHandle; virtual;
procedure CreateParams(var Params: TCreateParams); virtual; procedure CreateParams(var Params: TCreateParams); virtual;
procedure CreateWnd; virtual; //creates the window procedure CreateWnd; virtual; //creates the window

3
lcl/include/control.inc
View File

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

33
lcl/include/wincontrol.inc
View File

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