summaryrefslogtreecommitdiff
path: root/examples/gui/scrollframe
diff options
context:
space:
mode:
authorGraeme Geldenhuys <graemeg@gmail.com>2014-08-20 02:11:13 +0100
committerGraeme Geldenhuys <graemeg@gmail.com>2014-08-20 02:11:13 +0100
commitc8acc2c1666015daeb3038c838e5018c0ecd8903 (patch)
tree5ad2edaf0e5fb6be146491226dca4d915333d80d /examples/gui/scrollframe
parentc45010b6370b50f8e6192ddb7dc3d7762c8c29f7 (diff)
parentd0d8573b046e5020d05c86a970d303084de19b7d (diff)
downloadfpGUI-c8acc2c1666015daeb3038c838e5018c0ecd8903.tar.xz
Merge branch 'release-1.2' into master
Diffstat (limited to 'examples/gui/scrollframe')
-rw-r--r--examples/gui/scrollframe/bigframe_test.lpi78
-rw-r--r--examples/gui/scrollframe/bigframe_test.lpr114
-rw-r--r--examples/gui/scrollframe/frame_test.lpi78
-rw-r--r--examples/gui/scrollframe/frame_test.lpr112
4 files changed, 382 insertions, 0 deletions
diff --git a/examples/gui/scrollframe/bigframe_test.lpi b/examples/gui/scrollframe/bigframe_test.lpi
new file mode 100644
index 00000000..ee242841
--- /dev/null
+++ b/examples/gui/scrollframe/bigframe_test.lpi
@@ -0,0 +1,78 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+ <ProjectOptions>
+ <Version Value="9"/>
+ <General>
+ <Flags>
+ <MainUnitHasCreateFormStatements Value="False"/>
+ <MainUnitHasTitleStatement Value="False"/>
+ </Flags>
+ <SessionStorage Value="InProjectDir"/>
+ <MainUnit Value="0"/>
+ <Title Value="bigframe_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="bigframe_test.lpr"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="bigframe_test"/>
+ </Unit0>
+ </Units>
+ </ProjectOptions>
+ <CompilerOptions>
+ <Version Value="11"/>
+ <Target>
+ <Filename Value="bigframe_test"/>
+ </Target>
+ <SearchPaths>
+ <IncludeFiles Value="$(ProjOutDir)"/>
+ <UnitOutputDirectory Value="units/$(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/bigframe_test.lpr b/examples/gui/scrollframe/bigframe_test.lpr
new file mode 100644
index 00000000..5309e965
--- /dev/null
+++ b/examples/gui/scrollframe/bigframe_test.lpr
@@ -0,0 +1,114 @@
+program bigframe_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
+ if (i=2) and (j=2)
+ then SetPosition(6000, 6000, 100, 25)
+ else 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);
+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;
+ try
+ form.Show;
+ fpgApplication.Run;
+ finally
+ form.Free;
+ end;
+end.
+
diff --git a/examples/gui/scrollframe/frame_test.lpi b/examples/gui/scrollframe/frame_test.lpi
new file mode 100644
index 00000000..ab3bd77f
--- /dev/null
+++ b/examples/gui/scrollframe/frame_test.lpi
@@ -0,0 +1,78 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<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="units/$(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..252f8a07
--- /dev/null
+++ b/examples/gui/scrollframe/frame_test.lpr
@@ -0,0 +1,112 @@
+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);
+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;
+ try
+ form.Show;
+ fpgApplication.Run;
+ finally
+ form.Free;
+ end;
+end.
+