GitHub-Mirror/x2cl
1
0
Fork 0
mirror of synced 2024-11-22 01:53:50 +00:00
Code Issues Projects Releases Wiki Activity

Added: CursorGroup/Item properties

Browse Source 
Added: OnSelectedChanging/OnSelectedChanged events
Added: design-time editor
Fixed: drawing of disabled items in the unaMenuBarPainter
This commit is contained in:
Mark van Renswoude 2006-04-17 18:41:43 +00:00
parent b5eb0c6ad3
commit a401e01dd9
12 changed files with 1303 additions and 138 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
Packages/X2CLMBEditors.pas Normal file
View File

@ -0,0 +1,51 @@
{
:: Contains the design-time editor for the MenuBar
::
:: Last changed: $Date$
:: Revision: $Rev$
:: Author: $Author$
}
unit X2CLMBEditors;
interface
uses
DesignEditors;
type
TX2MenuBarComponentEditor = class(TComponentEditor)
public
procedure Edit(); override;
procedure ExecuteVerb(Index: Integer); override;
function GetVerb(Index: Integer): string; override;
function GetVerbCount(): Integer; override;
end;
implementation
uses
X2CLMenuBar,
X2CLMenuBarEditor;
{ TX2MenuBarComponentEditor }
procedure TX2MenuBarComponentEditor.Edit();
begin
if Assigned(Component) and (Component is TX2CustomMenuBar) then
TfrmMenuBarEditor.Execute(TX2CustomMenuBar(Component), Designer);
end;
procedure TX2MenuBarComponentEditor.ExecuteVerb(Index: Integer);
begin
Edit();
end;
function TX2MenuBarComponentEditor.GetVerb(Index: Integer): string;
begin
Result := 'Edit...';
end;
function TX2MenuBarComponentEditor.GetVerbCount(): Integer;
begin
Result := 1;
end;
end.

5
Packages/X2CLMBReg.pas
View File

@ -16,7 +16,8 @@ uses
DesignIntf, DesignIntf,
X2CLMenuBar, X2CLMenuBar,
X2CLmusikCubeMenuBarPainter, X2CLmusikCubeMenuBarPainter,
X2CLunaMenuBarPainter; X2CLunaMenuBarPainter,
X2CLMBEditors;
{.$R ..\Resources\MenuBar.dcr} {.$R ..\Resources\MenuBar.dcr}
@ -25,6 +26,8 @@ begin
RegisterComponents('X2Software', [TX2MenuBar, RegisterComponents('X2Software', [TX2MenuBar,
TX2MenuBarmusikCubePainter, TX2MenuBarmusikCubePainter,
TX2MenuBarunaPainter]); TX2MenuBarunaPainter]);
RegisterComponentEditor(TX2CustomMenuBar, TX2MenuBarComponentEditor);
end; end;
end. end.

253
Packages/X2CLMenuBarEditor.dfm Normal file
View File

@ -0,0 +1,253 @@
object frmMenuBarEditor: TfrmMenuBarEditor
Left = 0
Top = 0
BorderIcons = [biSystemMenu]
Caption = 'Editing'
ClientHeight = 376
ClientWidth = 276
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
FormStyle = fsStayOnTop
OldCreateOrder = False
Position = poOwnerFormCenter
OnClose = FormClose
OnCreate = FormCreate
OnDestroy = FormDestroy
PixelsPerInch = 96
TextHeight = 13
object tvMenu: TTreeView
Left = 0
Top = 26
Width = 276
Height = 331
Align = alClient
HideSelection = False
Indent = 19
ReadOnly = True
TabOrder = 0
OnChange = tvMenuChange
ExplicitTop = 20
ExplicitWidth = 252
ExplicitHeight = 281
end
object sbStatus: TStatusBar
Left = 0
Top = 357
Width = 276
Height = 19
Panels = <
item
Width = 50
end>
ExplicitTop = 307
ExplicitWidth = 252
end
object tbMenu: TToolBar
Left = 0
Top = 0
Width = 276
Height = 26
AutoSize = True
ButtonWidth = 84
EdgeBorders = [ebTop, ebBottom]
Images = ilsActions
List = True
ShowCaptions = True
TabOrder = 2
ExplicitWidth = 252
object tbAddGroup: TToolButton
Left = 0
Top = 0
Action = actAddGroup
AutoSize = True
end
object tbAddItem: TToolButton
Left = 81
Top = 0
Action = actAddItem
AutoSize = True
end
object tbDelete: TToolButton
Left = 154
Top = 0
Action = actDelete
AutoSize = True
end
end
object ilsActions: TImageList
Left = 8
Top = 32
Bitmap = {
494C010103000400040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
0000000000003600000028000000400000001000000001002000000000000010
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000007FA5
B8000B70A0001678A4004487A700000000000000000000000000007500000075
0000006D000000000000000000000000000000000000000000009B7C6B009B7C
6B009B7C6B009B7C6B009B7C6B009B7C6B009B7C6B00BFABA100007500000075
0000006D0000BFABA100000000000000000000000000000000002427AE00161C
AC005A5AA90000000000000000000000000000000000000000005353A9004F4F
A200000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000002F94
BD000079AC004CD9F7000CA3D20097CBDF0095C6DB008FBACF00007D000044DD
77000075000000000000000000000000000000000000000000009B776600FFFF
FF00FCF6ED00FCF6ED00FCF6ED00FCF6ED00FAF3E700FCF8F100007D000044DD
770000750000BDA99D000000000000000000000000004E4EAB001844F600194D
F8001031D2002427AE000000000000000000000000004E4EAB000928D700092E
D7000313B3004E4EAB0000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000689BAF001989
B700007EB10090EFFF0030E0FF007AEEFF0000860000008600000086000048E1
7B00007500000075000000750000000000000000000000000000A27F6F00FFFF
FF00DDC1B400DDC1B400DDC1B400E9D6CD0000860000008600000086000048E1
7B0000750000007500000075000000000000000000002022B1002451F9001F51
FF00194DF8001744E8001017AF00000000004545AD00092ED7001142F9000D3D
F5000D3DF500041ABC006F6FAA00000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000003B92B4003B9F
C600007EB1009FF1FF0046E2FF0090EFFF00008D00005EF791005AF38D0053EC
860048E17B0045DE780000750000000000000000000000000000A3807000FFFF
FF00DBC4BD00DBC4BD00DDC1B400EBDCD600008D00005EF791005AF38D0053EC
860048E17B0045DE7800007500000000000000000000000000001832DB00285A
FF002451F9002451F9001A4AF100060EAF000F30DD00164AFE001142F9001041
F6000D3DF5000D3DF5002C2CA200000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000074A0B1000E84B700B6F5
FB000081B400B6F5FB005EECFF00A3F3FF0000910000008D0000008D00005AF3
8D0000860000007D0000007D0000000000000000000000000000A9877800FFFF
FF00DBC6C200DBC4BD00DBC4BD00EBDCD60000910000008D0000008D00005AF3
8D0000860000007D0000007D000000000000000000007777B3001832DB004170
FF002D5DFF00285AFF00285AFF001F51FF00194DF800194DF8001142F9001142
F9000F3DF200161CAC0000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000000000004596B40044A5C900DDFF
FF000084B700C0FBFF0077F4FF00B6F5FB00ADF6FF00ADF6FF00008D00005EF7
910000860000C3F1F80061A8C700000000000000000000000000AB897A00FFFF
FF00DBC6C200DBC6C200DBC4BD00EBDED900EBDCD600EBDCD600008D00005EF7
910000860000C8B7AE00000000000000000000000000000000006969B8001A25
C5003A6DFF003668FF00285AFF00285AFF002451F900194DF8001F51FF00123D
ED002427AE000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000000000002790B800ABDCEA00E6FE
FE000084B700D2FFFF008EFDFF0089FAFF0082F6FF00B0F7FF00009100000091
0000008D0000C1FDFF000072A500000000000000000000000000AB897A00FFFF
FF00DBC6C200DBC4BD00DBC4BD00DBC4BD00DBBFB400EBDCD600009100000091
0000008D0000BFABA10000000000000000000000000000000000000000000000
00002F2FB3002E4EE7003668FF00285AFF00285AFF002451F900123DED002C2C
A200000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000000000000A8CBC00C9F6FA00F1FF
FF000088BB00DDFFFF00A1FFFF00A1FFFF0094F8FF00C0FBFF00C0FBFF00B0F7
FF00C3EDF500DDFFFF000072A500000000000000000000000000B1908000FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FCF8F100FFFFFF00FCF8F100FFFFFF00FCF8
F100FCF6ED009B7C6B0000000000000000000000000000000000000000000000
000000000000253FDF003A6DFF003668FF002D5DFF00285AFF001B46EA002427
AE00000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000018DC0000F92C1007EC4
DD000088BB00C3EDF5007ADBEA0085E3EF0092F0F800A1FFFF0094F8FF0065D2
E700ADF6FF00DDFFFF000079AC00000000000000000000000000AF8F8000FFFF
FF00DFCDCB00DFCDCB00DBC6C200DECAC600DDC1B400DDC1B400DEBEAD00DEBE
AD00FCF6ED009B7C6B0000000000000000000000000000000000000000000000
00002B2CC0004B7CFF004170FF003A6DFF003A6DFF00285AFF00285AFF001031
D2004A4AB2000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000018DC000F1FFFF00C3F1F800ABE7F10081D4E60065C6DF0065C6DF005FC2
DB00D2FFFF00E6FEFE000079AC00000000000000000000000000B1908000FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FCF8F100FCF8F100F9F4
EE00F0E8E0009C7D6D0000000000000000000000000000000000000000000000
0000253FDF00527CFA004170FF003668FF000C13C1003A6DFF00285AFF002451
F9000B1DC2000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00001A96C50031A5CD004AB0D30083CDE200D0EFF600E6FEFE00F1FFFF00E6FE
FE00DDFFFF00F1FFFF000079AC00000000000000000000000000B1908000FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00A3807000A782
7000A7827000A380700000000000000000000000000000000000000000004F4F
BD00527CFA005080FF004B7CFF00181FC500000000001B22C4003A6DFF00285A
FF001A4AF1001419B10000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000589FBA003298BE002390BC00158FBF00FFFF
FF00FFFFFF00FFFFFF00007EB100000000000000000000000000B8988800FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FCF8F100FFFFFF00A7827000F5E2
D900B1908000AB9E98000000000000000000000000000000000000000000252D
D6006A9CFF005788FF002E4EE7007070B90000000000000000001621C7002D5D
FF002451F9001439DD004545AD00000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000000088BB00EDF6
FA00FFFFFF00FFFFFF00007EB100000000000000000000000000B8988800FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00A7827000B08E
7D00AB9E98000000000000000000000000000000000000000000000000004B4B
C8003951E2005080FF002929C600000000000000000000000000000000001628
D300285AFF000F2EE3002123B500000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000002F99C3000084
B7000084B7000081B4004388A900000000000000000000000000B8988800B898
8800B1908000B1908000B1908000B08E7D00AC887700AC887700A7827000AB9E
9800000000000000000000000000000000000000000000000000000000000000
0000000000003E3EB90000000000000000000000000000000000000000006B6B
B6002E2EB5000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000424D3E000000000000003E000000
2800000040000000100000000100010000000000800000000000000000000000
000000000000000000000000FFFFFF00FFFFFFFFFFFF0000E1C7C003C7CF0000
E007C00383830000C001C00181010000C001C001C00100008001C00180030000
8001C003C00700008001C003F00F00008001C003F80F00008001C003F0070000
F001C003F0070000F001C003E0830000FE01C003E0C10000FFC1C007E1E10000
FFC1C00FFBE70000FFFFFFFFFFFF000000000000000000000000000000000000
000000000000}
end
object alMenu: TActionList
Images = ilsActions
Left = 36
Top = 32
object actAddGroup: TAction
Caption = '&Add group'
ImageIndex = 0
ShortCut = 45
SecondaryShortCuts.Strings = (
'Ctrl+N')
OnExecute = actAddGroupExecute
end
object actAddItem: TAction
Caption = '&Add item'
ImageIndex = 1
ShortCut = 45
SecondaryShortCuts.Strings = (
'Ctrl+N')
OnExecute = actAddItemExecute
end
object actDelete: TAction
Caption = '&Delete'
ImageIndex = 2
ShortCut = 46
SecondaryShortCuts.Strings = (
'Ctrl+Del')
OnExecute = actDeleteExecute
end
end
end

