Home: Code Repository: Mastering Delphi 5

Project FRAMES2

Project Structure

FRAMES2.DPR
FRAMESFORM.PAS
LISTFRAME.PAS
FRAMESFORM.DFM
LISTFRAME.DFM

program Frames2;

uses
  Forms,
  FramesForm in 'FramesForm.pas' {FormFrames},
  ListFrame in 'ListFrame.pas' {FrameList: TFrame};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TFormFrames, FormFrames);
  Application.Run;
end.

unit FramesForm;

interface

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

type
  TFormFrames = class(TForm)
    FrameList1: TFrameList;
    FrameList2: TFrameList;
    btnLeft: TButton;
    btnRight: TButton;
    procedure FrameList2btnClearClick(Sender: TObject);
    procedure btnLeftClick(Sender: TObject);
    procedure btnRightClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FormFrames: TFormFrames;

implementation

{$R *.DFM}

procedure TFormFrames.FrameList2btnClearClick(Sender: TObject);
begin
  if MessageDlg ('OK to empty the list box?',
      mtConfirmation, [mbYes, mbNo], 0) = idYes then
    // execute standard frame code
    FrameList2.btnClearClick(Sender);
end;

procedure TFormFrames.btnLeftClick(Sender: TObject);
begin
  FrameList1.ListBox.Items.AddStrings (
    FrameList2.ListBox.Items);
end;

procedure TFormFrames.btnRightClick(Sender: TObject);
begin
  FrameList2.ListBox.Items.AddStrings (
    FrameList1.ListBox.Items);
end;

end.

unit ListFrame;

interface

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

type
  TFrameList = class(TFrame)
    ListBox: TListBox;
    Edit: TEdit;
    btnAdd: TButton;
    btnRemove: TButton;
    btnClear: TButton;
    Bevel: TBevel;
    procedure btnAddClick(Sender: TObject);
    procedure btnRemoveClick(Sender: TObject);
    procedure btnClearClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

implementation

{$R *.DFM}

procedure TFrameList.btnAddClick(Sender: TObject);
begin
  ListBox.Items.Add (Edit.Text);
end;

procedure TFrameList.btnRemoveClick(Sender: TObject);
begin
  if ListBox.ItemIndex >= 0 then
    ListBox.Items.Delete (ListBox.ItemIndex);
end;

procedure TFrameList.btnClearClick(Sender: TObject);
begin
  ListBox.Clear;
end;

end.

object FormFrames: TFormFrames
  Left = 201
  Top = 131
  Width = 507
  Height = 350
  Caption = 'Frames2'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  inline FrameList1: TFrameList
    Left = 8
    Top = 8
    inherited ListBox: TListBox
      Sorted = True
    end
    inherited btnClear: TButton
      OnClick = nil
    end
  end
  inline FrameList2: TFrameList
    Left = 288
    Top = 8
    TabOrder = 1
    inherited btnClear: TButton
      OnClick = FrameList2btnClearClick
    end
  end
  object btnLeft: TButton
    Left = 224
    Top = 120
    Width = 49
    Height = 25
    Caption = '&<<'
    TabOrder = 2
    OnClick = btnLeftClick
  end
  object btnRight: TButton
    Left = 224
    Top = 152
    Width = 49
    Height = 25
    Caption = '&>>'
    TabOrder = 3
    OnClick = btnRightClick
  end
end

object FrameList: TFrameList
  Left = 0
  Top = 0
  Width = 202
  Height = 306
  TabOrder = 0
  object Bevel: TBevel
    Left = 0
    Top = 0
    Width = 202
    Height = 306
    Align = alClient
    Shape = bsFrame
  end
  object ListBox: TListBox
    Left = 8
    Top = 64
    Width = 185
    Height = 233
    ItemHeight = 13
    TabOrder = 0
  end
  object Edit: TEdit
    Left = 8
    Top = 40
    Width = 185
    Height = 21
    TabOrder = 1
    Text = 'Some text'
  end
  object btnAdd: TButton
    Left = 24
    Top = 8
    Width = 49
    Height = 25
    Caption = '&Add'
    TabOrder = 2
    OnClick = btnAddClick
  end
  object btnRemove: TButton
    Left = 76
    Top = 8
    Width = 49
    Height = 25
    Caption = '&Remove'
    TabOrder = 3
    OnClick = btnRemoveClick
  end
  object btnClear: TButton
    Left = 128
    Top = 8
    Width = 49
    Height = 25
    Caption = '&Clear'
    TabOrder = 4
    OnClick = btnClearClick
  end
end