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

LCL: TScrollingWincontrol: GetLogicalClientRect: independent of AutoScroll to avoid cycle, GetPreferredSize: independent of AutoScroll, added extra checks if LCL clientrect is not in sync with widgetset, improved debugging preferredsize

Browse Source 
git-svn-id: trunk@47873 -
This commit is contained in:
mattias 2015-02-17 23:58:41 +00:00
parent 10dc4d989c
commit 094fd462f5
5 changed files with 107 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
lcl/controls.pp
View File

@ -1958,6 +1958,7 @@ type
procedure CalculatePreferredSize(var PreferredWidth,
PreferredHeight: integer;
WithThemeSpace: Boolean); override;
procedure GetPreferredSizeClientFrame(out aWidth, aHeight: integer); virtual;
procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
function ChildClassAllowed(ChildClass: TClass): boolean; override;
procedure PaintControls(DC: HDC; First: TControl);

1
lcl/forms.pp
View File

@ -162,6 +162,7 @@ type
function GetClientScrollOffset: TPoint; override;
function GetLogicalClientRect: TRect; override;// logical size of client area
procedure DoOnResize; override;
procedure GetPreferredSizeClientFrame(out aWidth, aHeight: integer); override;
procedure WMSize(var Message: TLMSize); message LM_Size;
procedure WMHScroll(var Message : TLMHScroll); message LM_HScroll;
procedure WMVScroll(var Message : TLMVScroll); message LM_VScroll;

4
lcl/include/controlscrollbar.inc
View File

@ -334,7 +334,7 @@ begin
FRange := NewRange;
{$IFDEF VerboseScrollingWinControl}
//if DebugCondition then
DebugLn(['TControlScrollBar.SetRange ',dbgs(Kind),' ',Self,' FRange=',FRange]);
DebugLn(['TControlScrollBar.InternalSetRange ',dbgs(Kind),' ',Self,' FRange=',FRange]);
{$ENDIF}
ControlUpdateScrollBars;
end;
@ -444,7 +444,7 @@ function TControlScrollBar.ClientSizeWithoutBar: integer;
begin
Result:=ClientSize;
if IsScrollBarVisible then
inc(Result, GetSize+GetSystemMetrics(SM_SWSCROLLBARSPACING));
Result := Min(FControl.Width, Result+GetSize+GetSystemMetrics(SM_SWSCROLLBARSPACING));
end;
function TControlScrollBar.GetHorzScrollBar: TControlScrollBar;

72
lcl/include/scrollingwincontrol.inc
View File

