1
0
mirror of synced 2024-11-13 06:29:16 +00:00

Added: Action support

Added: TX2Color32 type
Fixed: re-selecting the items when designer is activated
This commit is contained in:
Mark van Renswoude 2006-05-22 05:13:12 +00:00
parent a401e01dd9
commit 7ca9314af1
10 changed files with 628 additions and 336 deletions

View File

@ -14,6 +14,7 @@ object frmMenuBarEditor: TfrmMenuBarEditor
FormStyle = fsStayOnTop FormStyle = fsStayOnTop
OldCreateOrder = False OldCreateOrder = False
Position = poOwnerFormCenter Position = poOwnerFormCenter
OnActivate = FormActivate
OnClose = FormClose OnClose = FormClose
OnCreate = FormCreate OnCreate = FormCreate
OnDestroy = FormDestroy OnDestroy = FormDestroy
@ -30,9 +31,6 @@ object frmMenuBarEditor: TfrmMenuBarEditor
ReadOnly = True ReadOnly = True
TabOrder = 0 TabOrder = 0
OnChange = tvMenuChange OnChange = tvMenuChange
ExplicitTop = 20
ExplicitWidth = 252
ExplicitHeight = 281
end end
object sbStatus: TStatusBar object sbStatus: TStatusBar
Left = 0 Left = 0
@ -43,8 +41,6 @@ object frmMenuBarEditor: TfrmMenuBarEditor
item item
Width = 50 Width = 50
end> end>
ExplicitTop = 307
ExplicitWidth = 252
end end
object tbMenu: TToolBar object tbMenu: TToolBar
Left = 0 Left = 0
@ -58,7 +54,6 @@ object frmMenuBarEditor: TfrmMenuBarEditor
List = True List = True
ShowCaptions = True ShowCaptions = True
TabOrder = 2 TabOrder = 2
ExplicitWidth = 252
object tbAddGroup: TToolButton object tbAddGroup: TToolButton
Left = 0 Left = 0
Top = 0 Top = 0

View File

@ -35,6 +35,7 @@ type
procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormDestroy(Sender: TObject); procedure FormDestroy(Sender: TObject);
procedure tvMenuChange(Sender: TObject; Node: TTreeNode); procedure tvMenuChange(Sender: TObject; Node: TTreeNode);
procedure FormActivate(Sender: TObject);
private private
FDesigner: IDesigner; FDesigner: IDesigner;
FMenuBar: TX2CustomMenuBar; FMenuBar: TX2CustomMenuBar;
@ -114,6 +115,22 @@ begin
{$ENDIF} {$ENDIF}
end; end;
procedure TfrmMenuBarEditor.FormActivate(Sender: TObject);
var
item: TX2CustomMenuBarItem;
begin
if Assigned(tvMenu.Selected) then
begin
item := TX2CustomMenuBarItem(tvMenu.Selected.Data);
if Assigned(Designer) then
Designer.SelectComponent(item);
end;
UpdateUI();
end;
procedure TfrmMenuBarEditor.FormClose(Sender: TObject; var Action: TCloseAction); procedure TfrmMenuBarEditor.FormClose(Sender: TObject; var Action: TCloseAction);
begin begin
if Assigned(Designer) and Assigned(MenuBar) then if Assigned(Designer) and Assigned(MenuBar) then

93
Source/X2CLGraphics.pas Normal file
View File

@ -0,0 +1,93 @@
{
:: Implements various graphics-related classes and functions.
::
:: Part of the X2Software Component Library
:: http://www.x2software.net/
::
:: Last changed: $Date$
:: Revision: $Rev$
:: Author: $Author$
}
unit X2CLGraphics;
interface
uses
Graphics;
type
TX2Color32 = type TColor;
function Color32(AColor: TColor; AAlpha: Byte = 255): TX2Color32;
function DelphiColor(AColor: TX2Color32): TColor;
function RedValue(AColor: TX2Color32): Byte;
function GreenValue(AColor: TX2Color32): Byte;
function BlueValue(AColor: TX2Color32): Byte;
function AlphaValue(AColor: TX2Color32): Byte;
function Blend(ABackground: TColor; AForeground: TX2Color32): TColor;
implementation
uses
Windows;
function Color32(AColor: TColor; AAlpha: Byte): TX2Color32;
begin
Result := (ColorToRGB(AColor) and $00FFFFFF) or (AAlpha shl 24);
end;
function DelphiColor(AColor: TX2Color32): TColor;
begin
Result := (AColor and $00FFFFFF);
end;
function RedValue(AColor: TX2Color32): Byte;
begin
Result := (AColor and $000000FF);
end;
function GreenValue(AColor: TX2Color32): Byte;
begin
Result := (AColor and $0000FF00) shr 8;
end;
function BlueValue(AColor: TX2Color32): Byte;
begin
Result := (AColor and $00FF0000) shr 16;
end;
function AlphaValue(AColor: TX2Color32): Byte;
begin
Result := (AColor and $FF000000) shr 24;
end;
function Blend(ABackground: TColor; AForeground: TX2Color32): TColor;
var
backColor: TX2Color32;
backAlpha: Integer;
foreAlpha: Integer;
begin
foreAlpha := AlphaValue(AForeground);
if foreAlpha = 0 then
Result := ABackground
else if foreAlpha = 255 then
Result := DelphiColor(AForeground)
else
begin
backColor := Color32(ABackground);
backAlpha := 256 - foreAlpha;
Result := RGB(((RedValue(backColor) * backAlpha) +
(RedValue(AForeground) * foreAlpha)) shr 8,
((GreenValue(backColor) * backAlpha) +
(GreenValue(AForeground) * foreAlpha)) shr 8,
((BlueValue(backColor) * backAlpha) +
(BlueValue(AForeground) * foreAlpha)) shr 8);
end;
end;
end.

View File