503
Packages/X2CLMenuBarEditor.pas Normal file
View File

@ -0,0 +1,503 @@
unit X2CLMenuBarEditor;
interface
uses
ActnList,
Classes,
ComCtrls,
Controls,
DesignIntf,
Forms,
ImgList,
ToolWin,
X2CLMenuBar;
type
TfrmMenuBarEditor = class(TForm, IX2MenuBarDesigner)
actAddGroup: TAction;
actAddItem: TAction;
actDelete: TAction;
alMenu: TActionList;
ilsActions: TImageList;
sbStatus: TStatusBar;
tbAddGroup: TToolButton;
tbAddItem: TToolButton;
tbDelete: TToolButton;
tbMenu: TToolBar;
tvMenu: TTreeView;
procedure actDeleteExecute(Sender: TObject);
procedure actAddItemExecute(Sender: TObject);
procedure actAddGroupExecute(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormDestroy(Sender: TObject);
procedure tvMenuChange(Sender: TObject; Node: TTreeNode);
private
FDesigner: IDesigner;
FMenuBar: TX2CustomMenuBar;
FDesignerAttached: Boolean;
procedure SetMenuBar(const Value: TX2CustomMenuBar);
procedure AttachDesigner();
procedure DetachDesigner();
function GetSelectedItem(): TX2CustomMenuBarItem;
function GetItemNode(AItem: TX2CustomMenuBarItem): TTreeNode;
protected
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure ItemAdded(AItem: TX2CustomMenuBarItem);
procedure ItemModified(AItem: TX2CustomMenuBarItem);
procedure ItemDeleting(AItem: TX2CustomMenuBarItem);
protected
procedure RefreshMenu();
function AddGroup(AGroup: TX2MenuBarGroup): TTreeNode;
function AddItem(ANode: TTreeNode; AItem: TX2MenuBarItem): TTreeNode;
procedure UpdateNode(ANode: TTreeNode);
procedure UpdateUI();
procedure Modified();
property Designer: IDesigner read FDesigner write FDesigner;
property MenuBar: TX2CustomMenuBar read FMenuBar write SetMenuBar;
public
class procedure Execute(AMenuBar: TX2CustomMenuBar; ADesigner: IDesigner);
end;
implementation
uses
Contnrs,
SysUtils;
var
GEditors: TObjectBucketList;
type
TProtectedX2CustomMenuBar = class(TX2CustomMenuBar);
{$R *.dfm}
{ TfrmMenuBarEditor }
class procedure TfrmMenuBarEditor.Execute(AMenuBar: TX2CustomMenuBar; ADesigner: IDesigner);
var
editorForm: TfrmMenuBarEditor;
begin
if not Assigned(GEditors) then
GEditors := TObjectBucketList.Create();
editorForm := nil;
if GEditors.Exists(AMenuBar) then
editorForm := TfrmMenuBarEditor(GEditors.Data[AMenuBar]);
if not Assigned(editorForm) then
begin
editorForm := TfrmMenuBarEditor.Create(Application);
editorForm.MenuBar := AMenuBar;
editorForm.Designer := ADesigner;
GEditors.Add(AMenuBar, editorForm);
end;
editorForm.Show();
end;
procedure TfrmMenuBarEditor.FormCreate(Sender: TObject);
begin
{$IFDEF VER180}
// Delphi (BDS) 2006
tbMenu.EdgeBorders := [];
tbMenu.DrawingStyle := dsGradient;
{$ENDIF}
end;
procedure TfrmMenuBarEditor.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if Assigned(Designer) and Assigned(MenuBar) then
Designer.SelectComponent(MenuBar);
Action := caFree;
end;
procedure TfrmMenuBarEditor.FormDestroy(Sender: TObject);
begin
if Assigned(MenuBar) then
begin
DetachDesigner();
if GEditors.Exists(MenuBar) then
GEditors.Remove(MenuBar);
end;
end;
procedure TfrmMenuBarEditor.tvMenuChange(Sender: TObject; Node: TTreeNode);
var
item: TX2CustomMenuBarItem;
begin
if Assigned(Node) then
begin
item := TX2CustomMenuBarItem(Node.Data);
if Assigned(Designer) then
Designer.SelectComponent(item);
end;
UpdateUI();
end;
procedure TfrmMenuBarEditor.RefreshMenu();
var
groupIndex: Integer;
begin
tvMenu.Items.BeginUpdate();
try
tvMenu.Items.Clear();
if Assigned(MenuBar) then
for groupIndex := 0 to Pred(MenuBar.Groups.Count) do
AddGroup(MenuBar.Groups[groupIndex]);
finally
tvMenu.Items.EndUpdate();
UpdateUI();
end;
end;
procedure TfrmMenuBarEditor.actAddGroupExecute(Sender: TObject);
begin
MenuBar.Groups.Add();
Modified();
end;
procedure TfrmMenuBarEditor.actAddItemExecute(Sender: TObject);
var
menuItem: TX2CustomMenuBarItem;
group: TX2MenuBarGroup;
begin
menuItem := GetSelectedItem();
if Assigned(menuItem) then
begin
group := nil;
if menuItem is TX2MenuBarGroup then
group := TX2MenuBarGroup(menuItem)
else if menuItem is TX2MenuBarItem then
group := TX2MenuBarItem(menuItem).Group;
if Assigned(group) then
begin
group.Items.Add();
if group.Items.Count = 1 then
group.Expanded := True;
Modified();
end;
end;
end;
procedure TfrmMenuBarEditor.actDeleteExecute(Sender: TObject);
var
menuItem: TX2CustomMenuBarItem;
begin
menuItem := GetSelectedItem();
if Assigned(menuItem) and Assigned(menuItem.Collection) then
begin
menuItem.Collection.Delete(menuItem.Index);
Modified();
end;
end;
function TfrmMenuBarEditor.AddGroup(AGroup: TX2MenuBarGroup): TTreeNode;
var
itemIndex: Integer;
siblingGroup: TX2MenuBarGroup;
siblingNode: TTreeNode;
groupNode: TTreeNode;
begin
tvMenu.Items.BeginUpdate();
try
siblingGroup := nil;
siblingNode := nil;
{ Make sure the group is inserted in the correct position by searching
for it's sibling group. Note: do NOT use Items[x] in a loop; TTreeView
emulates this by using GetFirst/GetNext. }
if AGroup.Index > 0 then
siblingGroup := TX2MenuBarGroup(AGroup.Collection.Items[Pred(AGroup.Index)]);
if Assigned(siblingGroup) then
begin
siblingNode := tvMenu.Items.GetFirstNode();
while Assigned(siblingNode) do
begin
if siblingNode.Data = siblingGroup then
break;
siblingNode := siblingNode.GetNextSibling();
end;
end;
if Assigned(siblingNode) then
groupNode := tvMenu.Items.Add(siblingNode, '')
else
groupNode := tvMenu.Items.AddFirst(nil, '');
groupNode.Data := AGroup;
UpdateNode(groupNode);
{ Add items }
for itemIndex := 0 to Pred(AGroup.Items.Count) do
AddItem(groupNode, AGroup.Items[itemIndex]);
groupNode.Expand(False);
Result := groupNode;
finally
tvMenu.Items.EndUpdate();
end;
end;
function TfrmMenuBarEditor.AddItem(ANode: TTreeNode; AItem: TX2MenuBarItem): TTreeNode;
var
siblingItem: TX2MenuBarItem;
siblingNode: TTreeNode;
itemNode: TTreeNode;
begin
tvMenu.Items.BeginUpdate();
try
siblingItem := nil;
siblingNode := nil;
{ See AddGroup }
if AItem.Index > 0 then
siblingItem := TX2MenuBarItem(AItem.Collection.Items[Pred(AItem.Index)]);
if Assigned(siblingItem) then
begin
siblingNode := ANode.GetFirstChild();
while Assigned(siblingNode) do
begin
if siblingNode.Data = siblingItem then
break;
siblingNode := siblingNode.GetNextSibling();
end;
end;
if Assigned(siblingNode) then
itemNode := tvMenu.Items.Add(siblingNode, '')
else
itemNode := tvMenu.Items.AddChildFirst(ANode, '');
itemNode.Data := AItem;
UpdateNode(itemNode);
Result := itemNode;
finally
tvMenu.Items.EndUpdate();
end;
end;
procedure TfrmMenuBarEditor.UpdateNode(ANode: TTreeNode);
var
menuItem: TX2CustomMenuBarItem;
begin
menuItem := TX2CustomMenuBarItem(ANode.Data);
ANode.Text := menuItem.Caption;
ANode.ImageIndex := menuItem.ImageIndex;
ANode.SelectedIndex := ANode.ImageIndex;
end;
procedure TfrmMenuBarEditor.UpdateUI();
var
itemSelected: Boolean;
begin
itemSelected := Assigned(tvMenu.Selected);
actAddGroup.Enabled := Assigned(MenuBar);
actAddItem.Enabled := itemSelected;
actDelete.Enabled := itemSelected;
end;
procedure TfrmMenuBarEditor.Modified();
begin
if Assigned(Designer) then
Designer.Modified();
UpdateUI();
end;
procedure TfrmMenuBarEditor.Notification(AComponent: TComponent; Operation: TOperation);
begin
if (Operation = opRemove) and (AComponent = MenuBar) then
begin
DetachDesigner();
Release();
end;
inherited;
end;
procedure TfrmMenuBarEditor.ItemAdded(AItem: TX2CustomMenuBarItem);
var
group: TX2MenuBarGroup;
groupNode: TTreeNode;
treeNode: TTreeNode;
begin
treeNode := nil;
if AItem is TX2MenuBarGroup then
treeNode := AddGroup(TX2MenuBarGroup(AItem))
else if AItem is TX2MenuBarItem then
begin
group := TX2MenuBarItem(AItem).Group;
groupNode := nil;
if Assigned(group) then
groupNode := GetItemNode(group);
if Assigned(groupNode) then
treeNode := AddItem(groupNode, TX2MenuBarItem(AItem));
end;
if Assigned(treeNode) then
tvMenu.Selected := treeNode;
end;
procedure TfrmMenuBarEditor.ItemModified(AItem: TX2CustomMenuBarItem);
var
treeNode: TTreeNode;
begin
tvMenu.Items.BeginUpdate();
try
treeNode := tvMenu.Items.GetFirstNode();
while Assigned(treeNode) do
begin
UpdateNode(treeNode);
treeNode := treeNode.GetNext();
end;
finally
tvMenu.Items.EndUpdate();
end;
end;
procedure TfrmMenuBarEditor.ItemDeleting(AItem: TX2CustomMenuBarItem);
var
treeNode: TTreeNode;
begin
treeNode := GetItemNode(AItem);
if Assigned(treeNode) then
tvMenu.Items.Delete(treeNode);
end;
procedure TfrmMenuBarEditor.AttachDesigner();
begin
if FDesignerAttached or (not Assigned(MenuBar)) then
exit;
TProtectedX2CustomMenuBar(MenuBar).Designer := Self;
FDesignerAttached := True;
end;
procedure TfrmMenuBarEditor.DetachDesigner();
begin
if not FDesignerAttached then
exit;
FDesignerAttached := False;
if Assigned(MenuBar) then
TProtectedX2CustomMenuBar(MenuBar).Designer := nil;
end;
function TfrmMenuBarEditor.GetSelectedItem(): TX2CustomMenuBarItem;
begin
Result := nil;
if Assigned(tvMenu.Selected) then
Result := TX2CustomMenuBarItem(tvMenu.Selected.Data);
end;
function TfrmMenuBarEditor.GetItemNode(AItem: TX2CustomMenuBarItem): TTreeNode;
var
treeNode: TTreeNode;
begin
Result := nil;
treeNode := tvMenu.Items.GetFirstNode();
while Assigned(treeNode) do
begin
if treeNode.Data = AItem then
begin
Result := treeNode;
break;
end;
treeNode := treeNode.GetNext();
end;
end;
procedure TfrmMenuBarEditor.SetMenuBar(const Value: TX2CustomMenuBar);
begin
if Value <> FMenuBar then
begin
if Assigned(FMenuBar) then
begin
DetachDesigner();
FMenuBar.RemoveFreeNotification(Self);
end;
FMenuBar := Value;
if Assigned(FMenuBar) then
begin
tvMenu.Images := FMenuBar.Images;
Self.Caption := 'Editing ' + FMenuBar.Name;
AttachDesigner();
FMenuBar.FreeNotification(Self);
end else
begin
Self.Caption := '';
tvMenu.Images := nil;
end;
RefreshMenu();
end;
end;
procedure FreeEditor(AInfo, AItem, AData: Pointer; out AContinue: Boolean);
begin
with (TObject(AData) as TfrmMenuBarEditor) do
begin
MenuBar := nil;
Free();
end;
end;
initialization
finalization
if Assigned(GEditors) then
GEditors.ForEach(FreeEditor);
FreeAndNil(GEditors);
end.

BIN
Resources/Icons/MenuBar/Add Group.ico Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.4 KiB

BIN
Resources/Icons/MenuBar/Add Item.ico Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.4 KiB

BIN
Resources/Icons/MenuBar/Delete.ico Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.4 KiB

369
Source/X2CLMenuBar.pas
View File

@ -31,10 +31,7 @@ const
type type
// #ToDo1 (MvR) 25-3-2006: various Select methods for key support // #ToDo1 (MvR) 25-3-2006: various Select methods for key support
// #ToDo1 (MvR) 1-4-2006: scroll wheel support // #ToDo1 (MvR) 1-4-2006: scroll wheel support
// #ToDo1 (MvR) 2-4-2006: OnSelectionChanging event // #ToDo1 (MvR) 2-4-2006: OnGetAnimationClass event?
// #ToDo1 (MvR) 2-4-2006: OnSelectionChanged event
// #ToDo1 (MvR) 2-4-2006: disabled drawing
// #ToDo1 (MvR) 2-4-2006: OnGetAnimationClass event
TX2CustomMenuBarAnimatorClass = class of TX2CustomMenuBarAnimator; TX2CustomMenuBarAnimatorClass = class of TX2CustomMenuBarAnimator;
TX2CustomMenuBarAnimator = class; TX2CustomMenuBarAnimator = class;
TX2CustomMenuBarPainterClass = class of TX2CustomMenuBarPainter; TX2CustomMenuBarPainterClass = class of TX2CustomMenuBarPainter;
@ -44,34 +41,41 @@ type
TX2MenuBarGroup = class; TX2MenuBarGroup = class;
TX2CustomMenuBar = class; TX2CustomMenuBar = class;
IX2MenuBarDesigner = interface
['{F648CFD2-771D-4531-84D0-621FD7597E48}']
procedure ItemAdded(AItem: TX2CustomMenuBarItem);
procedure ItemModified(AItem: TX2CustomMenuBarItem);
procedure ItemDeleting(AItem: TX2CustomMenuBarItem);
end;
TX2MenuBarHitTest = record TX2MenuBarHitTest = record
HitTestCode: Integer; HitTestCode: Integer;
Item: TX2CustomMenuBarItem; Item: TX2CustomMenuBarItem;
end; end;
TX2MenuBarDrawState = (mdsHot, mdsSelected, mdsGroupHot, TX2MenuBarDrawState = (mdsHot, mdsSelected, mdsGroupHot, mdsGroupSelected);
mdsGroupSelected); TX2MenuBarDrawStates = set of TX2MenuBarDrawState;
TX2MenuBarDrawStates = set of TX2MenuBarDrawState;
TX2MenuBarSpacingElement = (seBeforeGroupHeader, seAfterGroupHeader, TX2MenuBarSpacingElement = (seBeforeGroupHeader, seAfterGroupHeader,
seBeforeFirstItem, seAfterLastItem, seBeforeFirstItem, seAfterLastItem,
seBeforeItem, seAfterItem); seBeforeItem, seAfterItem);
TX2MenuBarOnExpandingEvent = procedure(Sender: TObject; TX2MenuBarSelectAction = (saBefore, saAfter, saBoth);
Group: TX2MenuBarGroup;
var Allowed: Boolean) of object;
TX2MenuBarOnExpandedEvent = procedure(Sender: TObject;
Group: TX2MenuBarGroup) of object;
TX2MenuBarItemBoundsProc = procedure(Sender: TObject; TX2MenuBarExpandingEvent = procedure(Sender: TObject; Group: TX2MenuBarGroup; var Allowed: Boolean) of object;
Item: TX2CustomMenuBarItem; TX2MenuBarExpandedEvent = procedure(Sender: TObject; Group: TX2MenuBarGroup) of object;
const MenuBounds: TRect; TX2MenuBarSelectedChangingEvent = procedure(Sender: TObject; Item, NewItem: TX2CustomMenUBarItem; var Allowed: Boolean) of object;
const ItemBounds: TRect; TX2MenuBarSelectedChangedEvent = procedure(Sender: TObject; Item: TX2CustomMenUBarItem) of object;
Data: Pointer;
var Abort: Boolean) of object;
TCollectionUpdateEvent = procedure(Sender: TObject; TX2MenuBarItemBoundsProc = procedure(Sender: TObject;
Item: TCollectionItem) of object; Item: TX2CustomMenuBarItem;
const MenuBounds: TRect;
const ItemBounds: TRect;
Data: Pointer;
var Abort: Boolean) of object;
TCollectionNotifyEvent = procedure(Sender: TObject; Item: TCollectionItem; Action: TCollectionNotification) of object;
TCollectionUpdateEvent = procedure(Sender: TObject; Item: TCollectionItem) of object;
IX2MenuBarPainterObserver = interface IX2MenuBarPainterObserver = interface
['{22DE60C9-49A1-4E7D-B547-901BEDCC0FB7}'] ['{22DE60C9-49A1-4E7D-B547-901BEDCC0FB7}']
@ -193,11 +197,14 @@ type
} }
TX2CustomMenuBarItems = class(TOwnedCollection) TX2CustomMenuBarItems = class(TOwnedCollection)
private private
FOnUpdate: TCollectionUpdateEvent; FOnNotify: TCollectionNotifyEvent;
FOnUpdate: TCollectionUpdateEvent;
protected protected
procedure Notify(Item: TCollectionItem; Action: TCollectionNotification); override;
procedure Update(Item: TCollectionItem); override; procedure Update(Item: TCollectionItem); override;
property OnUpdate: TCollectionUpdateEvent read FOnUpdate write FOnUpdate; property OnNotify: TCollectionNotifyEvent read FOnNotify write FOnNotify;
property OnUpdate: TCollectionUpdateEvent read FOnUpdate write FOnUpdate;
end; end;
{ {
@ -207,6 +214,8 @@ type
private private
function GetGroup(): TX2MenuBarGroup; function GetGroup(): TX2MenuBarGroup;
public public
constructor Create(Collection: TCollection); override;
property Group: TX2MenuBarGroup read GetGroup; property Group: TX2MenuBarGroup read GetGroup;
end; end;
@ -241,6 +250,7 @@ type
procedure SetEnabled(const Value: Boolean); override; procedure SetEnabled(const Value: Boolean); override;
procedure InternalSetExpanded(const Value: Boolean); procedure InternalSetExpanded(const Value: Boolean);
procedure ItemsNotify(Sender: TObject; Item: TCollectionItem; Action: TCollectionNotification);
procedure ItemsUpdate(Sender: TObject; Item: TCollectionItem); procedure ItemsUpdate(Sender: TObject; Item: TCollectionItem);
property SelectedItem: Integer read GetSelectedItem write FSelectedItem; property SelectedItem: Integer read GetSelectedItem write FSelectedItem;
@ -278,27 +288,32 @@ type
} }
TX2CustomMenuBar = class(TCustomControl, IX2MenuBarPainterObserver) TX2CustomMenuBar = class(TCustomControl, IX2MenuBarPainterObserver)
private private
FAllowCollapseAll: Boolean; FAllowCollapseAll: Boolean;
FAnimationStyle: TX2MenuBarAnimationStyle; FAnimationStyle: TX2MenuBarAnimationStyle;
FAnimationTime: Cardinal; FAnimationTime: Cardinal;
FAnimator: TX2CustomMenuBarAnimator; FAnimator: TX2CustomMenuBarAnimator;
FAutoCollapse: Boolean; FAutoCollapse: Boolean;
FAutoSelectItem: Boolean; FAutoSelectItem: Boolean;
FBorderStyle: TBorderStyle; FBorderStyle: TBorderStyle;
FExpandingGroups: TStringList; FCursorGroup: TCursor;
FGroups: TX2MenuBarGroups; FCursorItem: TCursor;
FHideScrollbar: Boolean; FDesigner: IX2MenuBarDesigner;
FHotItem: TX2CustomMenuBarItem; FExpandingGroups: TStringList;
FImageList: TCustomImageList; FGroups: TX2MenuBarGroups;
FLastMousePos: TPoint; FHideScrollbar: Boolean;
FOnCollapsed: TX2MenuBarOnExpandedEvent; FHotItem: TX2CustomMenuBarItem;
FOnCollapsing: TX2MenuBarOnExpandingEvent; FImages: TCustomImageList;
FOnExpanded: TX2MenuBarOnExpandedEvent; FLastMousePos: TPoint;
FOnExpanding: TX2MenuBarOnExpandingEvent; FOnCollapsed: TX2MenuBarExpandedEvent;
FPainter: TX2CustomMenuBarPainter; FOnCollapsing: TX2MenuBarExpandingEvent;
FScrollbar: Boolean; FOnExpanded: TX2MenuBarExpandedEvent;
FScrollOffset: Integer; FOnExpanding: TX2MenuBarExpandingEvent;
FSelectedItem: TX2CustomMenuBarItem; FOnSelectedChanged: TX2MenuBarSelectedChangedEvent;
FOnSelectedChanging: TX2MenuBarSelectedChangingEvent;
FPainter: TX2CustomMenuBarPainter;
FScrollbar: Boolean;
FScrollOffset: Integer;
FSelectedItem: TX2CustomMenuBarItem;
procedure SetAllowCollapseAll(const Value: Boolean); procedure SetAllowCollapseAll(const Value: Boolean);
procedure SetAnimator(const Value: TX2CustomMenuBarAnimator); procedure SetAnimator(const Value: TX2CustomMenuBarAnimator);
@ -307,12 +322,14 @@ type
procedure SetBorderStyle(const Value: TBorderStyle); procedure SetBorderStyle(const Value: TBorderStyle);
procedure SetGroups(const Value: TX2MenuBarGroups); procedure SetGroups(const Value: TX2MenuBarGroups);
procedure SetHideScrollbar(const Value: Boolean); procedure SetHideScrollbar(const Value: Boolean);
procedure SetImageList(const Value: TCustomImageList); procedure SetImages(const Value: TCustomImageList);
procedure SetScrollbar(const Value: Boolean); procedure SetScrollbar(const Value: Boolean);
procedure SetSelectedItem(const Value: TX2CustomMenuBarItem);
protected protected
procedure CreateParams(var Params: TCreateParams); override; procedure CreateParams(var Params: TCreateParams); override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override; procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure PainterUpdate(Sender: TX2CustomMenuBarPainter); procedure PainterUpdate(Sender: TX2CustomMenuBarPainter);
procedure GroupsNotify(Sender: TObject; Item: TCollectionItem; Action: TCollectionNotification);
procedure GroupsUpdate(Sender: TObject; Item: TCollectionItem); procedure GroupsUpdate(Sender: TObject; Item: TCollectionItem);
procedure UpdateScrollbar(); procedure UpdateScrollbar();
@ -325,6 +342,8 @@ type
procedure TestMousePos(); virtual; procedure TestMousePos(); virtual;
function GetMenuHeight(): Integer; virtual; function GetMenuHeight(): Integer; virtual;
property Designer: IX2MenuBarDesigner read FDesigner write FDesigner;
protected protected
procedure SetPainter(const Value: TX2CustomMenuBarPainter); virtual; procedure SetPainter(const Value: TX2CustomMenuBarPainter); virtual;
@ -343,25 +362,31 @@ type
function AllowInteraction(): Boolean; virtual; function AllowInteraction(): Boolean; virtual;
function ItemVisible(AItem: TX2CustomMenuBarItem): Boolean; virtual; function ItemVisible(AItem: TX2CustomMenuBarItem): Boolean; virtual;
property AllowCollapseAll: Boolean read FAllowCollapseAll write SetAllowCollapseAll default True; property AllowCollapseAll: Boolean read FAllowCollapseAll write SetAllowCollapseAll default True;
property AnimationStyle: TX2MenuBarAnimationStyle read FAnimationStyle write FAnimationStyle default DefaultAnimationStyle; property AnimationStyle: TX2MenuBarAnimationStyle read FAnimationStyle write FAnimationStyle default DefaultAnimationStyle;
property AnimationTime: Cardinal read FAnimationTime write FAnimationTime default DefaultAnimationTime; property AnimationTime: Cardinal read FAnimationTime write FAnimationTime default DefaultAnimationTime;
property Animator: TX2CustomMenuBarAnimator read FAnimator write SetAnimator; property Animator: TX2CustomMenuBarAnimator read FAnimator write SetAnimator;
property AutoCollapse: Boolean read FAutoCollapse write SetAutoCollapse default False; property AutoCollapse: Boolean read FAutoCollapse write SetAutoCollapse default False;
property AutoSelectItem: Boolean read FAutoSelectItem write SetAutoSelectItem default False; property AutoSelectItem: Boolean read FAutoSelectItem write SetAutoSelectItem default False;
property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsNone; property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsNone;
property HideScrollbar: Boolean read FHideScrollbar write SetHideScrollbar default True; property CursorGroup: TCursor read FCursorGroup write FCursorGroup default crDefault;
property OnCollapsed: TX2MenuBarOnExpandedEvent read FOnCollapsed write FOnCollapsed; property CursorItem: TCursor read FCursorItem write FCursorItem default crDefault;
property OnCollapsing: TX2MenuBarOnExpandingEvent read FOnCollapsing write FOnCollapsing; property HideScrollbar: Boolean read FHideScrollbar write SetHideScrollbar default True;
property OnExpanded: TX2MenuBarOnExpandedEvent read FOnExpanded write FOnExpanded; property OnCollapsed: TX2MenuBarExpandedEvent read FOnCollapsed write FOnCollapsed;
property OnExpanding: TX2MenuBarOnExpandingEvent read FOnExpanding write FOnExpanding; property OnCollapsing: TX2MenuBarExpandingEvent read FOnCollapsing write FOnCollapsing;
property Scrollbar: Boolean read FScrollbar write SetScrollbar default True; property OnExpanded: TX2MenuBarExpandedEvent read FOnExpanded write FOnExpanded;
property OnExpanding: TX2MenuBarExpandingEvent read FOnExpanding write FOnExpanding;
property OnSelectedChanged: TX2MenuBarSelectedChangedEvent read FOnSelectedChanged write FOnSelectedChanged;
property OnSelectedChanging: TX2MenuBarSelectedChangingEvent read FOnSelectedChanging write FOnSelectedChanging;
property Scrollbar: Boolean read FScrollbar write SetScrollbar default True;
protected protected
procedure DoAutoCollapse(AGroup: TX2MenuBarGroup); procedure DoAutoCollapse(AGroup: TX2MenuBarGroup); virtual;
procedure DoAutoSelectItem(AGroup: TX2MenuBarGroup); function DoAutoSelectItem(AGroup: TX2MenuBarGroup; AAction: TX2MenuBarSelectAction): Boolean; virtual;
procedure DoExpand(AGroup: TX2MenuBarGroup; AExpanding: Boolean); procedure DoExpand(AGroup: TX2MenuBarGroup; AExpanding: Boolean); virtual;
procedure DoExpandedChanging(AGroup: TX2MenuBarGroup; AExpanding: Boolean); virtual; procedure DoExpandedChanging(AGroup: TX2MenuBarGroup; AExpanding: Boolean); virtual;
procedure DoExpandedChanged(AGroup: TX2MenuBarGroup); virtual; procedure DoExpandedChanged(AGroup: TX2MenuBarGroup); virtual;
procedure DoSelectedChanging(ANewItem: TX2CustomMenuBarItem; var AAllowed: Boolean); virtual;
procedure DoSelectedChanged(); virtual;
public public
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
destructor Destroy(); override; destructor Destroy(); override;
@ -369,9 +394,10 @@ type
function HitTest(const APoint: TPoint): TX2MenuBarHitTest; overload; function HitTest(const APoint: TPoint): TX2MenuBarHitTest; overload;
function HitTest(AX, AY: Integer): TX2MenuBarHitTest; overload; function HitTest(AX, AY: Integer): TX2MenuBarHitTest; overload;
property Groups: TX2MenuBarGroups read FGroups write SetGroups; property Groups: TX2MenuBarGroups read FGroups write SetGroups;
property ImageList: TCustomImageList read FImageList write SetImageList; property Images: TCustomImageList read FImages write SetImages;
property Painter: TX2CustomMenuBarPainter read FPainter write SetPainter; property Painter: TX2CustomMenuBarPainter read FPainter write SetPainter;
property SelectedItem: TX2CustomMenuBarItem read FSelectedItem write SetSelectedItem;
end; end;
{ {
@ -391,9 +417,11 @@ type
property BevelOuter; property BevelOuter;
property BorderStyle; property BorderStyle;
property BorderWidth; property BorderWidth;
property CursorGroup;
property CursorItem;
property Groups; property Groups;
property HideScrollbar; property HideScrollbar;
property ImageList; property Images;
property OnClick; property OnClick;
property OnCollapsed; property OnCollapsed;
property OnCollapsing; property OnCollapsing;
@ -402,6 +430,8 @@ type
property OnExit; property OnExit;
property OnExpanded; property OnExpanded;
property OnExpanding; property OnExpanding;
property OnSelectedChanged;
property OnSelectedChanging;
property OnMouseActivate; property OnMouseActivate;
property OnMouseDown; property OnMouseDown;
property OnMouseEnter; property OnMouseEnter;
@ -741,13 +771,12 @@ end;
{ TX2CustomMenuBarItem } { TX2CustomMenuBarItem }
constructor TX2CustomMenuBarItem.Create(Collection: TCollection); constructor TX2CustomMenuBarItem.Create(Collection: TCollection);
begin begin
inherited;
FCaption := SDefaultItemCaption;
FEnabled := True; FEnabled := True;
FImageIndex := -1; FImageIndex := -1;
FOwnsData := True; FOwnsData := True;
FVisible := True; FVisible := True;
inherited;
end; end;
destructor TX2CustomMenuBarItem.Destroy(); destructor TX2CustomMenuBarItem.Destroy();
@ -848,6 +877,14 @@ end;
{ TX2CustomMenuBarItems } { TX2CustomMenuBarItems }
procedure TX2CustomMenuBarItems.Notify(Item: TCollectionItem; Action: TCollectionNotification);
begin
if Assigned(FOnNotify) then
FOnNotify(Self, Item, Action);
inherited;
end;
procedure TX2CustomMenuBarItems.Update(Item: TCollectionItem); procedure TX2CustomMenuBarItems.Update(Item: TCollectionItem);
begin begin
inherited; inherited;
@ -858,6 +895,13 @@ end;
{ TX2MenuBarItem } { TX2MenuBarItem }
constructor TX2MenuBarItem.Create(Collection: TCollection);
begin
Caption := SDefaultItemCaption;
inherited;
end;
function TX2MenuBarItem.GetGroup(): TX2MenuBarGroup; function TX2MenuBarItem.GetGroup(): TX2MenuBarGroup;
begin begin
Result := nil; Result := nil;
@ -878,7 +922,9 @@ end;
function TX2MenuBarItems.Add(const ACaption: TCaption): TX2MenuBarItem; function TX2MenuBarItems.Add(const ACaption: TCaption): TX2MenuBarItem;
begin begin
Result := TX2MenuBarItem(inherited Add()); Result := TX2MenuBarItem(inherited Add());
Result.Caption := ACaption;
if Length(ACaption) > 0 then
Result.Caption := ACaption;
end; end;
@ -896,11 +942,14 @@ end;
{ TX2MenuBarGroup } { TX2MenuBarGroup }
constructor TX2MenuBarGroup.Create(Collection: TCollection); constructor TX2MenuBarGroup.Create(Collection: TCollection);
begin begin
inherited; Caption := SDefaultGroupCaption;
FCaption := SDefaultGroupCaption;
FItems := TX2MenuBarItems.Create(Self); FItems := TX2MenuBarItems.Create(Self);
FItems.OnNotify := ItemsNotify;
FItems.OnUpdate := ItemsUpdate; FItems.OnUpdate := ItemsUpdate;
{ This results in the Collection's Notification being called, which needs to
be after we create our Items property. }
inherited;
end; end;
destructor TX2MenuBarGroup.Destroy(); destructor TX2MenuBarGroup.Destroy();
@ -953,6 +1002,12 @@ begin
end; end;
end; end;
procedure TX2MenuBarGroup.ItemsNotify(Sender: TObject; Item: TCollectionItem; Action: TCollectionNotification);
begin
if Assigned(Self.Collection) then
TProtectedCollection(Self.Collection).Notify(Item, Action);
end;
procedure TX2MenuBarGroup.ItemsUpdate(Sender: TObject; Item: TCollectionItem); procedure TX2MenuBarGroup.ItemsUpdate(Sender: TObject; Item: TCollectionItem);
var var
groupCollection: TProtectedCollection; groupCollection: TProtectedCollection;
@ -1008,6 +1063,7 @@ end;
function TX2MenuBarGroups.Add(const ACaption: TCaption): TX2MenuBarGroup; function TX2MenuBarGroups.Add(const ACaption: TCaption): TX2MenuBarGroup;
begin begin
Result := TX2MenuBarGroup(inherited Add()); Result := TX2MenuBarGroup(inherited Add());
if Length(ACaption) > 0 then if Length(ACaption) > 0 then
Result.Caption := ACaption; Result.Caption := ACaption;
end; end;
@ -1033,8 +1089,11 @@ begin
FAnimationStyle := DefaultAnimationStyle; FAnimationStyle := DefaultAnimationStyle;
FAnimationTime := DefaultAnimationTime; FAnimationTime := DefaultAnimationTime;
FBorderStyle := bsNone; FBorderStyle := bsNone;
FCursorGroup := crDefault;
FCursorItem := crDefault;
FExpandingGroups := TStringList.Create(); FExpandingGroups := TStringList.Create();
FGroups := TX2MenuBarGroups.Create(Self); FGroups := TX2MenuBarGroups.Create(Self);
FGroups.OnNotify := GroupsNotify;
FGroups.OnUpdate := GroupsUpdate; FGroups.OnUpdate := GroupsUpdate;
FHideScrollbar := True; FHideScrollbar := True;
FScrollbar := True; FScrollbar := True;
@ -1132,7 +1191,7 @@ begin
group := TX2MenuBarGroup(FExpandingGroups.Objects[0]); group := TX2MenuBarGroup(FExpandingGroups.Objects[0]);
FExpandingGroups.Delete(0); FExpandingGroups.Delete(0);
group.Expanded := expand; DoExpand(group, expand);
end; end;
end end
else else
@ -1154,13 +1213,13 @@ begin
if AItem = FHotItem then if AItem = FHotItem then
Include(Result, mdsHot); Include(Result, mdsHot);
if AItem = FSelectedItem then if AItem = SelectedItem then
Include(Result, mdsSelected); Include(Result, mdsSelected);
if Assigned(FHotItem) and (AItem = ItemGroup(FHotItem)) then if Assigned(FHotItem) and (AItem = ItemGroup(FHotItem)) then
Include(Result, mdsGroupHot); Include(Result, mdsGroupHot);
if Assigned(FSelectedItem) and (AItem = ItemGroup(FSelectedItem)) then if Assigned(SelectedItem) and (AItem = ItemGroup(SelectedItem)) then
Include(Result, mdsGroupSelected); Include(Result, mdsGroupSelected);
end; end;
@ -1384,9 +1443,11 @@ begin
if not allowed then if not allowed then
exit; exit;
{ Auto select item } { Pretend to auto select item - required for proper functioning of
the OnSelectedChanging event }
if AutoSelectItem then if AutoSelectItem then
DoAutoSelectItem(AGroup); if not DoAutoSelectItem(AGroup, saBefore) then
exit;
{ Allow collapse all } { Allow collapse all }
if not (AExpanding or AllowCollapseAll) then if not (AExpanding or AllowCollapseAll) then
@ -1405,6 +1466,10 @@ procedure TX2CustomMenuBar.DoExpandedChanged(AGroup: TX2MenuBarGroup);
begin begin
if AGroup.Expanded then if AGroup.Expanded then
begin begin
{ Auto select item }
if AutoSelectItem then
DoAutoSelectItem(AGroup, saAfter);
if Assigned(FOnExpanded) then if Assigned(FOnExpanded) then
FOnExpanded(Self, AGroup); FOnExpanded(Self, AGroup);
end else end else
@ -1412,6 +1477,19 @@ begin
FOnCollapsed(Self, AGroup); FOnCollapsed(Self, AGroup);
end; end;
procedure TX2CustomMenuBar.DoSelectedChanging(ANewItem: TX2CustomMenuBarItem;
var AAllowed: Boolean);
begin
if Assigned(FOnSelectedChanging) then
FOnSelectedChanging(Self, SelectedItem, ANewItem, AAllowed);
end;
procedure TX2CustomMenuBar.DoSelectedChanged();
begin
if Assigned(FOnSelectedChanged) then
FOnSelectedChanged(Self, SelectedItem);
end;
function TX2CustomMenuBar.AllowInteraction(): Boolean; function TX2CustomMenuBar.AllowInteraction(): Boolean;
begin begin
@ -1424,7 +1502,8 @@ begin
end; end;
procedure TX2CustomMenuBar.DoExpand(AGroup: TX2MenuBarGroup; AExpanding: Boolean); procedure TX2CustomMenuBar.DoExpand(AGroup: TX2MenuBarGroup;
AExpanding: Boolean);
var var
animatorClass: TX2CustomMenuBarAnimatorClass; animatorClass: TX2CustomMenuBarAnimatorClass;
itemsBuffer: Graphics.TBitmap; itemsBuffer: Graphics.TBitmap;
@ -1511,13 +1590,16 @@ begin
end; end;
end; end;
procedure TX2CustomMenuBar.DoAutoSelectItem(AGroup: TX2MenuBarGroup); function TX2CustomMenuBar.DoAutoSelectItem(AGroup: TX2MenuBarGroup;
AAction: TX2MenuBarSelectAction): Boolean;
var var
group: TX2MenuBarGroup; group: TX2MenuBarGroup;
groupIndex: Integer; groupIndex: Integer;
newItem: TX2CustomMenuBarItem;
begin begin
group := AGroup; Result := True;
group := AGroup;
if not Assigned(group) then if not Assigned(group) then
begin begin
for groupIndex := 0 to Pred(Groups.Count) do for groupIndex := 0 to Pred(Groups.Count) do
@ -1539,8 +1621,21 @@ begin
if group.Items.Count > 0 then if group.Items.Count > 0 then
begin begin
FSelectedItem := group.Items[group.SelectedItem]; newItem := group.Items[group.SelectedItem];
Invalidate();
if newItem <> SelectedItem then
begin
if AAction in [saBefore, saBoth] then
DoSelectedChanging(newItem, Result);
if Result and (AAction in [saAfter, saBoth]) then
begin
FSelectedItem := newItem;
DoSelectedChanged();
Invalidate();
end;
end;
end; end;
end; end;
@ -1578,9 +1673,9 @@ begin
begin begin
FPainter := nil; FPainter := nil;
Invalidate(); Invalidate();
end else if AComponent = FImageList then end else if AComponent = FImages then
begin begin
FImageList := nil; FImages := nil;
Invalidate(); Invalidate();
end; end;
@ -1592,10 +1687,31 @@ begin
Invalidate(); Invalidate();
end; end;
procedure TX2CustomMenuBar.GroupsNotify(Sender: TObject; Item: TCollectionItem; Action: TCollectionNotification);
begin
if Action = cnDeleting then
if Item = SelectedItem then
SelectedItem := nil
else if Item = FHotItem then
FHotItem := nil;
if Assigned(Designer) then
case Action of
cnAdded: Designer.ItemAdded(Item as TX2CustomMenuBarItem);
cnDeleting: Designer.ItemDeleting(Item as TX2CustomMenuBarItem);
end;
if TProtectedCollection(Item.Collection).UpdateCount = 0 then
Invalidate();
end;
procedure TX2CustomMenuBar.GroupsUpdate(Sender: TObject; Item: TCollectionItem); procedure TX2CustomMenuBar.GroupsUpdate(Sender: TObject; Item: TCollectionItem);
begin begin
if Assigned(FSelectedItem) and (not FSelectedItem.Enabled) then if Assigned(SelectedItem) and (not SelectedItem.Enabled) then
FSelectedItem := nil; SelectedItem := nil;
if Assigned(Designer) then
Designer.ItemModified(Item as TX2CustomMenuBarItem);
Invalidate(); Invalidate();
end; end;
@ -1619,19 +1735,15 @@ begin
if group.Enabled and (group.Items.Count > 0) then if group.Enabled and (group.Items.Count > 0) then
begin begin
group.Expanded := not group.Expanded; group.Expanded := not group.Expanded;
hitTest.Item := FSelectedItem; hitTest.Item := SelectedItem;
Invalidate(); Invalidate();
end; end;
end; end;
if Assigned(hitTest.Item) and (hitTest.Item <> FSelectedItem) and if Assigned(hitTest.Item) and (hitTest.Item <> SelectedItem) and
hitTest.Item.Enabled then hitTest.Item.Enabled then
begin begin
if hitTest.HitTestCode = htItem then SelectedItem := hitTest.Item;
TX2MenuBarItem(hitTest.Item).Group.SelectedItem := hitTest.Item.Index;
FSelectedItem := hitTest.Item;
Invalidate();
end; end;
end; end;
@ -1639,10 +1751,26 @@ begin
end; end;
procedure TX2CustomMenuBar.MouseMove(Shift: TShiftState; X, Y: Integer); procedure TX2CustomMenuBar.MouseMove(Shift: TShiftState; X, Y: Integer);
var
cursor: TCursor;
begin begin
FLastMousePos := Point(X, Y); FLastMousePos := Point(X, Y);
TestMousePos(); TestMousePos();
cursor := crDefault;
if Assigned(FHotItem) then
if FHotItem is TX2MenuBarGroup then
cursor := CursorGroup
else if FHotItem is TX2MenuBarItem then
cursor := CursorItem;
if (cursor <> crDefault) and FHotItem.Enabled then
begin
Windows.SetCursor(Screen.Cursors[cursor]);
exit;
end;
inherited; inherited;
end; end;
@ -1875,8 +2003,8 @@ begin
begin begin
FAutoSelectItem := Value; FAutoSelectItem := Value;
if Value and (not Assigned(FSelectedItem)) then if Value and (not Assigned(SelectedItem)) then
DoAutoSelectItem(nil); DoAutoSelectItem(nil, saBoth);
end; end;
end; end;
@ -1904,17 +2032,17 @@ begin
end; end;
end; end;
procedure TX2CustomMenuBar.SetImageList(const Value: TCustomImageList); procedure TX2CustomMenuBar.SetImages(const Value: TCustomImageList);
begin begin
if Value <> FImageList then if Value <> FImages then
begin begin
if Assigned(FImageList) then if Assigned(FImages) then
FImageList.RemoveFreeNotification(Self); FImages.RemoveFreeNotification(Self);
FImageList := Value; FImages := Value;
if Assigned(FImageList) then if Assigned(FImages) then
FImageList.FreeNotification(Self); FImages.FreeNotification(Self);
Invalidate(); Invalidate();
end; end;
@ -1952,5 +2080,38 @@ begin
end; end;
end; end;
procedure TX2CustomMenuBar.SetSelectedItem(const Value: TX2CustomMenuBarItem);
var
allowed: Boolean;
group: TX2MenuBarGroup;
begin
if Value <> FSelectedItem then
begin
allowed := True;
DoSelectedChanging(Value, allowed);
if allowed then
begin
FSelectedItem := Value;
if Value is TX2MenuBarItem then
begin
group := TX2MenuBarItem(Value).Group;
if Assigned(group) then
begin
group.SelectedItem := Value.Index;
if not group.Expanded then
group.Expanded := True;
end;
end;
DoSelectedChanged();
Invalidate();
end;
end;
end;
end. end.

33
Source/X2CLmusikCubeMenuBarPainter.pas
View File

@ -39,6 +39,8 @@ type
property OnChange: TNotifyEvent read FOnChange write FOnChange; property OnChange: TNotifyEvent read FOnChange write FOnChange;
public public
constructor Create(); constructor Create();
procedure Assign(Source: TPersistent); override;
function MixBorder(AColor: TColor): TColor; function MixBorder(AColor: TColor): TColor;
function MixFill(AColor: TColor): TColor; function MixFill(AColor: TColor): TColor;
@ -67,6 +69,8 @@ type
public public
constructor Create(); constructor Create();
destructor Destroy(); override; destructor Destroy(); override;
procedure Assign(Source: TPersistent); override;
published published
property Hot: TX2MenuBarmCColor read FHot write SetHot; property Hot: TX2MenuBarmCColor read FHot write SetHot;
property Normal: TX2MenuBarmCColor read FNormal write SetNormal; property Normal: TX2MenuBarmCColor read FNormal write SetNormal;
@ -350,7 +354,7 @@ begin
textBounds := itemBounds; textBounds := itemBounds;
Inc(textBounds.Left, 4); Inc(textBounds.Left, 4);
imageList := MenuBar.ImageList; imageList := MenuBar.Images;
if Assigned(imageList) then if Assigned(imageList) then
begin begin
if AItem.ImageIndex > -1 then if AItem.ImageIndex > -1 then
@ -453,6 +457,20 @@ begin
FFillColor := clNone; FFillColor := clNone;
end; end;
procedure TX2MenuBarmCColor.Assign(Source: TPersistent);
begin
if Source is TX2MenuBarmCColor then
with TX2MenuBarmCColor(Source) do
begin
Self.BorderColor := BorderColor;
Self.BorderAlpha := BorderAlpha;
Self.FillColor := FillColor;
Self.FillAlpha := FillAlpha;
end
else
inherited;
end;
procedure TX2MenuBarmCColor.DoChange(); procedure TX2MenuBarmCColor.DoChange();
begin begin
@ -559,6 +577,19 @@ begin
inherited; inherited;
end; end;
procedure TX2MenuBarmCColors.Assign(Source: TPersistent);
begin
if Source is TX2MenuBarmCColors then
with TX2MenuBarmCColors(Source) do
begin
Self.Hot.Assign(Hot);
Self.Normal.Assign(Normal);
Self.Selected.Assign(Selected);
end
else
inherited;
end;
procedure TX2MenuBarmCColors.DoChange(); procedure TX2MenuBarmCColors.DoChange();
begin begin

21
Source/X2CLunaMenuBarPainter.pas
View File

@ -240,21 +240,25 @@ begin
ACanvas.Brush.Color := $00E9E9E9; ACanvas.Brush.Color := $00E9E9E9;
{ Rounded rectangle } { Rounded rectangle }
if (mdsSelected in AState) or (mdsHot in AState) or if AGroup.Enabled and ((mdsSelected in AState) or (mdsHot in AState) or
(mdsGroupSelected in AState) then (mdsGroupSelected in AState)) then
ACanvas.Pen.Color := $00BE6363 ACanvas.Pen.Color := $00BE6363
else else
ACanvas.Pen.Color := clBlack; ACanvas.Pen.Color := clBlack;
ACanvas.Font.Color := ACanvas.Pen.Color;
ACanvas.RoundRect(ABounds.Left, ABounds.Top, ABounds.Right, ABounds.Bottom, 5, 5); ACanvas.RoundRect(ABounds.Left, ABounds.Top, ABounds.Right, ABounds.Bottom, 5, 5);
if AGroup.Enabled then
ACanvas.Font.Color := ACanvas.Pen.Color
else
ACanvas.Font.Color := clGray;
textRect := ABounds; textRect := ABounds;
Inc(textRect.Left, 4); Inc(textRect.Left, 4);
Dec(textRect.Right, 4); Dec(textRect.Right, 4);
{ Image } { Image }
imageList := AGroup.MenuBar.ImageList; imageList := AGroup.MenuBar.Images;
if Assigned(imageList) then if Assigned(imageList) then
begin begin
if AGroup.ImageIndex > -1 then if AGroup.ImageIndex > -1 then
@ -304,10 +308,13 @@ begin
end; end;
{ Text } { Text }
if (mdsSelected in AState) or (mdsHot in AState) then if AItem.Enabled then
ACanvas.Font.Color := clBlack if (mdsSelected in AState) or (mdsHot in AState) then
ACanvas.Font.Color := clBlack
else
ACanvas.Font.Color := $00404040
else else
ACanvas.Font.Color := $00404040; ACanvas.Font.Color := clSilver;
textBounds := focusBounds; textBounds := focusBounds;
Inc(textBounds.Left, 4); Inc(textBounds.Left, 4);

125
Test/MenuBar/MainForm.dfm
View File

@ -3,7 +3,7 @@ object frmMain: TfrmMain
Top = 219 Top = 219
Caption = 'X2MenuBar Test' Caption = 'X2MenuBar Test'
ClientHeight = 379 ClientHeight = 379
ClientWidth = 548 ClientWidth = 589
Color = clBtnFace Color = clBtnFace
Font.Charset = DEFAULT_CHARSET Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText Font.Color = clWindowText
@ -26,8 +26,8 @@ object frmMain: TfrmMain
ExplicitTop = -4 ExplicitTop = -4
end end
object lblAnimationTime: TLabel object lblAnimationTime: TLabel
Left = 356 Left = 424
Top = 24 Top = 20
Width = 98 Width = 98
Height = 13 Height = 13
Caption = 'Animation time (ms):' Caption = 'Animation time (ms):'
@ -38,8 +38,15 @@ object frmMain: TfrmMain
Width = 125 Width = 125
Height = 379 Height = 379
Align = alLeft Align = alLeft
AnimationStyle = asSlide Groups = <>
AnimationTime = 250 Images = glMenu
OnCollapsed = mbTestCollapsed
OnCollapsing = mbTestCollapsing
OnExpanded = mbTestExpanded
OnExpanding = mbTestExpanding
OnSelectedChanged = mbTestSelectedChanged
OnSelectedChanging = mbTestSelectedChanging
Painter = mcPainter
Groups = < Groups = <
item item
Caption = 'Share' Caption = 'Share'
@ -169,13 +176,10 @@ object frmMain: TfrmMain
Caption = 'Menu Item' Caption = 'Menu Item'
end> end>
end> end>
ImageList = glMenu
Painter = mcPainter
ExplicitLeft = 8
end end
object seAnimationTime: TJvSpinEdit object seAnimationTime: TJvSpinEdit
Left = 356 Left = 424
Top = 40 Top = 36
Width = 81 Width = 81
Height = 21 Height = 21
CheckMinValue = True CheckMinValue = True
@ -185,8 +189,8 @@ object frmMain: TfrmMain
OnChange = seAnimationTimeChange OnChange = seAnimationTimeChange
end end
object Panel1: TPanel object Panel1: TPanel
Left = 212 Left = 280
Top = 72 Top = 68
Width = 133 Width = 133
Height = 77 Height = 77
BevelOuter = bvNone BevelOuter = bvNone
@ -222,9 +226,9 @@ object frmMain: TfrmMain
end end
end end
object Panel2: TPanel object Panel2: TPanel
Left = 356 Left = 424
Top = 72 Top = 68
Width = 169 Width = 153
Height = 101 Height = 101
BevelOuter = bvNone BevelOuter = bvNone
TabOrder = 3 TabOrder = 3
@ -277,8 +281,8 @@ object frmMain: TfrmMain
end end
end end
object chkAutoCollapse: TCheckBox object chkAutoCollapse: TCheckBox
Left = 212 Left = 280
Top = 200 Top = 196
Width = 89 Width = 89
Height = 17 Height = 17
Caption = 'Auto collapse' Caption = 'Auto collapse'
@ -286,8 +290,8 @@ object frmMain: TfrmMain
OnClick = chkAutoCollapseClick OnClick = chkAutoCollapseClick
end end
object chkAllowCollapseAll: TCheckBox object chkAllowCollapseAll: TCheckBox
Left = 212 Left = 280
Top = 240 Top = 236
Width = 101 Width = 101
Height = 17 Height = 17
Caption = 'Allow collapse all' Caption = 'Allow collapse all'
@ -295,8 +299,8 @@ object frmMain: TfrmMain
OnClick = chkAllowCollapseAllClick OnClick = chkAllowCollapseAllClick
end end
object chkAutoSelectItem: TCheckBox object chkAutoSelectItem: TCheckBox
Left = 212 Left = 280
Top = 220 Top = 216
Width = 101 Width = 101
Height = 17 Height = 17
Caption = 'Auto select item' Caption = 'Auto select item'
@ -304,8 +308,8 @@ object frmMain: TfrmMain
OnClick = chkAutoSelectItemClick OnClick = chkAutoSelectItemClick
end end
object chkScrollbar: TCheckBox object chkScrollbar: TCheckBox
Left = 356 Left = 424
Top = 200 Top = 196
Width = 121 Width = 121
Height = 17 Height = 17
Caption = 'Scrollbar' Caption = 'Scrollbar'
@ -315,8 +319,8 @@ object frmMain: TfrmMain
OnClick = chkScrollbarClick OnClick = chkScrollbarClick
end end
object chkHideScrollbar: TCheckBox object chkHideScrollbar: TCheckBox
Left = 356 Left = 424
Top = 221 Top = 217
Width = 121 Width = 121
Height = 17 Height = 17
Caption = 'Hide Scrollbar' Caption = 'Hide Scrollbar'
@ -325,6 +329,77 @@ object frmMain: TfrmMain
TabOrder = 8 TabOrder = 8
OnClick = chkHideScrollbarClick OnClick = chkHideScrollbarClick
end end
object lbEvents: TListBox
Left = 152
Top = 267
Width = 421
Height = 93
ItemHeight = 13
TabOrder = 9
end
object Button1: TButton
Left = 152
Top = 68
Width = 113
Height = 25
Caption = 'SelectFirst'
Enabled = False
TabOrder = 10
end
object Button2: TButton
Left = 152
Top = 96
Width = 113
Height = 25
Caption = 'SelectPrior'
Enabled = False
TabOrder = 11
end
object Button3: TButton
Left = 152
Top = 124
Width = 113
Height = 25
Caption = 'SelectNext'
Enabled = False
TabOrder = 12
end
object Button4: TButton
Left = 152
Top = 152
Width = 113
Height = 25
Caption = 'SelectLast'
Enabled = False
TabOrder = 13
end
object Button5: TButton
Left = 152
Top = 180
Width = 113
Height = 25
Caption = 'SelectGroupByIndex'
Enabled = False
TabOrder = 14
end
object Button6: TButton
Left = 152
Top = 208
Width = 113
Height = 25
Caption = 'SelectItemByIndex'
Enabled = False
TabOrder = 15
end
object chkHotHand: TCheckBox
Left = 424
Top = 236
Width = 149
Height = 17
Caption = 'Hand cursor for hot items'
TabOrder = 16
OnClick = chkHotHandClick
end
object gcMenu: TX2GraphicContainer object gcMenu: TX2GraphicContainer
Graphics = < Graphics = <
item item

81
Test/MenuBar/MainForm.pas
View File

@ -44,6 +44,22 @@ type
chkScrollbar: TCheckBox; chkScrollbar: TCheckBox;
chkHideScrollbar: TCheckBox; chkHideScrollbar: TCheckBox;
rbSlideFade: TRadioButton; rbSlideFade: TRadioButton;
lbEvents: TListBox;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Button6: TButton;
chkHotHand: TCheckBox;
procedure mbTestSelectedChanging(Sender: TObject; Item,
NewItem: TX2CustomMenuBarItem; var Allowed: Boolean);
procedure mbTestSelectedChanged(Sender: TObject;
Item: TX2CustomMenuBarItem);
procedure chkHotHandClick(Sender: TObject);
procedure mbTestExpanding(Sender: TObject; Group: TX2MenuBarGroup; var Allowed: Boolean);
procedure mbTestExpanded(Sender: TObject; Group: TX2MenuBarGroup);
procedure mbTestCollapsing(Sender: TObject; Group: TX2MenuBarGroup; var Allowed: Boolean);
procedure mbTestCollapsed(Sender: TObject; Group: TX2MenuBarGroup);
procedure chkHideScrollbarClick(Sender: TObject); procedure chkHideScrollbarClick(Sender: TObject);
procedure chkScrollbarClick(Sender: TObject); procedure chkScrollbarClick(Sender: TObject);
procedure chkBlurShadowClick(Sender: TObject); procedure chkBlurShadowClick(Sender: TObject);
@ -54,9 +70,13 @@ type
procedure PainterClick(Sender: TObject); procedure PainterClick(Sender: TObject);
procedure AnimationClick(Sender: TObject); procedure AnimationClick(Sender: TObject);
procedure seAnimationTimeChange(Sender: TObject); procedure seAnimationTimeChange(Sender: TObject);
private
procedure Event(const AMsg: String);
end; end;
implementation implementation
uses
X2UtHandCursor;
{$R *.dfm} {$R *.dfm}
@ -104,11 +124,29 @@ begin
mbTest.HideScrollbar := chkHideScrollbar.Checked; mbTest.HideScrollbar := chkHideScrollbar.Checked;
end; end;
procedure TfrmMain.chkHotHandClick(Sender: TObject);
begin
if chkHotHand.Checked then
begin
mbTest.CursorGroup := crHandPoint;
mbTest.CursorItem := crHandPoint;
end else
begin
mbTest.CursorGroup := crDefault;
mbTest.CursorItem := crDefault;
end;
end;
procedure TfrmMain.chkScrollbarClick(Sender: TObject); procedure TfrmMain.chkScrollbarClick(Sender: TObject);
begin begin
mbTest.Scrollbar := chkScrollbar.Checked; mbTest.Scrollbar := chkScrollbar.Checked;
end; end;
procedure TfrmMain.Event(const AMsg: String);
begin
lbEvents.ItemIndex := lbEvents.Items.Add(AMsg);
end;
procedure TfrmMain.FormCreate(Sender: TObject); procedure TfrmMain.FormCreate(Sender: TObject);
begin begin
chkAutoCollapse.Checked := mbTest.AutoCollapse; chkAutoCollapse.Checked := mbTest.AutoCollapse;
@ -118,6 +156,49 @@ begin
chkHideScrollbar.Checked := mbTest.HideScrollbar; chkHideScrollbar.Checked := mbTest.HideScrollbar;
end; end;
procedure TfrmMain.mbTestCollapsed(Sender: TObject; Group: TX2MenuBarGroup);
begin
Event('OnCollapsed(' + Group.Caption + ')');
end;
procedure TfrmMain.mbTestCollapsing(Sender: TObject; Group: TX2MenuBarGroup; var Allowed: Boolean);
begin
Event('OnCollapsing(' + Group.Caption + ')');
end;
procedure TfrmMain.mbTestExpanded(Sender: TObject; Group: TX2MenuBarGroup);
begin
Event('OnExpanded(' + Group.Caption + ')');
end;
procedure TfrmMain.mbTestExpanding(Sender: TObject; Group: TX2MenuBarGroup; var Allowed: Boolean);
begin
Event('OnExpanding(' + Group.Caption + ')');
end;
procedure TfrmMain.mbTestSelectedChanged(Sender: TObject; Item: TX2CustomMenuBarItem);
begin
Event('OnSelectedChanged(' + Item.Caption + ')');
end;
procedure TfrmMain.mbTestSelectedChanging(Sender: TObject; Item, NewItem: TX2CustomMenuBarItem; var Allowed: Boolean);
var
itemCaption: String;
newItemCaption: String;
begin
itemCaption := '';
newItemCaption := '';
if Assigned(Item) then
itemCaption := Item.Caption;
if Assigned(NewItem) then
newItemCaption := NewItem.Caption;
Event('OnSelectedChanging(' + itemCaption + ', ' + newItemCaption + ')');
end;
procedure TfrmMain.PainterClick(Sender: TObject); procedure TfrmMain.PainterClick(Sender: TObject);
begin begin
if rbmusikCube.Checked then if rbmusikCube.Checked then