@ -42,7 +42,14 @@ end;
function TScrollingWinControl.GetLogicalClientRect: TRect;
begin
Result := ClientRect;
if AutoScroll then begin
{ The logical ClientRect is used by the child control layout algorithm.
And the visibility of scrollbars depend on the size of the child controls.
Prevent circular dependencies:
Use total ClientRect (no visible scrollbars). }
Result := Rect(0,0,VertScrollBar.ClientSizeWithoutBar,HorzScrollBar.ClientSizeWithoutBar);
end else
Result := ClientRect;
{if (FHorzScrollBar.Range>Result.Right)
or (FVertScrollBar.Range>Result.Bottom) then
DebugLn(['TScrollingWinControl.GetLogicalClientRect Client=',ClientWidth,'x',ClientHeight,' Ranges=',FHorzScrollBar.Range,'x',FVertScrollBar.Range]);}
@ -54,6 +61,32 @@ begin
Result.Bottom := FVertScrollBar.Range;
end;
procedure TScrollingWinControl.DoOnResize;
begin
inherited DoOnResize;
if AutoScroll then
begin
if (HorzScrollBar = nil) or (VertScrollBar = nil) then Exit;
if HorzScrollBar.Visible or VertScrollBar.Visible then
UpdateScrollBars;
end;
//debugln(['TScrollingWinControl.DoOnResize ',DbgSName(Self),' ',dbgs(BoundsRect),' ',dbgs(ClientRect),' ',dbgs(GetLogicalClientRect)]);
end;
procedure TScrollingWinControl.GetPreferredSizeClientFrame(out aWidth,
aHeight: integer);
begin
if AutoScroll and (VertScrollBar<>nil) then
aWidth:=Width-VertScrollBar.ClientSizeWithoutBar
else
aWidth:=Width-ClientWidth;
if AutoScroll and (HorzScrollBar<>nil) then
aHeight:=Height-HorzScrollBar.ClientSizeWithoutBar
else
aHeight:=Height-ClientHeight;
end;
procedure TScrollingWinControl.AlignControls(AControl: TControl; var ARect: TRect);
begin
if AutoScroll then
@ -74,6 +107,20 @@ end;
procedure TScrollingWinControl.CalculateAutoRanges;
{procedure trav(aControl: TControl; Prefix: string);
var
w: integer;
h: integer;
i: Integer;
begin
if not aControl.IsVisible then exit;
aControl.GetPreferredSize(w,h,true,true);
debugln([Prefix,'W ',DbgSName(aControl),' ',dbgs(aControl.BoundsRect),' Pref=',w,'x',h]);
if aControl is TWinControl then
for i:=0 to TWinControl(aControl).ControlCount-1 do
trav(TWinControl(aControl).Controls[i],Prefix+' ');
end;}
procedure GetPreferredClientRect(out PreferredWidth, PreferredHeight: integer);
var
CurClientRect: TRect;
@ -81,13 +128,16 @@ procedure TScrollingWinControl.CalculateAutoRanges;
PreferredWidth:=0;
PreferredHeight:=0;
GetPreferredSize(PreferredWidth,PreferredHeight,true,false);
//DebugLn(['GetPreferredClientRect ',DbgSName(FControl),' PrefSize=',PreferredWidth,'x',PreferredHeight]);
{$IFDEF VerboseScrollingWinControl}
DebugLn(['GetPreferredClientRect ',DbgSName(Self),' ClientRect=',dbgs(ClientRect),' PrefSize=',PreferredWidth,'x',PreferredHeight]);
//trav(Self,' ');
{$ENDIF}
CurClientRect := ClientRect;
if PreferredWidth>0 then
PreferredWidth:=Max(0,PreferredWidth-(Width-CurClientRect.Right));
if PreferredHeight>0 then
PreferredHeight:=Max(0,PreferredHeight-(Height-CurClientRect.Bottom));
//DebugLn(['GetPreferredClientRect ',DbgSName(FControl),' PrefClient=',PreferredWidth,'x',PreferredHeight,' Client=',dbgs(CurClientRect),' Size=',dbgs(FControl.BoundsRect)]);
//DebugLn(['GetPreferredClientRect ',DbgSName(Self),' PrefClient=',PreferredWidth,'x',PreferredHeight,' Client=',dbgs(CurClientRect),' Size=',dbgs(FControl.BoundsRect)]);
end;
var
@ -95,23 +145,13 @@ var
PreferredHeight: Integer;
begin
GetPreferredClientRect(PreferredWidth,PreferredHeight);
//DebugLn(['TScrollingWinControl.CalculateAutoRanges ',DbgSName(Self),' AutoSize=',AutoSize,' Bounds=',dbgs(BoundsRect),' Client=',dbgs(ClientRect),' pref=',PreferredWidth,'x',PreferredHeight]);
{$IFDEF VerboseScrollingWinControl}
DebugLn(['TScrollingWinControl.CalculateAutoRanges ',DbgSName(Self),' AutoSize=',AutoSize,' Bounds=',dbgs(BoundsRect),' Client=',dbgs(ClientRect),' LogClientRect=',dbgs(GetLogicalClientRect),' pref=',PreferredWidth,'x',PreferredHeight]);
{$ENDIF}
HorzScrollBar.InternalSetRange(PreferredWidth);
VertScrollBar.InternalSetRange(PreferredHeight);
end;
procedure TScrollingWinControl.DoOnResize;
begin
inherited DoOnResize;
if AutoScroll then
begin
if (HorzScrollBar = nil) or (VertScrollBar = nil) then Exit;
if HorzScrollBar.Visible or VertScrollBar.Visible then
UpdateScrollBars;
end;
end;
class function TScrollingWinControl.GetControlClassDefaultSize: TSize;
begin
Result.CX := 150;

