Marco's Web Center

Menu for Development

Site Menu
Object Pascal Handbook
Delphi Handbooks Collection
Mastering Borland Delphi 2005
(Old) White Papers
(Old)Tools
(Old) Conferences

My Other Sites
Italian Site (www.marcocantu.it)
the delphi search

Spirit of delphi

Advertising
Home My Blog Books Object Pascal Marco

Home: Code Repository: Mastering Delphi 5

Project REFLIST2

Project Structure


REFLIST2.DPR

program Reflist2;

uses
  Forms,
  RefForm in 'RefForm.pas' {Form1},
  NewDial in 'NewDial.pas' {FormItem};

{$R *.RES}

begin
  Application.CreateForm(TForm1, Form1);
  Application.CreateForm(TFormItem, FormItem);
  Application.Run;
end.

REFFORM.PAS

unit RefForm;

interface

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, Menus, ImgList;

type
  TForm1 = class(TForm)
    ListView1: TListView;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Exit1: TMenuItem;
    View1: TMenuItem;
    LargeIcons1: TMenuItem;
    SmallIcons1: TMenuItem;
    List1: TMenuItem;
    Details1: TMenuItem;
    Help1: TMenuItem;
    About1: TMenuItem;
    N1: TMenuItem;
    CheckBoxes1: TMenuItem;
    AddItems1: TMenuItem;
    N2: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure LargeIcons1Click(Sender: TObject);
    procedure SmallIcons1Click(Sender: TObject);
    procedure List1Click(Sender: TObject);
    procedure Details1Click(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure About1Click(Sender: TObject);
    procedure CheckBoxes1Click(Sender: TObject);
    procedure ListView1ColumnClick(Sender: TObject; Column: TListColumn);
    procedure ListView1Compare(Sender: TObject; Item1, Item2: TListItem;
      Data: Integer; var Compare: Integer);
    procedure ListView1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormDestroy(Sender: TObject);
    procedure AddItems1Click(Sender: TObject);
    procedure ListView1DblClick(Sender: TObject);
  public
    { Public declarations }
  private
    nSortCol: Integer;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}
{$R BITMAPS.RES}

uses
  StdCtrls, NewDial;

procedure TForm1.FormCreate(Sender: TObject);
var
  ImageList1, ImageList2: TImageList;
  List: TStringList;
  NewItem: TListItem;
  I: Integer;
begin
  // avoid warning
  NewItem := nil;

  // load the large images
  ImageList1 := TImageList.Create (Self);
  ImageList1.Height := 32;
  ImageList1.Width := 32;
  ImageList1.ResourceLoad (rtBitmap,
    'LargeImages', clWhite);
  ListView1.LargeImages := ImageList1;

  // load the small images
  ImageList2 := TImageList.Create (Self);
  ImageList2.ResourceLoad (rtBitmap,
    'SmallImages', clWhite);
  ListView1.SmallImages := ImageList2;

  // load the items
  ListView1.Items.Clear;
  List := TStringList.Create;
  try
    List.LoadFromFile (
      ExtractFilePath (Application.ExeName) + 'Items.txt');
    for I := 0 to List.Count - 1 do
      if List [I][1] = #9 then
        NewItem.SubItems.Add (Trim (List [I]))
      else if List [I][1] = '@' then
        NewItem.ImageIndex := StrToIntDef (List [I][2], 0)
      else
      begin
        // a new item
        NewItem := ListView1.Items.Add;
        NewItem.Caption := List [I];
      end;
  finally
    List.Free;
  end;
end;

procedure TForm1.LargeIcons1Click(Sender: TObject);
begin
  ListView1.ViewStyle := vsIcon;
  LargeIcons1.Checked := True;
end;

procedure TForm1.SmallIcons1Click(Sender: TObject);
begin
  ListView1.ViewStyle := vsSmallIcon;
  SmallIcons1.Checked := True;
end;

procedure TForm1.List1Click(Sender: TObject);
begin
  ListView1.ViewStyle := vsList;
  List1.Checked := True;
end;

procedure TForm1.Details1Click(Sender: TObject);
begin
  ListView1.ViewStyle := vsReport;
  Details1.Checked := True;
end;

procedure TForm1.Exit1Click(Sender: TObject);
begin
  Close;
end;

