Merge remote-tracking branch 'demerson/scroll-frame' into 'develop'

3 files changed, 541 insertions, 31 deletions

diff --git a/src/gui/fpg_basegrid.pas b/src/gui/fpg_basegrid.pas
index 146887b9..cbce739f 100644
--- a/src/gui/fpg_basegrid.pas
+++ b/src/gui/fpg_basegrid.pas
@@ -133,6 +133,7 @@ type
     procedure   HandleResize(awidth, aheight: TfpgCoord); override;
     procedure   HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); override;
     procedure   HandleMouseScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); override;
+    procedure   HandleMouseHorizScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); override;
     procedure   HandleMouseMove(x, y: integer; btnstate: word; shiftstate: TShiftState); override;
     procedure   HandleLMouseUp(x, y: integer; shiftstate: TShiftState); override;
     procedure   HandleLMouseDown(x, y: integer; shiftstate: TShiftState); override;
@@ -620,8 +621,10 @@ var
   vl: integer;
   i: integer;
   x: integer;
-  Hfits, showH: boolean;
-  Vfits, showV: boolean;
+  hmax: integer;
+  vmax: integer;
+  Hfits, showH : boolean;
+  Vfits, showV : boolean;
   crect: TfpgRect;
   borders: TRect;
 
@@ -740,7 +743,10 @@ begin
       FVScrollBar.SliderSize := VisibleLines / RowCount
     else
       FVScrollBar.SliderSize := 0;
-    FVScrollBar.Max := RowCount-VisibleLines;
+    vmax := RowCount - VisibleLines;
+    if FFirstRow > vmax then
+      FFirstRow := vmax;
+    FVScrollBar.Max := vmax;
     FVScrollBar.Position := FFirstRow;
     FVScrollBar.RepaintSlider;
     FVScrollBar.Top := borders.Top;
@@ -761,7 +767,10 @@ begin
     FHScrollBar.Min         := 0;
     if go_SmoothScroll in FOptions then
     begin
-      FHScrollBar.Max := cw - vw;
+      hmax := cw - vw;
+      FHScrollBar.Max := hmax;
+      if FXOffset>hmax then
+        FXOffset:=hmax;
       FHScrollBar.Position := FXOffset;
       FHScrollBar.SliderSize := HWidth / TotalColumnWidth;
       FHScrollBar.PageSize := 5;
@@ -1195,49 +1204,66 @@ end;
 procedure TfpgBaseGrid.HandleMouseScroll(x, y: integer; shiftstate: TShiftState; delta: smallint);
 var
   lRow: Integer;
-  lCol: Integer;
 begin
   inherited HandleMouseScroll(x, y, shiftstate, delta);
 
   lRow := FFirstRow;
-  lCol := FFirstCol;
 
-  if delta > 0 then // scroll down
-    inc(FFirstRow, abs(delta)*3)
-  else              // scroll up
-    if FFirstRow > 0 then
-      dec(FFirstRow, abs(delta)*3);
+  // If vertical scrollbar is not visible, but
+  // horizontal is, Mouse wheel will scroll horizontally.  :)
+  if FHScrollBar.Visible and (not FVScrollBar.Visible) then
+  begin
+    HandleMouseHorizScroll(x, y, shiftstate, delta);
+    Exit;
+  end;
+
+  inc(FFirstRow, delta*3);
 
   // apply limits
   if FFirstRow > RowCount - VisibleLines then
     FFirstRow := RowCount - VisibleLines;
   if FFirstRow < 0 then
     FFirstRow := 0;
-    
-  // scroll left/right
-  // If vertical scrollbar is not visible, but
-  // horizontal is. Mouse wheel will scroll horizontally.  :)
-  if FHScrollBar.Visible and (not FVScrollBar.Visible) then
-  begin
-    if delta > 0 then // scroll right
-    begin
-      if FFirstCol < (ColumnCount-1) then
-        inc(FFirstCol);
-    end
-    else
-    begin
-      if FFirstCol > 0 then
-        dec(FFirstCol);
-    end;
-  end;
 
-  if (lRow <> FFirstRow) or (lCol <> FFirstCol) then
+  if lRow <> FFirstRow then
   begin
     UpdateScrollBars;
     RePaint;
   end;
 end;
 
