paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-15 05:39:17 +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; R: TRect;
P: TPoint; P: TPoint;
NewLeft, NewTop, NewWidth, NewHeight: integer; NewLeft, NewTop, NewWidth, NewHeight: integer;
LeftOffset, TopOffset: Integer;
OwnerObject: TObject; OwnerObject: TObject;
MsgObject: TObject; MsgObject: TObject;
TheWinControl: TWinControl; TheWinControl: TWinControl;
@ -197,10 +196,9 @@ Var
PS : TPaintStruct; PS : TPaintStruct;
MemWidth: Integer; MemWidth: Integer;
MemHeight: Integer; MemHeight: Integer;
LeftOffset: Integer;
TopOffset: Integer;
AWinControl: TWinControl; AWinControl: TWinControl;
PaintMsg: TLMPaint; PaintMsg: TLMPaint;
ORect: TRect;
begin begin
// note: ignores the received DC // note: ignores the received DC
// do not use default deliver message // do not use default deliver message
@ -220,7 +218,12 @@ Var
PaintMsg.DC := MemDC; PaintMsg.DC := MemDC;
end; 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 try
DC := Windows.BeginPaint(Window, @PS); DC := Windows.BeginPaint(Window, @PS);
PaintMsg.Msg := LM_PAINT; PaintMsg.Msg := LM_PAINT;
@ -228,9 +231,9 @@ Var
if not AWinControl.DoubleBuffered then if not AWinControl.DoubleBuffered then
PaintMsg.DC := DC; PaintMsg.DC := DC;
AWinControl.EraseBackground(PaintMsg.DC); AWinControl.EraseBackground(PaintMsg.DC);
MoveWindowOrgEx(PaintMsg.DC, LeftOffset, TopOffset); MoveWindowOrgEx(PaintMsg.DC, ORect.Left, ORect.Top);
DeliverMessage(OwnerObject, PaintMsg); DeliverMessage(OwnerObject, PaintMsg);
MoveWindowOrgEx(PaintMsg.DC, -LeftOffset, -TopOffset); MoveWindowOrgEx(PaintMsg.DC, -ORect.Left, -ORect.Top);
if AWinControl.DoubleBuffered then if AWinControl.DoubleBuffered then
Windows.BitBlt(DC, 0, 0, MemWidth, MemHeight, MemDC, 0, 0, SRCCOPY); Windows.BitBlt(DC, 0, 0, MemWidth, MemHeight, MemDC, 0, 0, SRCCOPY);
Windows.EndPaint(Window, @PS); Windows.EndPaint(Window, @PS);
@ -920,18 +923,18 @@ Begin
// convert from win32 client to lcl client pos // convert from win32 client to lcl client pos
if PLMsg = @LMMouseMove then if PLMsg = @LMMouseMove then
begin begin
if GetLCLClientOriginOffset(Window,LeftOffset,TopOffset) then if GetLCLClientBoundsOffset(Window, R) then
begin begin
Dec(LMMouseMove.XPos, LeftOffset); Dec(LMMouseMove.XPos, R.Left);
Dec(LMMouseMove.YPos, TopOffset); Dec(LMMouseMove.YPos, R.Top);
end; end;
end else end else
if PLMsg = @LMMouse then if PLMsg = @LMMouse then
begin begin
if GetLCLClientOriginOffset(Window,LeftOffset,TopOffset) then if GetLCLClientBoundsOffset(Window, R) then
begin begin
Dec(LMMouse.XPos, LeftOffset); Dec(LMMouse.XPos, R.Left);
Dec(LMMouse.YPos, TopOffset); Dec(LMMouse.YPos, R.Top);
end; end;
end; end;
@ -1158,6 +1161,9 @@ end;
{ {
$Log$ $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 Revision 1.107 2004/05/23 13:35:19 micha
fix multiple mouse wheel messages 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 Hence, the LeftOffset is the frame width and the TopOffset is the caption
height. height.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
function GetLCLClientOriginOffset(Sender: TObject; function GetLCLClientBoundsOffset(Sender: TObject;
var LeftOffset, TopOffset: integer): boolean; var ORect: TRect): boolean;
var var
TM: TextMetricA; TM: TextMetricA;
DC: HDC; DC: HDC;
@ -669,63 +669,75 @@ var
ARect: TRect; ARect: TRect;
Begin Begin
Result:=false; Result:=false;
LeftOffset:=0;
TopOffset:=0;
if (Sender = nil) or (not (Sender is TWinControl)) then exit; if (Sender = nil) or (not (Sender is TWinControl)) then exit;
TheWinControl:=TWinControl(Sender); TheWinControl:=TWinControl(Sender);
if not TheWinControl.HandleAllocated then exit; if not TheWinControl.HandleAllocated then exit;
Handle := TheWinControl.Handle; Handle := TheWinControl.Handle;
ORect.Left := 0;
ORect.Top := 0;
ORect.Bottom := 0;
ORect.Right := 0;
If (TheWinControl is TCustomGroupBox) Then If (TheWinControl is TCustomGroupBox) Then
Begin Begin
// The client area of a groupbox under win32 is the whole size, including // The client area of a groupbox under win32 is the whole size, including
// the frame. The LCL defines the client area without the frame. // the frame. The LCL defines the client area without the frame.
// -> Adjust the position // -> Adjust the position
DC := Windows.GetDC(Handle); DC := Windows.GetDC(Handle);
// add the upper frame with the caption
GetTextMetrics(DC, TM); GetTextMetrics(DC, TM);
inc(TopOffset,TM.TMHeight); // add the upper frame with the caption ORect.Top := TM.TMHeight;
inc(LeftOffset,2); // add the left frame border // add the left frame border
ORect.Left := 2;
ORect.Right := -2;
ORect.Bottom := -2;
ReleaseDC(Handle, DC); ReleaseDC(Handle, DC);
End Else End Else
If TheWinControl is TCustomNoteBook then begin If TheWinControl is TCustomNoteBook then begin
// Can't use complete client rect in win32 interface, top part contains the tabs // Can't use complete client rect in win32 interface, top part contains the tabs
Windows.GetClientRect(Handle, @ARect); Windows.GetClientRect(Handle, @ARect);
Windows.SendMessage(Handle, TCM_AdjustRect, 0, LPARAM(@ARect)); ORect := ARect;
LeftOffset := ARect.Left; Windows.SendMessage(Handle, TCM_AdjustRect, 0, LPARAM(@ORect));
TopOffset := ARect.Top; Dec(ORect.Right, ARect.Right);
Dec(ORect.Bottom, ARect.Bottom);
end; 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; Result:=true;
end; end;
function GetLCLClientOriginOffset(Handle: HWnd; function GetLCLClientBoundsOffset(Handle: HWnd;
var LeftOffset, TopOffset: integer): boolean; var Rect: TRect): boolean;
var var
OwnerObject: TObject; OwnerObject: TObject;
begin begin
OwnerObject := TObject(GetProp(Handle, 'Wincontrol')); OwnerObject := TObject(GetProp(Handle, 'Wincontrol'));
Result:=GetLCLClientOriginOffset(OwnerObject,LeftOffset,TopOffset); Result:=GetLCLClientBoundsOffset(OwnerObject, Rect);
end; end;
Procedure LCLBoundsToWin32Bounds(Sender: TObject; Procedure LCLBoundsToWin32Bounds(Sender: TObject;
var Left, Top, Width, Height: Integer); var Left, Top, Width, Height: Integer);
var var
LeftOffset: integer; ORect: TRect;
TopOffset: integer;
Begin Begin
if (Sender=nil) or (not (Sender is TWinControl)) then exit; if (Sender=nil) or (not (Sender is TWinControl)) then exit;
GetLCLClientOriginOffset(TWinControl(Sender).Parent,LeftOffset,TopOffset); if not GetLCLClientBoundsOffset(TWinControl(Sender).Parent, ORect) then exit;
inc(Left,LeftOffset); inc(Left, ORect.Left);
inc(Top,TopOffset); inc(Top, ORect.Top);
End; End;
Procedure Win32PosToLCLPos(Sender: TObject; var Left, Top: SmallInt); Procedure Win32PosToLCLPos(Sender: TObject; var Left, Top: SmallInt);
var var
LeftOffset: integer; ORect: TRect;
TopOffset: integer;
Begin Begin
if (Sender=nil) or (not (Sender is TWinControl)) then exit; if (Sender=nil) or (not (Sender is TWinControl)) then exit;
GetLCLClientOriginOffset(TWinControl(Sender).Parent,LeftOffset,TopOffset); if not GetLCLClientBoundsOffset(TWinControl(Sender).Parent, ORect) then exit;
dec(Left,LeftOffset); dec(Left, ORect.Left);
dec(Top,TopOffset); dec(Top, ORect.Top);
End; End;
function BorderStyleToWin32Flags(Style: TFormBorderStyle): DWORD; function BorderStyleToWin32Flags(Style: TFormBorderStyle): DWORD;
@ -761,6 +773,9 @@ end;
{ ============================================================================= { =============================================================================
$Log$ $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 Revision 1.41 2004/05/14 15:20:47 micha
fix sizing when menu is attached to window 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; Function TWin32WidgetSet.ClientToScreen(Handle: HWND; Var P: TPoint): Boolean;
var var
LeftOffset, TopOffset: integer; ORect: TRect;
Begin Begin
Result := Boolean(Windows.ClientToScreen(Handle, @P)); Result := Boolean(Windows.ClientToScreen(Handle, @P));
if not Result then exit; if not Result then exit;
Result := GetLCLClientOriginOffset(Handle,LeftOffset,TopOffset); Result := GetLCLClientBoundsOffset(Handle, ORect);
if not Result then exit; if not Result then exit;
inc(P.X,LeftOffset); inc(P.X, ORect.Left);
inc(P.Y,TopOffset); inc(P.Y, ORect.Top);
End; End;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -1286,14 +1286,17 @@ End;
Retrieves the coordinates of a window's client area. 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 var
LeftOffset, TopOffset: integer; ARect: TRect;
begin begin
Result := Boolean(GetClientRect(Handle, Rect)); Result := Boolean(Windows.GetClientRect(Handle, @Rect));
if not Result then exit; if not Result then exit;
if not GetLCLClientOriginOffset(Handle,LeftOffset,TopOffset) then exit; if not GetLCLClientBoundsOffset(Handle, ARect) then exit;
OffsetRect(Rect,LeftOffset,TopOffset); Inc(Rect.Left, ARect.Left);
Inc(Rect.Top, ARect.Top);
Inc(Rect.Right, ARect.Right);
Inc(Rect.Bottom, ARect.Bottom);
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -1305,39 +1308,11 @@ end;
Retrieves the dimension of a window's client area. Retrieves the dimension of a window's client area.
Left and Top are always 0,0 Left and Top are always 0,0
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
Function TWin32WidgetSet.GetClientRect(Handle: HWND; Var Rect: TRect): Boolean; function TWin32WidgetSet.GetClientRect(Handle: HWND; var Rect: TRect): Boolean;
var begin
OwnerObject: TObject; Result := GetClientBounds(Handle, Rect);
TheWinControl: TWinControl; OffsetRect(Rect, -Rect.Left, -Rect.Top);
TM: TextMetricA; end;
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: GetClipBox Function: GetClipBox
@ -1403,13 +1378,13 @@ End;
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
Function TWin32WidgetSet.GetDC(HWnd: HWND): HDC; Function TWin32WidgetSet.GetDC(HWnd: HWND): HDC;
var var
LeftOffset, TopOffset: integer; ORect: TRect;
Begin Begin
Assert(False, Format('Trace:> [TWin32WidgetSet.GetDC] HWND: 0x%x', [HWnd])); Assert(False, Format('Trace:> [TWin32WidgetSet.GetDC] HWND: 0x%x', [HWnd]));
Result := Windows.GetDC(HWnd); Result := Windows.GetDC(HWnd);
if (Result<>0) and (HWnd<>0) if (Result<>0) and (HWnd<>0)
and GetLCLClientOriginOffset(HWnd,LeftOffset,TopOffset) then begin and GetLCLClientBoundsOffset(HWnd, ORect) then begin
MoveWindowOrgEx(Result,LeftOffset,TopOffset); MoveWindowOrgEx(Result, ORect.Left, ORect.Top);
end; end;
Assert(False, Format('Trace:< [TWin32WidgetSet.GetDC] Got 0x%x', [Result])); Assert(False, Format('Trace:< [TWin32WidgetSet.GetDC] Got 0x%x', [Result]));
End; End;
@ -1965,7 +1940,6 @@ var
LeftTop:TPoint; LeftTop:TPoint;
R: TRect; R: TRect;
ParentHandle: THandle; ParentHandle: THandle;
LeftOffset, TopOffset: integer;
begin begin
Result:=false; Result:=false;
if not Windows.GetWindowRect(Handle,@R) then exit; if not Windows.GetWindowRect(Handle,@R) then exit;
@ -1975,10 +1949,10 @@ begin
if ParentHandle<>0 then if ParentHandle<>0 then
begin begin
if not Windows.ScreenToClient(ParentHandle,@LeftTop) then exit; if not Windows.ScreenToClient(ParentHandle,@LeftTop) then exit;
if not GetLCLClientOriginOffset(ParentHandle,LeftOffset,TopOffset) then if not GetLCLClientBoundsOffset(ParentHandle, R) then
exit; exit;
dec(LeftTop.X,LeftOffset); dec(LeftTop.X, R.Left);
dec(LeftTop.Y,TopOffset); dec(LeftTop.Y, R.Top);
end; end;
Left:=LeftTop.X; Left:=LeftTop.X;
Top:=LeftTop.Y; Top:=LeftTop.Y;
@ -2053,14 +2027,14 @@ End;
Function TWin32WidgetSet.InvalidateRect(aHandle: HWND; Rect: PRect; BErase: Boolean): Boolean; Function TWin32WidgetSet.InvalidateRect(aHandle: HWND; Rect: PRect; BErase: Boolean): Boolean;
Var Var
Flags: UINT; Flags: UINT;
LeftOffset, TopOffset: Integer; ORect: TRect;
Begin Begin
// Result := Windows.InvalidateRect(aHandle, Windows.RECT(Rect^), bErase); // Result := Windows.InvalidateRect(aHandle, Windows.RECT(Rect^), bErase);
Flags := RDW_INVALIDATE or RDW_ALLCHILDREN; Flags := RDW_INVALIDATE or RDW_ALLCHILDREN;
if BErase then if BErase then
Flags := Flags or RDW_ERASE; Flags := Flags or RDW_ERASE;
GetLCLClientOriginOffset(aHandle, LeftOffset, TopOffset); GetLCLClientBoundsOffset(aHandle, ORect);
OffsetRect(Rect^, LeftOffset, TopOffset); OffsetRect(Rect^, ORect.Left, ORect.Top);
Result := Boolean(Windows.RedrawWindow(aHandle, Windows.RECT(Rect^), 0, Flags)); Result := Boolean(Windows.RedrawWindow(aHandle, Windows.RECT(Rect^), 0, Flags));
End; End;
@ -2995,6 +2969,9 @@ end;
{ ============================================================================= { =============================================================================
$Log$ $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 Revision 1.114 2004/05/21 11:20:26 micha
remove unused variable; fixes compiler warning remove unused variable; fixes compiler warning