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

LCL: fixed TScrollingWinControl.AutoScroll endless loop when one scrollbars needs to be shown because of the other

Browse Source 
git-svn-id: trunk@45082 -
This commit is contained in:
mattias 2014-05-18 17:01:29 +00:00
parent 1631dd22e2
commit 59516fe2c8
3 changed files with 66 additions and 117 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
lcl/forms.pp
View File

@ -80,12 +80,12 @@ type
TControlScrollBar = class(TPersistent)
private
FAutoRange: Longint; // = FRange - ClientSize, >=0
FAutoRange: Longint; // = Max(0, FRange - ClientSize)
FIncrement: TScrollBarInc;
FKind: TScrollBarKind;
FPage: TScrollBarInc;
FPosition: Integer;
FRange: Integer;
FRange: Integer; // if AutoScroll=true this is the needed size of the child controls
FSmooth: Boolean;
FTracking: Boolean;
FVisible: Boolean;
@ -103,7 +103,6 @@ type
function GetSmooth: Boolean; virtual;
function HandleAllocated: boolean; virtual;
function IsRangeStored: boolean; virtual;
procedure AutoCalcRange; virtual;
procedure ControlUpdateScrollBars; virtual;
procedure InternalSetRange(const AValue: Integer); virtual;
procedure ScrollHandler(var Message: TLMScroll);
@ -158,6 +157,7 @@ type
class procedure WSRegisterClass; override;
procedure AlignControls(AControl: TControl; var ARect: TRect); override;
function AutoScrollEnabled: Boolean; virtual;
procedure CalculateAutoRanges; virtual;
procedure CreateWnd; override;
function GetClientScrollOffset: TPoint; override;
function GetLogicalClientRect: TRect; override;// logical size of client area
@ -165,7 +165,7 @@ type
procedure WMSize(var Message: TLMSize); message LM_Size;
procedure WMHScroll(var Message : TLMHScroll); message LM_HScroll;
procedure WMVScroll(var Message : TLMVScroll); message LM_VScroll;
function ComputeScrollbars: Boolean; virtual;
procedure ComputeScrollbars; virtual;
procedure ScrollbarHandler(ScrollKind: TScrollBarKind;
OldPosition: Integer); virtual;
procedure SetAutoScroll(Value: Boolean); virtual;

69
lcl/include/controlscrollbar.inc
View File

