paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-30 00:11:51 +02:00
Code Issues Packages Projects Releases Wiki Activity

fixed GetWindowOrgEx, added GetDCOriginRelativeToWindow

Browse Source 
git-svn-id: trunk@5043 -
This commit is contained in:
mattias 2004-01-10 18:00:42 +00:00
parent 9605ba5354
commit 5daf16f5cd
8 changed files with 106 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
designer/designerprocs.pas
View File

@ -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;
DCOrig:=DCOrigin;
FFormOrigin.X:=DCOrig.X-FormClientOrig.X;
FFormOrigin.Y:=DCOrig.Y-FormClientOrig.Y;
GetDCOriginRelativeToWindow(FDC,FForm.Handle,FFormOrigin);
Include(FFlags,ddcFormOriginValid);
end;
Result:=FFormOrigin;

4
lcl/extctrls.pp
View File

@ -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

5
lcl/include/control.inc
View File

@ -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

11
lcl/include/intfbaselcl.inc
View File

@ -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

10
lcl/include/lclintf.inc
View File

@ -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

8
lcl/include/lclintfh.inc
View File

@ -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 LclEnableMenuItem(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 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

94
lcl/interfaces/gtk/gtkwinapi.inc
View File

@ -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
specified device context.
Returns the current offset of the DC.
------------------------------------------------------------------------------}
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));
if Drawable<>nil then begin
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;
P^:=GetDCOffset(TDeviceContext(DC));
Result:=1;
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
specified device context.
Sets the DC offset for the 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

6
lcl/interfaces/gtk/gtkwinapih.inc
View File

@ -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