cursor management updated:

- lcl notifies interface via WSControl.SetCursor of changes
- fix win32 interface to respond to wm_setcursor callback and set correct cursor

git-svn-id: trunk@5398 -

lcl/controls.pp

@@ -1710,7 +1710,8 @@ implementation
 
 uses
   Forms, // the circle can't be broken without breaking Delphi compatibility
-  Math;  // Math is in RTL and only a few functions are used.
+  Math,  // Math is in RTL and only a few functions are used.
+  WSControls;
 
 var
   // The interface knows, which TWinControl has the capture. This stores
@@ -2241,6 +2242,11 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.195  2004/04/11 10:19:28  micha
+  cursor management updated:
+  - lcl notifies interface via WSControl.SetCursor of changes
+  - fix win32 interface to respond to wm_setcursor callback and set correct cursor
+
   Revision 1.194  2004/04/09 23:52:01  mattias
   fixed hiding uninitialized controls
 

lcl/include/control.inc

@@ -1798,12 +1798,7 @@ begin
   if FCursor <> Value
   then begin
     FCursor := Value;
-    // This should not be called if it is already set to VALUE but if
+    TWSControlClass(WidgetSetClass).SetCursor(Self, Value);
-    // it's not created when it's set, and you set it again it skips this,
-    // so for now I do it this way.
-    // later, I'll create the cursor in the CreateComponent
-    // (or something like that)
-    if not(csDesigning in ComponentState) then CNSendMessage(LM_SETCURSOR, Self, nil);
   end;
 end;
 
@@ -2880,6 +2875,11 @@ end;
 
 { =============================================================================
   $Log$
+  Revision 1.182  2004/04/11 10:19:28  micha
+  cursor management updated:
+  - lcl notifies interface via WSControl.SetCursor of changes
+  - fix win32 interface to respond to wm_setcursor callback and set correct cursor
+
   Revision 1.181  2004/04/10 17:58:56  mattias
   implemented mainunit hints for include files
 

lcl/include/screen.inc

@@ -374,26 +374,9 @@ end;
   procedure TScreen.SetCursor(const AValue: TCursor);
  ------------------------------------------------------------------------------}
 procedure TScreen.SetCursor(const AValue: TCursor);
-//var
-  //MousePos: TPoint;
-  //Handle: HWND;
-  //Code: Longint;
 begin
   if AValue <> Cursor then begin
     FCursor := AValue;
-    {if AValue = crDefault then begin
-      // Reset the cursor to the default by sending a WM_SETCURSOR to the
-      //  window under the cursor
-      GetCursorPos(MousePos);
-      Handle := WindowFromPoint(MousePos);
-      if (Handle <> 0) and
-        (GetWindowThreadProcessId(Handle, nil) = GetCurrentThreadId) then
-      begin
-        Code := SendMessage(Handle, WM_NCHITTEST, 0, LongInt(PointToSmallPoint(P)));
-        SendMessage(Handle, WM_SETCURSOR, Handle, MakeLong(Code, WM_MOUSEMOVE));
-        Exit;
-      end;
-    end;}
     LCLIntf.SetCursor(Cursors[FCursor]);
   end;
   Inc(FCursorCount);

lcl/interfaces/win32/win32callback.inc

@@ -286,6 +286,11 @@ Begin
 
   Assert(False, 'Trace:WindowProc - Getting Object With Callback Procedure');
   OwnerObject := TObject(GetProp(Window, 'Wincontrol'));
+  if OwnerObject is TWinControl then begin
+    TheWinControl := TWinControl(OwnerObject);
+  end else begin
+    TheWinControl := nil;
+  end;
   Assert(False, 'Trace:WindowProc - Getting Callback Object');
 
   Assert(False, 'Trace:WindowProc - Checking Proc');
@@ -736,6 +741,14 @@ Begin
         LMMouse.Result := 0;
       End;
     End;
+    WM_SETCURSOR:
+    begin
+      if (TheWinControl <> nil) and (TheWinControl.Cursor <> crDefault) then
+      begin
+        Windows.SetCursor(Windows.LoadCursor(0, LclCursorToWin32CursorMap[TheWinControl.Cursor]));
+	WinProcess := false;
+      end;
+    end;
     WM_SETFOCUS:
     Begin
       LMessage.Msg := LM_SETFOCUS;
