From 5effa0b10e04ab09b09176d2786ab3527ca61736 Mon Sep 17 00:00:00 2001 From: micha Date: Sun, 11 Apr 2004 10:19:28 +0000 Subject: [PATCH] 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 | 8 +++- lcl/include/control.inc | 12 ++--- lcl/include/screen.inc | 17 ------- lcl/interfaces/win32/win32callback.inc | 21 +++++++- lcl/interfaces/win32/win32int.pp | 42 ++++++++++++++-- lcl/interfaces/win32/win32object.inc | 64 ++----------------------- lcl/interfaces/win32/win32winapi.inc | 6 +++ lcl/interfaces/win32/win32wscontrols.pp | 13 ++++- lcl/lmessages.pp | 22 ++------- lcl/widgetset/wscontrols.pp | 11 ++++- 10 files changed, 107 insertions(+), 109 deletions(-) diff --git a/lcl/controls.pp b/lcl/controls.pp index 637246e652..774456f5cc 100644 --- a/lcl/controls.pp +++ b/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 diff --git a/lcl/include/control.inc b/lcl/include/control.inc index 377811692a..a932cab603 100644 --- a/lcl/include/control.inc +++ b/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 - // 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); + TWSControlClass(WidgetSetClass).SetCursor(Self, Value); 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 diff --git a/lcl/include/screen.inc b/lcl/include/screen.inc index e1ccf9b4c5..8fe8983e93 100644 --- a/lcl/include/screen.inc +++ b/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); diff --git a/lcl/interfaces/win32/win32callback.inc b/lcl/interfaces/win32/win32callback.inc index cea25d4b3c..39ae086bdd 100644 --- a/lcl/interfaces/win32/win32callback.inc +++ b/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 - TheWinControl:=TWinControl(OwnerObject); + if TheWinControl <> nil then begin {$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 diff --git a/lcl/interfaces/win32/win32int.pp b/lcl/interfaces/win32/win32int.pp index 4d15e31591..bfe58656e5 100644 --- a/lcl/interfaces/win32/win32int.pp +++ b/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 diff --git a/lcl/interfaces/win32/win32object.inc b/lcl/interfaces/win32/win32object.inc index 684c8c8225..a949f7e965 100644 --- a/lcl/interfaces/win32/win32object.inc +++ b/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 diff --git a/lcl/interfaces/win32/win32winapi.inc b/lcl/interfaces/win32/win32winapi.inc index 681dcec9f1..11ea46d852 100644 --- a/lcl/interfaces/win32/win32winapi.inc +++ b/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 diff --git a/lcl/interfaces/win32/win32wscontrols.pp b/lcl/interfaces/win32/win32wscontrols.pp index 5e22988b3a..2b047af6f1 100644 --- a/lcl/interfaces/win32/win32wscontrols.pp +++ b/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); diff --git a/lcl/lmessages.pp b/lcl/lmessages.pp index 07f33b9f5a..e0875ff109 100644 --- a/lcl/lmessages.pp +++ b/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 diff --git a/lcl/widgetset/wscontrols.pp b/lcl/widgetset/wscontrols.pp index 4982e3475f..cd3adf93e1 100644 --- a/lcl/widgetset/wscontrols.pp +++ b/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);