Merge remote-tracking branch 'demerson/scroll-frame' into 'develop'

5 files changed, 385 insertions, 0 deletions

diff --git a/examples/gui/gridtest/gridtest.lpr b/examples/gui/gridtest/gridtest.lpr
index 4c2c0e16..173806e9 100644
--- a/examples/gui/gridtest/gridtest.lpr
+++ b/examples/gui/gridtest/gridtest.lpr
@@ -227,6 +227,9 @@ begin
     AddColumn('Column 1', 100, taLeftJustify);
     AddColumn('Col 2', 50, taCenter);
     AddColumn('Numbers', 150, taRightJustify);
+    AddColumn('Column 4', 150, taRightJustify);
+    AddColumn('Column 5', 150, taRightJustify);
+    AddColumn('Column 6', 150, taRightJustify);
     FontDesc := '#Grid';
     HeaderFontDesc := '#GridHeader';
     Hint := '';
diff --git a/examples/gui/scrollframe/bigframe_test.lpi b/examples/gui/scrollframe/bigframe_test.lpi
new file mode 100644
index 00000000..3721bff4
--- /dev/null
+++ b/examples/gui/scrollframe/bigframe_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="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="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/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..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..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.
+