fixed GetWindowOrgEx, added GetDCOriginRelativeToWindow

git-svn-id: trunk@5043 -

designer/designerprocs.pas

@@ -288,9 +288,15 @@ end;
 
 function TDesignerDeviceContext.GetDCOrigin: TPoint;
 // returns the DC origin in screen coordinates
+var
+  CurFormClientOrigin: TPoint;
+  CurFormOrigin: TPoint;
 begin
   if not (ddcDCOriginValid in FFlags) then begin
-    GetWindowOrgEx(FDC,@FDCOrigin);
+    CurFormClientOrigin:=FormClientOrigin;
+    CurFormOrigin:=FormOrigin;
+    FDCOrigin.X:=CurFormOrigin.X-CurFormClientOrigin.X;
+    FDCOrigin.Y:=CurFormOrigin.Y-CurFormClientOrigin.Y;
     Include(FFlags,ddcDCOriginValid);
   end;
   Result:=FDCOrigin;
@@ -323,10 +329,7 @@ var
   FormClientOrig, DCOrig: TPoint;
 begin
   if not (ddcFormOriginValid in FFlags) then begin
-    FormClientOrig:=FormClientOrigin;
+    GetDCOriginRelativeToWindow(FDC,FForm.Handle,FFormOrigin);
-    DCOrig:=DCOrigin;
-    FFormOrigin.X:=DCOrig.X-FormClientOrig.X;
-    FFormOrigin.Y:=DCOrig.Y-FormClientOrig.Y;
     Include(FFlags,ddcFormOriginValid);
   end;
   Result:=FFormOrigin;

lcl/extctrls.pp

@@ -732,7 +732,6 @@ type
     procedure SetBevelWidth(const Value: TBevelWidth);
     procedure SetBorderWidth(const Value: TBorderWidth);
     procedure SetBorderStyle(const Value: TControlBorderStyle);
-    //procedure WMWindowPosChanged(var Message: TLMWindowPosChanged); message LM_WINDOWPOSCHANGED;
   protected
     procedure AdjustClientRect(var Rect: TRect); override;
     function GetText: TCaption; override;
