summaryrefslogtreecommitdiff
path: root/examples/gui/scrollframe/frame_test.lpr
blob: 596664e66cec564a83a083bf667830754e25eb79 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
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,480,260);
  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.