+procedure TfpgBaseGrid.HandleMouseHorizScroll(x, y: integer; shiftstate: TShiftState; delta: smallint);
+var
+  old_val: Integer;
+begin
+  inherited HandleMouseHorizScroll(x, y, shiftstate, delta);
+
+  if go_SmoothScroll in Options then
+  begin
+    old_val := FXOffset;
+    inc(FXOffset, delta*FHScrollBar.ScrollStep);
+    if (FXOffset<0) then
+      FXOffset:=0;
+    // finding the maximum Xoffset is tricky, let updatescrollbars do it.
+    if (FXOffset=old_val) then
+      Exit;
+  end
+  else
+  begin
+    old_val := FFirstCol;
+    inc(FFirstCol, delta);
+    if FFirstCol<0 then
+      FFirstCol:=0
+    else if FFirstCol > ColumnCount-1 then
+      FFirstCol:=ColumnCount-1;
+    if FFirstCol=old_val then
+      Exit;
+  end;
+
+  UpdateScrollBars;
+  RePaint;
+end;
+
 procedure TfpgBaseGrid.HandleMouseMove(x, y: integer; btnstate: word; shiftstate: TShiftState);
 var
   hh: integer;
@@ -1578,7 +1604,7 @@ begin
   FHScrollBar.Orientation := orHorizontal;
   FHScrollBar.Visible     := False;
   FHScrollBar.OnScroll    := @HScrollBarMove;
-  FHScrollBar.ScrollStep  := 5;
+  FHScrollBar.ScrollStep  := 20;
 end;
 
 destructor TfpgBaseGrid.Destroy;
diff --git a/src/gui/fpg_scrollbar.pas b/src/gui/fpg_scrollbar.pas
index 7fd5de64..6f99588a 100644
--- a/src/gui/fpg_scrollbar.pas
+++ b/src/gui/fpg_scrollbar.pas
@@ -36,7 +36,7 @@ uses
 type
   TScrollNotifyEvent = procedure(Sender: TObject; position: integer) of object;
 
-  TfpgScrollStyle = (ssNone, ssHorizontal, ssVertical, ssAutoBoth);
+  TfpgScrollStyle = (ssNone, ssHorizontal, ssVertical, ssAutoBoth, ssBothVisible);
   
   TfpgScrollBarPart = (sbpNone, sbpUpBack, sbpPageUpBack, sbpSlider, sbpDownForward, sbpPageDownForward);
 