@ -41,9 +41,6 @@ begin
if GetAutoScroll then
begin
if FAutoRange < 0 then
AutoCalcRange;
if Value > FAutoRange then
begin
{$IFDEF VerboseScrollingWinControl}
@ -210,64 +207,6 @@ begin
FSmooth := AValue;
end;
procedure TControlScrollBar.AutoCalcRange;
function IsNonAligned(Control: TControl): boolean;
begin
Result:=(Control.Align in [alNone,alCustom])
and (Control.Anchors=[akLeft,akTop])
and (Control.AnchorSide[akLeft].Control=nil)
and (Control.AnchorSide[akTop].Control=nil);
end;
procedure GetPreferredClientRect(out PreferredWidth, PreferredHeight: integer);
var
CurClientRect: TRect;
begin
PreferredWidth:=0;
PreferredHeight:=0;
FControl.GetPreferredSize(PreferredWidth,PreferredHeight,true,false);
//DebugLn(['GetPreferredClientRect ',DbgSName(FControl),' PrefSize=',PreferredWidth,'x',PreferredHeight]);
CurClientRect := FControl.ClientRect;
if PreferredWidth>0 then
PreferredWidth:=Max(0,PreferredWidth-(FControl.Width-CurClientRect.Right));
if PreferredHeight>0 then
PreferredHeight:=Max(0,PreferredHeight-(FControl.Height-CurClientRect.Bottom));
//DebugLn(['GetPreferredClientRect ',DbgSName(FControl),' PrefClient=',PreferredWidth,'x',PreferredHeight,' Client=',dbgs(CurClientRect),' Size=',dbgs(FControl.BoundsRect)]);
end;
procedure AutoCalcVRange;
var
PreferredWidth: Integer;
PreferredHeight: Integer;
begin
GetPreferredClientRect(PreferredWidth,PreferredHeight);
//DebugLn(['AutoCalcVRange ',DbgSName(FControl),' AutoSize=',FControl.AutoSize,' Bounds=',dbgs(FControl.BoundsRect),' Client=',dbgs(FControl.ClientRect),' ' pref=',PreferredWidth,'x',PreferredHeight]);
InternalSetRange(PreferredHeight);
end;
procedure AutoCalcHRange;
var
PreferredWidth: Integer;
PreferredHeight: Integer;
begin
GetPreferredClientRect(PreferredWidth,PreferredHeight);
//if FControl.ClassName='TEditorCodetoolsOptionsFrame' then
//DebugLn(['AutoCalcHRange ',DbgSName(FControl),' AutoSize=',FControl.AutoSize,' Bounds=',dbgs(FControl.BoundsRect),' Client=',dbgs(FControl.ClientRect),' pref=',PreferredWidth,'x',PreferredHeight]);
InternalSetRange(PreferredWidth);
end;
begin
if GetAutoScroll then
begin
FVisible := True;
if Kind = sbVertical then
AutoCalcVRange
else
AutoCalcHRange;
end;
end;
procedure TControlScrollBar.UpdateScrollBar;
var
ScrollInfo: TScrollInfo;
@ -296,8 +235,8 @@ begin
end;
ShowScrollBar(FControl.Handle, IntfBarKind[Kind], NewVisible);
{$IFDEF VerboseScrollingWinControl}
if DebugCondition then
DebugLn(['TControlScrollBar.UpdateScrollBar ',DbgSName(FControl),' ',DbgSName(Self),' FVisible=',FVisible,' Range=',FRange,' FPosition=',FPosition,' FPage=',FPage,' FAutoRange=',FAutoRange,' ShouldVisible=',NewVisible]);
//if DebugCondition then
DebugLn(['TControlScrollBar.UpdateScrollBar ',DbgSName(FControl),' ',DbgSName(Self),' ',dbgs(Kind),' FVisible=',FVisible,' Range=',FRange,' FPosition=',FPosition,' FPage=',FPage,' FAutoRange=',FAutoRange,' ShouldVisible=',NewVisible]);
{$ENDIF}
end;
@ -498,14 +437,14 @@ function TControlScrollBar.ClientSizeWithBar: integer;
begin
Result := ClientSize;
if not IsScrollBarVisible then
dec(Result, GetSize);
dec(Result, GetSize+3);
end;
function TControlScrollBar.ClientSizeWithoutBar: integer;
begin
Result:=ClientSize;
if IsScrollBarVisible then
inc(Result, GetSize);
inc(Result, GetSize+3);
end;
function TControlScrollBar.GetHorzScrollBar: TControlScrollBar;

106
lcl/include/scrollingwincontrol.inc
View File

