lazarus/lcl/include/scrollingwincontrol.inc

{%MainUnit ../forms.pp}

{
 *****************************************************************************
 *                                                                           *
 *  This file is part of the Lazarus Component Library (LCL)                 *
 *                                                                           *
 *  See the file COPYING.modifiedLGPL.txt, included in this distribution,    *
 *  for details about the copyright.                                         *
 *                                                                           *
 *  This program is distributed in the hope that it will be useful,          *
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     *
 *                                                                           *
 *****************************************************************************
}

procedure TScrollingWinControl.SetAutoScroll(Value: Boolean);
begin
  if FAutoScroll = Value then exit;
  FAutoScroll := Value;
  if Value then
  begin
    HorzScrollBar.AutoCalcRange;
    VertScrollBar.AutoCalcRange;
    UpdateScrollBars;
  end
  else
  begin
    // If AutoScroll is false, then the scrollbars are always invisible
    if HandleAllocated then
    begin
      ShowScrollBar(Handle, SB_HORZ, False);
      ShowScrollBar(Handle, SB_VERT, False);
    end;
  end;
end;

procedure TScrollingWinControl.CreateWnd;
begin
  inherited CreateWnd;
  UpdateScrollBars;
end;

function TScrollingWinControl.GetClientScrollOffset: TPoint;
begin
  if (HorzScrollBar<>nil) and (VertScrollBar<>nil) then begin
    Result.X:=HorzScrollBar.Position;
    Result.Y:=VertScrollBar.Position;
  end else begin
    Result.X:=0;
    Result.Y:=0;
  end;
end;

function TScrollingWinControl.GetLogicalClientRect: TRect;
begin
  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]);}
  if (FHorzScrollBar.Range>Result.Right) then
    Result.Right:=FHorzScrollBar.Range;
  if (FVertScrollBar.Range>Result.Bottom) then
    Result.Bottom:=FVertScrollBar.Range;
end;

procedure TScrollingWinControl.AlignControls(AControl: TControl;
  var ARect: TRect);
begin
  if AutoScroll then
  begin
    if (HorzScrollBar=nil) or (VertScrollBar=nil) then exit;
    inherited AlignControls(AControl, ARect);

    HorzScrollBar.AutoCalcRange;
    VertScrollBar.AutoCalcRange;
    UpdateScrollBars;
  end
  else
    inherited AlignControls(AControl, ARect);
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: TPoint;
begin
  Result.X:=150;
  Result.Y:=150;
end;

procedure TScrollingWinControl.SetHorzScrollBar(Value: TControlScrollBar);
begin
  FHorzScrollbar.Assign(Value);
end;

procedure TScrollingWinControl.SetVertScrollBar(Value: TControlScrollBar);
begin
  FVertScrollbar.Assign(Value);
end;

function TScrollingWinControl.ComputeScrollbars: Boolean;
// true if something changed
// update Page, AutoRange, Visible

  procedure UpdateRange(p_Bar: TControlScrollBar);
  var
    SBSize: Longint;
    OtherScrollbar: TControlScrollBar;
    OldAutoRange: LongInt;
  begin
    OldAutoRange := p_Bar.FAutoRange;
    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;
    {$IFDEF VerboseScrollingWinControl}
    if p_Bar.DebugCondition then
      DebugLn(['UpdateRange p_Bar.fRange=',p_Bar.fRange,' SBSize=',SBSize,' ClientWidth=',ClientWidth,' FAutoRange=',p_Bar.FAutoRange]);
    {$ENDIF}
    if OldAutoRange <> p_Bar.FAutoRange then
      Result := true;
  end;
  
  procedure UpdateVisible(p_Bar: TControlScrollBar);
  var
    CurMax: Integer;
    OldVisible: Boolean;
  begin
    OldVisible:=p_Bar.FVisible;
    if p_Bar.Kind = sbVertical then
      CurMax := ClientHeight
    else
      CurMax := ClientWidth;
    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;
    //if p_Bar.Kind = sbVertical then DebugLn(['UpdateVisible ',dbgsName(Self),' p_Bar.FVisible=',p_Bar.FVisible,' FAutoScroll=',FAutoScroll,' p_Bar.FRange=',p_Bar.FRange,' CurMax=',CurMax]);
    if OldVisible <> p_Bar.FVisible then
      Result := true;
  end;
  