diff --git a/src/gui/fpg_scrollframe.pas b/src/gui/fpg_scrollframe.pas
new file mode 100644
index 00000000..fd467c46
--- /dev/null
+++ b/src/gui/fpg_scrollframe.pas
@@ -0,0 +1,484 @@
+unit fpg_scrollframe;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes,
+  SysUtils,
+  fpg_base,
+  fpg_main,
+  fpg_widget,
+  fpg_panel,
+  fpg_scrollbar;
+
+type
+  
+  TfpgScrollFrame = class;
+
+  { TfpgEmbeddingFrame }
+
+  TfpgEmbeddingFrame = class (TfpgFrame)
+  // The purpose of the EmbeddingFrame is to pass scroll events to the ParentScrollFrame
+  private
+    FParentScrollFrame : TfpgScrollFrame;
+  protected
+    procedure HandleMouseScroll(x, y: integer; shiftstate: TShiftState;
+        delta: smallint); override;
+    procedure HandleMouseHorizScroll(x, y: integer; shiftstate: TShiftState; 
+        delta: smallint); override;
+  public
+    property ParentScrollFrame : TfpgScrollFrame read FParentScrollFrame write FParentScrollFrame;
+  end;
+
+  { TfpgAutoSizingFrame }
+
+  TfpgAutoSizingFrame = class (TfpgEmbeddingFrame)
+  private
+    FMarginBR : integer;
+    procedure SetMarginBR (AValue: integer);
+  public
+    procedure AfterConstruction; override;
+    procedure AdjustDimsFor (w : TfpgWidget; updatewp: boolean = true);
+    procedure AdjustDimsWithout (w : TfpgWidget);
+    procedure RecalcFrameSize;
+    property MarginBR : integer read FMarginBR write SetMarginBR; // bottom-right margin
+  end;
+
+  TfpgASFrameClass = class of TfpgAutoSizingFrame;
+
+  { TfpgScrollFrame }
+
+  TfpgScrollFrame = class (TfpgFrame)
+  private
+    FContentFrame : TfpgAutoSizingFrame;
+    FVisibleArea : TfpgEmbeddingFrame;
+    FHScrollBar : TfpgScrollBar;
+    FVScrollBar : TfpgScrollBar;
+    FScrollBarStyle : TfpgScrollStyle;
+    function GetXOffset: integer;
+    function GetYOffset: integer;
+    procedure SetXOffset (x: integer);
+    procedure SetYOffset (y: integer);
+  protected
+    procedure HandleMouseScroll(x, y: integer; shiftstate: TShiftState;
+        delta: smallint); override;
+    procedure HandleMouseHorizScroll(x, y: integer; shiftstate: TShiftState; 
+        delta: smallint); override;
+    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
+
+
+{ TfpgEmbeddingFrame }
+
+procedure TfpgEmbeddingFrame.HandleMouseScroll(x, y: integer; 
+  shiftstate: TShiftState; delta: smallint);
+begin
+  ParentScrollFrame.HandleMouseScroll(x, y, shiftstate, delta);
+end;
+
+procedure TfpgEmbeddingFrame.HandleMouseHorizScroll(x, y: integer; 
+  shiftstate: TShiftState; delta: smallint);
+begin
+  ParentScrollFrame.HandleMouseHorizScroll(x, y, shiftstate, delta);
+end;
+
+
+{ TfpgAutoSizingFrame }
+
+procedure TfpgAutoSizingFrame.SetMarginBR(AValue: integer);
+begin
+  if FMarginBR=AValue then Exit;
+  FMarginBR:=AValue;
+  RecalcFrameSize;
+end;
+
+procedure TfpgAutoSizingFrame.AfterConstruction;
+begin
+  inherited AfterConstruction;
+  RecalcFrameSize;
+end;
+
+procedure TfpgAutoSizingFrame.AdjustDimsFor (w: TfpgWidget; updatewp: boolean = true);
+var
+  new_w, new_h: integer;
+begin
+  if not w.Visible then
+    Exit;
+  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
+      if ParentScrollFrame is TfpgScrollFrame then
+        ParentScrollFrame.UpdateScrollbars
+      else
+        UpdateWindowPosition;
+  end;
+end;
+
+procedure TfpgAutoSizingFrame.AdjustDimsWithout (w: TfpgWidget);
+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 TfpgWidget then
+    begin
+      if not TfpgWidget(c).Visible then
+        continue;
+      this_need := TfpgWidget(c).right+MarginBR+1;
+      if (this_need>max_w) then
+        max_w := this_need;
+      this_need := TfpgWidget(c).bottom+MarginBR+1;
+      if (this_need>max_h) then
+        max_h := this_need;
+    end;
+  end;
+  HandleResize(max_w, max_h);
+  if ParentScrollFrame is TfpgScrollFrame then
+    ParentScrollFrame.UpdateScrollbars
+  else
+    UpdateWindowPosition;
+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.HandleMouseScroll(x, y: integer; 
+  shiftstate: TShiftState; delta: smallint);
+var
+  old_val, new_val : integer;
+begin
+  inherited HandleMouseScroll(x, y, shiftstate, delta);
+  with FVScrollBar do
+  begin
+    if not Visible then
+      Exit;
+    Position:=Position+delta*ScrollStep;
+    if YOffset=Position then
+      Exit;
+    YOffset:=Position;
+  end;
+  UpdateScrollbars;
+end;
+
+procedure TfpgScrollFrame.HandleMouseHorizScroll(x, y: integer; 
+  shiftstate: TShiftState; delta: smallint);
+begin
+  inherited HandleMouseHorizScroll(x, y, shiftstate, delta);
+  with FHScrollBar do
+  begin
+    if not Visible then
+      Exit;
+    Position:=Position+delta*ScrollStep;
+    if XOffset=Position then
+      Exit;
+    XOffset:=Position;
+  end;
+  UpdateScrollbars;
+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 := TfpgEmbeddingFrame.Create(self);
+  FVisibleArea.HandleMove(0, 0);
+  FVisibleArea.ParentScrollFrame := self;
+
+  FContentFrame := TfpgAutoSizingFrame.Create(FVisibleArea);
+  FContentFrame.HandleMove(0, 0);
+  FContentFrame.ParentScrollFrame := self;
+end;
+
+constructor TfpgScrollFrame.Create(AOwner: TComponent; ContentFrameType: TfpgASFrameClass);
+begin
+  inherited Create(AOwner);
+
+  FVisibleArea := TfpgEmbeddingFrame.Create(self);
+  FVisibleArea.HandleMove(0, 0);
+  FVisibleArea.ParentScrollFrame := self;
+
+  FContentFrame := ContentFrameType.Create(FVisibleArea);
+  FContentFrame.HandleMove(0, 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;
+    ScrollStep  := 10;
+    end;
+
+  FHScrollBar := TfpgScrollBar.Create(self);
+  with FHScrollBar do begin
+    Orientation := orHorizontal;
+    OnScroll    := @HScrollBarMove;
+    Position    := 0;
+    ScrollStep  := 10;
+    end;
+
+  FScrollBarStyle := ssAutoBoth;
+end;
+
+
+end.