@@ -849,8 +862,7 @@ Begin
             Msg := LM_NULL;
           end;
         end;
-        if OwnerObject is TWinControl then begin
+        if TheWinControl <> nil then begin
-          TheWinControl:=TWinControl(OwnerObject);
           {$IFDEF VerboseSizeMsg}
           writeln('Win32CallBack WM_MOVE ',TheWinControl.Name,':',TheWinControl.ClassName,
             ' NewPos=',XPos,',',YPos);
@@ -1126,6 +1138,11 @@ end;
 
 {
   $Log$
+  Revision 1.100  2004/04/11 10:19:28  micha
+  cursor management updated:
+  - lcl notifies interface via WSControl.SetCursor of changes
+  - fix win32 interface to respond to wm_setcursor callback and set correct cursor
+
   Revision 1.99  2004/04/10 17:54:52  micha
   - added: [win32] mousewheel default handler sends scrollbar messages
   - fixed: lmsetcursor; partial todo

lcl/interfaces/win32/win32int.pp

@@ -40,6 +40,38 @@ Uses
   ExtCtrls, Forms, GraphMath, GraphType, InterfaceBase, LCLIntf, LCLType,
   LMessages, StdCtrls, SysUtils, VCLGlobals, Win32Def, Graphics, Menus;
 
+const
+
+  IDC_ARROW     = MakeIntResource(32512);
+  IDC_IBEAM     = MakeIntResource(32513);
+  IDC_WAIT      = MakeIntResource(32514);
+  IDC_CROSS     = MakeIntResource(32515);
+  IDC_UPARROW   = MakeIntResource(32516);
+  IDC_SIZE      = MakeIntResource(32640);
+  IDC_ICON      = MakeIntResource(32641);
+  IDC_SIZENWSE  = MakeIntResource(32642);
+  IDC_SIZENESW  = MakeIntResource(32643);
+  IDC_SIZEWE    = MakeIntResource(32644);
+  IDC_SIZENS    = MakeIntResource(32645);
+  IDC_SIZEALL   = MakeIntResource(32646);
+  IDC_NO        = MakeIntResource(32648);
+  IDC_HAND      = MakeIntResource(32649);
+  IDC_APPSTARTING = MakeIntResource(32650);
+  IDC_HELP      = MakeIntResource(32651);
+  IDC_NODROP    = MakeIntResource(32767);
+  IDC_DRAG      = MakeIntResource(32766);
+  IDC_HSPLIT    = MakeIntResource(32765);
+  IDC_VSPLIT    = MakeIntResource(32764);
+  IDC_MULTIDRAG = MakeIntResource(32763);
+  IDC_SQLWAIT   = MakeIntResource(32762);
+  IDC_HANDPT    = MakeIntResource(32761);
+
+  LclCursorToWin32CursorMap: array[crLow..crHigh] of PChar = (
+     IDC_SIZEALL, IDC_HANDPT, IDC_HELP, IDC_APPSTARTING, IDC_NO, IDC_SQLWAIT,
+     IDC_MULTIDRAG, IDC_VSPLIT, IDC_HSPLIT, IDC_NODROP, IDC_DRAG, IDC_WAIT,
+     IDC_UPARROW, IDC_SIZEWE, IDC_SIZENWSE, IDC_SIZENS, IDC_SIZENESW, IDC_SIZE,
+     IDC_IBEAM, IDC_CROSS, IDC_ARROW, IDC_ARROW, IDC_ARROW);
+
 Type
   { Virtual alignment-control record }
   TAlignment = Record
@@ -78,7 +110,6 @@ Type
     Procedure ResizeChild(Sender: TWinControl; Left, Top, Width, Height: Integer);
     Procedure AssignSelf(Window: HWnd; Data: Pointer);
     Procedure ReDraw(Child: TObject);
-    Procedure LmSetCursor(Sender: TObject; Data: Pointer);
     Procedure SetLimitText(Window: HWND; Limit: Word);
 
     Procedure ShowHide(Sender: TObject);
@@ -161,7 +192,7 @@ Uses
 // Win32WSCheckLst,
 // Win32WSCListBox,
 // Win32WSComCtrls,
-// Win32WSControls,
+ Win32WSControls,
 // Win32WSDbCtrls,
 // Win32WSDBGrids,
 // Win32WSDialogs,
@@ -199,7 +230,7 @@ Type
     TMsgArray = Array[0..1] Of Integer;
   {$ENDIF}
 
-Const
+const
   BOOL_RESULT: Array[Boolean] Of String = ('False', 'True');
   ClsName : array[0..20] of char = 'LazarusForm'#0;
   ToolBtnClsName : array[0..20] of char = 'ToolbarButton'#0;
@@ -224,6 +255,11 @@ End.
 { =============================================================================
 
   $Log$
+  Revision 1.77  2004/04/11 10:19:28  micha
+  cursor management updated:
+  - lcl notifies interface via WSControl.SetCursor of changes
+  - fix win32 interface to respond to wm_setcursor callback and set correct cursor
+
   Revision 1.76  2004/04/10 17:54:52  micha
   - added: [win32] mousewheel default handler sends scrollbar messages
   - fixed: lmsetcursor; partial todo

lcl/interfaces/win32/win32object.inc

@@ -422,8 +422,6 @@ Begin
       Assert(False, Format('Trace:  [TWin32WidgetSet.IntSendMessage3] %s --> Show/Hide', [Sender.ClassName]));
       ShowHide(Sender);
     End;
-    LM_SETCURSOR:
-      LmSetCursor(Sender, Data);
     LM_SETLABEL:
       SetLabel(Sender, Data);
     LM_GETVALUE:
@@ -1741,62 +1739,6 @@ begin
   end;
 end;
 
-const
-
-  IDC_ARROW     = MakeIntResource(32512);
-  IDC_IBEAM     = MakeIntResource(32513);
-  IDC_WAIT      = MakeIntResource(32514);
-  IDC_CROSS     = MakeIntResource(32515);
-  IDC_UPARROW   = MakeIntResource(32516);
-  IDC_SIZE      = MakeIntResource(32640);
-  IDC_ICON      = MakeIntResource(32641);
-  IDC_SIZENWSE  = MakeIntResource(32642);
-  IDC_SIZENESW  = MakeIntResource(32643);
-  IDC_SIZEWE    = MakeIntResource(32644);
-  IDC_SIZENS    = MakeIntResource(32645);
-  IDC_SIZEALL   = MakeIntResource(32646);
-  IDC_NO        = MakeIntResource(32648);
-  IDC_HAND      = MakeIntResource(32649);
-  IDC_APPSTARTING = MakeIntResource(32650);
-  IDC_HELP      = MakeIntResource(32651);
-  IDC_NODROP    = MakeIntResource(32767);
-  IDC_DRAG      = MakeIntResource(32766);
-  IDC_HSPLIT    = MakeIntResource(32765);
-  IDC_VSPLIT    = MakeIntResource(32764);
-  IDC_MULTIDRAG = MakeIntResource(32763);
-  IDC_SQLWAIT   = MakeIntResource(32762);
-  IDC_HANDPT    = MakeIntResource(32761);
-
-  LclCursorToWin32CursorMap: array[crLow..crHigh] of PChar = (
-     IDC_SIZEALL, IDC_HANDPT, IDC_HELP, IDC_APPSTARTING, IDC_NO, IDC_SQLWAIT,
-     IDC_MULTIDRAG, IDC_VSPLIT, IDC_HSPLIT, IDC_NODROP, IDC_DRAG, IDC_WAIT,
-     IDC_UPARROW, IDC_SIZEWE, IDC_SIZENWSE, IDC_SIZENS, IDC_SIZENESW, IDC_SIZE,
-     IDC_IBEAM, IDC_CROSS, IDC_ARROW, IDC_ARROW, IDC_ARROW);
-
-{------------------------------------------------------------------------------
-  Method: TWin32WidgetSet.LmSetCursor
-  Params:  Sender - the control which invoked this method
-  Returns: Nothing
-
-  Sets the cursor for a window
-
-  WARNING: Sender will be casted to TControl, CLEANUP!
- ------------------------------------------------------------------------------}
-Procedure TWin32WidgetSet.LmSetCursor(Sender: TObject; Data: Pointer);
-Var
-  Cursor: PChar;
-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');
-  if Data = nil then
-    Data := Pointer(Integer(crDefault));
-  Cursor := LclCursorToWin32CursorMap[Integer(Data)];
-  Assert(False, 'Trace:TWin32WidgetSet.LmSetCursor - Loading the cursor');
-  Windows.SetCursor(Windows.LoadCursor(0, Cursor));
-  Assert(False, 'Trace:TWin32WidgetSet.LmSetCursor - Exit');
-End;
-
 {------------------------------------------------------------------------------
   Method: TWin32WidgetSet.ResizeChild
   Params:  Sender                   - the object which invoked this function
@@ -2663,7 +2605,6 @@ End;
  ------------------------------------------------------------------------------}
 Function TWin32WidgetSet.SetValue(Sender: TObject; Data: Pointer): Integer;
 Var
-  Cur: PChar;
   Handle: HWnd;
   ST: SystemTime;
 
@@ -3028,6 +2969,11 @@ End;
 
 {
   $Log$
+  Revision 1.186  2004/04/11 10:19:28  micha
+  cursor management updated:
+  - lcl notifies interface via WSControl.SetCursor of changes
+  - fix win32 interface to respond to wm_setcursor callback and set correct cursor
+
   Revision 1.185  2004/04/11 07:00:30  micha
   speedup: don't redraw menubar if form is being destroyed
 

lcl/interfaces/win32/win32winapi.inc

@@ -1434,6 +1434,7 @@ begin
         WindowHandle, HMENU(nil), HInstance, nil);
     Windows.SetProp(OverlayWindow, 'DefWndProc', Windows.SetWindowLong(
         OverlayWindow, GWL_WNDPROC, LongInt(@OverlayWindowProc)));
+    Windows.SetProp(OverlayWindow, 'Wincontrol', Windows.GetProp(WindowHandle, 'Wincontrol'));
     Windows.SetProp(WindowHandle, 'Overlay', OverlayWindow);
   end;
   Result := Windows.GetDC(OverlayWindow);
@@ -2974,6 +2975,11 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.107  2004/04/11 10:19:28  micha
+  cursor management updated:
+  - lcl notifies interface via WSControl.SetCursor of changes
+  - fix win32 interface to respond to wm_setcursor callback and set correct cursor
+
   Revision 1.106  2004/04/10 17:54:52  micha
   - added: [win32] mousewheel default handler sends scrollbar messages
   - fixed: lmsetcursor; partial todo

lcl/interfaces/win32/win32wscontrols.pp

@@ -33,7 +33,7 @@ uses
 // To get as little as posible circles,
 // uncomment only when needed for registration
 ////////////////////////////////////////////////////
-//  Controls,
+  Controls,
 ////////////////////////////////////////////////////
   WSControls, WSLCLClasses;
 
@@ -53,6 +53,7 @@ type
   private
   protected
   public
+    class procedure SetCursor(AControl: TControl; ACursor: TCursor); override;
   end;
 
   { TWin32WSWinControl }
@@ -90,6 +91,14 @@ type
 
 implementation
 
+uses
+  Windows, Win32Int;
+
+procedure TWin32WSControl.SetCursor(AControl: TControl; ACursor: TCursor);
+begin
+  Windows.SetCursor(Windows.LoadCursor(0, LclCursorToWin32CursorMap[ACursor]));
+end;
+
 initialization
 
 ////////////////////////////////////////////////////
@@ -99,7 +108,7 @@ initialization
 // which actually implement something
 ////////////////////////////////////////////////////
 //  RegisterWSComponent(TDragImageList, TWin32WSDragImageList);
-//  RegisterWSComponent(TControl, TWin32WSControl);
+  RegisterWSComponent(TControl, TWin32WSControl);
 //  RegisterWSComponent(TWinControl, TWin32WSWinControl);
 //  RegisterWSComponent(TGraphicControl, TWin32WSGraphicControl);
 //  RegisterWSComponent(TCustomControl, TWin32WSCustomControl);

lcl/lmessages.pp

@@ -82,8 +82,6 @@ const
   LM_INSERTTOOLBUTTON = LM_ComUser+46;
   LM_DELETETOOLBUTTON = LM_ComUser+47;
 
-  //LM_SetCursor = LM_ComUser+48;  We define this later for Windows compatability.
-
   LM_IMAGECHANGED   = LM_ComUser+49;
   LM_LAYOUTCHANGED  = LM_ComUser+50;
   LM_BTNDEFAULT_CHANGED = LM_ComUser+51;
@@ -299,7 +297,6 @@ const
   LM_SHOWWINDOW        = $0018;
 
   LM_CANCELMODE        = $001F;
-  LM_SETCURSOR         = $0020;
   LM_DRAWITEM          = $002B;
   LM_MEASUREITEM       = $002C;
   LM_DELETEITEM        = $002D;
@@ -410,18 +407,6 @@ type
     ColorDepth : Integer;
   end;
 
-{$if defined(ver1_0) or not(defined(win32))}
-  TLMSETCURSOR = record
-    Msg : Cardinal;
-    CursorWnd : HWND;
-    HitText : Word;
-    MouseMsg : Word;
-    Result : Longint;
-  end;
-{$else}
-  TLMSetCursor = TWMSetCursor;
-{$endif}
-
   PLMScreenInit = ^TLMScreenInit;
 
   TLMCanvasCreate = Record
@@ -921,8 +906,6 @@ begin
   LM_INSERTTOOLBUTTON :Result:='LM_INSERTTOOLBUTTON';
   LM_DELETETOOLBUTTON :Result:='LM_DELETETOOLBUTTON';
 
-  //LM_SetCursor :Result:='LM_SetCursor'; a LM_ComUser+48;  We define this later for Windows compatability.
-
   LM_IMAGECHANGED   :Result:='LM_IMAGECHANGED';
   LM_LAYOUTCHANGED  :Result:='LM_LAYOUTCHANGED';
   LM_BTNDEFAULT_CHANGED :Result:='LM_BTNDEFAULT_CHANGED';
@@ -1089,6 +1072,11 @@ end.
 
 {
   $Log$
+  Revision 1.62  2004/04/11 10:19:28  micha
+  cursor management updated:
+  - lcl notifies interface via WSControl.SetCursor of changes
+  - fix win32 interface to respond to wm_setcursor callback and set correct cursor
+
   Revision 1.61  2004/04/04 17:10:05  marc
   Patch from Andrew Haines
 

lcl/widgetset/wscontrols.pp

@@ -33,7 +33,7 @@ uses
 // To get as little as posible circles,
 // uncomment only when needed for registration
 ////////////////////////////////////////////////////
-//  Controls,
+  Controls,
 ////////////////////////////////////////////////////
   WSLCLClasses, WSImgList;
 
@@ -53,8 +53,11 @@ type
   private
   protected
   public
+    class procedure SetCursor(AControl: TControl; ACursor: TCursor); virtual;
   end;
 
+  TWSControlClass = class of TWSControl;
+
   { TWSWinControl }
 
   TWSWinControl = class(TWSControl)
@@ -90,6 +93,10 @@ type
 
 implementation
 
+procedure TWSControl.SetCursor(AControl: TControl; ACursor: TCursor);
+begin
+end;
+
 initialization
 
 ////////////////////////////////////////////////////
@@ -99,7 +106,7 @@ initialization
 // which actually implement something
 ////////////////////////////////////////////////////
 //  RegisterWSComponent(TDragImageList, TWSDragImageList);
-//  RegisterWSComponent(TControl, TWSControl);
+  RegisterWSComponent(TControl, TWSControl);
 //  RegisterWSComponent(TWinControl, TWSWinControl);
 //  RegisterWSComponent(TGraphicControl, TWSGraphicControl);
 //  RegisterWSComponent(TCustomControl, TWSCustomControl);