mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-07 07:38:14 +02:00
moved code from TControlScrollBar to TScrollingWinControl, deriving TScrollingWinControl from TCustomControl from Flavio
git-svn-id: trunk@9952 -
This commit is contained in:
mattias
parent
0ddae4ae5b
commit
9b836a28f0
19
lcl/forms.pp
19
lcl/forms.pp
@ -104,7 +104,6 @@ type
|
||||
function VisibleIsStored: boolean; virtual;
|
||||
procedure AutoCalcRange; virtual;
|
||||
procedure ControlUpdateScrollBars; virtual;
|
||||
procedure ScrollControlBy(DeltaX, DeltaY: integer); virtual;
|
||||
procedure ScrollHandler(var Message: TLMScroll);
|
||||
procedure SetIncrement(const AValue: TScrollBarInc); virtual;
|
||||
procedure SetPage(const AValue: TScrollBarInc); virtual;
|
||||
@ -113,7 +112,7 @@ type
|
||||
procedure SetSize(const AValue: integer); virtual;
|
||||
procedure SetSmooth(const Value: Boolean); virtual;
|
||||
procedure SetVisible(const Value: Boolean); virtual;
|
||||
Procedure UpdateScrollBar; virtual;
|
||||
procedure UpdateScrollBar; virtual;
|
||||
public
|
||||
constructor Create(AControl: TWinControl; AKind: TScrollBarKind);
|
||||
procedure Assign(Source: TPersistent); override;
|
||||
@ -136,38 +135,32 @@ type
|
||||
|
||||
{ TScrollingWinControl }
|
||||
|
||||
TScrollingWinControl = class(TWinControl)
|
||||
TScrollingWinControl = class(TCustomControl)
|
||||
private
|
||||
FHorzScrollBar: TControlScrollBar;
|
||||
FVertScrollBar: TControlScrollBar;
|
||||
FAutoScroll: Boolean;
|
||||
FOnPaint: TNotifyEvent;
|
||||
FCanvas: TControlCanvas;
|
||||
FIsUpdating: Boolean;
|
||||
procedure SetAutoScroll(Value: Boolean);
|
||||
procedure SetHorzScrollBar(Value: TControlScrollBar);
|
||||
procedure SetVertScrollBar(Value: TControlScrollBar);
|
||||
//todo: rename to IsScrollbarsStored
|
||||
Function StoreScrollBars : Boolean;
|
||||
protected
|
||||
procedure AlignControls(AControl: TControl; var ARect: TRect); override;
|
||||
procedure CreateWnd; override;
|
||||
function GetClientScrollOffset: TPoint; override;
|
||||
Procedure WMEraseBkgnd(var Message: TLMEraseBkgnd); message LM_ERASEBKGND;
|
||||
procedure WMPaint(var message: TLMPaint); message LM_PAINT;
|
||||
procedure DoOnResize; override;
|
||||
procedure WMHScroll(var Message : TLMHScroll); message LM_HScroll;
|
||||
procedure WMVScroll(var Message : TLMVScroll); message LM_VScroll;
|
||||
procedure ScrollBy(DeltaX, DeltaY: Integer);
|
||||
property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
|
||||
procedure ComputeScrollbars; virtual;
|
||||
procedure ScrollbarHandler(p_ScrollKind: TScrollBarKind; p_OldPosition: Integer); virtual;
|
||||
public
|
||||
Constructor Create(AOwner : TComponent); Override;
|
||||
Destructor Destroy; Override;
|
||||
procedure Paint; dynamic;
|
||||
procedure PaintWindow(dc : Hdc); override;
|
||||
procedure UpdateScrollbars; virtual;
|
||||
procedure UpdateScrollbars;
|
||||
function HasVisibleScrollbars: boolean; virtual;
|
||||
procedure DestroyWnd; override;
|
||||
property Canvas: TControlCanvas read FCanvas;
|
||||
published
|
||||
property AutoScroll: Boolean read FAutoScroll write SetAutoScroll;
|
||||
property HorzScrollBar: TControlScrollBar
|
||||
|
||||
@ -47,10 +47,8 @@ begin
|
||||
// scroll content of FControl
|
||||
OldPosition:=FPosition;
|
||||
FPosition := Value;
|
||||
if Kind = sbVertical then
|
||||
ScrollControlBy(0, OldPosition - FPosition)
|
||||
else
|
||||
ScrollControlBy(OldPosition - FPosition, 0);
|
||||
if FControl is TScrollingWinControl then
|
||||
TScrollingWinControl(FControl).ScrollbarHandler(Kind, OldPosition);
|
||||
|
||||
// check that the new position is also set on the scrollbar
|
||||
if HandleAllocated
|
||||
@ -169,12 +167,6 @@ begin
|
||||
ControlUpdateScrollBars;
|
||||
end;
|
||||
|
||||
procedure TControlScrollBar.ScrollControlBy(DeltaX, DeltaY: integer);
|
||||
begin
|
||||
if FControl is TScrollingWinControl then
|
||||
TScrollingWinControl(FControl).ScrollBy(DeltaX, DeltaY);
|
||||
end;
|
||||
|
||||
procedure TControlScrollBar.SetSmooth(const Value: Boolean);
|
||||
begin
|
||||
// only used by the ScrollHandler procedure
|
||||
@ -237,58 +229,19 @@ end;
|
||||
procedure TControlScrollBar.UpdateScrollBar;
|
||||
var
|
||||
ScrollInfo: TScrollInfo;
|
||||
SBSize : Longint;
|
||||
OtherScrollbar: TControlScrollBar;
|
||||
CurMax: Integer;
|
||||
begin
|
||||
//todo: probably needs to be moved somewhere else.
|
||||
FAutoRange := 0;
|
||||
|
||||
if FControl is TScrollingWinControl then begin
|
||||
ScrollInfo.cbSize := SizeOf(ScrollInfo);
|
||||
ScrollInfo.fMask := SIF_ALL;
|
||||
ScrollInfo.nMin := 0;
|
||||
ScrollInfo.nMax := FRange;
|
||||
ScrollInfo.nPos := FPosition;
|
||||
ScrollInfo.nTrackPos := FPosition;
|
||||
|
||||
With TScrollingWinControl(FControl) do begin
|
||||
// page
|
||||
if Self.Kind=sbVertical then
|
||||
FPage := TScrollBarInc(Min(ClientHeight - 1,High(FPage)))
|
||||
else
|
||||
FPage := TScrollBarInc(Min(ClientWidth - 1,High(FPage)));
|
||||
ScrollInfo.nPage := FPage;
|
||||
|
||||
// range
|
||||
OtherScrollbar:=GetOtherScrollBar;
|
||||
If OtherScrollbar.FVisible then
|
||||
SBSize := OtherScrollbar.Size
|
||||
else
|
||||
SBSize := 0;
|
||||
if Kind=sbVertical then begin
|
||||
SBSize:=ClientHeight - SBSize;
|
||||
end else begin
|
||||
SBSize:=ClientWidth - SBSize;
|
||||
end;
|
||||
if (fRange>SBSize) and (SBSize>0) then FAutoRange := (FRange - SBSize)
|
||||
else FAutoRange := 0;
|
||||
ScrollInfo.nMax := FRange;
|
||||
|
||||
// visible
|
||||
if Kind=sbVertical then
|
||||
CurMax:=Height
|
||||
else
|
||||
CurMax:=Width;
|
||||
If (Self.FVisible and not FAutoScroll)
|
||||
or (FAutoScroll and (ScrollInfo.nMax > 0) and (ScrollInfo.nMax > CurMax))
|
||||
then
|
||||
Self.FVisible := True
|
||||
else
|
||||
Self.FVisible := False;
|
||||
|
||||
// transmit scollinfo to interface
|
||||
if HandleAllocated then
|
||||
SetScrollInfo(Handle, IntfBarKind[Kind], ScrollInfo, Self.FVisible);
|
||||
end
|
||||
if HandleAllocated then
|
||||
SetScrollInfo(FControl.Handle, IntfBarKind[Kind], ScrollInfo, FVisible);
|
||||
end;
|
||||
|
||||
SetPosition(ScrollInfo.nTrackPos);
|
||||
|
||||
@ -760,12 +760,12 @@ Procedure TCustomForm.PaintWindow(DC : Hdc);
|
||||
begin
|
||||
// FCanvas.Lock;
|
||||
try
|
||||
FCanvas.Handle := DC;
|
||||
Canvas.Handle := DC;
|
||||
//DebugLn('[TCustomForm.PaintWindow] ',ClassName,' DC=',DbgS(DC,8),' ',DbgS(FCanvas.Handle,8));
|
||||
try
|
||||
if FDesigner <> nil then FDesigner.PaintGrid else Paint;
|
||||
finally
|
||||
FCanvas.Handle := 0;
|
||||
Canvas.Handle := 0;
|
||||
end;
|
||||
finally
|
||||
// FCanvas.Unlock;
|
||||
|
||||
@ -56,42 +56,6 @@ begin
|
||||
inherited AlignControls(AControl, ARect);
|
||||
end;
|
||||
|
||||
Procedure TScrollingWinControl.WMEraseBkgnd(var Message: TLMEraseBkgnd);
|
||||
begin
|
||||
inherited WMEraseBkgnd(Message);
|
||||
end;
|
||||
|
||||
procedure TScrollingWinControl.WMPaint(var Message: TLMPaint);
|
||||
begin
|
||||
Include(FControlState, csCustomPaint);
|
||||
try
|
||||
inherited WMPaint(Message);
|
||||
finally
|
||||
Exclude(FControlState, csCustomPaint);
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure TScrollingWinControl.Paint;
|
||||
begin
|
||||
if Assigned (FOnPaint) then
|
||||
FOnPaint(Self);
|
||||
end;
|
||||
|
||||
Procedure TScrollingWinControl.PaintWindow(DC : Hdc);
|
||||
begin
|
||||
FCanvas.Lock;
|
||||
try
|
||||
FCanvas.Handle := DC;
|
||||
try
|
||||
Paint;
|
||||
finally
|
||||
FCanvas.Handle := 0;
|
||||
end;
|
||||
finally
|
||||
FCanvas.Unlock;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TScrollingWinControl.DoOnResize;
|
||||
begin
|
||||
inherited DoOnResize;
|
||||
@ -110,11 +74,64 @@ begin
|
||||
FVertScrollbar.Assign(Value);
|
||||
end;
|
||||
|
||||
procedure TScrollingWinControl.ComputeScrollbars;
|
||||
|
||||
procedure UpdateRange(p_Bar: TControlScrollBar);
|
||||
var
|
||||
SBSize: Longint;
|
||||
OtherScrollbar: TControlScrollBar;
|
||||
begin
|
||||
p_Bar.FAutoRange := 0;
|
||||
OtherScrollbar := p_Bar.GetOtherScrollBar;
|
||||
If OtherScrollbar.FVisible then
|
||||
SBSize := OtherScrollbar.Size
|
||||
else
|
||||
SBSize := 0;
|
||||
if p_Bar.Kind = sbVertical then
|
||||
SBSize := ClientHeight - SBSize
|
||||
else
|
||||
SBSize := ClientWidth - SBSize;
|
||||
if (p_Bar.fRange>SBSize) and (SBSize>0) then
|
||||
p_Bar.FAutoRange := (p_Bar.FRange - SBSize)
|
||||
else
|
||||
p_Bar.FAutoRange := 0;
|
||||
end;
|
||||
|
||||
procedure UpdateVisible(p_Bar: TControlScrollBar);
|
||||
var
|
||||
CurMax: Integer;
|
||||
begin
|
||||
if p_Bar.Kind = sbVertical then
|
||||
CurMax := Height
|
||||
else
|
||||
CurMax := Width;
|
||||
If (p_Bar.FVisible and not FAutoScroll)
|
||||
or (FAutoScroll and (p_Bar.FRange > 0) and (p_Bar.FRange > CurMax))
|
||||
then
|
||||
p_Bar.FVisible := True
|
||||
else
|
||||
p_Bar.FVisible := False;
|
||||
end;
|
||||
|
||||
begin
|
||||
//todo: why doesn't it simply use ClientWidth/Height?
|
||||
// page
|
||||
HorzScrollbar.FPage := Min(ClientWidth -1, High(HorzScrollbar.FPage));
|
||||
VertScrollbar.FPage := Min(ClientHeight -1, High(VertScrollbar.FPage));
|
||||
// range
|
||||
UpdateRange(VertScrollbar);
|
||||
UpdateRange(VertScrollbar);
|
||||
// visible
|
||||
UpdateVisible(HorzScrollbar);
|
||||
UpdateVisible(VertScrollbar);
|
||||
end;
|
||||
|
||||
Procedure TScrollingWinControl.UpdateScrollbars;
|
||||
begin
|
||||
If FIsUpdating then exit;
|
||||
FIsUpdating := True;
|
||||
try
|
||||
ComputeScrollbars;
|
||||
FVertScrollbar.UpdateScrollbar;
|
||||
FHorzScrollbar.UpdateScrollbar;
|
||||
finally
|
||||
@ -128,13 +145,6 @@ begin
|
||||
and (HorzScrollBar<>nil) and HorzScrollBar.Visible;
|
||||
end;
|
||||
|
||||
procedure TScrollingWinControl.DestroyWnd;
|
||||
begin
|
||||
inherited DestroyWnd;
|
||||
if Canvas<>nil then
|
||||
Canvas.FreeHandle;
|
||||
end;
|
||||
|
||||
Function TScrollingWinControl.StoreScrollBars : Boolean;
|
||||
begin
|
||||
Result := Not AutoScroll;
|
||||
@ -144,10 +154,19 @@ procedure TScrollingWinControl.ScrollBy(DeltaX, DeltaY: Integer);
|
||||
begin
|
||||
if HandleAllocated then begin
|
||||
TWSScrollingWinControlClass(WidgetSetClass).ScrollBy(Self, DeltaX, DeltaY);
|
||||
//todo: shouldn't call Invalidate. Instead, the TWidgetSet should call it if it needs to.
|
||||
Invalidate;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TScrollingWinControl.ScrollbarHandler(p_ScrollKind: TScrollBarKind; p_OldPosition: Integer);
|
||||
begin
|
||||
if p_ScrollKind = sbVertical then
|
||||
ScrollBy(0, FVertScrollBar.Position - p_OldPosition)
|
||||
else
|
||||
ScrollBy(FHorzScrollBar.Position - p_OldPosition, 0);
|
||||
end;
|
||||
|
||||
Procedure TScrollingWinControl.WMVScroll(var Message : TLMVScroll);
|
||||
begin
|
||||
VertScrollbar.ScrollHandler(Message);
|
||||
@ -162,9 +181,6 @@ Constructor TScrollingWinControl.Create(AOwner : TComponent);
|
||||
begin
|
||||
Inherited Create(AOwner);
|
||||
|
||||
FCanvas := TControlCanvas.Create;
|
||||
FCanvas.Control := Self;
|
||||
|
||||
FVertScrollbar := TControlScrollBar.Create(Self, sbVertical);
|
||||
FHorzScrollbar := TControlScrollBar.Create(Self, sbHorizontal);
|
||||
|
||||
@ -177,7 +193,6 @@ Destructor TScrollingWinControl.Destroy;
|
||||
begin
|
||||
FreeThenNil(FHorzScrollBar);
|
||||
FreeThenNil(FVertScrollBar);
|
||||
FreeThenNil(FCanvas);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user