Marco Web Center

[an error occurred while processing this directive]

Home: Code Repository: Mastering Delphi 6

Chapter 10 - Project FramePag

Project Structure

FramePag.dpr
program FramePag;

uses
  Forms,
  PageForm in 'PageForm.pas' {Form1},
  Frame2u in 'Frame2u.pas' {Frame2: TFrame},
  Frame3u in 'Frame3u.pas' {Frame3: TFrame};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.
PageForm.pas
unit PageForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Frame2u, Frame3u, StdCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    Button1: TButton;
    Button2: TButton;
    Frame21: TFrame2;
    Frame31: TFrame3;
    TabSheet3: TTabSheet;
    Frame32: TFrame3;
    procedure PageControl1Change(Sender: TObject);
    procedure Frame31btnAddClick(Sender: TObject);
    procedure Form1Close(Sender: TObject; var Action: TCloseAction);
    procedure Form1Destroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.PageControl1Change(Sender: TObject);
begin
  (PageControl1.ActivePage.Controls[0]
    as TWinControl).SetFocus;
end;

procedure TForm1.Frame31btnAddClick(Sender: TObject);
begin
  Frame31.btnAddClick(Sender);

end;

procedure TForm1.Form1Close(Sender: TObject; var Action: TCloseAction);
begin
  Beep;
end;

procedure TForm1.Form1Destroy(Sender: TObject);
begin
  Beep;
end;

end.
Frame2u.pas
unit Frame2u;

interface

uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TFrame2 = class(TFrame)
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    CheckBox3: TCheckBox;
    CheckBox4: TCheckBox;
    CheckBox5: TCheckBox;
    Button1: TButton;
    Button2: TButton;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

implementation

{$R *.DFM}

end.
Frame3u.pas
unit Frame3u;

interface

uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TFrame3 = class(TFrame)
    ListBox1: TListBox;
    btnAdd: TButton;
    btnDelete: TButton;
    LabelFile: TLabel;
    Label1: TLabel;
    btnSave: TButton;
    procedure btnAddClick(Sender: TObject);
    procedure btnDeleteClick(Sender: TObject);
    procedure btnSaveClick(Sender: TObject);
  private
    { Private declarations }
  public
    procedure CreateWnd; override;
  end;

implementation

{$R *.DFM}

procedure TFrame3.btnAddClick(Sender: TObject);
var
  strNew: string;
begin
  if InputQuery ('Enter new item', 'Text', strNew) then
    ListBox1.Items.Add (strNew);
end;

procedure TFrame3.btnDeleteClick(Sender: TObject);
begin
  if ListBox1.ItemIndex >= 0 then
    ListBox1.Items.Delete (ListBox1.ItemIndex);
end;

procedure TFrame3.CreateWnd;
begin
  inherited;
  // load data
  ListBox1.Items.LoadFromFile (LabelFile.Caption);
end;

procedure TFrame3.btnSaveClick(Sender: TObject);
begin
  ListBox1.Items.SaveToFile (LabelFile.Caption);
end;

end.
PageForm.dfm
object Form1: TForm1
  Left = 218
  Top = 120
  Width = 336
  Height = 356
  ActiveControl = Button1
  Caption = 'Frame Pages'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnClose = Form1Close
  OnDestroy = Form1Destroy
  PixelsPerInch = 96
  TextHeight = 13
  object PageControl1: TPageControl
    Left = 0
    Top = 0
    Width = 328
    Height = 281
    ActivePage = TabSheet3
    Anchors = [akLeft, akTop, akRight, akBottom]
    TabOrder = 0
    OnChange = PageControl1Change
    object TabSheet1: TTabSheet
      Caption = 'Frame2'
      inline Frame21: TFrame2
        Width = 320
        Height = 253
      end
    end
    object TabSheet2: TTabSheet
      Caption = 'Frame3'
      ImageIndex = 1
      inline Frame31: TFrame3
        Width = 320
        Height = 253
        inherited btnAdd: TButton
          OnClick = Frame31btnAddClick
        end
      end
    end
    object TabSheet3: TTabSheet
      Caption = 'Frame 3 (bis)'
      ImageIndex = 2
      inline Frame32: TFrame3
        Width = 320
        Height = 253
        inherited LabelFile: TLabel
          Width = 46
          Caption = 'List2.txt'
        end
      end
    end
  end
  object Button1: TButton
    Left = 150
    Top = 296
    Width = 75
    Height = 25
    Anchors = [akTop, akRight]
    Caption = 'Button1'
    TabOrder = 1
  end
  object Button2: TButton
    Left = 238
    Top = 296
    Width = 75
    Height = 25
    Anchors = [akTop, akRight]
    Caption = 'Button2'
    TabOrder = 2
  end
end
Frame2u.dfm
object Frame2: TFrame2
  Left = 0
  Top = 0
  Width = 443
  Height = 277
  Align = alClient
  TabOrder = 0
  object CheckBox1: TCheckBox
    Left = 24
    Top = 24
    Width = 97
    Height = 17
    Caption = 'CheckBox1'
    TabOrder = 0
  end
  object CheckBox2: TCheckBox
    Left = 24
    Top = 56
    Width = 97
    Height = 17
    Caption = 'CheckBox2'
    TabOrder = 1
  end
  object CheckBox3: TCheckBox
    Left = 24
    Top = 88
    Width = 97
    Height = 17
    Caption = 'CheckBox3'
    TabOrder = 2
  end
  object CheckBox4: TCheckBox
    Left = 24
    Top = 120
    Width = 97
    Height = 17
    Caption = 'CheckBox4'
    TabOrder = 3
  end
  object CheckBox5: TCheckBox
    Left = 24
    Top = 152
    Width = 97
    Height = 17
    Caption = 'CheckBox5'
    TabOrder = 4
  end
  object Button1: TButton
    Left = 168
    Top = 32
    Width = 75
    Height = 25
    Caption = 'Button1'
    TabOrder = 5
  end
  object Button2: TButton
    Left = 168
    Top = 72
    Width = 75
    Height = 25
    Caption = 'Button2'
    TabOrder = 6
  end
end
Frame3u.dfm
object Frame3: TFrame3
  Left = 0
  Top = 0
  Width = 362
  Height = 277
  Align = alClient
  TabOrder = 0
  object LabelFile: TLabel
    Left = 40
    Top = 16
    Width = 39
    Height = 13
    Caption = 'List.txt'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -11
    Font.Name = 'MS Sans Serif'
    Font.Style = [fsBold]
    ParentFont = False
  end
  object Label1: TLabel
    Left = 16
    Top = 16
    Width = 19
    Height = 13
    Caption = 'File:'
  end
  object ListBox1: TListBox
    Left = 16
    Top = 32
    Width = 169
    Height = 209
    ItemHeight = 13
    TabOrder = 0
  end
  object btnAdd: TButton
    Left = 200
    Top = 32
    Width = 75
    Height = 25
    Caption = '&Add'
    TabOrder = 1
    OnClick = btnAddClick
  end
  object btnDelete: TButton
    Left = 200
    Top = 64
    Width = 75
    Height = 25
    Caption = '&Delete'
    TabOrder = 2
    OnClick = btnDeleteClick
  end
  object btnSave: TButton
    Left = 200
    Top = 96
    Width = 75
    Height = 25
    Caption = '&Save'
    TabOrder = 3
    OnClick = btnSaveClick
  end
end