- added: [win32] mousewheel default handler sends scrollbar messages

- fixed: lmsetcursor; partial todo

git-svn-id: trunk@5392 -

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
 

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;
+	// check if mouse cursor within this window, otherwise send message to window the mouse is hovering over
-        UserData := Pointer(GetWindowLong(Window, GWL_USERDATA));
+	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
 

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
 

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);
+  Windows.SetCursor(Windows.LoadCursor(0, Cursor));
-  Assert(False, Format('Trace:Cursor handle --> 0x%X', [Res]));
   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
 

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