77
lcl/include/wincontrol.inc
View File

@ -1024,7 +1024,7 @@ procedure TAutoSizeCtrlData.ComputePreferredClientArea(
if (not UseCurrentWidth) or (not UseCurrentHeight) then
Child.GetPreferredSize(CurPreferredWidth,CurPreferredHeight,true,true);
//if Child.Name='ToolTipBevel' then debugln(['InitPreferredSizes ',DbgSName(Child),' Bounds=',dbgs(Child.BoundsRect),' Anchors=',dbgs(Child.Anchors),' CurAnchors=',dbgs(CurAnchors),' UseW=',UseCurrentWidth,' UseH=',UseCurrentHeight,' Pref=',CurPreferredWidth,'x',CurPreferredHeight]);
//if Child.Name='OtherInfoGroupBox' then debugln(['InitPreferredSizes ',DbgSName(Child),' Bounds=',dbgs(Child.BoundsRect),' Anchors=',dbgs(Child.Anchors),' CurAnchors=',dbgs(CurAnchors),' UseW=',UseCurrentWidth,' UseH=',UseCurrentHeight,' Pref=',CurPreferredWidth,'x',CurPreferredHeight]);
if UseCurrentWidth then
NewWidth:=Child.Width
else if (CurPreferredWidth>0)
@ -1153,7 +1153,7 @@ begin
until ComputePositions;
{$IFDEF VerboseAutoSizeCtrlData}
//if WinControl.ClassName='TBreakPropertyDlg' then
if WinControl.ClassName='TProjectVersionInfoOptionsFrame' then
WriteDebugReport('Positions completed','');
{$ENDIF}
@ -1216,6 +1216,7 @@ begin
end;
{$IFDEF VerboseAutoSizeCtrlData}
//if WinControl.ClassName='TProjectVersionInfoOptionsFrame' then
DebugLn(['TAutoSizeCtrlData.ComputePreferredClientArea END ',DbgSName(Control),' PreferredClientWidth/height=',PreferredClientWidth,',',PreferredClientHeight]);
{$ENDIF}
end;
@ -7966,33 +7967,41 @@ end;
------------------------------------------------------------------------------}
procedure TWinControl.CalculatePreferredSize(var PreferredWidth,
PreferredHeight: integer; WithThemeSpace: Boolean);
{procedure trav(aControl: TControl; Prefix: string);
var
w: integer;
h: integer;
i: Integer;
begin
if not aControl.IsVisible then exit;
if aControl<>Self then begin
aControl.GetPreferredSize(w,h,true,true);
debugln([Prefix,'W ',DbgSName(aControl),' ',dbgs(aControl.BoundsRect),' Pref=',w,'x',h]);
end;
if aControl is TWinControl then
for i:=0 to TWinControl(aControl).ControlCount-1 do
trav(TWinControl(aControl).Controls[i],Prefix+' ');
end;}
var
Layout: TAutoSizeCtrlData;
NewClientWidth: Integer;
NewClientHeight: Integer;
CurClientRect: TRect;
NewWidth: Integer;
NewHeight: Integer;
NewMoveLeft, NewMoveRight: integer;
AdjustedClientRect: TRect;
FrameWidth: integer;
FrameHeight: integer;
begin
inherited CalculatePreferredSize(PreferredWidth,PreferredHeight,WithThemeSpace);
if HandleAllocated then begin
TWSWinControlClass(WidgetSetClass).GetPreferredSize(Self,
PreferredWidth, PreferredHeight, WithThemeSpace);
//DebugLn(['TWinControl.CalculatePreferredSize WidgetSet ',DbgSName(Self),' Preferred=',PreferredWidth,'x',PreferredHeight]);
//if (Name='OtherInfoGroupBox') or (Name='ProjectVersionInfoOptionsFrame') then
// debugln(['TWinControl.CalculatePreferredSize Widget ',DbgSName(Self),' ',DbgSName(WidgetSetClass),' ',PreferredWidth,'x',PreferredHeight]);
end;
// check AdjustClientRect
CurClientRect:=Rect(0,0,1000,1000);
AdjustedClientRect:=CurClientRect;
AdjustClientRect(AdjustedClientRect);
PreferredWidth:=Max(PreferredWidth,
AdjustedClientRect.Left+CurClientRect.Right-AdjustedClientRect.Right);
PreferredHeight:=Max(PreferredHeight,
AdjustedClientRect.Top+CurClientRect.Bottom-AdjustedClientRect.Bottom);
if ControlCount>0 then begin
// Beware: ControlCount>0 does not mean that there are visible children
@ -8002,33 +8011,33 @@ begin
Layout:=TAutoSizeCtrlData.Create(Self);
Layout.ComputePreferredClientArea(false,false,NewMoveLeft,NewMoveRight,
NewClientWidth,NewClientHeight);
//if (Name='OtherInfoGroupBox') or (Name='ProjectVersionInfoOptionsFrame') then
// debugln(['TWinControl.CalculatePreferredSize NewClientWidth=',NewClientWidth,' NewClientHeight=',NewClientHeight]);
if (NewMoveLeft<>0) or (NewMoveRight<>0) then ;
finally
Layout.Free;
end;
NewWidth:=0;
NewHeight:=0;
// add the control border around the client area
CurClientRect := GetClientRect;
if (NewClientWidth>0)
or ((NewClientWidth=0) and (csAutoSize0x0 in ControlStyle)) then
NewWidth:=Width-CurClientRect.Right+NewClientWidth;
if (NewClientHeight>0)
or ((NewClientHeight=0) and (csAutoSize0x0 in ControlStyle)) then
NewHeight:=Height-CurClientRect.Bottom+NewClientHeight;
{$IF defined(VerboseAutoSize) or defined(VerboseAllAutoSize)}
//if (Name='OtherInfoGroupBox') or (Name='ProjectVersionInfoOptionsFrame') then
debugln(['TWinControl.CalculatePreferredSize ',DbgSName(Self),
' HandleAllocated=',HandleAllocated,
' Cur=',Width,'x',Height,
' Client=',CurClientRect.Right,'x',CurClientRect.Bottom,
' NewWidth=',NewWidth,' NewHeight=',NewHeight,
' Client=',ClientWidth,'x',ClientHeight,
' NewClientWidth=',NewClientWidth,' NewClientHeight=',NewClientHeight,
' IntfPref+AdjustClientRect=',PreferredWidth,'x',PreferredHeight]);
' IntfPref+Child+AdjustClientRect=',PreferredWidth,'x',PreferredHeight]);
//if (Name='EditorsPanel') then trav(Self,' ');
{$ENDIF}
PreferredWidth:=Max(PreferredWidth,NewWidth);
PreferredHeight:=Max(PreferredHeight,NewHeight);
PreferredWidth:=Max(PreferredWidth,NewClientWidth);
PreferredHeight:=Max(PreferredHeight,NewClientHeight);
end;
// add clientarea frame
GetPreferredSizeClientFrame(FrameWidth,FrameHeight);
PreferredWidth+=Max(0,FrameWidth);
PreferredHeight+=Max(0,FrameHeight);
// add borderspacing
if (PreferredWidth>0)
or ((PreferredWidth=0) and (csAutoSize0x0 in ControlStyle)) then
inc(PreferredWidth,BorderSpacing.InnerBorder*2);
@ -8036,12 +8045,20 @@ begin
or ((PreferredHeight=0) and (csAutoSize0x0 in ControlStyle)) then
inc(PreferredHeight,BorderSpacing.InnerBorder*2);
{$IFDEF VerboseAutoSize}
//if (Name='OtherInfoGroupBox') or (Name='ProjectVersionInfoOptionsFrame') then
debugln('TWinControl.CalculatePreferredSize ',DbgSName(Self),
' HandleAllocated=',dbgs(HandleAllocated),
' ClientFrame=',FrameWidth,'x',FrameHeight,
' Preferred=',dbgs(PreferredWidth),'x',dbgs(PreferredHeight));
{$ENDIF}
end;
procedure TWinControl.GetPreferredSizeClientFrame(out aWidth, aHeight: integer);
begin
aWidth:=Width-ClientWidth;
aHeight:=Height-ClientHeight;
end;
{------------------------------------------------------------------------------
Method: TWinControl.RealGetText
Params: None