@ -13,11 +13,6 @@ procedure TScrollingWinControl.SetAutoScroll(Value: Boolean);
begin
if FAutoScroll = Value then Exit;
FAutoScroll := Value;
if Value then
begin
HorzScrollBar.AutoCalcRange;
VertScrollBar.AutoCalcRange;
end;
UpdateScrollBars;
end;
@ -26,11 +21,6 @@ begin
DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TScrollingWinControl.CreateWnd'){$ENDIF};
try
inherited CreateWnd;
if AutoScroll then
begin
HorzScrollBar.AutoCalcRange;
VertScrollBar.AutoCalcRange;
end;
UpdateScrollBars;
finally
EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TScrollingWinControl.CreateWnd'){$ENDIF};
@ -71,8 +61,6 @@ begin
if (HorzScrollBar = nil) or (VertScrollBar = nil) then Exit;
inherited AlignControls(AControl, ARect);
HorzScrollBar.AutoCalcRange;
VertScrollBar.AutoCalcRange;
UpdateScrollBars;
end
else
@ -84,6 +72,34 @@ begin
Result := not (AutoSize or (DockSite and UseDockManager));
end;
procedure TScrollingWinControl.CalculateAutoRanges;
procedure GetPreferredClientRect(out PreferredWidth, PreferredHeight: integer);
var
CurClientRect: TRect;
begin
PreferredWidth:=0;
PreferredHeight:=0;
GetPreferredSize(PreferredWidth,PreferredHeight,true,false);
//DebugLn(['GetPreferredClientRect ',DbgSName(FControl),' PrefSize=',PreferredWidth,'x',PreferredHeight]);
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)]);
end;
var
PreferredWidth: Integer;
PreferredHeight: Integer;
begin
GetPreferredClientRect(PreferredWidth,PreferredHeight);
//DebugLn(['TScrollingWinControl.CalculateAutoRanges ',DbgSName(Self),' AutoSize=',AutoSize,' Bounds=',dbgs(BoundsRect),' Client=',dbgs(ClientRect),' pref=',PreferredWidth,'x',PreferredHeight]);
HorzScrollBar.InternalSetRange(PreferredWidth);
VertScrollBar.InternalSetRange(PreferredHeight);
end;
procedure TScrollingWinControl.DoOnResize;
begin
inherited DoOnResize;
@ -91,7 +107,8 @@ begin
if AutoScroll then
begin
if (HorzScrollBar = nil) or (VertScrollBar = nil) then Exit;
if HorzScrollBar.Visible or VertScrollBar.Visible then UpdateScrollBars;
if HorzScrollBar.Visible or VertScrollBar.Visible then
UpdateScrollBars;
end;
end;
@ -136,54 +153,47 @@ begin
//
end;
function TScrollingWinControl.ComputeScrollbars: Boolean;
// true if something changed
// update Page, AutoRange, IsScrollBarVisible
procedure TScrollingWinControl.ComputeScrollbars;
// true if something has changed
// update Page, AutoRange
function UpdateRange(p_Bar: TControlScrollBar): Boolean;
var
SBSize: Longint;
OtherScrollbar: TControlScrollBar;
OldAutoRange: LongInt;
procedure UpdateBar(aBar: TControlScrollBar; aClientSize: integer);
begin
Result := False;
OldAutoRange := p_Bar.FAutoRange;
p_Bar.FAutoRange := 0;
OtherScrollbar := p_Bar.GetOtherScrollBar;
SBSize := OtherScrollbar.ClientSize;
if (p_Bar.FRange > SBSize) and (SBSize > 0) then
p_Bar.FAutoRange := (p_Bar.FRange - SBSize)
else
p_Bar.FAutoRange := 0;
// page (must be smaller than Range but at least 1)
aBar.FPage := Max(1,Min(Min(aBar.Range,aClientSize), High(HorzScrollbar.FPage)));
aBar.FAutoRange := Max(0, aBar.Range - aClientSize);
{$IFDEF VerboseScrollingWinControl}
if p_Bar.DebugCondition then
DebugLn(['UpdateRange p_Bar.fRange=',p_Bar.FRange,' SBSize=',SBSize,' ClientWidth=',ClientWidth,' FAutoRange=',p_Bar.FAutoRange]);
debugln(['TScrollingWinControl.ComputeScrollbars ',DbgSName(Self),' ',dbgs(aBar.Kind),' Page=',aBar.Page,' Range=',aBar.Range,' ClientSize=',aClientSize]);
{$ENDIF}
if OldAutoRange <> p_Bar.FAutoRange then
Result := True;
end;
var
NewPage: Integer;
ClientW: Integer;
ClientH: Integer;
begin
Result := False;
CalculateAutoRanges;
// page (must be smaller than Range but at least 1)
NewPage := Max(1,Min(VertScrollbar.ClientSize, High(HorzScrollbar.FPage)));
if NewPage <> HorzScrollbar.FPage then
ClientW:=VertScrollBar.ClientSizeWithoutBar;
ClientH:=HorzScrollBar.ClientSizeWithoutBar;
if VertScrollBar.Range > ClientH then
begin
HorzScrollbar.FPage := NewPage;
Result := True;
// vertical does not fit -> vertical scrollbar will be shown
ClientW:=VertScrollBar.ClientSizeWithBar;
end;
NewPage := Max(1,Min(HorzScrollbar.ClientSize, High(VertScrollbar.FPage)));
if NewPage <> VertScrollbar.FPage then
if HorzScrollBar.Range > ClientW then
begin
VertScrollbar.FPage := NewPage;
Result := True;
// horizontal does not fit -> horizontal scrollbar will be shown
ClientH:=HorzScrollBar.ClientSizeWithBar;
if VertScrollBar.Range > ClientH then
begin
// vertical does not fit, because of the other scrollbar
// -> vertical scrollbar will be shown too
ClientW:=VertScrollBar.ClientSizeWithBar;
end;
end;
// range
if UpdateRange(HorzScrollbar) then Result:=true;
if UpdateRange(VertScrollbar) then Result:=true;
UpdateBar(HorzScrollBar,ClientW);
UpdateBar(VertScrollBar,ClientH);
end;
procedure TScrollingWinControl.UpdateScrollbars;