diff options
| -rw-r--r-- | examples/gui/scrollframe/frame_test.lpi | 78 | ||||
| -rw-r--r-- | examples/gui/scrollframe/frame_test.lpr | 114 | ||||
| -rw-r--r-- | src/corelib/x11/fpgui_toolkit.lpk | 6 | ||||
| -rw-r--r-- | src/corelib/x11/fpgui_toolkit.pas | 26 | ||||
| -rw-r--r-- | src/gui/fpg_scrollbar.pas | 2 | ||||
| -rw-r--r-- | src/gui/fpg_scrollframe.pas | 405 |
6 files changed, 617 insertions, 14 deletions
diff --git a/examples/gui/scrollframe/frame_test.lpi b/examples/gui/scrollframe/frame_test.lpi new file mode 100644 index 00000000..2f5b09bd --- /dev/null +++ b/examples/gui/scrollframe/frame_test.lpi @@ -0,0 +1,78 @@ +<?xml version="1.0"?> +<CONFIG> + <ProjectOptions> + <Version Value="9"/> + <General> + <Flags> + <MainUnitHasCreateFormStatements Value="False"/> + <MainUnitHasTitleStatement Value="False"/> + </Flags> + <SessionStorage Value="InProjectDir"/> + <MainUnit Value="0"/> + <Title Value="frame_test"/> + <UseAppBundle Value="False"/> + <ResourceType Value="res"/> + </General> + <i18n> + <EnableI18N LFM="False"/> + </i18n> + <VersionInfo> + <StringTable ProductVersion=""/> + </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> + <ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + <LaunchingApplication PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> + </local> + </RunParams> + <RequiredPackages Count="1"> + <Item1> + <PackageName Value="fpgui_toolkit"/> + </Item1> + </RequiredPackages> + <Units Count="1"> + <Unit0> + <Filename Value="frame_test.lpr"/> + <IsPartOfProject Value="True"/> + <UnitName Value="frame_test"/> + </Unit0> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <Target> + <Filename Value="frame_test"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Other> + <CompilerMessages> + <MsgFileName Value=""/> + </CompilerMessages> + <CompilerPath Value="$(CompPath)"/> + </Other> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/examples/gui/scrollframe/frame_test.lpr b/examples/gui/scrollframe/frame_test.lpr new file mode 100644 index 00000000..3fd804f5 --- /dev/null +++ b/examples/gui/scrollframe/frame_test.lpr @@ -0,0 +1,114 @@ +program frame_test; + +{$mode objfpc}{$H+} + +uses + Classes, + sysutils, + fpg_base, + fpg_main, + fpg_button, + fpg_label, + fpg_form, + fpg_panel, + fpg_scrollframe + ; + +procedure create_buttons (f : TfpgFrame); +var + i, j, ij : integer; + b : TfpgButton; +const + num_button_cols = 4; + num_button_rows = 5; +begin + with f do begin + for i := 0 to num_button_cols-1 do + begin + for j := 0 to num_button_rows-1 do + begin + if (j>4) and (j<16) then continue; + ij := j + num_button_rows*i; + b := TfpgButton.Create(f); + with b do begin + SetPosition(20+i*105, 50+j*30, 100, 25); + name := 'button' + inttostr(ij); + Text := 'Button ' + inttostr(ij+1); + FontDesc := '#Label1'; + end; + end; + end; + end; +end; + +type + + { t_sample_frame } + + t_sample_frame = class (TfpgAutoSizingFrame) + protected + my_color : TfpgColor; + embed_button : TfpgButton; + procedure click_embed_button (Sender: TObject); + procedure paint_my_stuff (Sender: TObject); + public + procedure AfterCreate; override; + end; + +procedure t_sample_frame.click_embed_button(Sender: TObject); +var + inner_bevel : TfpgBevel; + inner_frame : TfpgScrollFrame; +begin + embed_button.Visible:=false; + inner_bevel := TfpgBevel.Create(self); + with inner_bevel do begin; + SetPosition(90, 210, 300, 300); + BorderStyle := bsDouble; + Shape := bsFrame; + UpdateWindowPosition; + end; + RecalcFrameSize; + + inner_frame := TfpgScrollFrame.Create(inner_bevel, t_sample_frame); + inner_frame.Align:=alClient; +end; + +procedure t_sample_frame.paint_my_stuff (Sender: TObject); +begin + canvas.Color := my_color; + canvas.FillRectangle (30, 30, 200, 400); +end; + +procedure t_sample_frame.AfterCreate; +begin + inherited AfterCreate; + MarginBR:=7; + my_color:=TfpgColor(random(high(longint))); + embed_button := CreateButton (self, 20, 240, 270, + 'Click to embed another Scroll-Frame here', @click_embed_button); + OnPaint:=@paint_my_stuff; + create_buttons(self); + RecalcFrameSize; +end; + + +var + form: TfpgForm; + outer_frame: TfpgScrollFrame; + +begin + fpgApplication.Initialize; + form := TfpgForm.Create(nil); + 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; + finally + form.Free; + end; +end. + diff --git a/src/corelib/x11/fpgui_toolkit.lpk b/src/corelib/x11/fpgui_toolkit.lpk index c769331e..ff08daeb 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="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..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. |