diff --git a/lcl/include/wincontrol.inc b/lcl/include/wincontrol.inc index 243a5892cf..4b9c7cb1d2 100644 --- a/lcl/include/wincontrol.inc +++ b/lcl/include/wincontrol.inc @@ -2871,6 +2871,8 @@ begin Shift := [ssMiddle]; DoMouseWheel(Shift, Message.WheelDelta, MousePos); + + inherited; end; {------------------------------------------------------------------------------ @@ -3446,6 +3448,10 @@ end; { ============================================================================= $Log$ + Revision 1.217 2004/04/10 17:54:52 micha + - added: [win32] mousewheel default handler sends scrollbar messages + - fixed: lmsetcursor; partial todo + Revision 1.216 2004/04/09 23:52:01 mattias fixed hiding uninitialized controls diff --git a/lcl/interfaces/win32/win32callback.inc b/lcl/interfaces/win32/win32callback.inc index 1290c5b6d9..cea25d4b3c 100644 --- a/lcl/interfaces/win32/win32callback.inc +++ b/lcl/interfaces/win32/win32callback.inc @@ -123,6 +123,7 @@ Var LMessage: TLMessage; PLMsg: PLMessage; R: TRect; + P: TPoint; NewLeft, NewTop, NewWidth, NewHeight: integer; LeftOffset, TopOffset: Integer; OwnerObject: TObject; @@ -627,12 +628,29 @@ Begin PLMsg:=@LMMouseEvent; With LMMouseEvent Do Begin - Msg := LM_MOUSEWHEEL; - WheelDelta := SmallInt(Hi(WParam)); X := SmallInt(Lo(LParam)); Y := SmallInt(Hi(LParam)); - State := GetShiftState; - UserData := Pointer(GetWindowLong(Window, GWL_USERDATA)); + // check if mouse cursor within this window, otherwise send message to window the mouse is hovering over + if GetWindowRect(Window, R) <> 0 then + begin + if (X < R.Left) or (R.Right < X) + or (Y < R.Top) or (R.Bottom < Y) then + begin + P.X := X; + P.Y := Y; + Window := TWin32WidgetSet(InterfaceObject).WindowFromPoint(P); + if Window = HWND(nil) then + exit; + + PostMessage(Window, WM_MOUSEWHEEL, WParam, LParam); + exit; + end; + end; + + Msg := LM_MOUSEWHEEL; + WheelDelta := SmallInt(Hi(WParam)); + State := GetShiftState; + UserData := Pointer(GetWindowLong(Window, GWL_USERDATA)); End; End; //TODO:LM_MOVEPAGE,LM_MOVETOROW,LM_MOVETOCOLUMN @@ -936,8 +954,6 @@ End; ------------------------------------------------------------------------------} function OverlayWindowProc(Window: HWnd; Msg: UInt; WParam: Windows.WParam; LParam: Windows.LParam): LResult; stdcall; -var - PS: PAINTSTRUCT; begin case Msg of WM_ERASEBKGND: @@ -1110,6 +1126,10 @@ end; { $Log$ + Revision 1.99 2004/04/10 17:54:52 micha + - added: [win32] mousewheel default handler sends scrollbar messages + - fixed: lmsetcursor; partial todo + Revision 1.98 2004/03/05 18:37:46 micha prevent selection invalid page diff --git a/lcl/interfaces/win32/win32int.pp b/lcl/interfaces/win32/win32int.pp index 421902de7d..4d15e31591 100644 --- a/lcl/interfaces/win32/win32int.pp +++ b/lcl/interfaces/win32/win32int.pp @@ -78,7 +78,7 @@ Type Procedure ResizeChild(Sender: TWinControl; Left, Top, Width, Height: Integer); Procedure AssignSelf(Window: HWnd; Data: Pointer); Procedure ReDraw(Child: TObject); - Procedure LmSetCursor(Sender: TObject); + Procedure LmSetCursor(Sender: TObject; Data: Pointer); Procedure SetLimitText(Window: HWND; Limit: Word); Procedure ShowHide(Sender: TObject); @@ -224,6 +224,10 @@ End. { ============================================================================= $Log$ + Revision 1.76 2004/04/10 17:54:52 micha + - added: [win32] mousewheel default handler sends scrollbar messages + - fixed: lmsetcursor; partial todo + Revision 1.75 2004/03/26 21:20:54 vincents Fixed line endings diff --git a/lcl/interfaces/win32/win32object.inc b/lcl/interfaces/win32/win32object.inc index c24448b668..1c0ac79dc5 100644 --- a/lcl/interfaces/win32/win32object.inc +++ b/lcl/interfaces/win32/win32object.inc @@ -423,7 +423,7 @@ Begin ShowHide(Sender); End; LM_SETCURSOR: - LmSetCursor(Sender); + LmSetCursor(Sender, Data); LM_SETLABEL: SetLabel(Sender, Data); LM_GETVALUE: @@ -1781,18 +1781,18 @@ const WARNING: Sender will be casted to TControl, CLEANUP! ------------------------------------------------------------------------------} -Procedure TWin32WidgetSet.LmSetCursor(Sender: TObject); +Procedure TWin32WidgetSet.LmSetCursor(Sender: TObject; Data: Pointer); Var Cursor: PChar; - Res: HCURSOR; Begin Assert(False, 'Trace:TWin32WidgetSet.LmSetCursor - Start'); Assert(False, Format('Trace:TWin32WidgetSet.LmSetCursor - Sender --> %S', [Sender.ClassName])); Assert(False, 'Trace:TWin32WidgetSet.LmSetCursor - Getting the cursor'); - Cursor := LclCursorToWin32CursorMap[TControl(Sender).Cursor]; + if Data = nil then + Data := Pointer(Integer(crDefault)); + Cursor := LclCursorToWin32CursorMap[Integer(Data)]; Assert(False, 'Trace:TWin32WidgetSet.LmSetCursor - Loading the cursor'); - Res := LoadCursor(0, Cursor); - Assert(False, Format('Trace:Cursor handle --> 0x%X', [Res])); + Windows.SetCursor(Windows.LoadCursor(0, Cursor)); Assert(False, 'Trace:TWin32WidgetSet.LmSetCursor - Exit'); End; @@ -2092,6 +2092,9 @@ Begin pClassName := @ClsName; WindowTitle := StrCaption; SubClassWndProc := nil; + if Sender is TTreeView then + if TTreeView(Sender).BorderStyle = bsSingle then + FlagsEx := FlagsEx or WS_EX_CLIENTEDGE; End; csForm: Begin @@ -3024,6 +3027,10 @@ End; { $Log$ + Revision 1.184 2004/04/10 17:54:52 micha + - added: [win32] mousewheel default handler sends scrollbar messages + - fixed: lmsetcursor; partial todo + Revision 1.183 2004/03/18 22:26:24 mattias fixed grids TComboBox from Jesus diff --git a/lcl/interfaces/win32/win32winapi.inc b/lcl/interfaces/win32/win32winapi.inc index c611ca0721..681dcec9f1 100644 --- a/lcl/interfaces/win32/win32winapi.inc +++ b/lcl/interfaces/win32/win32winapi.inc @@ -1,4 +1,4 @@ -// included by win32int.pp + {****************************************************************************** All Windows API implementations. @@ -171,6 +171,32 @@ var end; end; + procedure CallMouseWheelHandler; + var + ScrollInfo: Windows.tagScrollInfo; + WParam: Windows.WParam; + begin + if not TWinControl(Sender).HandleAllocated then + exit; + + FillChar(ScrollInfo, sizeof(ScrollInfo), #0); + ScrollInfo.cbSize := sizeof(ScrollInfo); + ScrollInfo.fMask := SIF_PAGE or SIF_POS or SIF_RANGE; + if Windows.GetScrollInfo(TWinControl(Sender).Handle, SB_VERT, ScrollInfo) then + begin + with TLMMouseEvent(Message) do + begin + WParam := Windows.WParam(ScrollInfo.nPos - (WheelDelta * Integer(ScrollInfo.nPage) * 4) div (120 * 10)); + if WParam > ScrollInfo.nMax then + WParam := ScrollInfo.nMax; + if WParam < ScrollInfo.nMin then + WParam := ScrollInfo.nMin; + WParam := SB_THUMBPOSITION or (WParam shl 16); + end; + Windows.PostMessage(TWinControl(Sender).Handle, WM_VSCROLL, WParam, HWND(nil)); + end; + end; + procedure DrawOwnerButton(Data: PDrawItemStruct); var Flags:integer; // How the button looks like (pressed or not pressed) BitmapHandle: HBITMAP; // Handle of the button glyph @@ -321,6 +347,13 @@ begin end; end; end; + + LM_MOUSEWHEEL: + begin + // provide default wheel scrolling functionality + CallMouseWheelHandler; + end; + end; end; @@ -2941,6 +2974,10 @@ end; { ============================================================================= $Log$ + Revision 1.106 2004/04/10 17:54:52 micha + - added: [win32] mousewheel default handler sends scrollbar messages + - fixed: lmsetcursor; partial todo + Revision 1.105 2004/03/25 23:08:22 vincents added Trace: to assert message