procedure TForm1.About1Click(Sender: TObject);
begin
  MessageDlg ('Reference List (ListView example)' +
    #13'from "Mastering Delphi"'#13'author: Marco Cantý'  ,
    mtInformation, [mbOk], 0);
end;

procedure TForm1.CheckBoxes1Click(Sender: TObject);
begin
  ListView1.Checkboxes :=
    not ListView1.Checkboxes;
  CheckBoxes1.Checked :=
    not CheckBoxes1.Checked;
end;

procedure TForm1.ListView1ColumnClick(Sender: TObject;
  Column: TListColumn);
begin
  nSortCol := Column.Index;
  ListView1.AlphaSort;
end;

procedure TForm1.ListView1Compare(Sender: TObject;
  Item1, Item2: TListItem;
  Data: Integer; var Compare: Integer);
begin
  if nSortCol = 0 then
    Compare := CompareStr (Item1.Caption, Item2.Caption)
  else
    Compare := CompareStr (Item1.SubItems [nSortCol - 1],
       Item2.SubItems [nSortCol - 1]);
end;

procedure TForm1.ListView1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  // do the default action
  inherited;

  // if there is a selected item
  if (ListView1.Selected <> nil) and
      (Button = mbRight) then
    // edit the caption
    ListView1.Selected.EditCaption;
end;

procedure TForm1.FormDestroy(Sender: TObject);
var
  I, J: Integer;
  List: TStringList;
