1
0
mirror of synced 2024-11-22 01:53:50 +00:00

Added: CursorGroup/Item properties

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

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.

View File

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

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

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.

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.4 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.4 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.4 KiB

View File

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

View File

@ -40,6 +40,8 @@ type
public
constructor Create();
procedure Assign(Source: TPersistent); override;
function MixBorder(AColor: TColor): TColor;
function MixFill(AColor: TColor): TColor;
published
@ -67,6 +69,8 @@ type
public
constructor Create();
destructor Destroy(); override;
procedure Assign(Source: TPersistent); override;
published
property Hot: TX2MenuBarmCColor read FHot write SetHot;
property Normal: TX2MenuBarmCColor read FNormal write SetNormal;
@ -350,7 +354,7 @@ begin
textBounds := itemBounds;
Inc(textBounds.Left, 4);
imageList := MenuBar.ImageList;
imageList := MenuBar.Images;
if Assigned(imageList) then
begin
if AItem.ImageIndex > -1 then
@ -453,6 +457,20 @@ begin
FFillColor := clNone;
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();
begin
@ -559,6 +577,19 @@ begin
inherited;
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();
begin

View File

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

View File

@ -3,7 +3,7 @@ object frmMain: TfrmMain
Top = 219
Caption = 'X2MenuBar Test'
ClientHeight = 379
ClientWidth = 548
ClientWidth = 589
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
@ -26,8 +26,8 @@ object frmMain: TfrmMain
ExplicitTop = -4
end
object lblAnimationTime: TLabel
Left = 356
Top = 24
Left = 424
Top = 20
Width = 98
Height = 13
Caption = 'Animation time (ms):'
@ -38,8 +38,15 @@ object frmMain: TfrmMain
Width = 125
Height = 379
Align = alLeft
AnimationStyle = asSlide
AnimationTime = 250
Groups = <>
Images = glMenu
OnCollapsed = mbTestCollapsed
OnCollapsing = mbTestCollapsing
OnExpanded = mbTestExpanded
OnExpanding = mbTestExpanding
OnSelectedChanged = mbTestSelectedChanged
OnSelectedChanging = mbTestSelectedChanging
Painter = mcPainter
Groups = <
item
Caption = 'Share'
@ -169,13 +176,10 @@ object frmMain: TfrmMain
Caption = 'Menu Item'
end>
end>
ImageList = glMenu
Painter = mcPainter
ExplicitLeft = 8
end
object seAnimationTime: TJvSpinEdit
Left = 356
Top = 40
Left = 424
Top = 36
Width = 81
Height = 21
CheckMinValue = True
@ -185,8 +189,8 @@ object frmMain: TfrmMain
OnChange = seAnimationTimeChange
end
object Panel1: TPanel
Left = 212
Top = 72
Left = 280
Top = 68
Width = 133
Height = 77
BevelOuter = bvNone
@ -222,9 +226,9 @@ object frmMain: TfrmMain
end
end
object Panel2: TPanel
Left = 356
Top = 72
Width = 169
Left = 424
Top = 68
Width = 153
Height = 101
BevelOuter = bvNone
TabOrder = 3
@ -277,8 +281,8 @@ object frmMain: TfrmMain
end
end
object chkAutoCollapse: TCheckBox
Left = 212
Top = 200
Left = 280
Top = 196
Width = 89
Height = 17
Caption = 'Auto collapse'
@ -286,8 +290,8 @@ object frmMain: TfrmMain
OnClick = chkAutoCollapseClick
end
object chkAllowCollapseAll: TCheckBox
Left = 212
Top = 240
Left = 280
Top = 236
Width = 101
Height = 17
Caption = 'Allow collapse all'
@ -295,8 +299,8 @@ object frmMain: TfrmMain
OnClick = chkAllowCollapseAllClick
end
object chkAutoSelectItem: TCheckBox
Left = 212
Top = 220
Left = 280
Top = 216
Width = 101
Height = 17
Caption = 'Auto select item'
@ -304,8 +308,8 @@ object frmMain: TfrmMain
OnClick = chkAutoSelectItemClick
end
object chkScrollbar: TCheckBox
Left = 356
Top = 200
Left = 424
Top = 196
Width = 121
Height = 17
Caption = 'Scrollbar'
@ -315,8 +319,8 @@ object frmMain: TfrmMain
OnClick = chkScrollbarClick
end
object chkHideScrollbar: TCheckBox
Left = 356
Top = 221
Left = 424
Top = 217
Width = 121
Height = 17
Caption = 'Hide Scrollbar'
@ -325,6 +329,77 @@ object frmMain: TfrmMain
TabOrder = 8
OnClick = chkHideScrollbarClick
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
Graphics = <
item

View File

@ -44,6 +44,22 @@ type
chkScrollbar: TCheckBox;
chkHideScrollbar: TCheckBox;
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 chkScrollbarClick(Sender: TObject);
procedure chkBlurShadowClick(Sender: TObject);
@ -54,9 +70,13 @@ type
procedure PainterClick(Sender: TObject);
procedure AnimationClick(Sender: TObject);
procedure seAnimationTimeChange(Sender: TObject);
private
procedure Event(const AMsg: String);
end;
implementation
uses
X2UtHandCursor;
{$R *.dfm}
@ -104,11 +124,29 @@ begin
mbTest.HideScrollbar := chkHideScrollbar.Checked;
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);
begin
mbTest.Scrollbar := chkScrollbar.Checked;
end;
procedure TfrmMain.Event(const AMsg: String);
begin
lbEvents.ItemIndex := lbEvents.Items.Add(AMsg);
end;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
chkAutoCollapse.Checked := mbTest.AutoCollapse;
@ -118,6 +156,49 @@ begin
chkHideScrollbar.Checked := mbTest.HideScrollbar;
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);
begin
if rbmusikCube.Checked then