@ -2,6 +2,9 @@
:: X2CLMenuBar is a generic group/items menu. Through the various painters, :: X2CLMenuBar is a generic group/items menu. Through the various painters,
:: it can resemble styles such as the musikCube or BBox/Uname-IT menu bars. :: it can resemble styles such as the musikCube or BBox/Uname-IT menu bars.
:: ::
:: Part of the X2Software Component Library
:: http://www.x2software.net/
::
:: Last changed: $Date$ :: Last changed: $Date$
:: Revision: $Rev$ :: Revision: $Rev$
:: Author: $Author$ :: Author: $Author$
@ -10,6 +13,7 @@ unit X2CLMenuBar;
interface interface
uses uses
ActnList,
Classes, Classes,
Contnrs, Contnrs,
Controls, Controls,
@ -31,7 +35,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: OnGetAnimationClass event? // #ToDo1 (MvR) 29-4-2006: action support
TX2CustomMenuBarAnimatorClass = class of TX2CustomMenuBarAnimator; TX2CustomMenuBarAnimatorClass = class of TX2CustomMenuBarAnimator;
TX2CustomMenuBarAnimator = class; TX2CustomMenuBarAnimator = class;
TX2CustomMenuBarPainterClass = class of TX2CustomMenuBarPainter; TX2CustomMenuBarPainterClass = class of TX2CustomMenuBarPainter;
@ -62,6 +66,7 @@ type
TX2MenuBarSelectAction = (saBefore, saAfter, saBoth); TX2MenuBarSelectAction = (saBefore, saAfter, saBoth);
TX2ComponentNotificationEvent = procedure(Sender: TObject; AComponent: TComponent; Operation: TOperation) of object;
TX2MenuBarExpandingEvent = procedure(Sender: TObject; Group: TX2MenuBarGroup; var Allowed: Boolean) of object; TX2MenuBarExpandingEvent = procedure(Sender: TObject; Group: TX2MenuBarGroup; var Allowed: Boolean) of object;
TX2MenuBarExpandedEvent = procedure(Sender: TObject; Group: TX2MenuBarGroup) of object; TX2MenuBarExpandedEvent = procedure(Sender: TObject; Group: TX2MenuBarGroup) of object;
TX2MenuBarSelectedChangingEvent = procedure(Sender: TObject; Item, NewItem: TX2CustomMenUBarItem; var Allowed: Boolean) of object; TX2MenuBarSelectedChangingEvent = procedure(Sender: TObject; Item, NewItem: TX2CustomMenUBarItem; var Allowed: Boolean) of object;
@ -158,19 +163,63 @@ type
procedure DetachObserver(AObserver: IX2MenuBarPainterObserver); procedure DetachObserver(AObserver: IX2MenuBarPainterObserver);
end; end;
{
:$ Action link for menu items and groups.
}
TX2MenuBarActionLink = class(TActionLink)
private
FClient: TX2CustomMenuBarItem;
protected
procedure AssignClient(AClient: TObject); override;
function IsCaptionLinked(): Boolean; override;
function IsEnabledLinked(): Boolean; override;
function IsImageIndexLinked(): Boolean; override;
function IsVisibleLinked(): Boolean; override;
procedure SetCaption(const Value: string); override;
procedure SetEnabled(Value: Boolean); override;
procedure SetImageIndex(Value: Integer); override;
procedure SetVisible(Value: Boolean); override;
property Client: TX2CustomMenuBarItem read FClient;
end;
{
:$ Provides component notifications for collection items.
}
TX2ComponentNotification = class(TComponent)
private
FOnNotification: TX2ComponentNotificationEvent;
published
protected
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
published
property OnNotification: TX2ComponentNotificationEvent read FOnNotification write FOnNotification;
end;
{ {
:$ Base class for menu items and groups. :$ Base class for menu items and groups.
} }
TX2CustomMenuBarItem = class(TCollectionItem) TX2CustomMenuBarItem = class(TCollectionItem)
private private
FAction: TBasicAction;
FActionLink: TX2MenuBarActionLink;
FCaption: String; FCaption: String;
FData: TObject; FData: TObject;
FEnabled: Boolean; FEnabled: Boolean;
FImageIndex: TImageIndex; FImageIndex: TImageIndex;
FOwnsData: Boolean; FOwnsData: Boolean;
FVisible: Boolean; FVisible: Boolean;
FNotification: TX2ComponentNotification;
private
procedure DoActionChange(Sender: TObject);
protected protected
procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); virtual;
function IsCaptionStored(): Boolean; virtual;
function GetMenuBar(): TX2CustomMenuBar; virtual; function GetMenuBar(): TX2CustomMenuBar; virtual;
procedure SetAction(const Value: TBasicAction);
procedure SetCaption(const Value: String); virtual; procedure SetCaption(const Value: String); virtual;
procedure SetData(const Value: TObject); virtual; procedure SetData(const Value: TObject); virtual;
procedure SetEnabled(const Value: Boolean); virtual; procedure SetEnabled(const Value: Boolean); virtual;
@ -182,11 +231,13 @@ type
procedure Assign(Source: TPersistent); override; procedure Assign(Source: TPersistent); override;
property ActionLink: TX2MenuBarActionLink read FActionLink;
property Data: TObject read FData write SetData; property Data: TObject read FData write SetData;
property OwnsData: Boolean read FOwnsData write FOwnsData; property OwnsData: Boolean read FOwnsData write FOwnsData;
property MenuBar: TX2CustomMenuBar read GetMenuBar; property MenuBar: TX2CustomMenuBar read GetMenuBar;
published published
property Caption: String read FCaption write SetCaption; property Action: TBasicAction read FAction write SetAction;
property Caption: String read FCaption write SetCaption stored IsCaptionStored;
property Enabled: Boolean read FEnabled write SetEnabled default True; property Enabled: Boolean read FEnabled write SetEnabled default True;
property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1; property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1;
property Visible: Boolean read FVisible write SetVisible default True; property Visible: Boolean read FVisible write SetVisible default True;
@ -213,6 +264,8 @@ type
TX2MenuBarItem = class(TX2CustomMenuBarItem) TX2MenuBarItem = class(TX2CustomMenuBarItem)
private private
function GetGroup(): TX2MenuBarGroup; function GetGroup(): TX2MenuBarGroup;
protected
function IsCaptionStored(): Boolean; override;
public public
constructor Create(Collection: TCollection); override; constructor Create(Collection: TCollection); override;
@ -247,6 +300,8 @@ type
procedure SetExpanded(const Value: Boolean); procedure SetExpanded(const Value: Boolean);
procedure SetItems(const Value: TX2MenuBarItems); procedure SetItems(const Value: TX2MenuBarItems);
protected protected
protected
function IsCaptionStored(): Boolean; override;
procedure SetEnabled(const Value: Boolean); override; procedure SetEnabled(const Value: Boolean); override;
procedure InternalSetExpanded(const Value: Boolean); procedure InternalSetExpanded(const Value: Boolean);
@ -394,6 +449,15 @@ 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;
function SelectFirst(): TX2CustomMenuBarItem;
function SelectLast(): TX2CustomMenuBarItem;
function SelectNext(): TX2CustomMenuBarItem;
function SelectPrior(): TX2CustomMenuBarItem;
function SelectGroup(AIndex: Integer): TX2MenuBarGroup;
function SelectItem(AIndex: Integer; AGroup: TX2MenuBarGroup = nil): TX2CustomMenuBarItem; overload;
function SelectItem(AIndex: Integer; AGroup: Integer = -1): TX2CustomMenuBarItem; overload;
property Groups: TX2MenuBarGroups read FGroups write SetGroups; property Groups: TX2MenuBarGroups read FGroups write SetGroups;
property Images: TCustomImageList read FImages write SetImages; property Images: TCustomImageList read FImages write SetImages;
property Painter: TX2CustomMenuBarPainter read FPainter write SetPainter; property Painter: TX2CustomMenuBarPainter read FPainter write SetPainter;
@ -768,6 +832,72 @@ begin
end; end;
{ TX2MenuBarActionLink }
procedure TX2MenuBarActionLink.AssignClient(AClient: TObject);
begin
FClient := (AClient as TX2CustomMenuBarItem);
end;
function TX2MenuBarActionLink.IsCaptionLinked(): Boolean;
begin
Result := inherited IsCaptionLinked() and
(Client.Caption = (Action as TCustomAction).Caption);
end;
function TX2MenuBarActionLink.IsEnabledLinked(): Boolean;
begin
Result := inherited IsCaptionLinked() and
(Client.Enabled = (Action as TCustomAction).Enabled);
end;
function TX2MenuBarActionLink.IsImageIndexLinked(): Boolean;
begin
Result := inherited IsCaptionLinked() and
(Client.ImageIndex = (Action as TCustomAction).ImageIndex);
end;
function TX2MenuBarActionLink.IsVisibleLinked(): Boolean;
begin
Result := inherited IsCaptionLinked() and
(Client.Visible = (Action as TCustomAction).Visible);
end;
procedure TX2MenuBarActionLink.SetCaption(const Value: string);
begin
if IsCaptionLinked() then
Client.Caption := Value;
end;
procedure TX2MenuBarActionLink.SetEnabled(Value: Boolean);
begin
if IsEnabledLinked() then
Client.Enabled := Value;
end;
procedure TX2MenuBarActionLink.SetImageIndex(Value: Integer);
begin
if IsImageIndexLinked() then
Client.ImageIndex := Value;
end;
procedure TX2MenuBarActionLink.SetVisible(Value: Boolean);
begin
if IsVisibleLinked() then
Client.Visible := Value;
end;
{ TX2ComponentNotification }
procedure TX2ComponentNotification.Notification(AComponent: TComponent;
Operation: TOperation);
begin
if Assigned(FOnNotification) then
FOnNotification(Self, AComponent, Operation);
inherited;
end;
{ TX2CustomMenuBarItem } { TX2CustomMenuBarItem }
constructor TX2CustomMenuBarItem.Create(Collection: TCollection); constructor TX2CustomMenuBarItem.Create(Collection: TCollection);
begin begin
@ -782,11 +912,59 @@ end;
destructor TX2CustomMenuBarItem.Destroy(); destructor TX2CustomMenuBarItem.Destroy();
begin begin
Data := nil; Data := nil;
FreeAndNil(FActionLink);
FreeAndNil(FNotification);
inherited; inherited;
end; end;
procedure TX2CustomMenuBarItem.Assign(Source: TPersistent);
begin
if Source is TX2CustomMenuBarItem then
with TX2CustomMenuBarItem(Source) do
begin
Self.Caption := Caption;
Self.Data := Data;
Self.OwnsData := OwnsData;
end
else
inherited;
end;
procedure TX2CustomMenuBarItem.DoActionChange(Sender: TObject);
begin
if Sender = Action then
ActionChange(Sender, False);
end;
procedure TX2CustomMenuBarItem.ActionChange(Sender: TObject;
CheckDefaults: Boolean);
begin
if Sender is TCustomAction then
with TCustomAction(Sender) do
begin
if (not CheckDefaults) or (not Self.IsCaptionStored()) then
Self.Caption := Caption;
if (not CheckDefaults) or Self.Enabled then
Self.Enabled := Enabled;
if (not CheckDefaults) or (Self.ImageIndex = -1) then
Self.ImageIndex := ImageIndex;
if (not CheckDefaults) or Self.Visible then
Self.Visible := Visible;
end;
end;
function TX2CustomMenuBarItem.IsCaptionStored(): Boolean;
begin
Result := (Length(Caption) > 0);
end;
function TX2CustomMenuBarItem.GetMenuBar(): TX2CustomMenuBar; function TX2CustomMenuBarItem.GetMenuBar(): TX2CustomMenuBar;
var var
parentCollection: TCollection; parentCollection: TCollection;
@ -814,19 +992,37 @@ begin
end; end;
end; end;
procedure TX2CustomMenuBarItem.Assign(Source: TPersistent); procedure TX2CustomMenuBarItem.SetAction(const Value: TBasicAction);
begin begin
if Source is TX2CustomMenuBarItem then if Value <> FAction then
with TX2CustomMenuBarItem(Source) do
begin begin
Self.Caption := Caption; if Assigned(FAction) then
Self.Data := Data; FAction.RemoveFreeNotification(FNotification);
Self.OwnsData := OwnsData;
end
else
inherited;
end;
FAction := Value;
if Assigned(FAction) then
begin
if not Assigned(FActionLink) then
begin
FActionLink := TX2MenuBarActionLink.Create(Self);
FActionLink.OnChange := DoActionChange;
end;
FActionLink.Action := Value;
if not Assigned(FNotification) then
FNotification := TX2ComponentNotification.Create(nil);
ActionChange(Value, csLoading in Value.ComponentState);
FAction.FreeNotification(FNotification);
end else
begin
FreeAndNil(FActionLink);
FreeAndNil(FNotification);
end;
end;
end;
procedure TX2CustomMenuBarItem.SetCaption(const Value: String); procedure TX2CustomMenuBarItem.SetCaption(const Value: String);
begin begin
@ -902,6 +1098,13 @@ begin
inherited; inherited;
end; end;
function TX2MenuBarItem.IsCaptionStored(): Boolean;
begin
Result := (Caption <> SDefaultItemCaption);
end;
function TX2MenuBarItem.GetGroup(): TX2MenuBarGroup; function TX2MenuBarItem.GetGroup(): TX2MenuBarGroup;
begin begin
Result := nil; Result := nil;
@ -1019,6 +1222,11 @@ begin
groupCollection.Update(Item); groupCollection.Update(Item);
end; end;
function TX2MenuBarGroup.IsCaptionStored(): Boolean;
begin
Result := (Caption <> SDefaultGroupCaption);
end;
procedure TX2MenuBarGroup.SetEnabled(const Value: Boolean); procedure TX2MenuBarGroup.SetEnabled(const Value: Boolean);
begin begin
inherited; inherited;
@ -1666,6 +1874,58 @@ begin
end; end;
function TX2CustomMenuBar.SelectFirst(): TX2CustomMenuBarItem;
begin
// #ToDo1 (MvR) 29-4-2006: implement this
Result := nil;
end;
function TX2CustomMenuBar.SelectLast(): TX2CustomMenuBarItem;
begin
// #ToDo1 (MvR) 29-4-2006: implement this
Result := nil;
end;
function TX2CustomMenuBar.SelectNext(): TX2CustomMenuBarItem;
begin
// #ToDo1 (MvR) 29-4-2006: implement this
Result := nil;
end;
function TX2CustomMenuBar.SelectPrior(): TX2CustomMenuBarItem;
begin
// #ToDo1 (MvR) 29-4-2006: implement this
Result := nil;
end;
function TX2CustomMenuBar.SelectGroup(AIndex: Integer): TX2MenuBarGroup;
begin
// #ToDo1 (MvR) 29-4-2006: implement this
Result := nil;
end;
function TX2CustomMenuBar.SelectItem(AIndex: Integer;
AGroup: TX2MenuBarGroup): TX2CustomMenuBarItem;
begin
// #ToDo1 (MvR) 29-4-2006: implement this
Result := nil;
end;
function TX2CustomMenuBar.SelectItem(AIndex, AGroup: Integer): TX2CustomMenuBarItem;
var
group: TX2MenuBarGroup;
begin
group := nil;
if (AGroup > 0) and (AGroup < Groups.Count) then
group := Groups[AGroup];
Result := SelectItem(AIndex, group);
end;
procedure TX2CustomMenuBar.Notification(AComponent: TComponent; Operation: TOperation); procedure TX2CustomMenuBar.Notification(AComponent: TComponent; Operation: TOperation);
begin begin
if Operation = opRemove then if Operation = opRemove then
@ -2107,6 +2367,9 @@ begin
end; end;
end; end;
if Assigned(FSelectedItem) and Assigned(FSelectedItem.Action) then
FSelectedItem.ActionLink.Execute(Self);
DoSelectedChanged(); DoSelectedChanged();
Invalidate(); Invalidate();
end; end;

