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

cleanup lcl<->win32 bounds code, remove duplicate code

Browse Source 
git-svn-id: trunk@5523 -
This commit is contained in:
micha 2004-05-29 11:45:19 +00:00
parent b2ea8a5dba
commit e969b5041d
3 changed files with 84 additions and 86 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
lcl/interfaces/win32/win32callback.inc
View File

@ -125,7 +125,6 @@ Var
R: TRect;
P: TPoint;
NewLeft, NewTop, NewWidth, NewHeight: integer;
LeftOffset, TopOffset: Integer;
OwnerObject: TObject;
MsgObject: TObject;
TheWinControl: TWinControl;
@ -197,10 +196,9 @@ Var
PS : TPaintStruct;
MemWidth: Integer;
MemHeight: Integer;
LeftOffset: Integer;
TopOffset: Integer;
AWinControl: TWinControl;
PaintMsg: TLMPaint;
ORect: TRect;
begin
// note: ignores the received DC
// do not use default deliver message
@ -220,7 +218,12 @@ Var
PaintMsg.DC := MemDC;
end;
GetLclClientOriginOffset(AWinControl.Handle, LeftOffset, TopOffset);
if not GetLCLClientBoundsOffset(AWinControl.Handle, ORect) then
begin
ORect.Left := 0;
ORect.Top := 0;
{ we don't use ORect.Right and ORect.Bottom, initialize here if needed }
end;
try
DC := Windows.BeginPaint(Window, @PS);
PaintMsg.Msg := LM_PAINT;
@ -228,9 +231,9 @@ Var
if not AWinControl.DoubleBuffered then
PaintMsg.DC := DC;
AWinControl.EraseBackground(PaintMsg.DC);
MoveWindowOrgEx(PaintMsg.DC, LeftOffset, TopOffset);
MoveWindowOrgEx(PaintMsg.DC, ORect.Left, ORect.Top);
DeliverMessage(OwnerObject, PaintMsg);
MoveWindowOrgEx(PaintMsg.DC, -LeftOffset, -TopOffset);
MoveWindowOrgEx(PaintMsg.DC, -ORect.Left, -ORect.Top);
if AWinControl.DoubleBuffered then
Windows.BitBlt(DC, 0, 0, MemWidth, MemHeight, MemDC, 0, 0, SRCCOPY);
Windows.EndPaint(Window, @PS);
@ -920,18 +923,18 @@ Begin
// convert from win32 client to lcl client pos
if PLMsg = @LMMouseMove then
begin
if GetLCLClientOriginOffset(Window,LeftOffset,TopOffset) then
if GetLCLClientBoundsOffset(Window, R) then
begin
Dec(LMMouseMove.XPos, LeftOffset);
Dec(LMMouseMove.YPos, TopOffset);
Dec(LMMouseMove.XPos, R.Left);
Dec(LMMouseMove.YPos, R.Top);
end;
end else
if PLMsg = @LMMouse then
begin
if GetLCLClientOriginOffset(Window,LeftOffset,TopOffset) then
if GetLCLClientBoundsOffset(Window, R) then
begin
Dec(LMMouse.XPos, LeftOffset);
Dec(LMMouse.YPos, TopOffset);
Dec(LMMouse.XPos, R.Left);
Dec(LMMouse.YPos, R.Top);
end;
end;
@ -1158,6 +1161,9 @@ end;
{
$Log$
Revision 1.108 2004/05/29 11:45:19 micha
cleanup lcl<->win32 bounds code, remove duplicate code
Revision 1.107 2004/05/23 13:35:19 micha
fix multiple mouse wheel messages

59
lcl/interfaces/win32/win32proc.inc
View File

@ -659,8 +659,8 @@ End;
Hence, the LeftOffset is the frame width and the TopOffset is the caption
height.
-------------------------------------------------------------------------------}
function GetLCLClientOriginOffset(Sender: TObject;
var LeftOffset, TopOffset: integer): boolean;
function GetLCLClientBoundsOffset(Sender: TObject;
var ORect: TRect): boolean;
var
TM: TextMetricA;
DC: HDC;
@ -669,63 +669,75 @@ var
ARect: TRect;
Begin
Result:=false;
LeftOffset:=0;
TopOffset:=0;
if (Sender = nil) or (not (Sender is TWinControl)) then exit;
TheWinControl:=TWinControl(Sender);
if not TheWinControl.HandleAllocated then exit;
Handle := TheWinControl.Handle;
ORect.Left := 0;
ORect.Top := 0;
ORect.Bottom := 0;
ORect.Right := 0;
If (TheWinControl is TCustomGroupBox) Then
Begin
// The client area of a groupbox under win32 is the whole size, including
// the frame. The LCL defines the client area without the frame.
// -> Adjust the position
DC := Windows.GetDC(Handle);
// add the upper frame with the caption
GetTextMetrics(DC, TM);
inc(TopOffset,TM.TMHeight); // add the upper frame with the caption
inc(LeftOffset,2); // add the left frame border
ORect.Top := TM.TMHeight;
// add the left frame border
ORect.Left := 2;
ORect.Right := -2;
ORect.Bottom := -2;
ReleaseDC(Handle, DC);
End Else
If TheWinControl is TCustomNoteBook then begin
// Can't use complete client rect in win32 interface, top part contains the tabs
Windows.GetClientRect(Handle, @ARect);
Windows.SendMessage(Handle, TCM_AdjustRect, 0, LPARAM(@ARect));
LeftOffset := ARect.Left;
TopOffset := ARect.Top;
ORect := ARect;
Windows.SendMessage(Handle, TCM_AdjustRect, 0, LPARAM(@ORect));
Dec(ORect.Right, ARect.Right);
Dec(ORect.Bottom, ARect.Bottom);
end;
{
if (Windows.GetWindowLong(Handle, GWL_EXSTYLE) and WS_EX_CLIENTEDGE) <> 0 then
begin
Dec(LeftOffset, Windows.GetSystemMetrics(SM_CXEDGE));
Dec(TopOffset, Windows.GetSystemMetrics(SM_CYEDGE));
end;
}
Result:=true;
end;
function GetLCLClientOriginOffset(Handle: HWnd;
var LeftOffset, TopOffset: integer): boolean;
function GetLCLClientBoundsOffset(Handle: HWnd;
var Rect: TRect): boolean;
var
OwnerObject: TObject;
begin
OwnerObject := TObject(GetProp(Handle, 'Wincontrol'));
Result:=GetLCLClientOriginOffset(OwnerObject,LeftOffset,TopOffset);
Result:=GetLCLClientBoundsOffset(OwnerObject, Rect);
end;
Procedure LCLBoundsToWin32Bounds(Sender: TObject;
var Left, Top, Width, Height: Integer);
var
LeftOffset: integer;
TopOffset: integer;
ORect: TRect;
Begin
if (Sender=nil) or (not (Sender is TWinControl)) then exit;
GetLCLClientOriginOffset(TWinControl(Sender).Parent,LeftOffset,TopOffset);
inc(Left,LeftOffset);
inc(Top,TopOffset);
if not GetLCLClientBoundsOffset(TWinControl(Sender).Parent, ORect) then exit;
inc(Left, ORect.Left);
inc(Top, ORect.Top);
End;
Procedure Win32PosToLCLPos(Sender: TObject; var Left, Top: SmallInt);
var
LeftOffset: integer;
TopOffset: integer;
ORect: TRect;
Begin
if (Sender=nil) or (not (Sender is TWinControl)) then exit;
GetLCLClientOriginOffset(TWinControl(Sender).Parent,LeftOffset,TopOffset);
dec(Left,LeftOffset);
dec(Top,TopOffset);
if not GetLCLClientBoundsOffset(TWinControl(Sender).Parent, ORect) then exit;
dec(Left, ORect.Left);
dec(Top, ORect.Top);
End;
function BorderStyleToWin32Flags(Style: TFormBorderStyle): DWORD;
@ -761,6 +773,9 @@ end;
{ =============================================================================
$Log$
Revision 1.42 2004/05/29 11:45:19 micha
cleanup lcl<->win32 bounds code, remove duplicate code
Revision 1.41 2004/05/14 15:20:47 micha
fix sizing when menu is attached to window

81
lcl/interfaces/win32/win32winapi.inc
View File

@ -407,14 +407,14 @@ End;
------------------------------------------------------------------------------}
Function TWin32WidgetSet.ClientToScreen(Handle: HWND; Var P: TPoint): Boolean;
var
LeftOffset, TopOffset: integer;
ORect: TRect;
Begin
Result := Boolean(Windows.ClientToScreen(Handle, @P));
if not Result then exit;
Result := GetLCLClientOriginOffset(Handle,LeftOffset,TopOffset);
Result := GetLCLClientBoundsOffset(Handle, ORect);
if not Result then exit;
inc(P.X,LeftOffset);
inc(P.Y,TopOffset);
inc(P.X, ORect.Left);
inc(P.Y, ORect.Top);
End;
{------------------------------------------------------------------------------
@ -1286,14 +1286,17 @@ End;
Retrieves the coordinates of a window's client area.
------------------------------------------------------------------------------}
function TWin32WidgetSet.GetClientBounds(Handle: HWND; Var Rect: TRect): Boolean;
function TWin32WidgetSet.GetClientBounds(Handle: HWND; var Rect: TRect): Boolean;
var
LeftOffset, TopOffset: integer;
ARect: TRect;
begin
Result := Boolean(GetClientRect(Handle, Rect));
Result := Boolean(Windows.GetClientRect(Handle, @Rect));
if not Result then exit;
if not GetLCLClientOriginOffset(Handle,LeftOffset,TopOffset) then exit;
OffsetRect(Rect,LeftOffset,TopOffset);
if not GetLCLClientBoundsOffset(Handle, ARect) then exit;
Inc(Rect.Left, ARect.Left);
Inc(Rect.Top, ARect.Top);
Inc(Rect.Right, ARect.Right);
Inc(Rect.Bottom, ARect.Bottom);
end;
{------------------------------------------------------------------------------
@ -1305,39 +1308,11 @@ end;
Retrieves the dimension of a window's client area.
Left and Top are always 0,0
------------------------------------------------------------------------------}
Function TWin32WidgetSet.GetClientRect(Handle: HWND; Var Rect: TRect): Boolean;
var
OwnerObject: TObject;
TheWinControl: TWinControl;
TM: TextMetricA;
DC: HDC;
Begin
Result := Boolean(Windows.GetClientRect(Handle, @Rect));
if not Result then exit;
OwnerObject := TObject(Windows.GetProp(Handle, 'Wincontrol'));
if OwnerObject is TWinControl then begin
TheWinControl:=TWinControl(OwnerObject);
if TheWinControl is TCustomGroupBox then begin
// The client area of a groupbox under win32 is the whole size, including
// the frame. The LCL defines the client area without the frame.
// -> Adjust the client size
DC := Windows.GetDC(Handle);
GetTextMetrics(DC, TM);
dec(Rect.Bottom,TM.TMHeight+2); // subtract the top frame with the caption
// and subtract the bottom frame
dec(Rect.Right,2+2); // subtract the left and right frame border
ReleaseDC(Handle, DC);
{writeln('TWin32WidgetSet.GetClientRect ',TheWinControl.Name,':',TheWinControl.ClassName,
' ClientRect=',Rect.Right,',',Rect.Bottom,
' CurLCLBounds=',TheWinControl.Left,',',TheWinControl.Top,',',TheWinControl.Width,',',TheWinControl.Height);}
end else
if TheWinControl is TCustomNoteBook then begin
// Can't use complete client rect in win32 interface, top part contains the tabs
Windows.SendMessage(TheWinControl.Handle, TCM_AdjustRect, 0, LPARAM(@Rect));
OffsetRect(Rect, -Rect.Left, -Rect.Top);
end;
end;
End;
function TWin32WidgetSet.GetClientRect(Handle: HWND; var Rect: TRect): Boolean;
begin
Result := GetClientBounds(Handle, Rect);
OffsetRect(Rect, -Rect.Left, -Rect.Top);
end;
{------------------------------------------------------------------------------
Function: GetClipBox
@ -1403,13 +1378,13 @@ End;
------------------------------------------------------------------------------}
Function TWin32WidgetSet.GetDC(HWnd: HWND): HDC;
var
LeftOffset, TopOffset: integer;
ORect: TRect;
Begin
Assert(False, Format('Trace:> [TWin32WidgetSet.GetDC] HWND: 0x%x', [HWnd]));
Result := Windows.GetDC(HWnd);
if (Result<>0) and (HWnd<>0)
and GetLCLClientOriginOffset(HWnd,LeftOffset,TopOffset) then begin
MoveWindowOrgEx(Result,LeftOffset,TopOffset);
and GetLCLClientBoundsOffset(HWnd, ORect) then begin
MoveWindowOrgEx(Result, ORect.Left, ORect.Top);
end;
Assert(False, Format('Trace:< [TWin32WidgetSet.GetDC] Got 0x%x', [Result]));
End;
@ -1965,7 +1940,6 @@ var
LeftTop:TPoint;
R: TRect;
ParentHandle: THandle;
LeftOffset, TopOffset: integer;
begin
Result:=false;
if not Windows.GetWindowRect(Handle,@R) then exit;
@ -1975,10 +1949,10 @@ begin
if ParentHandle<>0 then
begin
if not Windows.ScreenToClient(ParentHandle,@LeftTop) then exit;
if not GetLCLClientOriginOffset(ParentHandle,LeftOffset,TopOffset) then
if not GetLCLClientBoundsOffset(ParentHandle, R) then
exit;
dec(LeftTop.X,LeftOffset);
dec(LeftTop.Y,TopOffset);
dec(LeftTop.X, R.Left);
dec(LeftTop.Y, R.Top);
end;
Left:=LeftTop.X;
Top:=LeftTop.Y;
@ -2053,14 +2027,14 @@ End;
Function TWin32WidgetSet.InvalidateRect(aHandle: HWND; Rect: PRect; BErase: Boolean): Boolean;
Var
Flags: UINT;
LeftOffset, TopOffset: Integer;
ORect: TRect;
Begin
// Result := Windows.InvalidateRect(aHandle, Windows.RECT(Rect^), bErase);
Flags := RDW_INVALIDATE or RDW_ALLCHILDREN;
if BErase then
Flags := Flags or RDW_ERASE;
GetLCLClientOriginOffset(aHandle, LeftOffset, TopOffset);
OffsetRect(Rect^, LeftOffset, TopOffset);
GetLCLClientBoundsOffset(aHandle, ORect);
OffsetRect(Rect^, ORect.Left, ORect.Top);
Result := Boolean(Windows.RedrawWindow(aHandle, Windows.RECT(Rect^), 0, Flags));
End;
@ -2995,6 +2969,9 @@ end;
{ =============================================================================
$Log$
Revision 1.115 2004/05/29 11:45:19 micha
cleanup lcl<->win32 bounds code, remove duplicate code
Revision 1.114 2004/05/21 11:20:26 micha
remove unused variable; fixes compiler warning