Scroll-Frame!

4 files changed, 425 insertions, 14 deletions

diff --git a/src/corelib/x11/fpgui_toolkit.lpk b/src/corelib/x11/fpgui_toolkit.lpk
index 2ac5a337..9be3ad6e 100644
--- a/src/corelib/x11/fpgui_toolkit.lpk
+++ b/src/corelib/x11/fpgui_toolkit.lpk
@@ -29,7 +29,7 @@
     <Description Value="fpGUI Toolkit"/>
     <License Value="LGPL 2 with static linking exception."/>
     <Version Minor="8"/>
-    <Files Count="99">
+    <Files Count="100">
       <Item1>
         <Filename Value="../stdimages.inc"/>
         <Type Value="Include"/>
@@ -426,6 +426,10 @@
         <Filename Value="../render/software/Agg2D.pas"/>
         <UnitName Value="Agg2D"/>
       </Item99>
+      <Item100>
+        <Filename Value="../../gui/fpg_scrollframe.pas"/>
+        <UnitName Value="fpg_scrollframe"/>
+      </Item100>
     </Files>
     <LazDoc Paths="../../../docs/xml/corelib;../../../docs/xml/corelib/x11;../../../docs/xml/corelib/gdi;../../../docs/xml/gui"/>
     <RequiredPkgs Count="1">
diff --git a/src/corelib/x11/fpgui_toolkit.pas b/src/corelib/x11/fpgui_toolkit.pas
index 10dc7f27..4f4f92c0 100644
--- a/src/corelib/x11/fpgui_toolkit.pas
+++ b/src/corelib/x11/fpgui_toolkit.pas
@@ -8,19 +8,21 @@ interface
 
 uses
   fpg_base, fpg_main, fpg_cmdlineparams, fpg_command_intf, fpg_constants, 
-  fpg_extinterpolation, fpg_imagelist, fpg_imgfmt_bmp, fpg_pofiles, fpg_popupwindow, 
-  fpg_stdimages, fpg_stringhashlist, fpg_translations, fpg_stringutils, fpg_utils, 
-  fpg_widget, fpg_wuline, fpg_impl, fpg_x11, fpg_netlayer_x11, fpg_keyconv_x11, 
-  fpg_xft_x11, fpg_animation, fpg_basegrid, fpg_button, fpg_checkbox, fpg_combobox, 
-  fpg_customgrid, fpg_dialogs, fpg_editcombo, fpg_edit, fpg_form, fpg_gauge, fpg_grid, 
-  fpg_hyperlink, fpg_iniutils, fpg_label, fpg_listbox, fpg_listview, fpg_memo, fpg_menu, 
+  fpg_extinterpolation, fpg_imagelist, fpg_imgfmt_bmp, fpg_pofiles, 
+  fpg_popupwindow, fpg_stdimages, fpg_stringhashlist, fpg_translations, 
+  fpg_stringutils, fpg_utils, fpg_widget, fpg_wuline, fpg_impl, fpg_x11, 
+  fpg_netlayer_x11, fpg_keyconv_x11, fpg_xft_x11, fpg_animation, fpg_basegrid, 
+  fpg_button, fpg_checkbox, fpg_combobox, fpg_customgrid, fpg_dialogs, 
+  fpg_editcombo, fpg_edit, fpg_form, fpg_gauge, fpg_grid, fpg_hyperlink, 
+  fpg_iniutils, fpg_label, fpg_listbox, fpg_listview, fpg_memo, fpg_menu, 
   fpg_mru, fpg_panel, fpg_popupcalendar, fpg_progressbar, fpg_radiobutton, 
-  fpg_scrollbar, fpg_style, fpg_tab, fpg_trackbar, fpg_tree, fpgui_db, fpg_splitter, 
-  fpg_hint, fpg_spinedit, fpg_extgraphics, fpg_ColorMapping, fpg_ColorWheel, 
-  fpg_interface, fpg_editbtn, fpg_imgfmt_jpg, fpg_imgutils, fpg_stylemanager, 
-  fpg_style_win2k, fpg_style_motif, fpg_style_clearlooks, fpg_style_bluecurve, 
-  fpg_style_bitmap, fpg_readonly, fpg_imgfmt_png, U_Command, U_Pdf, U_Report, 
-  U_ReportImages, U_Visu, fpg_trayicon, Agg2D;
+  fpg_scrollbar, fpg_style, fpg_tab, fpg_trackbar, fpg_tree, fpgui_db, 
+  fpg_splitter, fpg_hint, fpg_spinedit, fpg_extgraphics, fpg_ColorMapping, 
+  fpg_ColorWheel, fpg_interface, fpg_editbtn, fpg_imgfmt_jpg, fpg_imgutils, 
+  fpg_stylemanager, fpg_style_win2k, fpg_style_motif, fpg_style_clearlooks, 
+  fpg_style_bluecurve, fpg_style_bitmap, fpg_readonly, fpg_imgfmt_png, 
+  U_Command, U_Pdf, U_Report, U_ReportImages, U_Visu, fpg_trayicon, Agg2D, 
+  fpg_scrollframe;
 
 implementation
 
diff --git a/src/gui/fpg_scrollbar.pas b/src/gui/fpg_scrollbar.pas
index dd0a4c7c..29a37449 100644
--- a/src/gui/fpg_scrollbar.pas
+++ b/src/gui/fpg_scrollbar.pas
@@ -39,7 +39,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..335b97a8
--- /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;
+    FScrollFrame : 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;
+
+  FScrollFrame.SetPosition(0, 0, visWidth, visHeight);
+  FScrollFrame.UpdateWindowPosition;
+
+  FContentFrame.UpdateWindowPosition;
+end;
+
+constructor TfpgScrollFrame.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+
+  FScrollFrame := TfpgFrame.Create(self);
+  FScrollFrame.SetPosition(0, 0, 1, 1);
+
+  FContentFrame := TfpgAutoSizingFrame.Create(FScrollFrame);
+  FContentFrame.SetPosition(0, 0, 1, 1);
+  FContentFrame.ParentScrollFrame := self;
+end;
+
+constructor TfpgScrollFrame.Create(AOwner: TComponent; ContentFrameType: TfpgASFrameClass);
+begin
+  inherited Create(AOwner);
+
+  FScrollFrame := TfpgFrame.Create(self);
+  FScrollFrame.Left := 0;
+  FScrollFrame.Top := 0;
+
+  FContentFrame := ContentFrameType.Create(FScrollFrame);
+  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.