var
  NewPage: Integer;
begin
  Result := false;
  // page
  NewPage := Max(1,Min(ClientWidth -1, High(HorzScrollbar.FPage)));
  if NewPage <> HorzScrollbar.FPage then
  begin
    HorzScrollbar.FPage := NewPage;
    Result := true;
  end;
  NewPage := Max(1,Min(ClientHeight -1, High(VertScrollbar.FPage)));
  if NewPage <> VertScrollbar.FPage then
  begin
    VertScrollbar.FPage := NewPage;
    Result := true;
  end;
  // range
  UpdateRange(HorzScrollbar);
  UpdateRange(VertScrollbar);
  // visible
  UpdateVisible(HorzScrollbar);
  UpdateVisible(VertScrollbar);
end;

procedure TScrollingWinControl.UpdateScrollbars;
begin
  if ([csLoading,csDestroying]*ComponentState<>[]) then exit;
  if not HandleAllocated then exit;
  if (HorzScrollBar=nil) or (VertScrollBar=nil) then exit;

  if FIsUpdating then exit;

  if not FAutoScroll then Exit;

  FIsUpdating := True;
  try
    ComputeScrollbars; // page, autorange, visible
    FVertScrollbar.UpdateScrollbar;
    FHorzScrollbar.UpdateScrollbar;
  finally
    FIsUpdating := False;
  end;
end;

function TScrollingWinControl.HasVisibleScrollbars: boolean;
begin
  Result:=(VertScrollBar<>nil) and VertScrollBar.Visible
      and (HorzScrollBar<>nil) and HorzScrollBar.Visible;
end;

function TScrollingWinControl.StoreScrollBars : Boolean;
begin
  Result := Not AutoScroll;
end;

class procedure TScrollingWinControl.WSRegisterClass;
begin
  inherited WSRegisterClass;
  RegisterScrollingWinControl;
end;

procedure TScrollingWinControl.ScrollBy(DeltaX, DeltaY: Integer);
begin
  if HandleAllocated then begin
    TWSScrollingWinControlClass(WidgetSetClass).ScrollBy(Self, DeltaX, DeltaY);
    Invalidate;
  end;
end;

procedure TScrollingWinControl.ScrollbarHandler(ScrollKind: TScrollBarKind;
  OldPosition: Integer);
begin
  if ScrollKind = sbVertical then
    ScrollBy(0, FVertScrollBar.Position - OldPosition)
  else
    ScrollBy(FHorzScrollBar.Position - OldPosition, 0);
end;

procedure TScrollingWinControl.Loaded;
begin
  inherited Loaded;
  UpdateScrollbars;
end;

procedure TScrollingWinControl.WMVScroll(var Message : TLMVScroll);
begin
  VertScrollbar.ScrollHandler(Message);
end;

procedure TScrollingWinControl.WMHScroll(var Message : TLMHScroll);
begin
  //DebugLn(['TScrollingWinControl.WMHScroll ',dbgsName(Self)]);
  HorzScrollbar.ScrollHandler(Message);
end;

constructor TScrollingWinControl.Create(TheOwner : TComponent);
begin
  Inherited Create(TheOwner);

  FAutoScroll := true;
  FVertScrollbar := TControlScrollBar.Create(Self, sbVertical);
  FHorzScrollbar := TControlScrollBar.Create(Self, sbHorizontal);

  ControlStyle := [csAcceptsControls, csClickEvents, csDoubleClicks];

  SetInitialBounds(0,0,GetControlClassDefaultSize.X,GetControlClassDefaultSize.Y);
end;

destructor TScrollingWinControl.Destroy;
begin
  FreeThenNil(FHorzScrollBar);
  FreeThenNil(FVertScrollBar);
  inherited Destroy;
end;

// included by forms.pp