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
public
end;
var
Form1: TForm1;
implementation
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);
end;
procedure TForm1.ListActionItemSelected(Sender: TCustomListAction;
Control: TControl);
begin
ListBox1.Items.Add ((Control as TCustomActionCombo).SelText);
end;
end.
|
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
|