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

lcl: better protect Form.AutoScroll from change when BorderStyle does not allow this

Browse Source 
git-svn-id: trunk@21479 -
This commit is contained in:
paul 2009-08-29 03:50:50 +00:00
parent 56c45690de
commit 0dafbae6a4
2 changed files with 12 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
lcl/forms.pp
View File

@ -153,13 +153,11 @@ type
FVertScrollBar: TControlScrollBar; FVertScrollBar: TControlScrollBar;
FAutoScroll: Boolean; FAutoScroll: Boolean;
FIsUpdating: Boolean; FIsUpdating: Boolean;
procedure SetAutoScroll(Value: Boolean);
procedure SetHorzScrollBar(Value: TControlScrollBar); procedure SetHorzScrollBar(Value: TControlScrollBar);
procedure SetVertScrollBar(Value: TControlScrollBar); procedure SetVertScrollBar(Value: TControlScrollBar);
function StoreScrollBars : Boolean; function StoreScrollBars: Boolean;
protected protected
class procedure WSRegisterClass; override; class procedure WSRegisterClass; override;
property AutoScroll: Boolean read FAutoScroll write SetAutoScroll default False;
procedure AlignControls(AControl: TControl; var ARect: TRect); override; procedure AlignControls(AControl: TControl; var ARect: TRect); override;
procedure CreateWnd; override; procedure CreateWnd; override;
function GetClientScrollOffset: TPoint; override; function GetClientScrollOffset: TPoint; override;
@ -170,7 +168,9 @@ type
function ComputeScrollbars: Boolean; virtual; function ComputeScrollbars: Boolean; virtual;
procedure ScrollbarHandler(ScrollKind: TScrollBarKind; procedure ScrollbarHandler(ScrollKind: TScrollBarKind;
OldPosition: Integer); virtual; OldPosition: Integer); virtual;
procedure SetAutoScroll(Value: Boolean); virtual;
procedure Loaded; override; procedure Loaded; override;
property AutoScroll: Boolean read FAutoScroll write SetAutoScroll default False;
public public
constructor Create(TheOwner : TComponent); override; constructor Create(TheOwner : TComponent); override;
destructor Destroy; override; destructor Destroy; override;
@ -508,6 +508,7 @@ type
procedure DoSendBoundsToInterface; override; procedure DoSendBoundsToInterface; override;
procedure DoAutoSize; override; procedure DoAutoSize; override;
procedure SetAutoSize(Value: Boolean); override; procedure SetAutoSize(Value: Boolean); override;
procedure SetAutoScroll(Value: Boolean); override;
protected protected
// drag and dock // drag and dock
procedure BeginAutoDrag; override; procedure BeginAutoDrag; override;

11
lcl/include/customform.inc
View File

@ -21,7 +21,7 @@
{ $DEFINE CHECK_POSITION} { $DEFINE CHECK_POSITION}
const const
FormStylesAllowAutoScroll = [bsSizeable, bsSizeToolWin]; BorderStylesAllowAutoScroll = [bsSizeable, bsSizeToolWin];
{ TCustomForm } { TCustomForm }
@ -1092,6 +1092,11 @@ begin
inherited SetAutoSize(Value); inherited SetAutoSize(Value);
end; end;
procedure TCustomForm.SetAutoScroll(Value: Boolean);
begin
inherited SetAutoScroll(Value and (BorderStyle in BorderStylesAllowAutoScroll));
end;
procedure TCustomForm.BeginAutoDrag; procedure TCustomForm.BeginAutoDrag;
begin begin
// allow form dragging only if it is docked into a site without DockManager // allow form dragging only if it is docked into a site without DockManager
@ -1314,7 +1319,7 @@ begin
//TODO: Finish SETBORDERSTYLE //TODO: Finish SETBORDERSTYLE
// AutoScroll is only available for bsSizeable, bsSizeToolWin windows // AutoScroll is only available for bsSizeable, bsSizeToolWin windows
if not (NewStyle in FormStylesAllowAutoScroll) then if not (NewStyle in BorderStylesAllowAutoScroll) then
AutoScroll := False; AutoScroll := False;
AdaptBorderIcons := not (csLoading in ComponentState) and AdaptBorderIcons := not (csLoading in ComponentState) and
@ -1712,7 +1717,7 @@ end;
function TCustomForm.IsAutoScrollStored: Boolean; function TCustomForm.IsAutoScrollStored: Boolean;
begin begin
// store autoscroll only if BorderStyle allows this // store autoscroll only if BorderStyle allows this
Result := IsForm and (BorderStyle in FormStylesAllowAutoScroll); Result := IsForm and (BorderStyle in BorderStylesAllowAutoScroll);
end; end;
{------------------------------------------------------------------------------} {------------------------------------------------------------------------------}