summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/corelib/fpg_base.pas1
-rw-r--r--src/corelib/fpg_widget.pas18
-rw-r--r--src/corelib/x11/fpg_x11.pas47
-rw-r--r--src/corelib/x11/fpgui_toolkit.lpk6
-rw-r--r--src/corelib/x11/fpgui_toolkit.pas4
-rw-r--r--src/gui/fpg_basegrid.pas86
-rw-r--r--src/gui/fpg_scrollbar.pas2
-rw-r--r--src/gui/fpg_scrollframe.pas484
8 files changed, 600 insertions, 48 deletions
diff --git a/src/corelib/fpg_base.pas b/src/corelib/fpg_base.pas
index ea108b61..eee90d4a 100644
--- a/src/corelib/fpg_base.pas
+++ b/src/corelib/fpg_base.pas
@@ -121,6 +121,7 @@ const
FPGM_FREEME = 19;
FPGM_DROPENTER = 20;
FPGM_DROPEXIT = 21;
+ FPGM_HSCROLL = 22;
FPGM_USER = 50000;
FPGM_KILLME = MaxInt;
diff --git a/src/corelib/fpg_widget.pas b/src/corelib/fpg_widget.pas
index 8fb68a04..527e2987 100644
--- a/src/corelib/fpg_widget.pas
+++ b/src/corelib/fpg_widget.pas
@@ -39,6 +39,8 @@ type
TfpgDragDropEvent = procedure(Sender, Source: TObject; X, Y: integer; AData: variant) of object;
+ { TfpgWidget }
+
TfpgWidget = class(TfpgWindow)
private
FAcceptDrops: boolean;
@@ -57,6 +59,7 @@ type
FOnMouseMove: TMouseMoveEvent;
FOnMouseUp: TMouseButtonEvent;
FOnMouseScroll: TMouseWheelEvent;
+ FOnMouseHorizScroll: TMouseWheelEvent;
FOnPaint: TPaintEvent;
FOnKeyPress: TKeyPressEvent;
FOnResize: TNotifyEvent;
@@ -82,6 +85,7 @@ type
procedure MsgMouseEnter(var msg: TfpgMessageRec); message FPGM_MOUSEENTER;
procedure MsgMouseExit(var msg: TfpgMessageRec); message FPGM_MOUSEEXIT;
procedure MsgMouseScroll(var msg: TfpgMessageRec); message FPGM_SCROLL;
+ procedure MsgMouseHorizScroll(var msg: TfpgMessageRec); message FPGM_HSCROLL;
procedure MsgDropEnter(var msg: TfpgMessageRec); message FPGM_DROPENTER;
procedure MsgDropExit(var msg: TfpgMessageRec); message FPGM_DROPEXIT;
protected
@@ -135,6 +139,7 @@ type
procedure HandleMouseEnter; virtual;
procedure HandleMouseExit; virtual;
procedure HandleMouseScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); virtual;
+ procedure HandleMouseHorizScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); virtual;
function FindFocusWidget(startwg: TfpgWidget; direction: TFocusSearchDirection): TfpgWidget;
procedure HandleAlignments(const dwidth, dheight: TfpgCoord); virtual;
procedure HandleShow; virtual;
@@ -155,6 +160,7 @@ type
property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;
property OnMouseUp: TMouseButtonEvent read FOnMouseUp write FOnMouseUp;
property OnMouseScroll: TMouseWheelEvent read FOnMouseScroll write FOnMouseScroll;
+ property OnMouseHorizScroll: TMouseWheelEvent read FOnMouseHorizScroll write FOnMouseHorizScroll;
property OnPaint: TPaintEvent read FOnPaint write FOnPaint;
property OnResize: TNotifyEvent read FOnResize write FOnResize;
property OnShowHint: THintEvent read GetOnShowHint write SetOnShowHint;
@@ -862,6 +868,12 @@ begin
msg.Params.mouse.shiftstate, msg.Params.mouse.delta);
end;
+procedure TfpgWidget.MsgMouseHorizScroll(var msg: TfpgMessageRec);
+begin
+ HandleMouseHorizScroll(msg.Params.mouse.x, msg.Params.mouse.y,
+ msg.Params.mouse.shiftstate, msg.Params.mouse.delta);
+end;
+
procedure TfpgWidget.MsgDropEnter(var msg: TfpgMessageRec);
begin
// do nothing
@@ -1201,6 +1213,12 @@ begin
FOnMouseScroll(self, shiftstate, delta, Point(x, y));
end;
+procedure TfpgWidget.HandleMouseHorizScroll(x, y: integer; shiftstate: TShiftState; delta: smallint);
+begin
+ if Assigned(FOnMouseHorizScroll) then
+ FOnMouseHorizScroll(self, shiftstate, delta, Point(x, y));
+end;
+
function TfpgWidget.FindFocusWidget(startwg: TfpgWidget; direction: TFocusSearchDirection): TfpgWidget;
var
w: TfpgWidget;
diff --git a/src/corelib/x11/fpg_x11.pas b/src/corelib/x11/fpg_x11.pas
index ca147772..569772ae 100644
--- a/src/corelib/x11/fpg_x11.pas
+++ b/src/corelib/x11/fpg_x11.pas
@@ -1842,31 +1842,50 @@ begin
if not blockmsg then
begin
if (ev.xbutton.button >= 4) and (ev.xbutton.button <= 7) then // mouse wheel
+ // 4=up, 5=down, 6=left, 7=right
begin
// generate scroll events:
if ev._type = X.ButtonPress then
begin
- if ev.xbutton.button = Button4 then
+ if (ev.xbutton.button = Button4) or (ev.xbutton.button = 6) then // x.pp lacks Button6, Button7
i := -1
else
i := 1;
// Check for other mouse wheel messages in the queue
- while XCheckTypedWindowEvent(display, ev.xbutton.window, X.ButtonPress, @NewEvent) do
- begin
- if NewEvent.xbutton.Button = 4 then
- Dec(i)
- else if NewEvent.xbutton.Button = 5 then
- Inc(i)
- else
- begin
- XPutBackEvent(display, @NewEvent);
- break;
- end;
- end;
+ if ev.xbutton.button in [Button4,Button5] then
+ while XCheckTypedWindowEvent(display, ev.xbutton.window, X.ButtonPress, @NewEvent) do
+ begin
+ if NewEvent.xbutton.Button = 4 then
+ Dec(i)
+ else if NewEvent.xbutton.Button = 5 then
+ Inc(i)
+ else
+ begin
+ XPutBackEvent(display, @NewEvent);
+ break;
+ end;
+ end
+ else // button is 6 or 7
+ while XCheckTypedWindowEvent(display, ev.xbutton.window, X.ButtonPress, @NewEvent) do
+ begin
+ if NewEvent.xbutton.Button = 6 then
+ Dec(i)
+ else if NewEvent.xbutton.Button = 7 then
+ Inc(i)
+ else
+ begin
+ XPutBackEvent(display, @NewEvent);
+ break;
+ end;
+ end;
msgp.mouse.delta := i;
- fpgPostMessage(nil, w, FPGM_SCROLL, msgp);
+
+ if ev.xbutton.button in [Button4,Button5] then
+ fpgPostMessage(nil, w, FPGM_SCROLL, msgp)
+ else
+ fpgPostMessage(nil, w, FPGM_HSCROLL, msgp);
end;
end
else
diff --git a/src/corelib/x11/fpgui_toolkit.lpk b/src/corelib/x11/fpgui_toolkit.lpk
index 7793f989..d5ad23c8 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 Major="1"/>
- <Files Count="105">
+ <Files Count="106">
<Item1>
<Filename Value="../stdimages.inc"/>
<Type Value="Include"/>
@@ -450,6 +450,10 @@
<Filename Value="../../gui/fpg_style_win8.pas"/>
<UnitName Value="fpg_style_win8"/>
</Item105>
+ <Item106>
+ <Filename Value="../../gui/fpg_scrollframe.pas"/>
+ <UnitName Value="fpg_scrollframe"/>
+ </Item106>
</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 d6855fc9..86e456f4 100644
--- a/src/corelib/x11/fpgui_toolkit.pas
+++ b/src/corelib/x11/fpgui_toolkit.pas
@@ -22,8 +22,8 @@ uses
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_dbugintf, fpg_dbugmsg, fpg_fontcache, fpg_style_carbon,
- fpg_style_plastic, fpg_style_win8;
+ fpg_dbugintf, fpg_dbugmsg, fpg_fontcache, fpg_style_carbon,
+ fpg_style_plastic, fpg_style_win8, fpg_scrollframe;
implementation
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.
generated by cgit v1.2.3-70-g09d2 (git 2.48.0) at 2025-01-14 00:39:59 +0000