From 094fd462f511e625ce5e088bfa37b691dc082b6f Mon Sep 17 00:00:00 2001 From: mattias Date: Tue, 17 Feb 2015 23:58:41 +0000 Subject: [PATCH] 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 git-svn-id: trunk@47873 - --- lcl/controls.pp | 1 + lcl/forms.pp | 1 + lcl/include/controlscrollbar.inc | 4 +- lcl/include/scrollingwincontrol.inc | 72 +++++++++++++++++++++------ lcl/include/wincontrol.inc | 77 ++++++++++++++++++----------- 5 files changed, 107 insertions(+), 48 deletions(-) diff --git a/lcl/controls.pp b/lcl/controls.pp index 150f3abf91..154eeb76d9 100644 --- a/lcl/controls.pp +++ b/lcl/controls.pp @@ -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); diff --git a/lcl/forms.pp b/lcl/forms.pp index 5f699ad0d2..39770ca8f5 100644 --- a/lcl/forms.pp +++ b/lcl/forms.pp @@ -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; diff --git a/lcl/include/controlscrollbar.inc b/lcl/include/controlscrollbar.inc index 09969f3a52..aaeca232a9 100644 --- a/lcl/include/controlscrollbar.inc +++ b/lcl/include/controlscrollbar.inc @@ -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; diff --git a/lcl/include/scrollingwincontrol.inc b/lcl/include/scrollingwincontrol.inc index ae7f40ee19..9313b36f11 100644 --- a/lcl/include/scrollingwincontrol.inc +++ b/lcl/include/scrollingwincontrol.inc @@ -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; diff --git a/lcl/include/wincontrol.inc b/lcl/include/wincontrol.inc index 0ac8fb4324..55e1e85b9d 100644 --- a/lcl/include/wincontrol.inc +++ b/lcl/include/wincontrol.inc @@ -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