View File

@ -1,7 +1,9 @@
{ {
:: Implements the animators for the MenuBar. :: Implements the animators for the MenuBar. Though they are tightly
:: interlinked (for now), this keeps the main unit clean.
:: ::
:: Though they are tightly interlinked (for now), this keeps the units clean. :: Part of the X2Software Component Library
:: http://www.x2software.net/
:: ::
:: Last changed: $Date$ :: Last changed: $Date$
:: Revision: $Rev$ :: Revision: $Rev$

View File

@ -1,6 +1,9 @@
{ {
:: Implements a musikCube-style painter for the X2MenuBar. :: Implements a musikCube-style painter for the X2MenuBar.
:: ::
:: Part of the X2Software Component Library
:: http://www.x2software.net/
::
:: Last changed: $Date$ :: Last changed: $Date$
:: Revision: $Rev$ :: Revision: $Rev$
:: Author: $Author$ :: Author: $Author$
@ -14,41 +17,35 @@ uses
ImgList, ImgList,
Windows, Windows,
X2CLGraphics,
X2CLMenuBar; X2CLMenuBar;
type type
// #ToDo1 (MvR) 19-3-2006: IsStored implementations
// #ToDo1 (MvR) 19-3-2006: cache positions
TX2MenuBarmCColor = class(TPersistent) TX2MenuBarmCColor = class(TPersistent)
private private
FBorderAlpha: Byte; FBorder: TX2Color32;
FBorderColor: TColor; FFill: TX2Color32;
FFillAlpha: Byte; FDefaultBorder: TX2Color32;
FFillColor: TColor; FDefaultFill: TX2Color32;
FOnChange: TNotifyEvent; FOnChange: TNotifyEvent;
procedure SetBorderAlpha(const Value: Byte); procedure SetBorder(const Value: TX2Color32);
procedure SetBorderColor(const Value: TColor); procedure SetFill(const Value: TX2Color32);
procedure SetFillAlpha(const Value: Byte); function IsBorderStored(): Boolean;
procedure SetFillColor(const Value: TColor); function IsFillStored(): Boolean;
protected protected
procedure DoChange(); procedure DoChange();
function MixColors(ABackColor, AForeColor: TColor; AAlpha: Byte): TColor; procedure SetDefaultColors(ABorder, AFill: TX2Color32);
property DefaultBorder: TX2Color32 read FDefaultBorder write FDefaultBorder;
property DefaultFill: TX2Color32 read FDefaultFill write FDefaultFill;
property OnChange: TNotifyEvent read FOnChange write FOnChange; property OnChange: TNotifyEvent read FOnChange write FOnChange;
public public
constructor Create();
procedure Assign(Source: TPersistent); override; procedure Assign(Source: TPersistent); override;
function MixBorder(AColor: TColor): TColor;
function MixFill(AColor: TColor): TColor;
published published
property BorderColor: TColor read FBorderColor write SetBorderColor; property Border: TX2Color32 read FBorder write SetBorder stored IsBorderStored;
property BorderAlpha: Byte read FBorderAlpha write SetBorderAlpha; property Fill: TX2Color32 read FFill write SetFill stored IsFillStored;
property FillColor: TColor read FFillColor write SetFillColor;
property FillAlpha: Byte read FFillAlpha write SetFillAlpha;
end; end;
TX2MenuBarmCColors = class(TPersistent) TX2MenuBarmCColors = class(TPersistent)
@ -156,57 +153,28 @@ end;
procedure TX2MenuBarmusikCubePainter.ResetColors(); procedure TX2MenuBarmusikCubePainter.ResetColors();
begin begin
{ Group buttons } { Group buttons }
with GroupColors.Hot do GroupColors.Hot.SetDefaultColors( Color32(clBtnShadow),
begin Color32(clBtnShadow, 128));
BorderColor := clBtnShadow;
FillAlpha := 128;
FillColor := clBtnShadow;
end;
with GroupColors.Normal do GroupColors.Normal.SetDefaultColors( Color32(clBtnShadow, 64),
begin Color32(clBtnShadow, 64));
BorderAlpha := 64;
BorderColor := clBtnShadow;
FillAlpha := 64;
FillColor := clBtnShadow;
end;
with GroupColors.Selected do GroupColors.Selected.SetDefaultColors(Color32(clBtnShadow),
begin Color32(clBtnHighlight));
BorderColor := clBtnShadow;
FillColor := clBtnHighlight;
end;
{ Indicator } { Indicator }
with IndicatorColors.Selected do IndicatorColors.Selected.SetDefaultColors(Color32(clActiveCaption, 252),
begin Color32(clActiveCaption, 252));
BorderAlpha := 252;
BorderColor := clActiveCaption;
FillAlpha := 252;
FillColor := clActiveCaption;
end;
{ Item buttons } { Item buttons }
with ItemColors.Hot do ItemColors.Hot.SetDefaultColors( Color32(clBtnShadow),
begin Color32(clBtnHighlight, 114));
BorderColor := clBtnShadow;
FillAlpha := 114;
FillColor := clBtnHighlight;
end;
with ItemColors.Normal do ItemColors.Normal.SetDefaultColors( Color32(clBtnHighlight, 50),
begin Color32(clBtnHighlight, 50));
BorderAlpha := 50;
BorderColor := clBtnHighlight;
FillAlpha := 50;
FillColor := clBtnHighlight;
end;
with ItemColors.Selected do ItemColors.Selected.SetDefaultColors( Color32(clBtnShadow),
begin Color32(clBtnHighlight));
BorderColor := clBtnShadow;
FillColor := clBtnHighlight;
end;
end; end;
@ -294,9 +262,9 @@ begin
begin begin
groupColor := GetColor(GroupColors, AState); groupColor := GetColor(GroupColors, AState);
Brush.Color := groupColor.MixFill(Color); Brush.Color := Blend(Color, groupColor.Fill);
Brush.Style := bsSolid; Brush.Style := bsSolid;
Pen.Color := groupColor.MixBorder(Color); Pen.Color := Blend(Color, groupColor.Border);
Pen.Style := psSolid; Pen.Style := psSolid;
Rectangle(ABounds); Rectangle(ABounds);
@ -338,16 +306,16 @@ begin
itemBounds := ABounds; itemBounds := ABounds;
indicatorBounds := itemBounds; indicatorBounds := itemBounds;
indicatorBounds.Right := indicatorBounds.Left + 6; indicatorBounds.Right := indicatorBounds.Left + 6;
Brush.Color := indicatorColor.MixFill(Color); Brush.Color := Blend(Color, indicatorColor.Fill);
Brush.Style := bsSolid; Brush.Style := bsSolid;
Pen.Color := indicatorColor.MixBorder(Color); Pen.Color := Blend(Color, indicatorColor.Border);
Pen.Style := psSolid; Pen.Style := psSolid;
Rectangle(itemBounds); Rectangle(itemBounds);
itemBounds.Left := indicatorBounds.Right; itemBounds.Left := indicatorBounds.Right;
Brush.Color := itemColor.MixFill(Color); Brush.Color := Blend(Color, itemColor.Fill);
Brush.Style := bsSolid; Brush.Style := bsSolid;
Pen.Color := itemColor.MixBorder(Color); Pen.Color := Blend(Color, itemColor.Border);
Pen.Style := psSolid; Pen.Style := psSolid;
Rectangle(itemBounds); Rectangle(itemBounds);
@ -447,25 +415,15 @@ end;
{ TX2MenuBarmCColor } { TX2MenuBarmCColor }
constructor TX2MenuBarmCColor.Create();
begin
inherited;
FBorderAlpha := 255;
FBorderColor := clNone;
FFillAlpha := 255;
FFillColor := clNone;
end;
procedure TX2MenuBarmCColor.Assign(Source: TPersistent); procedure TX2MenuBarmCColor.Assign(Source: TPersistent);
begin begin
if Source is TX2MenuBarmCColor then if Source is TX2MenuBarmCColor then
with TX2MenuBarmCColor(Source) do with TX2MenuBarmCColor(Source) do
begin begin
Self.BorderColor := BorderColor; Self.DefaultBorder := DefaultBorder;
Self.BorderAlpha := BorderAlpha; Self.DefaultFill := DefaultFill;
Self.FillColor := FillColor; Self.Border := Border;
Self.FillAlpha := FillAlpha; Self.Fill := Fill;
end end
else else
inherited; inherited;
@ -478,77 +436,39 @@ begin
FOnChange(Self); FOnChange(Self);
end; end;
procedure TX2MenuBarmCColor.SetDefaultColors(ABorder, AFill: TX2Color32);
function TX2MenuBarmCColor.MixColors(ABackColor, AForeColor: TColor;
AAlpha: Byte): TColor;
var
cBack: Cardinal;
cFore: Cardinal;
bBack: Byte;
begin begin
{ Source: X2UtGraphics.BlendColors } FDefaultBorder := ABorder;
cBack := ColorToRGB(ABackColor); FDefaultFill := AFill;
cFore := ColorToRGB(AForeColor); FBorder := ABorder;
bBack := 255 - AAlpha; FFill := AFill;
Result := RGB(((GetRValue(cBack) * bBack) +
(GetRValue(cFore) * AAlpha)) shr 8,
((GetGValue(cBack) * bBack) +
(GetGValue(cFore) * AAlpha)) shr 8,
((GetBValue(cBack) * bBack) +
(GetBValue(cFore) * AAlpha)) shr 8);
end;
function TX2MenuBarmCColor.MixBorder(AColor: TColor): TColor;
begin
if BorderColor = clNone then
Result := AColor
else
Result := MixColors(AColor, BorderColor, BorderAlpha);
end;
function TX2MenuBarmCColor.MixFill(AColor: TColor): TColor;
begin
if FillColor = clNone then
Result := AColor
else
Result := MixColors(AColor, FillColor, FillAlpha);
end; end;
procedure TX2MenuBarmCColor.SetBorderAlpha(const Value: Byte); function TX2MenuBarmCColor.IsBorderStored(): Boolean;
begin begin
if Value <> FBorderAlpha then Result := (FBorder <> FDefaultBorder);
end;
function TX2MenuBarmCColor.IsFillStored(): Boolean;
begin
Result := (FFill <> FDefaultFill);
end;
procedure TX2MenuBarmCColor.SetBorder(const Value: TX2Color32);
begin
if Value <> FBorder then
begin begin
FBorderAlpha := Value; FBorder := Value;
DoChange(); DoChange();
end; end;
end; end;
procedure TX2MenuBarmCColor.SetBorderColor(const Value: TColor); procedure TX2MenuBarmCColor.SetFill(const Value: TX2Color32);
begin begin
if Value <> FBorderColor then if Value <> FFill then
begin begin
FBorderColor := Value; FFill := Value;
DoChange();
end;
end;
procedure TX2MenuBarmCColor.SetFillAlpha(const Value: Byte);
begin
if Value <> FFillAlpha then
begin
FFillAlpha := Value;
DoChange();
end;
end;
procedure TX2MenuBarmCColor.SetFillColor(const Value: TColor);
begin
if Value <> FFillColor then
begin
FFillColor := Value;
DoChange(); DoChange();
end; end;
end; end;

View File

@ -1,6 +1,9 @@
{ {
:: Implements a Uname-IT-style painter for the X2MenuBar. :: Implements a Uname-IT-style painter for the X2MenuBar.
:: ::
:: Part of the X2Software Component Library
:: http://www.x2software.net/
::
:: Last changed: $Date$ :: Last changed: $Date$
:: Revision: $Rev$ :: Revision: $Rev$
:: Author: $Author$ :: Author: $Author$

View File

@ -32,151 +32,6 @@ object frmMain: TfrmMain
Height = 13 Height = 13
Caption = 'Animation time (ms):' Caption = 'Animation time (ms):'
end end
object mbTest: TX2MenuBar
Left = 0
Top = 0
Width = 125
Height = 379
Align = alLeft
Groups = <>
Images = glMenu
OnCollapsed = mbTestCollapsed
OnCollapsing = mbTestCollapsing
OnExpanded = mbTestExpanded
OnExpanding = mbTestExpanding
OnSelectedChanged = mbTestSelectedChanged
OnSelectedChanging = mbTestSelectedChanging
Painter = mcPainter
Groups = <
item
Caption = 'Share'
ImageIndex = 0
Expanded = True
Items = <
item
Caption = 'File'
ImageIndex = 0
end
item
Caption = 'Folder'
ImageIndex = 1
end
item
Caption = 'Photo'
ImageIndex = 2
end
item
Caption = 'Video'
ImageIndex = 3
end
item
Caption = 'Invisible item'
Visible = False
end
item
Caption = 'Disabled item'
Enabled = False
end>
end
item
Caption = 'Group'
ImageIndex = 1
Expanded = False
Items = <
item
Caption = 'Menu Item'
end>
end
item
Caption = 'Group without items'
ImageIndex = 2
Expanded = False
Items = <>
end
item
Caption = 'Biiiiig group.'
Expanded = False
Items = <
item
Caption = 'Menu Item'
end
item
Caption = 'Menu Item'
end
item
Caption = 'Menu Item'
end
item
Caption = 'Menu Item'
end
item
Caption = 'Menu Item'
end
item
Caption = 'Menu Item'
end
item
Caption = 'Menu Item'
end
item
Caption = 'Menu Item'
end
item
Caption = 'Menu Item'
end
item
Caption = 'Menu Item'
end
item
Caption = 'Menu Item'
end
item
Caption = 'Menu Item'
end
item
Caption = 'Menu Item'
end
item
Caption = 'Menu Item'
end
item
Caption = 'Menu Item'
end
item
Caption = 'Menu Item'
end
item
Caption = 'Menu Item'
end
item
Caption = 'Menu Item'
end
item
Caption = 'Menu Item'
end
item
Caption = 'Menu Item'
end
item
Caption = 'Menu Item'
end>
end
item
Caption = 'Disabled group'
Enabled = False
Expanded = False
Items = <
item
Caption = 'Menu Item'
end
item
Caption = 'Menu Item'
end
item
Caption = 'Menu Item'
end>
end>
end
object seAnimationTime: TJvSpinEdit object seAnimationTime: TJvSpinEdit
Left = 424 Left = 424
Top = 36 Top = 36
@ -185,7 +40,7 @@ object frmMain: TfrmMain
CheckMinValue = True CheckMinValue = True
ButtonKind = bkStandard ButtonKind = bkStandard
Value = 250.000000000000000000 Value = 250.000000000000000000
TabOrder = 1 TabOrder = 0
OnChange = seAnimationTimeChange OnChange = seAnimationTimeChange
end end
object Panel1: TPanel object Panel1: TPanel
@ -194,7 +49,7 @@ object frmMain: TfrmMain
Width = 133 Width = 133
Height = 77 Height = 77
BevelOuter = bvNone BevelOuter = bvNone
TabOrder = 2 TabOrder = 1
object rbmusikCube: TRadioButton object rbmusikCube: TRadioButton
Left = 0 Left = 0
Top = 0 Top = 0
@ -231,7 +86,7 @@ object frmMain: TfrmMain
Width = 153 Width = 153
Height = 101 Height = 101
BevelOuter = bvNone BevelOuter = bvNone
TabOrder = 3 TabOrder = 2
object rbSliding: TRadioButton object rbSliding: TRadioButton
Left = 0 Left = 0
Top = 20 Top = 20
@ -286,7 +141,7 @@ object frmMain: TfrmMain
Width = 89 Width = 89
Height = 17 Height = 17
Caption = 'Auto collapse' Caption = 'Auto collapse'
TabOrder = 4 TabOrder = 3
OnClick = chkAutoCollapseClick OnClick = chkAutoCollapseClick
end end
object chkAllowCollapseAll: TCheckBox object chkAllowCollapseAll: TCheckBox
@ -295,7 +150,7 @@ object frmMain: TfrmMain
Width = 101 Width = 101
Height = 17 Height = 17
Caption = 'Allow collapse all' Caption = 'Allow collapse all'
TabOrder = 6 TabOrder = 5
OnClick = chkAllowCollapseAllClick OnClick = chkAllowCollapseAllClick
end end
object chkAutoSelectItem: TCheckBox object chkAutoSelectItem: TCheckBox
@ -304,7 +159,7 @@ object frmMain: TfrmMain
Width = 101 Width = 101
Height = 17 Height = 17
Caption = 'Auto select item' Caption = 'Auto select item'
TabOrder = 5 TabOrder = 4
OnClick = chkAutoSelectItemClick OnClick = chkAutoSelectItemClick
end end
object chkScrollbar: TCheckBox object chkScrollbar: TCheckBox
@ -315,7 +170,7 @@ object frmMain: TfrmMain
Caption = 'Scrollbar' Caption = 'Scrollbar'
Checked = True Checked = True
State = cbChecked State = cbChecked
TabOrder = 7 TabOrder = 6
OnClick = chkScrollbarClick OnClick = chkScrollbarClick
end end
object chkHideScrollbar: TCheckBox object chkHideScrollbar: TCheckBox
@ -326,7 +181,7 @@ object frmMain: TfrmMain
Caption = 'Hide Scrollbar' Caption = 'Hide Scrollbar'
Checked = True Checked = True
State = cbChecked State = cbChecked
TabOrder = 8 TabOrder = 7
OnClick = chkHideScrollbarClick OnClick = chkHideScrollbarClick
end end
object lbEvents: TListBox object lbEvents: TListBox
@ -335,7 +190,7 @@ object frmMain: TfrmMain
Width = 421 Width = 421
Height = 93 Height = 93
ItemHeight = 13 ItemHeight = 13
TabOrder = 9 TabOrder = 8
end end
object Button1: TButton object Button1: TButton
Left = 152 Left = 152
@ -344,7 +199,7 @@ object frmMain: TfrmMain
Height = 25 Height = 25
Caption = 'SelectFirst' Caption = 'SelectFirst'
Enabled = False Enabled = False
TabOrder = 10 TabOrder = 9
end end
object Button2: TButton object Button2: TButton
Left = 152 Left = 152
@ -353,7 +208,7 @@ object frmMain: TfrmMain
Height = 25 Height = 25
Caption = 'SelectPrior' Caption = 'SelectPrior'
Enabled = False Enabled = False
TabOrder = 11 TabOrder = 10
end end
object Button3: TButton object Button3: TButton
Left = 152 Left = 152
@ -362,7 +217,7 @@ object frmMain: TfrmMain
Height = 25 Height = 25
Caption = 'SelectNext' Caption = 'SelectNext'
Enabled = False Enabled = False
TabOrder = 12 TabOrder = 11
end end
object Button4: TButton object Button4: TButton
Left = 152 Left = 152
@ -371,7 +226,7 @@ object frmMain: TfrmMain
Height = 25 Height = 25
Caption = 'SelectLast' Caption = 'SelectLast'
Enabled = False Enabled = False
TabOrder = 13 TabOrder = 12
end end
object Button5: TButton object Button5: TButton
Left = 152 Left = 152
@ -380,7 +235,7 @@ object frmMain: TfrmMain
Height = 25 Height = 25
Caption = 'SelectGroupByIndex' Caption = 'SelectGroupByIndex'
Enabled = False Enabled = False
TabOrder = 14 TabOrder = 13
end end
object Button6: TButton object Button6: TButton
Left = 152 Left = 152
@ -389,7 +244,7 @@ object frmMain: TfrmMain
Height = 25 Height = 25
Caption = 'SelectItemByIndex' Caption = 'SelectItemByIndex'
Enabled = False Enabled = False
TabOrder = 15 TabOrder = 14
end end
object chkHotHand: TCheckBox object chkHotHand: TCheckBox
Left = 424 Left = 424
@ -397,9 +252,132 @@ object frmMain: TfrmMain
Width = 149 Width = 149
Height = 17 Height = 17
Caption = 'Hand cursor for hot items' Caption = 'Hand cursor for hot items'
TabOrder = 16 TabOrder = 15
OnClick = chkHotHandClick OnClick = chkHotHandClick
end end
object mbTest: TX2MenuBar
Left = 0
Top = 0
Width = 125
Height = 379
Align = alLeft
Groups = <
item
Caption = 'Share'
ImageIndex = 0
Expanded = True
Items = <
item
Caption = 'File'
ImageIndex = 0
end
item
Caption = 'Folder'
ImageIndex = 1
end
item
Caption = 'Photo'
ImageIndex = 2
end
item
Caption = 'Video'
ImageIndex = 3
end
item
Caption = 'Invisible item'
Visible = False
end
item
Caption = 'Disabled item'
Enabled = False
end>
end
item
Caption = 'Actions test'
ImageIndex = 1
Expanded = False
Items = <
item
Action = actTest
Caption = 'I'#39'm an action!'
ImageIndex = 1
end>
end
item
Caption = 'Group without items'
ImageIndex = 2
Expanded = False
Items = <>
end
item
Caption = 'Biiiiig group.'
Expanded = False
Items = <
item
end
item
end
item
end
item
end
item
end
item
end
item
end
item
end
item
end
item
end
item
end
item
end
item
end
item
end
item
end
item
end
item
end
item
end
item
end
item
end
item
end>
end
item
Caption = 'Disabled group'
Enabled = False
Expanded = False
Items = <
item
end
item
end
item
end>
end>
Images = glMenu
OnCollapsed = mbTestCollapsed
OnCollapsing = mbTestCollapsing
OnExpanded = mbTestExpanded
OnExpanding = mbTestExpanding
OnSelectedChanged = mbTestSelectedChanged
OnSelectedChanging = mbTestSelectedChanging
Painter = mcPainter
ExplicitLeft = -6
end
object gcMenu: TX2GraphicContainer object gcMenu: TX2GraphicContainer
Graphics = < Graphics = <
item item
@ -522,4 +500,14 @@ object frmMain: TfrmMain
Left = 152 Left = 152
Top = 36 Top = 36
end end
object alMenu: TActionList
Images = glMenu
Left = 236
Top = 8
object actTest: TAction
Caption = 'I'#39'm an action!'
ImageIndex = 1
OnExecute = actTestExecute
end
end
end end

View File

@ -17,11 +17,10 @@ uses
X2CLGraphicList, X2CLGraphicList,
X2CLMenuBar, X2CLMenuBar,
X2CLmusikCubeMenuBarPainter, X2CLmusikCubeMenuBarPainter,
X2CLunaMenuBarPainter; X2CLunaMenuBarPainter, ActnList;
type type
TfrmMain = class(TForm) TfrmMain = class(TForm)
mbTest: TX2MenuBar;
mcPainter: TX2MenuBarmusikCubePainter; mcPainter: TX2MenuBarmusikCubePainter;
gcMenu: TX2GraphicContainer; gcMenu: TX2GraphicContainer;
glMenu: TX2GraphicList; glMenu: TX2GraphicList;
@ -51,6 +50,9 @@ type
Button5: TButton; Button5: TButton;
Button6: TButton; Button6: TButton;
chkHotHand: TCheckBox; chkHotHand: TCheckBox;
mbTest: TX2MenuBar;
alMenu: TActionList;
actTest: TAction;
procedure mbTestSelectedChanging(Sender: TObject; Item, procedure mbTestSelectedChanging(Sender: TObject; Item,
NewItem: TX2CustomMenuBarItem; var Allowed: Boolean); NewItem: TX2CustomMenuBarItem; var Allowed: Boolean);
procedure mbTestSelectedChanged(Sender: TObject; procedure mbTestSelectedChanged(Sender: TObject;
@ -70,16 +72,24 @@ 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);
procedure actTestExecute(Sender: TObject);
private private
procedure Event(const AMsg: String); procedure Event(const AMsg: String);
end; end;
implementation implementation
uses uses
Dialogs,
X2UtHandCursor; X2UtHandCursor;
{$R *.dfm} {$R *.dfm}
procedure TfrmMain.actTestExecute(Sender: TObject);
begin
ShowMessage('Action saying: hi!');
end;
procedure TfrmMain.AnimationClick(Sender: TObject); procedure TfrmMain.AnimationClick(Sender: TObject);
var var
style: TX2MenuBarAnimationStyle; style: TX2MenuBarAnimationStyle;

View File

@ -3,7 +3,8 @@ program MenuBarTest;
uses uses
Forms, Forms,
MainForm in 'MainForm.pas' {frmMain}, MainForm in 'MainForm.pas' {frmMain},
X2CLMenuBarAnimators in '..\..\Source\X2CLMenuBarAnimators.pas'; X2CLMenuBarAnimators in '..\..\Source\X2CLMenuBarAnimators.pas',
X2CLGraphics in '..\..\Source\X2CLGraphics.pas';
{$R *.res} {$R *.res}