From 7664a81732b7ecaf4d59368fe7752dfbe47d1a35 Mon Sep 17 00:00:00 2001 From: marc Date: Tue, 29 Jul 2003 00:28:43 +0000 Subject: [PATCH] + Implemented GetCursorPos git-svn-id: trunk@4432 - --- lcl/include/winapi.inc | 5 ++- lcl/interfaces/gtk/gtkint.pp | 4 ++ lcl/interfaces/gtk/gtkwinapi.inc | 75 ++++++++++++++++++++++++------- lcl/interfaces/gtk/gtkwinapih.inc | 4 ++ 4 files changed, 72 insertions(+), 16 deletions(-) diff --git a/lcl/include/winapi.inc b/lcl/include/winapi.inc index cb3947e5f6..85570fb20b 100644 --- a/lcl/include/winapi.inc +++ b/lcl/include/winapi.inc @@ -406,7 +406,7 @@ end; Function GetCursorPos(var lpPoint:TPoint): Boolean; Begin - Result := InterfaceObject.GetCaretPos(lpPoint); + Result := InterfaceObject.GetCursorPos(lpPoint); end; function GetCharABCWidths(DC: HDC; p2, p3: UINT; const ABCStructs): Boolean; @@ -1660,6 +1660,9 @@ end; { ============================================================================= $Log$ + Revision 1.93 2003/07/29 00:28:42 marc + + Implemented GetCursorPos + Revision 1.92 2003/07/07 13:19:08 mattias added raw image examples diff --git a/lcl/interfaces/gtk/gtkint.pp b/lcl/interfaces/gtk/gtkint.pp index 51a5157300..170e08e57c 100644 --- a/lcl/interfaces/gtk/gtkint.pp +++ b/lcl/interfaces/gtk/gtkint.pp @@ -53,6 +53,7 @@ uses {$ELSE} glib, gdk, gtk, {$Ifndef NoGdkPixbufLib}gdkpixbuf,{$EndIf} {$ENDIF} + xlib, SysUtils, LMessages, Classes, Controls, Forms, LCLStrConsts, VclGlobals, LCLProc, LCLLinux, LCLType, gtkDef, DynHashArray, LazQueue, GraphType, GraphMath; @@ -349,6 +350,9 @@ end. { ============================================================================= $Log$ + Revision 1.136 2003/07/29 00:28:43 marc + + Implemented GetCursorPos + Revision 1.135 2003/07/06 17:53:34 mattias updated polish localization diff --git a/lcl/interfaces/gtk/gtkwinapi.inc b/lcl/interfaces/gtk/gtkwinapi.inc index 4c29f75eb4..d5984c9e29 100644 --- a/lcl/interfaces/gtk/gtkwinapi.inc +++ b/lcl/interfaces/gtk/gtkwinapi.inc @@ -3308,12 +3308,15 @@ end; ------------------------------------------------------------------------------} Function TGTKObject.GetActiveWindow : HWND; var - List: PGList; + TopList, List: PGList; Widget: PGTKWidget; Window: PGTKWindow; begin - List := gdk_window_get_toplevels; + // Default to 0 + Result := 0; + TopList := gdk_window_get_toplevels; + List := TopList; while List <> nil do begin if (List^.Data <> nil) @@ -3326,15 +3329,14 @@ begin if (Widget <> nil) and gtk_widget_has_focus(Widget) then begin Result := HWND(GetMainWidget(PGtkWidget(Window))); - Exit; + Break; end; end; end; list := g_list_next(list); end; - - // If we are here we didn't find anything - Result := 0; + if TopList <> nil + then g_list_free(TopList); end; {------------------------------------------------------------------------------ @@ -3365,9 +3367,8 @@ end; {------------------------------------------------------------------------------ Function: GetCaretPos - Params: none - Returns: Nothing - + Params: lpPoint: The caretposition + Returns: True if succesful ------------------------------------------------------------------------------} function TgtkObject.GetCaretPos(var lpPoint: TPoint): Boolean; @@ -3739,6 +3740,44 @@ begin +b(rsgtkOptionClass); end; +{------------------------------------------------------------------------------ + Function: GetCursorPos + Params: lpPoint: The cursorposition + Returns: True if succesful + + ------------------------------------------------------------------------------} +function TgtkObject.GetCursorPos(var lpPoint: TPoint ): Boolean; +var + root, child: pointer; + winx, winy: Integer; + xmask: Cardinal; + TopList, List: PGList; +begin + // TODO: GTK2 native implementation with gdk_display_get_pointer + + Result := False; + + TopList := gdk_window_get_toplevels; + List := TopList; + while List <> nil do + begin + if (List^.Data <> nil) + and gdk_window_is_visible(List^.Data) + then begin + XQueryPointer(gdk_window_xdisplay(List^.Data), + gdk_window_xwindow(List^.Data), + @root, @child, @lpPoint.X, @lpPoint.Y, @winx, @winy, @xmask); + + Result := True; + Break; + end; + List := g_list_next(List); + end; + + if TopList <> nil + then g_list_free(TopList); +end; + {------------------------------------------------------------------------------ Function: GetDC Params: none @@ -3892,12 +3931,15 @@ end; ------------------------------------------------------------------------------} function TgtkObject.GetFocus: HWND; var - List: PGList; + TopList, List: PGList; Widget: PGTKWidget; Window: PGTKWindow; begin - List := gdk_window_get_toplevels; - + // Default to 0 + Result := 0; + + TopList := gdk_window_get_toplevels; + List := TopList; while List <> nil do begin if (List^.Data <> nil) @@ -3910,15 +3952,15 @@ begin if (Widget <> nil) and gtk_widget_has_focus(Widget) then begin Result := HWND(GetMainWidget(Widget)); - Exit; + Break; end; end; end; list := g_list_next(list); end; - // If we are here we didn't find anything - Result := 0; + if TopList <> nil + then g_list_free(TopList); end; {------------------------------------------------------------------------------ @@ -8707,6 +8749,9 @@ end; { ============================================================================= $Log$ + Revision 1.265 2003/07/29 00:28:43 marc + + Implemented GetCursorPos + Revision 1.264 2003/07/21 23:43:32 marc * Fixed radiogroup menuitems diff --git a/lcl/interfaces/gtk/gtkwinapih.inc b/lcl/interfaces/gtk/gtkwinapih.inc index bc47b397ac..865d271f3d 100644 --- a/lcl/interfaces/gtk/gtkwinapih.inc +++ b/lcl/interfaces/gtk/gtkwinapih.inc @@ -93,6 +93,7 @@ Function GetClientRect(handle : HWND; var ARect : TRect) : Boolean; override; Function GetClipBox(DC : hDC; lpRect : PRect) : Longint; override; Function GetClipRGN(DC : hDC; RGN : hRGN) : Longint; override; Function GetCmdLineParamDescForInterface: string; override; +function GetCursorPos(var lpPoint: TPoint): Boolean; override; function GetDC(hWnd: HWND): HDC; override; function GetDeviceCaps(DC: HDC; Index: Integer): Integer; Override; function GetDeviceRawImageDescription(DC: HDC; Desc: PRawImageDescription): boolean; override; @@ -211,6 +212,9 @@ Procedure DeleteCriticalSection(var CritSection: TCriticalSection); Override; { ============================================================================= $Log$ + Revision 1.74 2003/07/29 00:28:43 marc + + Implemented GetCursorPos + Revision 1.73 2003/07/06 20:40:34 mattias TWinControl.WmSize/Move now updates interface messages smarter