From 486f4f48ff250ce64ab532a302b6bbd6c05c4050 Mon Sep 17 00:00:00 2001 From: David Laurence Emerson Date: Mon, 27 May 2013 22:59:46 -0700 Subject: Scroll-Frame! --- src/gui/fpg_scrollframe.pas | 405 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 405 insertions(+) create mode 100644 src/gui/fpg_scrollframe.pas (limited to 'src/gui/fpg_scrollframe.pas') 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. -- cgit v1.2.3-70-g09d2 From 4823d681953279fbdf6081695f55b250d098aee7 Mon Sep 17 00:00:00 2001 From: David Laurence Emerson Date: Mon, 27 May 2013 23:52:32 -0700 Subject: renamed FScrollFrame (bad name) to FVisibleArea --- src/gui/fpg_scrollframe.pas | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) (limited to 'src/gui/fpg_scrollframe.pas') diff --git a/src/gui/fpg_scrollframe.pas b/src/gui/fpg_scrollframe.pas index 335b97a8..d10c69fd 100644 --- a/src/gui/fpg_scrollframe.pas +++ b/src/gui/fpg_scrollframe.pas @@ -40,7 +40,7 @@ type TfpgScrollFrame = class (TfpgFrame) private FContentFrame : TfpgAutoSizingFrame; - FScrollFrame : TfpgFrame; + FVisibleArea : TfpgFrame; FHScrollBar : TfpgScrollBar; FVScrollBar : TfpgScrollBar; FScrollBarStyle : TfpgScrollStyle; @@ -348,8 +348,8 @@ begin FVScrollBar.UpdateWindowPosition; FHScrollBar.UpdateWindowPosition; - FScrollFrame.SetPosition(0, 0, visWidth, visHeight); - FScrollFrame.UpdateWindowPosition; + FVisibleArea.SetPosition(0, 0, visWidth, visHeight); + FVisibleArea.UpdateWindowPosition; FContentFrame.UpdateWindowPosition; end; @@ -358,10 +358,10 @@ constructor TfpgScrollFrame.Create(AOwner: TComponent); begin inherited Create(AOwner); - FScrollFrame := TfpgFrame.Create(self); - FScrollFrame.SetPosition(0, 0, 1, 1); + FVisibleArea := TfpgFrame.Create(self); + FVisibleArea.SetPosition(0, 0, 1, 1); - FContentFrame := TfpgAutoSizingFrame.Create(FScrollFrame); + FContentFrame := TfpgAutoSizingFrame.Create(FVisibleArea); FContentFrame.SetPosition(0, 0, 1, 1); FContentFrame.ParentScrollFrame := self; end; @@ -370,11 +370,11 @@ constructor TfpgScrollFrame.Create(AOwner: TComponent; ContentFrameType: TfpgASF begin inherited Create(AOwner); - FScrollFrame := TfpgFrame.Create(self); - FScrollFrame.Left := 0; - FScrollFrame.Top := 0; + FVisibleArea := TfpgFrame.Create(self); + FVisibleArea.Left := 0; + FVisibleArea.Top := 0; - FContentFrame := ContentFrameType.Create(FScrollFrame); + FContentFrame := ContentFrameType.Create(FVisibleArea); FContentFrame.Left := 0; FContentFrame.Top := 0; FContentFrame.ParentScrollFrame := self; -- cgit v1.2.3-70-g09d2 From 4a87dba6e869e8091cc2bf19d90b0349c4c1fad9 Mon Sep 17 00:00:00 2001 From: David Laurence Emerson Date: Tue, 28 May 2013 16:29:34 -0700 Subject: Scroll-Frame: mousewheel scrolling is working, but only when both scrollbars are visible --- examples/gui/scrollframe/frame_test.lpr | 2 +- src/gui/fpg_scrollframe.pas | 75 ++++++++++++++++++++++++++++++--- 2 files changed, 69 insertions(+), 8 deletions(-) (limited to 'src/gui/fpg_scrollframe.pas') diff --git a/examples/gui/scrollframe/frame_test.lpr b/examples/gui/scrollframe/frame_test.lpr index 3fd804f5..596664e6 100644 --- a/examples/gui/scrollframe/frame_test.lpr +++ b/examples/gui/scrollframe/frame_test.lpr @@ -100,7 +100,7 @@ var begin fpgApplication.Initialize; form := TfpgForm.Create(nil); - form.SetPosition(0,0,380,360); + form.SetPosition(0,0,480,260); outer_frame := TfpgScrollFrame.Create(form, t_sample_frame); outer_frame.Align:=alClient; outer_frame.ContentFrame.RecalcFrameSize; diff --git a/src/gui/fpg_scrollframe.pas b/src/gui/fpg_scrollframe.pas index d10c69fd..c98ca6df 100644 --- a/src/gui/fpg_scrollframe.pas +++ b/src/gui/fpg_scrollframe.pas @@ -25,9 +25,14 @@ type FParentScrollFrame : TfpgScrollFrame; // it's actually the grandparent procedure SetMarginBR (AValue: integer); procedure UpdatePos; + protected + procedure HandleMouseScroll(x, y: integer; shiftstate: TShiftState; + delta: smallint); override; + procedure HandleMouseHorizScroll(x, y: integer; shiftstate: TShiftState; + delta: smallint); override; public - procedure AdjustDimsFor (w : TfpgWindow; updatewp: boolean = true); - procedure AdjustDimsWithout (w : TfpgWindow); + procedure AdjustDimsFor (w : TfpgWidget; updatewp: boolean = true); + procedure AdjustDimsWithout (w : TfpgWidget); procedure RecalcFrameSize; property MarginBR : integer read FMarginBR write SetMarginBR; // bottom-right margin property ParentScrollFrame : TfpgScrollFrame read FParentScrollFrame write FParentScrollFrame; @@ -49,6 +54,10 @@ type 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); @@ -81,10 +90,24 @@ begin ParentScrollFrame.UpdateScrollbars; end; -procedure TfpgAutoSizingFrame.AdjustDimsFor (w: TfpgWindow; updatewp: boolean = true); +procedure TfpgAutoSizingFrame.HandleMouseScroll(x, y: integer; + shiftstate: TShiftState; delta: smallint); +begin + ParentScrollFrame.HandleMouseScroll(x, y, shiftstate, delta); +end; + +procedure TfpgAutoSizingFrame.HandleMouseHorizScroll(x, y: integer; + shiftstate: TShiftState; delta: smallint); +begin + ParentScrollFrame.HandleMouseHorizScroll(x, y, shiftstate, delta); +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 @@ -95,7 +118,7 @@ begin end; end; -procedure TfpgAutoSizingFrame.AdjustDimsWithout (w: TfpgWindow); +procedure TfpgAutoSizingFrame.AdjustDimsWithout (w: TfpgWidget); begin if (Width = w.Right+MarginBR+1) or (Height = w.Bottom+MarginBR+1) then @@ -116,12 +139,14 @@ begin max_h := 1; for i := 0 to ComponentCount-1 do begin c := Components[i]; - if c is TfpgWindow then + if c is TfpgWidget then begin - this_need := TfpgWindow(c).right+MarginBR+1; + 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 := TfpgWindow(c).bottom+MarginBR+1; + this_need := TfpgWidget(c).bottom+MarginBR+1; if (this_need>max_h) then max_h := this_need; end; @@ -157,6 +182,40 @@ begin 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); @@ -389,6 +448,7 @@ begin Orientation := orVertical; OnScroll := @VScrollBarMove; Position := 0; + ScrollStep := 10; end; FHScrollBar := TfpgScrollBar.Create(self); @@ -396,6 +456,7 @@ begin Orientation := orHorizontal; OnScroll := @HScrollBarMove; Position := 0; + ScrollStep := 10; end; FScrollBarStyle := ssAutoBoth; -- cgit v1.2.3-70-g09d2 From 8d5cbfcff09528a7038e78f672de862dadd5fd34 Mon Sep 17 00:00:00 2001 From: David Laurence Emerson Date: Tue, 28 May 2013 16:44:44 -0700 Subject: Scroll-frame: mousewheel scrolling working completely now. Scrolling within the VisibleArea but outside the ContentFrame was not passing scroll events to the ParentScrollFrame. --- src/gui/fpg_scrollframe.pas | 75 ++++++++++++++++++++++++++------------------- 1 file changed, 43 insertions(+), 32 deletions(-) (limited to 'src/gui/fpg_scrollframe.pas') diff --git a/src/gui/fpg_scrollframe.pas b/src/gui/fpg_scrollframe.pas index c98ca6df..8e5bc769 100644 --- a/src/gui/fpg_scrollframe.pas +++ b/src/gui/fpg_scrollframe.pas @@ -17,25 +17,32 @@ type TfpgScrollFrame = class; - { TfpgAutoSizingFrame } + { TfpgEmbeddingFrame } - TfpgAutoSizingFrame = class (TfpgFrame) + TfpgEmbeddingFrame = class (TfpgFrame) + // The purpose of the EmbeddingFrame is to pass scroll events to the ParentScrollFrame private - FMarginBR : integer; - FParentScrollFrame : TfpgScrollFrame; // it's actually the grandparent - procedure SetMarginBR (AValue: integer); - procedure UpdatePos; + 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 AdjustDimsFor (w : TfpgWidget; updatewp: boolean = true); procedure AdjustDimsWithout (w : TfpgWidget); procedure RecalcFrameSize; property MarginBR : integer read FMarginBR write SetMarginBR; // bottom-right margin - property ParentScrollFrame : TfpgScrollFrame read FParentScrollFrame write FParentScrollFrame; end; TfpgASFrameClass = class of TfpgAutoSizingFrame; @@ -45,7 +52,7 @@ type TfpgScrollFrame = class (TfpgFrame) private FContentFrame : TfpgAutoSizingFrame; - FVisibleArea : TfpgFrame; + FVisibleArea : TfpgEmbeddingFrame; FHScrollBar : TfpgScrollBar; FVScrollBar : TfpgScrollBar; FScrollBarStyle : TfpgScrollStyle; @@ -72,36 +79,34 @@ type property ContentFrame : TfpgAutoSizingFrame read FContentFrame write FContentFrame; end; -implementation -{ TfpgAutoSizingFrame } +implementation -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; +{ TfpgEmbeddingFrame } -procedure TfpgAutoSizingFrame.HandleMouseScroll(x, y: integer; +procedure TfpgEmbeddingFrame.HandleMouseScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); begin ParentScrollFrame.HandleMouseScroll(x, y, shiftstate, delta); end; -procedure TfpgAutoSizingFrame.HandleMouseHorizScroll(x, y: integer; +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.AdjustDimsFor (w: TfpgWidget; updatewp: boolean = true); var new_w, new_h: integer; @@ -114,7 +119,10 @@ begin begin HandleResize(new_w, new_h); if updatewp then - UpdatePos; + if ParentScrollFrame is TfpgScrollFrame then + ParentScrollFrame.UpdateScrollbars + else + UpdateWindowPosition; end; end; @@ -152,7 +160,10 @@ begin end; end; HandleResize(max_w, max_h); - UpdatePos; + if ParentScrollFrame is TfpgScrollFrame then + ParentScrollFrame.UpdateScrollbars + else + UpdateWindowPosition; end; @@ -417,8 +428,9 @@ constructor TfpgScrollFrame.Create(AOwner: TComponent); begin inherited Create(AOwner); - FVisibleArea := TfpgFrame.Create(self); + FVisibleArea := TfpgEmbeddingFrame.Create(self); FVisibleArea.SetPosition(0, 0, 1, 1); + FVisibleArea.ParentScrollFrame := self; FContentFrame := TfpgAutoSizingFrame.Create(FVisibleArea); FContentFrame.SetPosition(0, 0, 1, 1); @@ -429,13 +441,12 @@ constructor TfpgScrollFrame.Create(AOwner: TComponent; ContentFrameType: TfpgASF begin inherited Create(AOwner); - FVisibleArea := TfpgFrame.Create(self); - FVisibleArea.Left := 0; - FVisibleArea.Top := 0; + FVisibleArea := TfpgEmbeddingFrame.Create(self); + FVisibleArea.SetPosition(0, 0, 1, 1); + FVisibleArea.ParentScrollFrame := self; FContentFrame := ContentFrameType.Create(FVisibleArea); - FContentFrame.Left := 0; - FContentFrame.Top := 0; + FContentFrame.SetPosition(0, 0, 1, 1); FContentFrame.ParentScrollFrame := self; end; -- cgit v1.2.3-70-g09d2 From 451114d2008f0b3750bc9840099287b87cff247c Mon Sep 17 00:00:00 2001 From: David Laurence Emerson Date: Tue, 28 May 2013 20:50:51 -0700 Subject: Scroll-frame: fixed a couple bugs with RecalcFrameSize --- examples/gui/scrollframe/frame_test.lpr | 4 +--- src/gui/fpg_scrollframe.pas | 15 +++++++++++---- 2 files changed, 12 insertions(+), 7 deletions(-) (limited to 'src/gui/fpg_scrollframe.pas') diff --git a/examples/gui/scrollframe/frame_test.lpr b/examples/gui/scrollframe/frame_test.lpr index 596664e6..252f8a07 100644 --- a/examples/gui/scrollframe/frame_test.lpr +++ b/examples/gui/scrollframe/frame_test.lpr @@ -89,7 +89,6 @@ begin 'Click to embed another Scroll-Frame here', @click_embed_button); OnPaint:=@paint_my_stuff; create_buttons(self); - RecalcFrameSize; end; @@ -100,10 +99,9 @@ var begin fpgApplication.Initialize; form := TfpgForm.Create(nil); - form.SetPosition(0,0,480,260); + form.SetPosition(0,0,380,360); outer_frame := TfpgScrollFrame.Create(form, t_sample_frame); outer_frame.Align:=alClient; - outer_frame.ContentFrame.RecalcFrameSize; try form.Show; fpgApplication.Run; diff --git a/src/gui/fpg_scrollframe.pas b/src/gui/fpg_scrollframe.pas index 8e5bc769..fd467c46 100644 --- a/src/gui/fpg_scrollframe.pas +++ b/src/gui/fpg_scrollframe.pas @@ -39,6 +39,7 @@ type FMarginBR : integer; procedure SetMarginBR (AValue: integer); public + procedure AfterConstruction; override; procedure AdjustDimsFor (w : TfpgWidget; updatewp: boolean = true); procedure AdjustDimsWithout (w : TfpgWidget); procedure RecalcFrameSize; @@ -107,6 +108,12 @@ begin RecalcFrameSize; end; +procedure TfpgAutoSizingFrame.AfterConstruction; +begin + inherited AfterConstruction; + RecalcFrameSize; +end; + procedure TfpgAutoSizingFrame.AdjustDimsFor (w: TfpgWidget; updatewp: boolean = true); var new_w, new_h: integer; @@ -429,11 +436,11 @@ begin inherited Create(AOwner); FVisibleArea := TfpgEmbeddingFrame.Create(self); - FVisibleArea.SetPosition(0, 0, 1, 1); + FVisibleArea.HandleMove(0, 0); FVisibleArea.ParentScrollFrame := self; FContentFrame := TfpgAutoSizingFrame.Create(FVisibleArea); - FContentFrame.SetPosition(0, 0, 1, 1); + FContentFrame.HandleMove(0, 0); FContentFrame.ParentScrollFrame := self; end; @@ -442,11 +449,11 @@ begin inherited Create(AOwner); FVisibleArea := TfpgEmbeddingFrame.Create(self); - FVisibleArea.SetPosition(0, 0, 1, 1); + FVisibleArea.HandleMove(0, 0); FVisibleArea.ParentScrollFrame := self; FContentFrame := ContentFrameType.Create(FVisibleArea); - FContentFrame.SetPosition(0, 0, 1, 1); + FContentFrame.HandleMove(0, 0); FContentFrame.ParentScrollFrame := self; end; -- cgit v1.2.3-70-g09d2 From a85842cc80b6c641153fa1984f7773e1e201b854 Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Mon, 23 Jun 2014 21:10:00 +0100 Subject: Added the standard copyright notice to the new unit. --- examples/gui/scrollframe/bigframe_test.lpi | 2 +- examples/gui/scrollframe/frame_test.lpi | 2 +- src/gui/fpg_scrollframe.pas | 21 ++++++++++++++++++--- 3 files changed, 20 insertions(+), 5 deletions(-) (limited to 'src/gui/fpg_scrollframe.pas') diff --git a/examples/gui/scrollframe/bigframe_test.lpi b/examples/gui/scrollframe/bigframe_test.lpi index 3721bff4..d7112088 100644 --- a/examples/gui/scrollframe/bigframe_test.lpi +++ b/examples/gui/scrollframe/bigframe_test.lpi @@ -1,4 +1,4 @@ - + diff --git a/examples/gui/scrollframe/frame_test.lpi b/examples/gui/scrollframe/frame_test.lpi index 2f5b09bd..b85b81b7 100644 --- a/examples/gui/scrollframe/frame_test.lpi +++ b/examples/gui/scrollframe/frame_test.lpi @@ -1,4 +1,4 @@ - + diff --git a/src/gui/fpg_scrollframe.pas b/src/gui/fpg_scrollframe.pas index fd467c46..528ed442 100644 --- a/src/gui/fpg_scrollframe.pas +++ b/src/gui/fpg_scrollframe.pas @@ -1,3 +1,21 @@ +{ + fpGUI - Free Pascal GUI Toolkit + + Copyright (C) 2006 - 2014 See the file AUTHORS.txt, included in this + distribution, for details of the copyright. + + See the file COPYING.modifiedLGPL, included in this distribution, + for details about redistributing fpGUI. + + 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. + + Description: + Defines a scrollable frame widget. + + This unit was originally written by David Emerson +} unit fpg_scrollframe; {$mode objfpc}{$H+} @@ -17,7 +35,6 @@ type TfpgScrollFrame = class; - { TfpgEmbeddingFrame } TfpgEmbeddingFrame = class (TfpgFrame) // The purpose of the EmbeddingFrame is to pass scroll events to the ParentScrollFrame @@ -32,7 +49,6 @@ type property ParentScrollFrame : TfpgScrollFrame read FParentScrollFrame write FParentScrollFrame; end; - { TfpgAutoSizingFrame } TfpgAutoSizingFrame = class (TfpgEmbeddingFrame) private @@ -48,7 +64,6 @@ type TfpgASFrameClass = class of TfpgAutoSizingFrame; - { TfpgScrollFrame } TfpgScrollFrame = class (TfpgFrame) private -- cgit v1.2.3-70-g09d2 From 7995a7f7e319b08ed0d58bfd141737b9902d8a38 Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Thu, 10 Jul 2014 22:20:40 +0100 Subject: Tweak so the TfpgScrollFrame can play nicer with the UI Designer. Basically it allows us to set the Content Frame after the ScrollFrame was created. --- src/gui/fpg_scrollframe.pas | 10 ++++++++++ 1 file changed, 10 insertions(+) (limited to 'src/gui/fpg_scrollframe.pas') diff --git a/src/gui/fpg_scrollframe.pas b/src/gui/fpg_scrollframe.pas index 528ed442..ca36520a 100644 --- a/src/gui/fpg_scrollframe.pas +++ b/src/gui/fpg_scrollframe.pas @@ -92,6 +92,7 @@ type constructor Create (AOwner: TComponent); override; constructor Create (AOwner: TComponent; ContentFrameType: TfpgASFrameClass); virtual; procedure AfterCreate; override; + procedure SetContentFrameType(AContentFrameType: TfpgASFrameClass); property ContentFrame : TfpgAutoSizingFrame read FContentFrame write FContentFrame; end; @@ -495,5 +496,14 @@ begin FScrollBarStyle := ssAutoBoth; end; +procedure TfpgScrollFrame.SetContentFrameType(AContentFrameType: TfpgASFrameClass); +begin + if Assigned(FContentFrame) then + FContentFrame.Free; + FContentFrame := AContentFrameType.Create(FVisibleArea); + FContentFrame.HandleMove(0, 0); + FContentFrame.ParentScrollFrame := self; +end; + end. -- cgit v1.2.3-70-g09d2 From a872f4ef99ec514dea6dbcc3cc895193c30c6364 Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Thu, 10 Jul 2014 23:03:39 +0100 Subject: scrollframe: code formatting and design time painting --- src/gui/fpg_scrollframe.pas | 69 +++++++++++++++++++++++++++++---------------- 1 file changed, 45 insertions(+), 24 deletions(-) (limited to 'src/gui/fpg_scrollframe.pas') diff --git a/src/gui/fpg_scrollframe.pas b/src/gui/fpg_scrollframe.pas index ca36520a..008832ce 100644 --- a/src/gui/fpg_scrollframe.pas +++ b/src/gui/fpg_scrollframe.pas @@ -65,35 +65,34 @@ type TfpgASFrameClass = class of TfpgAutoSizingFrame; - TfpgScrollFrame = class (TfpgFrame) + 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); + 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 + 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 HandlePaint; 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; - procedure SetContentFrameType(AContentFrameType: TfpgASFrameClass); - property ContentFrame : TfpgAutoSizingFrame read FContentFrame write FContentFrame; + procedure AfterCreate; override; + procedure SetContentFrameType(AContentFrameType: TfpgASFrameClass); + property ContentFrame: TfpgAutoSizingFrame read FContentFrame write FContentFrame; end; @@ -267,6 +266,28 @@ begin UpdateScrollBars; end; +procedure TfpgScrollFrame.HandlePaint; +begin + if csDesigning in ComponentState then + begin + // clear background rectangle + Canvas.Clear(clDarkGray); + // When designing, don't draw colors + // but draw an outline + Canvas.SetLineStyle(1, lsDash); + Canvas.DrawRectangle(GetClientRect); + Canvas.SetLineStyle(1, lsSolid); + Canvas.Color := clUIDesignerGreen; + Canvas.DrawLine(0, 0, Width, Height); + Canvas.DrawLine(Width, 0, 0, Height); + Canvas.TextColor := clShadow1; + Canvas.DrawText(5, 5, Name + ': ' + ClassName); + Exit; //==> + end; + + inherited HandlePaint; +end; + procedure TfpgScrollFrame.HScrollBarMove (Sender: TObject; position: integer); begin if position = XOffset then -- cgit v1.2.3-70-g09d2