begin
  // store the items
  List := TStringList.Create;
  try
    for I := 0 to ListView1.Items.Count - 1 do
    begin
      // save the caption
      List.Add (ListView1.Items[I].Caption);
      // save the index
      List.Add ('@' + IntToStr (ListView1.Items[I].ImageIndex));
      // save the subitems (indented)
      for J := 0 to ListView1.Items[I].SubItems.Count - 1 do
        List.Add (#9 + ListView1.Items[I].SubItems [J]);
    end;
    List.SaveToFile (
      ExtractFilePAth (Application.ExeName) + 'Items.txt');
  finally
    List.Free;
  end;
end;

procedure TForm1.AddItems1Click(Sender: TObject);
var
  NewItem: TListItem;
begin
  FormItem.Caption := 'New Item';
  FormItem.Clear;
  if FormItem.ShowModal = mrOK then
  begin
    NewItem := ListView1.Items.Add;
    NewItem.Caption := FormItem.EditReference.Text;
    NewItem.ImageIndex := FormItem.ComboType.ItemIndex;
    NewItem.SubItems.Add (FormItem.EditAuthor.Text);
    NewItem.SubItems.Add (FormItem.EditCountry.Text);
  end;
end;

procedure TForm1.ListView1DblClick(Sender: TObject);
begin
  if ListView1.Selected <> nil then
  begin
    // dialog initialization
    FormItem.Caption := 'Edit Item';
    FormItem.EditReference.Text := ListView1.Selected.Caption;
    FormItem.ComboType.ItemIndex := ListView1.Selected.ImageIndex;
    FormItem.EditAuthor.Text := ListView1.Selected.SubItems [0];
    FormItem.EditCountry.Text := ListView1.Selected.SubItems [1];

    // show it
    if FormItem.ShowModal = mrOK then
    begin
      // read the new values
      ListView1.Selected.Caption := FormItem.EditReference.Text;
      ListView1.Selected.ImageIndex := FormItem.ComboType.ItemIndex;
      ListView1.Selected.SubItems [0] := FormItem.EditAuthor.Text;
      ListView1.Selected.SubItems [1] := FormItem.EditCountry.Text;
    end;
  end;
end;

end.

NEWDIAL.PAS

unit NewDial;

interface

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

type
  TFormItem = class(TForm)
    EditReference: TEdit;
    EditAuthor: TEdit;
    EditCountry: TEdit;
    ComboType: TComboBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
  private
    { Private declarations }
  public
    procedure Clear;
  end;

var
  FormItem: TFormItem;

implementation

{$R *.DFM}

{ TFormItem }

procedure TFormItem.Clear;
var
  I: Integer;
begin
  // clear each edit box
  for I := 0 to ControlCount - 1 do
    if Controls [I] is TEdit then
      TEdit (Controls[I]).Text := '';
end;

end.

REFFORM.DFM

object Form1: TForm1
  Left = 199
  Top = 108
  Width = 488
  Height = 300
  ActiveControl = ListView1
  Caption = 'Reference List'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  Menu = MainMenu1
  OldCreateOrder = True
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object ListView1: TListView
    Left = 0
    Top = 0
    Width = 480
    Height = 254
    Align = alClient
    Columns = <
      item
        Caption = 'Reference'
        Width = 230
      end
      item
        Caption = 'Author'
        Width = 180
      end
      item
        Caption = 'Country'
      end>
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -13
    Font.Name = 'MS Sans Serif'
    Font.Style = [fsBold]
    FullDrag = True
    HideSelection = False
    HotTrack = True
    ParentFont = False
    SortType = stBoth
    TabOrder = 0
    ViewStyle = vsReport
    OnColumnClick = ListView1ColumnClick
    OnCompare = ListView1Compare
    OnDblClick = ListView1DblClick
    OnMouseDown = ListView1MouseDown
  end
  object MainMenu1: TMainMenu
    Left = 424
    Top = 8
    object File1: TMenuItem
      Caption = '&File'
      object AddItems1: TMenuItem
        Caption = '&Add Items'
        OnClick = AddItems1Click
      end
      object N2: TMenuItem
        Caption = '-'
      end
      object Exit1: TMenuItem
        Caption = 'E&xit'
        OnClick = Exit1Click
      end
    end
    object View1: TMenuItem
      Caption = '&View'
      object LargeIcons1: TMenuItem
        Caption = 'Lar&ge Icons'
        GroupIndex = 1
        RadioItem = True
        OnClick = LargeIcons1Click
      end
      object SmallIcons1: TMenuItem
        Caption = 'S&mall Icons'
        GroupIndex = 1
        RadioItem = True
        OnClick = SmallIcons1Click
      end
      object List1: TMenuItem
        Caption = '&List'
        Checked = True
        GroupIndex = 1
        RadioItem = True
        OnClick = List1Click
      end
      object Details1: TMenuItem
        Caption = '&Details'
        GroupIndex = 1
        RadioItem = True
        OnClick = Details1Click
      end
      object N1: TMenuItem
        Caption = '-'
        GroupIndex = 1
      end
      object CheckBoxes1: TMenuItem
        Caption = 'CheckBoxes'
        GroupIndex = 1
        OnClick = CheckBoxes1Click
      end
    end
    object Help1: TMenuItem
      Caption = '&Help'
      object About1: TMenuItem
        Caption = 'About Reference List...'
        OnClick = About1Click
      end
    end
  end
end

NEWDIAL.DFM

object FormItem: TFormItem
  Left = 336
  Top = 271
  Width = 365
  Height = 190
  Caption = 'Item'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  Position = poScreenCenter
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 24
    Top = 28
    Width = 53
    Height = 13
    Caption = '&Reference:'
    FocusControl = EditReference
  end
  object Label2: TLabel
    Left = 24
    Top = 60
    Width = 27
    Height = 13
    Caption = '&Type:'
    FocusControl = ComboType
  end
  object Label3: TLabel
    Left = 24
    Top = 92
    Width = 34
    Height = 13
    Caption = '&Author:'
    FocusControl = EditAuthor
  end
  object Label4: TLabel
    Left = 24
    Top = 124
    Width = 39
    Height = 13
    Caption = '&Country:'
    FocusControl = EditCountry
  end
  object EditReference: TEdit
    Left = 96
    Top = 24
    Width = 241
    Height = 21
    TabOrder = 0
  end
  object EditAuthor: TEdit
    Left = 96
    Top = 88
    Width = 145
    Height = 21
    TabOrder = 2
  end
  object EditCountry: TEdit
    Left = 96
    Top = 120
    Width = 145
    Height = 21
    TabOrder = 3
  end
  object ComboType: TComboBox
    Left = 96
    Top = 56
    Width = 145
    Height = 21
    Style = csDropDownList
    ItemHeight = 13
    Items.Strings = (
      'Book'
      'CD'
      'Magazine'
      'Mail Address'
      'Web Site')
    TabOrder = 1
  end
  object BitBtn1: TBitBtn
    Left = 264
    Top = 72
    Width = 75
    Height = 25
    TabOrder = 4
    Kind = bkOK
  end
  object BitBtn2: TBitBtn
    Left = 264
    Top = 104
    Width = 75
    Height = 25
    TabOrder = 5
    Kind = bkCancel
  end
end