@@ -837,6 +836,9 @@ end.
 
  {
   $Log$
+  Revision 1.88  2004/01/10 18:00:42  mattias
+  fixed GetWindowOrgEx, added GetDCOriginRelativeToWindow
+
   Revision 1.87  2004/01/03 23:14:59  mattias
   default font can now change height and fixed gtk crash
 

lcl/include/control.inc

@@ -2479,7 +2479,7 @@ begin
   then raise EInvalidOperation.CreateFmt('Control ''%s'' has no parent window', [Name]);
 
   Result := Parent.GetDeviceContext(WindowHandle);
-  SetWindowOrgEx(Result, Left, Top, nil);
+  MoveWindowOrgEx(Result, Left, Top);
   IntersectClipRect(Result, 0, 0, Width, Height);
 end;
 
@@ -2613,6 +2613,9 @@ end;
 
 { =============================================================================
   $Log$
+  Revision 1.164  2004/01/10 18:00:42  mattias
+  fixed GetWindowOrgEx, added GetDCOriginRelativeToWindow
+
   Revision 1.163  2004/01/06 17:58:06  mattias
   fixed setting TRadioButton.Caption for gtk
 

lcl/include/intfbaselcl.inc

@@ -154,6 +154,14 @@ begin
   Result := false;
 end;
 
+function TInterfaceBase.GetDCOriginRelativeToWindow(PaintDC: HDC;
+  WindowHandle: HWND; var OriginDiff: TPoint): boolean;
+begin
+  OriginDiff.X:=0;
+  OriginDiff.Y:=0;
+  Result:=true;
+end;
+
 function TInterfaceBase.GetDesignerDC(WindowHandle: HWND): HDC;
 begin
   Result:=GetDC(WindowHandle);
@@ -494,6 +502,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.9  2004/01/10 18:00:42  mattias
+  fixed GetWindowOrgEx, added GetDCOriginRelativeToWindow
+
   Revision 1.8  2004/01/09 20:03:13  mattias
   implemented new statusbar methods in gtk intf
 

lcl/include/lclintf.inc

@@ -156,6 +156,13 @@ begin
   Result := InterfaceObject.GetCmdLineParamDescForInterface;
 end;
 
+function GetDCOriginRelativeToWindow(PaintDC: HDC; WindowHandle: HWND;
+  var OriginDiff: TPoint): boolean;
+begin
+  Result := InterfaceObject.GetDCOriginRelativeToWindow(PaintDC,WindowHandle,
+                                                        OriginDiff);
+end;
+
 function GetDesignerDC(WindowHandle: HWND): HDC;
 begin
   Result := InterfaceObject.GetDesignerDC(WindowHandle);
@@ -478,6 +485,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.8  2004/01/10 18:00:42  mattias
+  fixed GetWindowOrgEx, added GetDCOriginRelativeToWindow
+
   Revision 1.7  2004/01/09 20:03:13  mattias
   implemented new statusbar methods in gtk intf
 

lcl/include/lclintfh.inc

@@ -60,6 +60,7 @@ function GetBitmapRawImageDescription(Bitmap: HBITMAP; Desc: PRawImageDescriptio
 function GetCaretRespondToFocus(handle: HWND; var ShowHideOnFocus: boolean): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
 function GetClientBounds(handle : HWND; var ARect: TRect) : Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
 function GetCmdLineParamDescForInterface: string; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
+function GetDCOriginRelativeToWindow(PaintDC: HDC; WindowHandle: HWND; var OriginDiff: TPoint): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
 function GetDesignerDC(WindowHandle: HWND): HDC; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
 function GetDeviceRawImageDescription(DC: HDC; Desc: PRawImageDescription): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
 function GetDeviceSize(DC: HDC; var p: TPoint): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
@@ -80,8 +81,8 @@ function InvalidateFrame(aHandle : HWND; ARect : pRect; bErase : Boolean; Border
 
 function LoadStockPixmap(StockID: longint) : HBitmap; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
 
-function LclCheckMenuItem(AMenuItem: TComponent): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
+function LClCheckMenuItem(AMenuItem: TComponent): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
-function LclEnableMenuItem(AMenuItem: TComponent): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
+function LClEnableMenuItem(AMenuItem: TComponent): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
 
 function MoveWindowOrgEx(dc : hdc; dX,dY : Integer): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
 
@@ -147,6 +148,9 @@ procedure RaiseLastOSError;
 { =============================================================================
 
   $Log$
+  Revision 1.8  2004/01/10 18:00:42  mattias
+  fixed GetWindowOrgEx, added GetDCOriginRelativeToWindow
+
   Revision 1.7  2004/01/09 20:03:13  mattias
   implemented new statusbar methods in gtk intf
 

lcl/interfaces/gtk/gtkwinapi.inc

@@ -4157,6 +4157,57 @@ begin
   end;
 end;
 
+{------------------------------------------------------------------------------
+  function TgtkObject.GetDCOriginRelativeToWindow(PaintDC: HDC;
+    WindowHandle: HWND; var OriginDiff: TPoint): boolean;
+    
+  Returns the origin of PaintDC relative to the window handle.
+  Example:
+    A PaintDC of a TButton at 20,10 with a DC Offset of 0,0 on a form and the
+    WindowHandle is the form.
+    Then OriginDiff will be the the difference between the Forms client origin
+    and the PaintDC will be 20,10.
+ ------------------------------------------------------------------------------}
+function TgtkObject.GetDCOriginRelativeToWindow(PaintDC: HDC;
+  WindowHandle: HWND; var OriginDiff: TPoint): boolean;
+
+  procedure InvalidDrawable;
+  begin
+    {$IFDEF RaiseExceptionOnNilPointers}
+    RaiseException('TGTKObject.GetDCOriginRelativeToWindow Window=nil');
+    {$ENDIF}
+    writeln('TgtkObject.GetDCOriginRelativeToWindow:',
+      ' WARNING: PaintDC ',HexStr(Cardinal(PaintDC),8),' without gdkwindow.',
+      ' Widget=',HexStr(Cardinal(TDeviceContext(PaintDC).wnd),8));
+  end;
+
+var
+  DCOrigin: TPoint;
+  DCScreenOrigin: TPoint;
+  WindowScreenOrigin: TPoint;
+  Widget: PGtkWidget;
+begin
+  Result := false;
+  OriginDiff := Point(0,0);
+  If not IsValidDC(PaintDC) then exit;
+  with TDeviceContext(PaintDC) do begin
+    DCOrigin:=GetDCOffset(TDeviceContext(PaintDC));
+    if Drawable=nil then
+      InvalidDrawable;
+    gdk_window_get_origin(PGdkWindow(Drawable),
+                          @(DCScreenOrigin.X), @(DCScreenOrigin.Y));
+    inc(DCScreenOrigin.X,DCOrigin.X);
+    inc(DCScreenOrigin.Y,DCOrigin.Y);
+    Widget:=GetFixedWidget(PGtkWidget(WindowHandle));
+    if Widget=nil then Widget:=PGtkWidget(WindowHandle);
+    gdk_window_get_origin(PGdkWindow(Widget^.window),
+                          @(WindowScreenOrigin.X), @(WindowScreenOrigin.Y));
+    OriginDiff.X:=DCScreenOrigin.X-WindowScreenOrigin.X;
+    OriginDiff.Y:=DCScreenOrigin.Y-WindowScreenOrigin.Y;
+    Result := true;
+  end;
+end;
+
 {------------------------------------------------------------------------------
   Function: GetDesignerDC
   Params:  none
@@ -5352,49 +5403,20 @@ end;
   Params:  none
   Returns: Nothing
 
-  Returns the x- and y-coordinates of the window origin for the
+  Returns the current offset of the DC.
-  specified device context.
  ------------------------------------------------------------------------------}
 function TgtkObject.GetWindowOrgEx(dc : hdc; P : PPoint): Integer;
-
-  procedure InvalidDrawable;
-  begin
-    {$IFDEF RaiseExceptionOnNilPointers}
-    RaiseException('TGTKObject.GetWindowOrgEx Window=nil');
-    {$ENDIF}
-    writeln('TgtkObject.GetWindowOrgEx:',
-      ' WARNING: DC ',HexStr(Cardinal(DC),8),' without gdkwindow.',
-      ' Widget=',HexStr(Cardinal(TDeviceContext(DC).wnd),8));
-  end;
-
-var
-  DCOrigin: TPoint;
 begin
-//  gdk_window_get_deskrelative_origin(pgtkwidget(TDeviceContext(DC).hwnd)^.window, @P.X, @P.Y);
-//write('[TgtkObject.GetWindowOrgEx] ',p.x,' ',p.y);
-//  gdk_window_get_root_origin(pgtkwidget(TDeviceContext(DC).hwnd)^.window, @P.X, @P.Y);
-//write(' / ',p.x,' ',p.y);
   Result := 0;
   if P=nil then exit;
   P^ := Point(0,0);
-  If IsValidDC(DC) then
+  If not IsValidDC(DC) then exit;
   with TDeviceContext(DC) do begin
-    DCOrigin:=GetDCOffset(TDeviceContext(DC));
+    P^:=GetDCOffset(TDeviceContext(DC));
-    if Drawable<>nil then begin
+    Result:=1;
-      BeginGDKErrorTrap;
-      gdk_window_get_origin(PGdkWindow(Drawable), @(P^.X), @(P^.Y));
-      EndGDKErrorTrap;
-      inc(P^.X,DCOrigin.X);
-      inc(P^.Y,DCOrigin.Y);
-      Result := 1;
-    end else begin
-      InvalidDrawable;
-    end;
   end;
-//writeln(' / ',p.x,' ',p.y);
 end;
 
-
 {------------------------------------------------------------------------------
   Function: GetWindowRect
   Params:  none
@@ -8009,8 +8031,7 @@ end;
   Function TgtkObject.SetWindowOrgEx(DC : HDC; NewX, NewY : Integer;
     OldPoint: PPoint) : Boolean;
 
-  Sets the x-coordinates and y-coordinates of the window origin for the
+  Sets the DC offset for the specified device context.
-  specified device context.
  ------------------------------------------------------------------------------}
 Function TgtkObject.SetWindowOrgEx(DC : HDC; NewX, NewY : Integer;
   OldPoint: PPoint) : Boolean;
@@ -9100,6 +9121,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.313  2004/01/10 18:00:42  mattias
+  fixed GetWindowOrgEx, added GetDCOriginRelativeToWindow
+
   Revision 1.312  2004/01/10 00:46:46  mattias
   fixed DestroyComponent
 

lcl/interfaces/gtk/gtkwinapih.inc

@@ -97,10 +97,11 @@ 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 GetDCOriginRelativeToWindow(PaintDC: HDC; WindowHandle: HWND; var OriginDiff: TPoint): boolean; override;
+function GetDesignerDC(WindowHandle: HWND): HDC; override;
 function GetDeviceCaps(DC: HDC; Index: Integer): Integer; Override;
 function GetDeviceRawImageDescription(DC: HDC; Desc: PRawImageDescription): boolean; override;
 function GetDeviceSize(DC: HDC; var p: TPoint): boolean; override;
-function GetDesignerDC(WindowHandle: HWND): HDC; override;
 function GetDIBits(DC: HDC; Bitmap: HBitmap; StartScan, NumScans: UINT; Bits: Pointer; var BitInfo: BitmapInfo; Usage: UINT): Integer; Override;
 function GetFocus: HWND; override;
 function GetFontLanguageInfo(DC: HDC): DWord; override;
@@ -213,6 +214,9 @@ Function WindowFromPoint(Point : TPoint) : HWND; override;
 { =============================================================================
 
   $Log$
+  Revision 1.83  2004/01/10 18:00:42  mattias
+  fixed GetWindowOrgEx, added GetDCOriginRelativeToWindow
+
   Revision 1.82  2003/12/30 21:05:13  micha
   fix gtk interface due to lcl interface change (from vincent