1 files changed, 405 insertions, 0 deletions
diff --git a/src/gui/fpg_scrollframe.pas b/src/gui/fpg_scrollframe.pas
new file mode 100644
index 00000000..d10c69fd
--- /dev/null
+++ b/src/gui/fpg_scrollframe.pas
@@ -0,0 +1,405 @@
+unit fpg_scrollframe;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes,
+  SysUtils,
+  fpg_base,
+  fpg_main,
+  fpg_widget,
+  fpg_panel,
+  fpg_scrollbar;
+
+type
+  
+  TfpgScrollFrame = class;
+
+  { TfpgAutoSizingFrame }
+
+  TfpgAutoSizingFrame = class (TfpgFrame)
+  private
+    FMarginBR : integer;
+    FParentScrollFrame : TfpgScrollFrame; // it's actually the grandparent
+    procedure SetMarginBR (AValue: integer);
+    procedure UpdatePos;
+  public
+    procedure AdjustDimsFor (w : TfpgWindow; updatewp: boolean = true);
+    procedure AdjustDimsWithout (w : TfpgWindow);
+    procedure RecalcFrameSize;
+    property MarginBR : integer read FMarginBR write SetMarginBR; // bottom-right margin
+    property ParentScrollFrame : TfpgScrollFrame read FParentScrollFrame write FParentScrollFrame;
+  end;
+
+  TfpgASFrameClass = class of TfpgAutoSizingFrame;
+
+  { TfpgScrollFrame }
+
+  TfpgScrollFrame = class (TfpgFrame)
+  private
+    FContentFrame : TfpgAutoSizingFrame;
+    FVisibleArea : TfpgFrame;
+    FHScrollBar : TfpgScrollBar;
+    FVScrollBar : TfpgScrollBar;
+    FScrollBarStyle : TfpgScrollStyle;
+    function GetXOffset: integer;
+    function GetYOffset: integer;
+    procedure SetXOffset (x: integer);
+    procedure SetYOffset (y: integer);
+  protected
+    procedure HandleResize(awidth, aheight: TfpgCoord); override;
+    procedure HandleShow; override;
+    procedure HScrollBarMove(Sender: TObject; position: integer);
+    procedure VScrollBarMove(Sender: TObject; position: integer);
+    procedure UpdateScrollbars; virtual;
+    property XOffset : integer read GetXOffset write SetXOffset; // these do not...
+    property YOffset : integer read GetYOffset write SetYOffset; // ...updatewindowposition
+  public
+    constructor Create (AOwner: TComponent); override;
+    constructor Create (AOwner: TComponent; ContentFrameType: TfpgASFrameClass); virtual;
+    procedure AfterCreate; override;
+    property ContentFrame : TfpgAutoSizingFrame read FContentFrame write FContentFrame;
+  end;
+
+implementation
+
+{ TfpgAutoSizingFrame }
+
+procedure TfpgAutoSizingFrame.SetMarginBR(AValue: integer);
+begin
+  if FMarginBR=AValue then Exit;
+  FMarginBR:=AValue;
+  RecalcFrameSize;
+end;
+
+procedure TfpgAutoSizingFrame.UpdatePos;
+begin
+  UpdateWindowPosition;
+  if ParentScrollFrame is TfpgScrollFrame then
+    ParentScrollFrame.UpdateScrollbars;
+end;
+
+procedure TfpgAutoSizingFrame.AdjustDimsFor (w: TfpgWindow; updatewp: boolean = true);
+var
+  new_w, new_h: integer;
+begin
+  new_w := w.Right+MarginBR+1;
+  new_h := w.Bottom+MarginBR+1;
+  if (Width < new_w) or (Height < new_h) then
+  begin
+    HandleResize(new_w, new_h);
+    if updatewp then
+      UpdatePos;
+  end;
+end;
+
+procedure TfpgAutoSizingFrame.AdjustDimsWithout (w: TfpgWindow);
+begin
+  if (Width = w.Right+MarginBR+1)
+  or (Height = w.Bottom+MarginBR+1) then
+    RecalcFrameSize;
+end;
+
+procedure TfpgAutoSizingFrame.RecalcFrameSize;
+var
+  i : integer;
+  c : TComponent;
+  max_w, max_h : integer;
+  this_need : integer;
+  par : TfpgWidget;
+begin
+  if ComponentCount=0 then
+    Exit;
+  max_w := 1;
+  max_h := 1;
+  for i := 0 to ComponentCount-1 do begin
+    c := Components[i];
+    if c is TfpgWindow then
+    begin
+      this_need := TfpgWindow(c).right+MarginBR+1;
+      if (this_need>max_w) then
+        max_w := this_need;
+      this_need := TfpgWindow(c).bottom+MarginBR+1;
+      if (this_need>max_h) then
+        max_h := this_need;
+    end;
+  end;
+  HandleResize(max_w, max_h);
+  UpdatePos;
+end;
+
+
+{ TfpgScrollFrame }
+
+function TfpgScrollFrame.GetXOffset: integer;
+begin
+  result := -FContentFrame.Left;
+end;
+
+function TfpgScrollFrame.GetYOffset: integer;
+begin
+  result := -FContentFrame.Top;
+end;
+
+procedure TfpgScrollFrame.SetXOffset (x: integer);
+begin
+  if ContentFrame.Left = -x then
+    Exit;
+  FContentFrame.Left := -x;
+end;
+
+procedure TfpgScrollFrame.SetYOffset (y: integer);
+begin
+  if ContentFrame.Top = -y then
+    Exit;
+  FContentFrame.Top := -y;
+end;
+
+procedure TfpgScrollFrame.HandleResize(awidth, aheight: TfpgCoord);
+begin
+  inherited HandleResize(awidth, aheight);
+  if (csLoading in ComponentState) or (csUpdating in ComponentState) then
+    Exit; //==>
+  if HasHandle then
+    UpdateScrollBars;
+end;
+
+procedure TfpgScrollFrame.HandleShow;
+begin
+  inherited HandleShow;
+  if (csLoading in ComponentState) then
+    Exit;
+  UpdateScrollBars;
+end;
+
+procedure TfpgScrollFrame.HScrollBarMove (Sender: TObject; position: integer);
+begin
+  if position = XOffset then
+    Exit;
+  XOffset := position;
+  FContentFrame.UpdateWindowPosition;
+end;
+
+procedure TfpgScrollFrame.VScrollBarMove (Sender: TObject; position: integer);
+begin
+  if position = YOffset then
+    Exit;
+  YOffset := position;
+  FContentFrame.UpdateWindowPosition;
+end;
+
+procedure TfpgScrollFrame.UpdateScrollbars;
+var
+  contentWidth, contentHeight: integer;
+  visWidth, visHeight: integer;
+  Hfits, Vfits : boolean;
+  showHsb, showVsb : boolean;
+  prevHideHsb, prevHideVsb : boolean;
+
+  procedure hideScrollbar (sb : TfpgScrollBar);
+  begin
+    with sb do
+      if Visible then
+      begin
+        Visible := False;
+        UpdateWindowPosition;
+      end;
+  end;
+
+  procedure getVisWidth;
+  begin
+    if showVsb then
+      visWidth := Width - (FVScrollBar.Width-1)
+    else
+      visWidth := Width;
+    Hfits := visWidth >= contentWidth
+  end;
+
+  procedure getVisHeight;
+  begin
+    if showHsb then
+      visHeight := Height - (FHScrollBar.Height-1)
+    else
+      visHeight := Height;
+    Vfits := visHeight >= contentHeight;
+  end;
+
+begin
+  if (csLoading in ComponentState) or (csUpdating in ComponentState) then
+    Exit; //==>
+
+  // if we don't want any scrollbars, hide them and exit
+  if FScrollBarStyle = ssNone then
+  begin
+    hideScrollbar (FHScrollBar);
+    hideScrollbar (FVScrollBar);
+    exit;
+  end;
+
+  // preliminary width/height calculations
+  prevHideHsb := not FHScrollBar.Visible;
+  prevHideVsb := not FVScrollBar.Visible;
+  showVsb := (FScrollBarStyle = ssBothVisible);
+  showHsb := showVsb;
+  contentWidth := ContentFrame.Width;
+  contentHeight := ContentFrame.Height;
+  getVisWidth;
+  getVisHeight;
+
+  // determine whether to show scrollbars for different configurations
+  case FScrollBarStyle of
+    ssHorizontal:
+        begin
+          hideScrollbar (FVScrollBar);
+          if not Hfits then
+          begin
+            showHsb := true;
+            getVisHeight;
+          end;
+        end;
+    ssVertical:
+        begin
+          hideScrollbar (FHScrollBar);
+          if not Vfits then
+          begin
+            showVsb := true;
+            getVisWidth;
+          end;
+        end;
+    ssAutoBoth:
+        if not Vfits then
+        begin
+          showVsb := true;
+          getVisWidth;
+          if not Hfits then
+          begin
+            showHsb := true;
+            getVisHeight;
+            getVisWidth;
+          end;
+        end
+        else if not Hfits then
+        begin
+          showHsb := true;
+          getVisHeight;
+          if not Vfits then
+          begin
+            showVsb := true;
+            getVisWidth;
+            getVisHeight;
+          end;
+        end;
+  end;
+
+  // show or hide the scrollbars
+
+  if showVsb then with FVScrollBar do
+  begin
+    if prevHideVsb then
+      Position := 0;
+    Visible := true;
+    Min := 0;
+    Max := contentHeight - visHeight;  // may set position!
+    YOffset := Position;
+    if contentHeight > 0 then
+      SliderSize := visHeight / contentHeight
+    else
+      SliderSize := 0;
+    RepaintSlider;
+    Top     := 0;
+    Left    := visWidth;
+    Height  := visHeight;
+    PageSize:= visHeight;
+  end
+  else
+  begin
+    FVScrollBar.Visible := false;
+    if Vfits then // if vertical doesn't fit and no scrollbar, do not change offset
+      YOffset := 0;
+  end;
+
+  if showHsb then with FHScrollBar do
+  begin
+    if prevHideHsb then
+      Position := 0;
+    Visible := true;
+    Min := 0;
+    Max := contentWidth - visWidth;  // may set position!
+    XOffset := Position;
+    if contentWidth > 0 then
+      SliderSize := visWidth / contentWidth
+    else
+      SliderSize := 0;
+    RepaintSlider;
+    Top     := visHeight;
+    Left    := 0;
+    Width   := visWidth;
+    PageSize:= visWidth;
+  end
+  else
+  begin
+    FHScrollBar.Visible := false;
+    if Hfits then // if horizontal doesn't fit and no scrollbar, do not change offset
+      XOffset := 0;
+  end;
+
+  FVScrollBar.UpdateWindowPosition;
+  FHScrollBar.UpdateWindowPosition;
+
+  FVisibleArea.SetPosition(0, 0, visWidth, visHeight);
+  FVisibleArea.UpdateWindowPosition;
+
+  FContentFrame.UpdateWindowPosition;
+end;
+
+constructor TfpgScrollFrame.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+
+  FVisibleArea := TfpgFrame.Create(self);
+  FVisibleArea.SetPosition(0, 0, 1, 1);
+
+  FContentFrame := TfpgAutoSizingFrame.Create(FVisibleArea);
+  FContentFrame.SetPosition(0, 0, 1, 1);
+  FContentFrame.ParentScrollFrame := self;
+end;
+
+constructor TfpgScrollFrame.Create(AOwner: TComponent; ContentFrameType: TfpgASFrameClass);
+begin
+  inherited Create(AOwner);
+
+  FVisibleArea := TfpgFrame.Create(self);
+  FVisibleArea.Left := 0;
+  FVisibleArea.Top := 0;
+
+  FContentFrame := ContentFrameType.Create(FVisibleArea);
+  FContentFrame.Left := 0;
+  FContentFrame.Top := 0;
+  FContentFrame.ParentScrollFrame := self;
+end;
+
+procedure TfpgScrollFrame.AfterCreate;
+begin
+  inherited AfterCreate;
+
+  FVScrollBar := TfpgScrollBar.Create(self);
+  with FVScrollBar do begin
+    Orientation := orVertical;
+    OnScroll    := @VScrollBarMove;
+    Position    := 0;
+    end;
+
+  FHScrollBar := TfpgScrollBar.Create(self);
+  with FHScrollBar do begin
+    Orientation := orHorizontal;
+    OnScroll    := @HScrollBarMove;
+    Position    := 0;
+    end;
+
+  FScrollBarStyle := ssAutoBoth;
+end;
+
+
+end.