Marco Web Center

[an error occurred while processing this directive]

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