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 6

Chapter 08 - Project ListActions

Project Structure

ListActions.dpr
program ListActions;

uses
  Forms,
  ListActForm in 'ListActForm.pas' {Form1};

{$R *.res}

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

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ToolWin, ActnMan, ActnCtrls, StdCtrls, ActnList, ListActns,
  ActnMenus, ExtActns, DateUtils;

type
  TForm1 = class(TForm)
    ActionManager1: TActionManager;
    StaticListAction1: TStaticListAction;
    ListBox1: TListBox;
    ActionToolBar1: TActionToolBar;
    VirtualListAction1: TVirtualListAction;
    ListControlCopySelection1: TListControlCopySelection;
    ListControlDeleteSelection1: TListControlDeleteSelection;
    ActionToolBar2: TActionToolBar;
    ListControlMoveSelection2: TListControlMoveSelection;
    ListBox2: TListBox;
    procedure VirtualListAction1GetItemCount(Sender: TCustomListAction;
      var Count: Integer);
    procedure VirtualListAction1GetItem(Sender: TCustomListAction;
      const Index: Integer; var Value: String; var ImageIndex: Integer;
      var Data: Pointer);
    procedure ListActionItemSelected(Sender: TCustomListAction;
      Control: TControl);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.VirtualListAction1GetItemCount(Sender: TCustomListAction;
  var Count: Integer);
begin
  Count := 100;
end;

procedure TForm1.VirtualListAction1GetItem(Sender: TCustomListAction;
  const Index: Integer; var Value: String; var ImageIndex: Integer;
  var Data: Pointer);
begin
  Value := 'Item' + IntToStr (Index);
  // add this code to check when the method is called
  { + ' - ' + IntToStr (SecondOf (Now)) + ':' +
    IntToStr (MilliSecondOf (Now));}
end;

procedure TForm1.ListActionItemSelected(Sender: TCustomListAction;
  Control: TControl);
begin
  ListBox1.Items.Add ((Control as TCustomActionCombo).SelText);
end;

end.
ListActForm.dfm
object Form1: TForm1
  Left = 231
  Top = 109
  Width = 329
  Height = 395
  Caption = 'ListActions'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  DesignSize = (
    321
    368)
  PixelsPerInch = 96
  TextHeight = 13
  object ListBox1: TListBox
    Left = 8
    Top = 64
    Width = 305
    Height = 145
    Anchors = [akLeft, akTop, akRight]
    ItemHeight = 13
    TabOrder = 0
  end
  object ActionToolBar1: TActionToolBar
    Left = 0
    Top = 0
    Width = 321
    Height = 26
    ActionManager = ActionManager1
    AllowHiding = True
    Caption = 'ActionToolBar1'
    EdgeBorders = [ebTop, ebBottom]
    HorzSeparator = True
    Orientation = boLeftToRight
    PersistentHotKeys = False
    Spacing = 0
  end
  object ActionToolBar2: TActionToolBar
    Left = 0
    Top = 26
    Width = 321
    Height = 29
    ActionManager = ActionManager1
    AllowHiding = True
    Caption = 'ActionToolBar2'
    EdgeBorders = [ebTop, ebBottom]
    HorzSeparator = True
    Orientation = boLeftToRight
    PersistentHotKeys = False
    Spacing = 0
  end
  object ListBox2: TListBox
    Left = 8
    Top = 216
    Width = 305
    Height = 145
    Anchors = [akLeft, akTop, akRight, akBottom]
    ItemHeight = 13
    TabOrder = 3
  end
  object ActionManager1: TActionManager
    ActionBars.SessionCount = 1
    ActionBars = <
      item
        Items = <
          item
            Action = StaticListAction1
            Caption = '&Numbers'
          end
          item
            Action = VirtualListAction1
            Caption = '&Items'
          end>
        ActionBar = ActionToolBar1
        AutoSize = False
      end
      item
        Items = <
          item
            Items = <
              item
                Action = StaticListAction1
              end>
            Caption = '&List'
          end>
        AutoSize = False
      end
      item
        Items = <
          item
            Action = ListControlCopySelection1
            Caption = '&Copy'
          end
          item
            Action = ListControlDeleteSelection1
            Caption = '&Delete'
          end
          item
            Action = ListControlMoveSelection2
            Caption = '&Move'
          end>
        ActionBar = ActionToolBar2
        AutoSize = False
      end>
    LinkedActionLists = <>
    Left = 48
    Top = 88
    object StaticListAction1: TStaticListAction
      Category = 'List'
      Caption = 'Numbers'
      ItemIndex = 0
      Items.CaseSensitive = False
      Items.SortType = stNone
      Items = <
        item
          Caption = 'one'
        end
        item
          Caption = 'two'
        end
        item
          Caption = 'three'
        end
        item
          Caption = 'four'
        end>
      OnItemSelected = ListActionItemSelected
    end
    object VirtualListAction1: TVirtualListAction
      Category = 'List'
      Caption = 'Items'
      ItemIndex = 0
      OnGetItem = VirtualListAction1GetItem
      OnGetItemCount = VirtualListAction1GetItemCount
      OnItemSelected = ListActionItemSelected
    end
    object ListControlCopySelection1: TListControlCopySelection
      Category = 'List'
      Caption = 'Copy'
      Destination = ListBox2
      ListControl = ListBox1
    end
    object ListControlDeleteSelection1: TListControlDeleteSelection
      Category = 'List'
      Caption = 'Delete'
    end
    object ListControlMoveSelection2: TListControlMoveSelection
      Category = 'List'
      Caption = 'Move'
      Destination = ListBox2
      ListControl = ListBox1
    end
  end
  object ListControlMoveSelection1: TListControlMoveSelection
    Category = 'List'
    Caption = 'ListControlMoveSelection1'
  end
end