diff --git a/Lib/D2006/placeholder.txt b/Lib/D2006/placeholder.txt
new file mode 100644
index 0000000..e69de29
diff --git a/Lib/D7/placeholder.txt b/Lib/D7/placeholder.txt
new file mode 100644
index 0000000..e69de29
diff --git a/Packages/X2CLGLReg.pas b/Packages/X2CLGLReg.pas
index 2c1300e..f3aa4f0 100644
--- a/Packages/X2CLGLReg.pas
+++ b/Packages/X2CLGLReg.pas
@@ -21,7 +21,8 @@ uses
procedure Register;
begin
- RegisterComponents('X²Software', [TX2GraphicContainer, TX2GraphicList]);
+ RegisterComponents('X2Software', [TX2GraphicContainer, TX2GraphicList]);
+
RegisterPropertyEditor(TypeInfo(TX2GraphicCollection), TX2GraphicContainer, 'Graphics', TX2GraphicsProperty);
RegisterComponentEditor(TX2GraphicContainer, TX2GraphicContainerEditor);
RegisterComponentEditor(TX2GraphicList, TX2GraphicListEditor);
diff --git a/Packages/X2CLMBReg.pas b/Packages/X2CLMBReg.pas
new file mode 100644
index 0000000..688cc06
--- /dev/null
+++ b/Packages/X2CLMBReg.pas
@@ -0,0 +1,29 @@
+{
+ :: Registers the MenuBar components
+ ::
+ :: Last changed: $Date$
+ :: Revision: $Rev$
+ :: Author: $Author$
+}
+unit X2CLMBReg;
+
+interface
+ procedure Register;
+
+implementation
+uses
+ Classes,
+ DesignIntf,
+ X2CLMenuBar,
+ X2CLmusikCubePainter;
+
+{.$R ..\Resources\MenuBar.dcr}
+
+procedure Register;
+begin
+ RegisterComponents('X2Software', [TX2MenuBar,
+ TX2MenuBarmusikCubePainter]);
+end;
+
+end.
+
diff --git a/Source/X2CLMenuBar.pas b/Source/X2CLMenuBar.pas
new file mode 100644
index 0000000..38ce87e
--- /dev/null
+++ b/Source/X2CLMenuBar.pas
@@ -0,0 +1,1306 @@
+{
+ :: 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.
+ ::
+ :: Last changed: $Date$
+ :: Revision: $Rev$
+ :: Author: $Author$
+}
+unit X2CLMenuBar;
+
+interface
+uses
+ Classes,
+ Contnrs,
+ Controls,
+ Forms,
+ Graphics,
+ ImgList,
+ Messages,
+ Windows;
+
+type
+ // #ToDo1 (MvR) 19-3-2006: implement collection Update mechanisms
+ // #ToDo1 (MvR) 19-3-2006: group ImageIndex
+ // #ToDo1 (MvR) 19-3-2006: OnCollapsing/OnCollapse/expand events
+ // #ToDo1 (MvR) 19-3-2006: AutoCollapse property
+ // #ToDo1 (MvR) 19-3-2006: AutoSelectItem property or something
+ // #ToDo1 (MvR) 19-3-2006: find a way to remember the selected item per
+ // group, required for when AutoCollapse = True and
+ // AutoSelectItem = True
+ TX2MenuBarPainterClass = class of TX2MenuBarPainter;
+ TX2MenuBarPainter = class;
+ TX2MenuBarItem = class;
+ TX2MenuBarGroup = class;
+ TX2CustomMenuBar = class;
+
+ IX2MenuBarPainterObserver = interface
+ ['{22DE60C9-49A1-4E7D-B547-901BEDCC0FB7}']
+ procedure PainterUpdate(Sender: TX2MenuBarPainter);
+ end;
+
+ TX2MenuBarHitTest = record
+ HitTestCode: Integer;
+ Item: TObject;
+ end;
+
+ TX2MenuBarDrawState = (mdsHot, mdsSelected);
+ TX2MenuBarDrawStates = set of TX2MenuBarDrawState;
+
+ TX2MenuBarAnimationStyle = (asNone, asSlide);
+
+ {
+ :$ Abstract animation class
+
+ :: Descendants implement the animation-specific drawing code.
+ }
+ TX2MenuBarAnimator = class(TObject)
+ private
+ FAnimationTime: Cardinal;
+ FExpanding: Boolean;
+ FGroup: TX2MenuBarGroup;
+ FMenuBar: TX2CustomMenuBar;
+ FStartTime: Cardinal;
+ FItemsBuffer: Graphics.TBitmap;
+ FTerminated: Boolean;
+
+ function GetTimeElapsed(): Cardinal;
+ protected
+ procedure Terminate(); virtual;
+
+ property ItemsBuffer: Graphics.TBitmap read FItemsBuffer;
+ property MenuBar: TX2CustomMenuBar read FMenuBar write FMenuBar;
+ property TimeElapsed: Cardinal read GetTimeElapsed;
+ public
+ constructor Create(AItemsBuffer: Graphics.TBitmap); virtual;
+ destructor Destroy(); override;
+
+ function PrepareHitPoint(APoint: TPoint): TPoint; virtual;
+ function Draw(ACanvas: TCanvas; const ABounds: TRect): Integer; virtual; abstract;
+
+ property AnimationTime: Cardinal read FAnimationTime write FAnimationTime;
+ property Expanding: Boolean read FExpanding write FExpanding;
+ property Group: TX2MenuBarGroup read FGroup write FGroup;
+ property Terminated: Boolean read FTerminated;
+ end;
+
+ {
+ :$ Implements a sliding animation
+ }
+ TX2MenuBarSlideAnimator = class(TX2MenuBarAnimator)
+ private
+ FSlidePos: Integer;
+ FSlideHeight: Integer;
+ public
+ function PrepareHitPoint(APoint: TPoint): TPoint; override;
+ function Draw(ACanvas: TCanvas; const ABounds: TRect): Integer; override;
+ end;
+
+ {
+ :$ Abstract painter class.
+
+ :: Descendants must implement the actual drawing code.
+ }
+ TX2MenuBarPainter = class(TComponent)
+ private
+ FAnimationStyle: TX2MenuBarAnimationStyle;
+ FAnimationTime: Cardinal;
+ FMenuBar: TX2CustomMenuBar;
+ FObservers: TInterfaceList;
+
+ function GetMenuBar(): TX2CustomMenuBar;
+ protected
+ procedure BeginPaint(const AMenuBar: TX2CustomMenuBar);
+ procedure EndPaint();
+
+ function GetGroupHeaderHeight(AGroup: TX2MenuBarGroup): Integer; virtual; abstract;
+ function GetGroupHeight(AGroup: TX2MenuBarGroup): Integer; virtual;
+ function GetItemHeight(AItem: TX2MenuBarItem): Integer; virtual; abstract;
+
+ procedure DrawBackground(ACanvas: TCanvas; const ABounds: TRect); virtual; abstract;
+ procedure DrawGroupHeader(ACanvas: TCanvas; AGroup: TX2MenuBarGroup; const ABounds: TRect; AState: TX2MenuBarDrawStates); virtual; abstract;
+ procedure DrawItem(ACanvas: TCanvas; AItem: TX2MenuBarItem; const ABounds: TRect; AState: TX2MenuBarDrawStates); virtual; abstract;
+
+ function CreateAnimator(AItemsBuffer: Graphics.TBitmap): TX2MenuBarAnimator; virtual;
+
+ procedure NotifyObservers();
+
+ property MenuBar: TX2CustomMenuBar read GetMenuBar;
+ protected
+ property AnimationStyle: TX2MenuBarAnimationStyle read FAnimationStyle write FAnimationStyle;
+ property AnimationTime: Cardinal read FAnimationTime write FAnimationTime;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy(); override;
+
+ function HitTest(APoint: TPoint): TX2MenuBarHitTest; overload; virtual;
+ function HitTest(AX, AY: Integer): TX2MenuBarHitTest; overload;
+
+ procedure AttachObserver(AObserver: IX2MenuBarPainterObserver);
+ procedure DetachObserver(AObserver: IX2MenuBarPainterObserver);
+ end;
+
+ {
+ :$ Contains a single menu item.
+ }
+ TX2MenuBarItem = class(TCollectionItem)
+ private
+ FCaption: String;
+ FData: TObject;
+ FOwnsData: Boolean;
+ FImageIndex: TImageIndex;
+
+ function GetGroup(): TX2MenuBarGroup;
+ function GetMenuBar(): TX2CustomMenuBar;
+ procedure SetCaption(const Value: String);
+ procedure SetData(const Value: TObject);
+ procedure SetImageIndex(const Value: TImageIndex);
+ public
+ constructor Create(Collection: TCollection); override;
+ destructor Destroy(); override;
+
+ procedure Assign(Source: TPersistent); override;
+
+ property Data: TObject read FData write SetData;
+ property Group: TX2MenuBarGroup read GetGroup;
+ property MenuBar: TX2CustomMenuBar read GetMenuBar;
+ property OwnsData: Boolean read FOwnsData write FOwnsData;
+ published
+ property Caption: String read FCaption write SetCaption;
+ property ImageIndex: TImageIndex read FImageIndex write SetImageIndex;
+ end;
+
+ {
+ :$ Manages a collection of menu items.
+ }
+ TX2MenuBarItems = class(TOwnedCollection)
+ private
+ function GetItem(Index: Integer): TX2MenuBarItem;
+ procedure SetItem(Index: Integer; const Value: TX2MenuBarItem);
+ public
+ constructor Create(AOwner: TPersistent);
+
+ function Add(const ACaption: TCaption = ''): TX2MenuBarItem;
+
+ property Items[Index: Integer]: TX2MenuBarItem read GetItem write SetItem; default;
+ end;
+
+ {
+ :$ Contains a single menu group.
+ }
+ TX2MenuBarGroup = class(TCollectionItem)
+ private
+ FCaption: String;
+ FExpanded: Boolean;
+ FItems: TX2MenuBarItems;
+ FData: TObject;
+ FOwnsData: Boolean;
+
+ function GetMenuBar(): TX2CustomMenuBar;
+ procedure SetCaption(const Value: String);
+ procedure SetExpanded(const Value: Boolean);
+ procedure SetItems(const Value: TX2MenuBarItems);
+ procedure SetData(const Value: TObject);
+ public
+ constructor Create(Collection: TCollection); override;
+ destructor Destroy(); override;
+
+ procedure Assign(Source: TPersistent); override;
+
+ property Data: TObject read FData write SetData;
+ property MenuBar: TX2CustomMenuBar read GetMenuBar;
+ property OwnsData: Boolean read FOwnsData write FOwnsData;
+ published
+ property Caption: String read FCaption write SetCaption;
+ property Expanded: Boolean read FExpanded write SetExpanded;
+ property Items: TX2MenuBarItems read FItems write SetItems;
+ end;
+
+ {
+ :$ Manages a collection of menu groups.
+ }
+ TX2MenuBarGroups = class(TOwnedCollection)
+ private
+ function GetItem(Index: Integer): TX2MenuBarGroup;
+ procedure SetItem(Index: Integer; const Value: TX2MenuBarGroup);
+ public
+ constructor Create(AOwner: TPersistent);
+
+ function Add(const ACaption: TCaption = ''): TX2MenuBarGroup;
+
+ property Items[Index: Integer]: TX2MenuBarGroup read GetItem write SetItem; default;
+ end;
+
+ {
+ :$ Implements the menu bar.
+
+ :: The menu bar is the visual container for the menu. It manages the groups
+ :: and items, and implements the switching between menu items. It does not
+ :: paint itself, instead it delegates this to it's linked Painter.
+ }
+ TX2CustomMenuBar = class(TCustomControl, IX2MenuBarPainterObserver)
+ private
+ FBorderStyle: TBorderStyle;
+ FGroups: TX2MenuBarGroups;
+ FPainter: TX2MenuBarPainter;
+ FHotItem: TObject;
+ FSelectedItem: TObject;
+ FImageList: TCustomImageList;
+ FAnimator: TX2MenuBarAnimator;
+ FLastMousePos: TPoint;
+
+ procedure SetBorderStyle(const Value: TBorderStyle);
+ procedure SetGroups(const Value: TX2MenuBarGroups);
+ procedure SetImageList(const Value: TCustomImageList);
+ protected
+ procedure CreateParams(var Params: TCreateParams); override;
+ procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+ procedure PainterUpdate(Sender: TX2MenuBarPainter);
+
+ procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
+ procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
+// procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
+ procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
+
+ procedure TestMousePos(); virtual;
+ protected
+ procedure SetPainter(const Value: TX2MenuBarPainter); virtual;
+
+ procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND;
+ procedure Paint(); override;
+
+ function GetDrawState(AItem: TObject): TX2MenuBarDrawStates;
+ function DrawMenu(ACanvas: TCanvas; const ABounds: TRect): Integer; virtual;
+ function DrawMenuItems(ACanvas: TCanvas; AGroup: TX2MenuBarGroup; const ABounds: TRect): Integer; virtual;
+ procedure DrawNoPainter(ACanvas: TCanvas; const ABounds: TRect); virtual;
+
+ function AllowInteraction(): Boolean; virtual;
+ procedure AnimateExpand(AGroup: TX2MenuBarGroup; AExpanding: Boolean);
+
+ property Animator: TX2MenuBarAnimator read FAnimator write FAnimator;
+ property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsNone;
+ protected
+ function ExpandedChanging(AGroup: TX2MenuBarGroup; AExpanding: Boolean): Boolean; virtual;
+ procedure ExpandedChanged(AGroup: TX2MenuBarGroup); virtual;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy(); override;
+
+ function HitTest(APoint: TPoint): TX2MenuBarHitTest; overload;
+ function HitTest(AX, AY: Integer): TX2MenuBarHitTest; overload;
+
+ property Groups: TX2MenuBarGroups read FGroups write SetGroups;
+ property ImageList: TCustomImageList read FImageList write SetImageList;
+ property Painter: TX2MenuBarPainter read FPainter write SetPainter;
+ end;
+
+ {
+ :$ Exposes the menu bar's published properties.
+ }
+ TX2MenuBar = class(TX2CustomMenuBar)
+ published
+ property Align;
+ property BevelEdges;
+ property BevelInner;
+ property BevelKind;
+ property BevelOuter;
+ property BorderStyle;
+ property BorderWidth;
+ property Groups;
+ property ImageList;
+ property OnClick;
+ property OnDblClick;
+ property OnEnter;
+ property OnExit;
+ property OnMouseActivate;
+ property OnMouseDown;
+ property OnMouseEnter;
+ property OnMouseLeave;
+ property OnMouseMove;
+ property OnMouseUp;
+ property OnResize;
+ property Painter;
+ end;
+
+ {
+ :$ Provides a wrapper for the DrawText API.
+ }
+ TDrawTextClipStyle = (csNone, csEllipsis, csPathEllipsis);
+
+ procedure DrawText(ACanvas: TCanvas; const AText: String;
+ const ABounds: TRect;
+ AHorzAlignment: TAlignment = taLeftJustify;
+ AVertAlignment: TVerticalAlignment = taVerticalCenter;
+ AMultiLine: Boolean = False;
+ AClipStyle: TDrawTextClipStyle = csNone);
+
+
+const
+ { HitTest Codes }
+ htUnknown = 0;
+ htBackground = 1;
+ htGroup = 2;
+ htItem = 3;
+
+implementation
+uses
+ SysUtils;
+
+const
+ DefaultAnimationStyle = asSlide;
+ DefaultAnimationTime = 250;
+ SDefaultItemCaption = 'Menu Item';
+ SDefaultGroupCaption = 'Group';
+ SNoPainter = 'Painter property not set';
+
+
+{ DrawText wrapper }
+procedure DrawText(ACanvas: TCanvas; const AText: String;
+ const ABounds: TRect; AHorzAlignment: TAlignment;
+ AVertAlignment: TVerticalAlignment;
+ AMultiLine: Boolean; AClipStyle: TDrawTextClipStyle);
+const
+ HorzAlignmentFlags: array[TAlignment] of Cardinal =
+ (DT_LEFT, DT_RIGHT, DT_CENTER);
+ VertAlignmentFlags: array[TVerticalAlignment] of Cardinal =
+ (DT_TOP, DT_BOTTOM, DT_VCENTER);
+ MultiLineFlags: array[Boolean] of Cardinal =
+ (DT_SINGLELINE, 0);
+ ClipStyleFlags: array[TDrawTextClipStyle] of Cardinal =
+ (0, DT_END_ELLIPSIS, DT_PATH_ELLIPSIS);
+
+var
+ flags: Cardinal;
+ bounds: TRect;
+
+begin
+ flags := HorzAlignmentFlags[AHorzAlignment] or
+ VertAlignmentFlags[AVertAlignment] or
+ MultiLineFlags[AMultiLine] or
+ ClipStyleFlags[AClipStyle];
+
+ if AMultiLine and (AClipStyle <> csNone) then
+ flags := flags or DT_EDITCONTROL;
+
+ bounds := ABounds;
+ Windows.DrawText(ACanvas.Handle, PChar(AText), Length(AText), bounds, flags);
+end;
+
+
+{ TX2MenuBarPainter }
+constructor TX2MenuBarPainter.Create(AOwner: TComponent);
+begin
+ inherited;
+
+ FAnimationStyle := DefaultAnimationStyle;
+ FAnimationTime := DefaultAnimationTime;
+
+ if AOwner is TX2CustomMenuBar then
+ FMenuBar := TX2CustomMenuBar(AOwner);
+end;
+
+destructor TX2MenuBarPainter.Destroy();
+begin
+ FreeAndNil(FObservers);
+ inherited;
+end;
+
+
+procedure TX2MenuBarPainter.AttachObserver(AObserver: IX2MenuBarPainterObserver);
+begin
+ if not Assigned(FObservers) then
+ FObservers := TInterfaceList.Create();
+
+ if FObservers.IndexOf(AObserver) = -1 then
+ FObservers.Add(AObserver);
+end;
+
+procedure TX2MenuBarPainter.DetachObserver(AObserver: IX2MenuBarPainterObserver);
+begin
+ if Assigned(FObservers) then
+ FObservers.Remove(AObserver);
+end;
+
+
+procedure TX2MenuBarPainter.BeginPaint(const AMenuBar: TX2CustomMenuBar);
+begin
+ Assert(not Assigned(FMenuBar), 'BeginPaint already called');
+ FMenuBar := AMenuBar;
+end;
+
+procedure TX2MenuBarPainter.EndPaint();
+begin
+ Assert(Assigned(FMenuBar), 'EndPaint without BeginPaint');
+ FMenuBar := nil;
+end;
+
+procedure TX2MenuBarPainter.NotifyObservers();
+var
+ observerIndex: Integer;
+
+begin
+ if Assigned(FObservers) then
+ for observerIndex := 0 to Pred(FObservers.Count) do
+ (FObservers[observerIndex] as IX2MenuBarPainterObserver).PainterUpdate(Self);
+end;
+
+
+function TX2MenuBarPainter.GetGroupHeight(AGroup: TX2MenuBarGroup): Integer;
+var
+ itemIndex: Integer;
+
+begin
+ Result := 0;
+ for itemIndex := 0 to Pred(AGroup.Items.Count) do
+ Inc(Result, GetItemHeight(AGroup.Items[itemIndex]));
+end;
+
+
+function TX2MenuBarPainter.CreateAnimator(AItemsBuffer: Graphics.TBitmap): TX2MenuBarAnimator;
+begin
+ Result := nil;
+
+ case AnimationStyle of
+ asSlide: Result := TX2MenuBarSlideAnimator.Create(AItemsBuffer);
+ end;
+
+ if Assigned(Result) then
+ Result.AnimationTime := AnimationTime;
+end;
+
+
+function TX2MenuBarPainter.HitTest(APoint: TPoint): TX2MenuBarHitTest;
+var
+ hitRect: TRect;
+ groupIndex: Integer;
+ group: TX2MenuBarGroup;
+ itemIndex: Integer;
+ item: TX2MenuBarItem;
+
+begin
+ Result.HitTestCode := htUnknown;
+ Result.Item := nil;
+ hitRect := Rect(0, 0, MenuBar.ClientWidth, 0);
+
+ for groupIndex := 0 to Pred(MenuBar.Groups.Count) do
+ begin
+ group := MenuBar.Groups[groupIndex];
+ hitRect.Bottom := hitRect.Top + GetGroupHeaderHeight(group);
+
+ if PtInRect(hitRect, APoint) then
+ begin
+ Result.HitTestCode := htGroup;
+ Result.Item := group;
+ break;
+ end;
+
+ hitRect.Top := hitRect.Bottom;
+ if group.Expanded then
+ begin
+ for itemIndex := 0 to Pred(group.Items.Count) do
+ begin
+ item := group.Items[itemIndex];
+ hitRect.Bottom := hitRect.Top + GetItemHeight(item);
+
+ if PtInRect(hitRect, APoint) then
+ begin
+ Result.HitTestCode := htItem;
+ Result.Item := item;
+ break;
+ end;
+
+ hitRect.Top := hitRect.Bottom;
+ end;
+
+ if Result.HitTestCode <> htUnknown then
+ break;
+ end;
+ end;
+end;
+
+function TX2MenuBarPainter.HitTest(AX, AY: Integer): TX2MenuBarHitTest;
+begin
+ Result := HitTest(Point(AX, AY));
+end;
+
+
+function TX2MenuBarPainter.GetMenuBar(): TX2CustomMenuBar;
+begin
+ Assert(Assigned(FMenuBar), 'BeginPaint not called');
+ Result := FMenuBar;
+end;
+
+
+{ TX2MenuBarAnimator }
+constructor TX2MenuBarAnimator.Create(AItemsBuffer: Graphics.TBitmap);
+begin
+ inherited Create();
+
+ FStartTime := GetTickCount();
+ FItemsBuffer := Graphics.TBitmap.Create();
+ FItemsBuffer.Assign(AItemsBuffer);
+end;
+
+destructor TX2MenuBarAnimator.Destroy();
+begin
+ FreeAndNil(FItemsBuffer);
+
+ inherited;
+end;
+
+
+function TX2MenuBarAnimator.GetTimeElapsed(): Cardinal;
+var
+ currentTime: Cardinal;
+
+begin
+ currentTime := GetTickCount();
+ Result := currentTime - FStartTime;
+
+ if currentTime < FStartTime then
+ Inc(Result, High(Cardinal));
+end;
+
+procedure TX2MenuBarAnimator.Terminate();
+begin
+ FTerminated := True;
+end;
+
+
+function TX2MenuBarAnimator.PrepareHitPoint(APoint: TPoint): TPoint;
+begin
+ Result := APoint;
+end;
+
+{ TX2MenuBarSlideAnimator }
+function TX2MenuBarSlideAnimator.PrepareHitPoint(APoint: TPoint): TPoint;
+begin
+ Result := inherited PrepareHitPoint(APoint);
+
+ { While expanding / collapsing, Group.Expanded has already changed. HitTest
+ uses this data to determine if items should be taken into account. We must
+ compensate for that while sliding. }
+ if Expanding then
+ begin
+ if Result.Y > (FSlidePos + FSlideHeight) then
+ Inc(Result.Y, ItemsBuffer.Height - FSlideHeight);
+ end
+ else
+ if Result.Y >= FSlidePos then
+ if Result.Y <= FSlidePos + FSlideHeight then
+ Result.Y := -1
+ else
+ Dec(Result.Y, FSlideHeight);
+end;
+
+function TX2MenuBarSlideAnimator.Draw(ACanvas: TCanvas; const ABounds: TRect): Integer;
+var
+ elapsed: Cardinal;
+ sourceRect: TRect;
+ destRect: TRect;
+
+begin
+ elapsed := TimeElapsed;
+ FSlidePos := ABounds.Top;
+ FSlideHeight := Trunc((elapsed / AnimationTime) * ItemsBuffer.Height);
+ if not Expanding then
+ FSlideHeight := ItemsBuffer.Height - FSlideHeight;
+
+ Result := FSlideHeight;
+
+ sourceRect := Rect(0, 0, ItemsBuffer.Width, FSlideHeight);
+ destRect := ABounds;
+ destRect.Bottom := destRect.Top + FSlideHeight;
+ ACanvas.CopyRect(destRect, ItemsBuffer.Canvas, sourceRect);
+
+ if elapsed >= AnimationTime then
+ Terminate();
+end;
+
+
+{ TX2MenuBarItem }
+constructor TX2MenuBarItem.Create(Collection: TCollection);
+begin
+ inherited;
+
+ FCaption := SDefaultItemCaption;
+end;
+
+destructor TX2MenuBarItem.Destroy();
+begin
+ if OwnsData then
+ FreeAndNil(FData);
+
+ inherited;
+end;
+
+
+function TX2MenuBarItem.GetGroup(): TX2MenuBarGroup;
+begin
+ Result := nil;
+
+ if Assigned(Collection) and (Collection.Owner <> nil) and
+ (Collection.Owner is TX2MenuBarGroup) then
+ Result := TX2MenuBarGroup(Collection.Owner);
+end;
+
+function TX2MenuBarItem.GetMenuBar(): TX2CustomMenuBar;
+var
+ group: TX2MenuBarGroup;
+
+begin
+ Result := nil;
+ group := GetGroup();
+ if Assigned(group) then
+ Result := group.MenuBar;
+end;
+
+procedure TX2MenuBarItem.Assign(Source: TPersistent);
+begin
+ if Source is TX2MenuBarItem then
+ with TX2MenuBarItem(Source) do
+ begin
+ Self.Caption := Caption;
+ Self.Data := Data;
+ Self.OwnsData := OwnsData;
+ end
+ else
+ inherited;
+end;
+
+
+procedure TX2MenuBarItem.SetCaption(const Value: String);
+begin
+ if Value <> FCaption then
+ begin
+ FCaption := Value;
+ Changed(False);
+ end;
+end;
+
+procedure TX2MenuBarItem.SetData(const Value: TObject);
+begin
+ if Value <> FData then
+ begin
+ if FOwnsData then
+ FreeAndNil(FData);
+
+ FData := Value;
+ end;
+end;
+
+procedure TX2MenuBarItem.SetImageIndex(const Value: TImageIndex);
+begin
+ if Value <> FImageIndex then
+ begin
+ FImageIndex := Value;
+ Changed(False);
+ end;
+end;
+
+
+{ TX2MenuBarItems }
+constructor TX2MenuBarItems.Create(AOwner: TPersistent);
+begin
+ inherited Create(AOwner, TX2MenuBarItem);
+end;
+
+
+function TX2MenuBarItems.Add(const ACaption: TCaption): TX2MenuBarItem;
+begin
+ Result := TX2MenuBarItem(inherited Add());
+ Result.Caption := ACaption;
+end;
+
+
+function TX2MenuBarItems.GetItem(Index: Integer): TX2MenuBarItem;
+begin
+ Result := TX2MenuBarItem(inherited GetItem(Index));
+end;
+
+procedure TX2MenuBarItems.SetItem(Index: Integer; const Value: TX2MenuBarItem);
+begin
+ inherited SetItem(Index, Value);
+end;
+
+
+{ TX2MenuBarGroup }
+constructor TX2MenuBarGroup.Create(Collection: TCollection);
+begin
+ inherited;
+
+ FCaption := SDefaultGroupCaption;
+ FItems := TX2MenuBarItems.Create(Self);
+end;
+
+destructor TX2MenuBarGroup.Destroy();
+begin
+ FreeAndNil(FItems);
+
+ if OwnsData then
+ FreeAndNil(FData);
+
+ inherited;
+end;
+
+
+procedure TX2MenuBarGroup.Assign(Source: TPersistent);
+begin
+ if Source is TX2MenuBarGroup then
+ with TX2MenuBarGroup(Source) do
+ begin
+ Self.Caption := Caption;
+ Self.Items.Assign(Items);
+ end
+ else
+ inherited;
+end;
+
+
+function TX2MenuBarGroup.GetMenuBar(): TX2CustomMenuBar;
+begin
+ Result := nil;
+
+ if Assigned(Collection) and (Collection.Owner <> nil) and
+ (Collection.Owner is TX2CustomMenuBar) then
+ Result := TX2CustomMenuBar(Collection.Owner);
+end;
+
+procedure TX2MenuBarGroup.SetCaption(const Value: String);
+begin
+ if Value <> FCaption then
+ begin
+ FCaption := Value;
+ Changed(False);
+ end;
+end;
+
+procedure TX2MenuBarGroup.SetData(const Value: TObject);
+begin
+ if Value <> FData then
+ begin
+ if FOwnsData then
+ FreeAndNil(FData);
+
+ FData := Value;
+ end;
+end;
+
+procedure TX2MenuBarGroup.SetExpanded(const Value: Boolean);
+var
+ menu: TX2CustomMenuBar;
+
+begin
+ if Value <> FExpanded then
+ begin
+ menu := MenuBar;
+ if Assigned(menu) then
+ menu.ExpandedChanging(Self, Value);
+
+ FExpanded := Value;
+ Changed(False);
+
+ if Assigned(menu) then
+ menu.ExpandedChanged(Self);
+ end;
+end;
+
+procedure TX2MenuBarGroup.SetItems(const Value: TX2MenuBarItems);
+begin
+ if Value <> FItems then
+ begin
+ FItems.Assign(Value);
+ Changed(False);
+ end;
+end;
+
+
+{ TX2MenuBarGroups }
+constructor TX2MenuBarGroups.Create(AOwner: TPersistent);
+begin
+ inherited Create(AOwner, TX2MenuBarGroup);
+end;
+
+
+function TX2MenuBarGroups.Add(const ACaption: TCaption): TX2MenuBarGroup;
+begin
+ Result := TX2MenuBarGroup(inherited Add());
+ if Length(ACaption) > 0 then
+ Result.Caption := ACaption;
+end;
+
+
+function TX2MenuBarGroups.GetItem(Index: Integer): TX2MenuBarGroup;
+begin
+ Result := TX2MenuBarGroup(inherited GetItem(Index));
+end;
+
+procedure TX2MenuBarGroups.SetItem(Index: Integer; const Value: TX2MenuBarGroup);
+begin
+ inherited SetItem(Index, Value);
+end;
+
+{ TX2CustomMenuBar }
+constructor TX2CustomMenuBar.Create(AOwner: TComponent);
+begin
+ inherited;
+
+ FBorderStyle := bsNone;
+ FGroups := TX2MenuBarGroups.Create(Self);
+end;
+
+procedure TX2CustomMenuBar.CreateParams(var Params: TCreateParams);
+const
+ BorderStyles: array[TBorderStyle] of DWORD = (0, WS_BORDER);
+
+begin
+ inherited;
+
+ { Source: TScrollBox.CreateParams }
+ with Params do
+ begin
+ Style := Style or BorderStyles[FBorderStyle];
+
+ if NewStyleControls and Ctl3D and (FBorderStyle = bsSingle) then
+ begin
+ Style := Style and not WS_BORDER;
+ ExStyle := ExStyle or WS_EX_CLIENTEDGE;
+ end;
+ end;
+end;
+
+destructor TX2CustomMenuBar.Destroy();
+begin
+ FreeAndNil(FGroups);
+
+ inherited;
+end;
+
+procedure TX2CustomMenuBar.WMEraseBkgnd(var Msg: TWMEraseBkgnd);
+begin
+ Msg.Result := 0;
+end;
+
+procedure TX2CustomMenuBar.Paint();
+var
+ buffer: Graphics.TBitmap;
+
+begin
+ if Assigned(Painter) then
+ begin
+ buffer := Graphics.TBitmap.Create();
+ try
+ buffer.PixelFormat := pf24bit;
+ buffer.Width := Self.ClientWidth;
+ buffer.Height := Self.ClientHeight;
+
+ Painter.BeginPaint(Self);
+ try
+ Painter.DrawBackground(buffer.Canvas, Self.ClientRect);
+ DrawMenu(buffer.Canvas, Self.ClientRect);
+ finally
+ Painter.EndPaint();
+ end;
+ finally
+ Self.Canvas.Draw(0, 0, buffer);
+ FreeAndNil(buffer);
+ end;
+
+ if Assigned(Animator) then
+ begin
+ if Animator.Terminated then
+ FreeAndNil(FAnimator);
+
+ TestMousePos();
+ Invalidate();
+ end;
+ end
+ else
+ DrawNoPainter(Self.Canvas, Self.ClientRect);
+end;
+
+
+function TX2CustomMenuBar.GetDrawState(AItem: TObject): TX2MenuBarDrawStates;
+begin
+ Result := [];
+
+ if AItem = FHotItem then
+ Include(Result, mdsHot);
+
+ if AItem = FSelectedItem then
+ Include(Result, mdsSelected);
+end;
+
+function TX2CustomMenuBar.DrawMenu(ACanvas: TCanvas; const ABounds: TRect): Integer;
+var
+ groupIndex: Integer;
+ group: TX2MenuBarGroup;
+ groupBounds: TRect;
+ drawState: TX2MenuBarDrawStates;
+
+begin
+ groupBounds := ABounds;
+
+ for groupIndex := 0 to Pred(Groups.Count) do
+ begin
+ { Group header }
+ group := Groups[groupIndex];
+ groupBounds.Bottom := groupBounds.Top +
+ Painter.GetGroupHeaderHeight(group);
+
+ if groupBounds.Bottom > ABounds.Bottom then
+ break;
+
+ drawState := GetDrawState(group);
+ Painter.DrawGroupHeader(ACanvas, group, groupBounds, drawState);
+ groupBounds.Top := groupBounds.Bottom;
+
+ if Assigned(Animator) and (Animator.Group = group) then
+ begin
+ { Animated group }
+ groupBounds.Bottom := ABounds.Bottom;
+ Inc(groupBounds.Top, Animator.Draw(ACanvas, groupBounds));
+ end else
+ begin
+ { Items }
+ if group.Expanded and (groupBounds.Top <= ABounds.Bottom) then
+ begin
+ groupBounds.Bottom := ABounds.Bottom;
+ Inc(groupBounds.Top, DrawMenuItems(ACanvas, group, groupBounds));
+ end;
+ end;
+ end;
+
+ Result := groupBounds.Top - ABounds.Top;
+end;
+
+function TX2CustomMenuBar.DrawMenuItems(ACanvas: TCanvas;
+ AGroup: TX2MenuBarGroup;
+ const ABounds: TRect): Integer;
+var
+ itemIndex: Integer;
+ item: TX2MenuBarItem;
+ itemBounds: TRect;
+ drawState: TX2MenuBarDrawStates;
+
+begin
+ itemBounds := ABounds;
+
+ for itemIndex := 0 to Pred(AGroup.Items.Count) do
+ begin
+ item := AGroup.Items[itemIndex];
+ itemBounds.Bottom := itemBounds.Top + Painter.GetItemHeight(item);
+
+ if itemBounds.Bottom <= ABounds.Bottom then
+ begin
+ drawState := GetDrawState(item);
+ Painter.DrawItem(ACanvas, item, itemBounds, drawState);
+ end;
+
+ itemBounds.Top := itemBounds.Bottom;
+ end;
+
+ Result := itemBounds.Top - ABounds.Top;
+end;
+
+procedure TX2CustomMenuBar.DrawNoPainter(ACanvas: TCanvas; const ABounds: TRect);
+const
+ XorColor = $00FFD8CE; // RGB(206, 216, 255)
+
+begin
+ with ACanvas do
+ begin
+ Brush.Color := clBtnFace;
+ FillRect(ABounds);
+
+ Pen.Style := psDot;
+ Pen.Mode := pmXor;
+ Pen.Color := XorColor;
+ Brush.Style := bsClear;
+ Rectangle(ABounds);
+
+ DrawText(ACanvas, SNoPainter, ABounds, taCenter);
+ end;
+end;
+
+
+function TX2CustomMenuBar.ExpandedChanging(AGroup: TX2MenuBarGroup;
+ AExpanding: Boolean): Boolean;
+begin
+ // #ToDo1 (MvR) 20-3-2006: raise event
+
+ AnimateExpand(AGroup, AExpanding);
+
+ Result := True;
+end;
+
+procedure TX2CustomMenuBar.ExpandedChanged(AGroup: TX2MenuBarGroup);
+begin
+ // #ToDo1 (MvR) 20-3-2006: raise event
+end;
+
+
+function TX2CustomMenuBar.AllowInteraction(): Boolean;
+begin
+ Result := not Assigned(Animator);
+end;
+
+
+procedure TX2CustomMenuBar.AnimateExpand(AGroup: TX2MenuBarGroup; AExpanding: Boolean);
+var
+ itemsBuffer: Graphics.TBitmap;
+ itemsBounds: TRect;
+
+begin
+ Assert(not Assigned(Animator), 'Already animating');
+ if not Assigned(Painter) then
+ exit;
+
+ Painter.BeginPaint(Self);
+ try
+ itemsBuffer := Graphics.TBitmap.Create();
+ try
+ itemsBuffer.PixelFormat := pf24bit;
+ itemsBuffer.Width := Self.ClientWidth;
+ itemsBuffer.Height := Painter.GetGroupHeight(AGroup);
+ itemsBounds := Rect(0, 0, itemsBuffer.Width, itemsBuffer.Height);
+
+ // #ToDo3 (MvR) 23-3-2006: this will probably cause problems if we ever
+ // want a bitmapped/customdrawn background.
+ // Maybe we can trick around a bit with the
+ // canvas offset? think about it later.
+ Painter.DrawBackground(itemsBuffer.Canvas, itemsBounds);
+ DrawMenuItems(itemsBuffer.Canvas, AGroup, itemsBounds);
+
+ Animator := Painter.CreateAnimator(itemsBuffer);
+ if Assigned(Animator) then
+ begin
+ Animator.Group := AGroup;
+ Animator.Expanding := AExpanding;
+ end;
+ finally
+ FreeAndNil(itemsBuffer);
+ end;
+ finally
+ Painter.EndPaint();
+ Invalidate();
+ end;
+
+// Painter.BeginPaint(Self);
+// try
+// groupBounds := Painter.GetGroupBounds(AGroup, ClientRect);
+// menuBitmap.Width := Self.ClientWidth;
+// menuBitmap.Height := Self.ClientHeight;
+// Painter.DrawBackground(menuBitmap.Canvas, ClientRect);
+// DrawMenu(menuBitmap.Canvas, ClientRect);
+// finally
+// Painter.EndPaint();
+// end;
+//
+ { Pre-paint the parts which will be animated }
+// Animator.Top.Width := Self.ClientWidth;
+// Animator.Top.Height := groupBounds.Top;
+// Animator.Top.Canvas.Draw(0, 0, menuBitmap);
+//
+// Animator.Group.Width := Self.ClientWidth;
+// Animator.Group.Height := groupBounds.Bottom - groupBounds.Top;
+// Animator.Group.Canvas.Draw(0, -groupBounds.Top, menuBitmap);
+//
+// Animator.Bottom.Width := Self.ClientWidth;
+// Animator.Bottom.Height := Self.ClientHeight - groupBounds.Bottom;
+// Animator.Bottom.Canvas.Draw(0, -groupBounds.Bottom, menuBitmap);
+// finally
+// FreeAndNil(menuBitmap);
+// end;
+
+// Animator.Expanding := AExpanding;
+// Animator.Max := 250;
+// timeStart := GetTickCount();
+// repeat
+// timeNow := GetTickCount();
+// Animator.Position := timeNow - timeStart;
+//
+// Invalidate();
+// Application.ProcessMessages();
+// // #ToDo1 (MvR) 20-3-2006: wait for paint cycle (event)?
+// Sleep(0);
+// until (timeNow > timeStart + 250) or (timeNow < timeStart);
+// finally
+// EndAnimate();
+// end;
+end;
+
+
+function TX2CustomMenuBar.HitTest(APoint: TPoint): TX2MenuBarHitTest;
+var
+ hitPoint: TPoint;
+
+begin
+ Result.HitTestCode := htUnknown;
+ Result.Item := nil;
+ hitPoint := APoint;
+
+ { Sliding animations alter the position of the underlying groups }
+ if Assigned(Animator) then
+ hitPoint := Animator.PrepareHitPoint(hitPoint);
+
+ if PtInRect(Self.ClientRect, APoint) then
+ begin
+ Painter.BeginPaint(Self);
+ try
+ Result := Painter.HitTest(hitPoint);
+ finally
+ Painter.EndPaint();
+ end;
+ end;
+end;
+
+function TX2CustomMenuBar.HitTest(AX, AY: Integer): TX2MenuBarHitTest;
+begin
+ Result := HitTest(Point(AX, AY));
+end;
+
+
+procedure TX2CustomMenuBar.Notification(AComponent: TComponent; Operation: TOperation);
+begin
+ if Operation = opRemove then
+ if AComponent = FPainter then
+ begin
+ FPainter := nil;
+ Invalidate();
+ end else if AComponent = FImageList then
+ begin
+ FImageList := nil;
+ Invalidate();
+ end;
+
+ inherited;
+end;
+
+procedure TX2CustomMenuBar.PainterUpdate(Sender: TX2MenuBarPainter);
+begin
+ Invalidate();
+end;
+
+
+procedure TX2CustomMenuBar.MouseDown(Button: TMouseButton; Shift: TShiftState;
+ X, Y: Integer);
+var
+ hitTest: TX2MenuBarHitTest;
+ group: TX2MenuBarGroup;
+
+begin
+ if AllowInteraction then
+ begin
+ hitTest := Self.HitTest(X, Y);
+
+ if hitTest.HitTestCode = htGroup then
+ begin
+ group := TX2MenuBarGroup(hitTest.Item);
+ if group.Items.Count > 0 then
+ begin
+ hitTest.Item := FSelectedItem;
+ group.Expanded := not group.Expanded;
+ Invalidate();
+ end;
+ end;
+
+ if hitTest.Item <> FSelectedItem then
+ begin
+ FSelectedItem := hitTest.Item;
+ Invalidate();
+ end;
+ end;
+
+ inherited;
+end;
+
+procedure TX2CustomMenuBar.MouseMove(Shift: TShiftState; X, Y: Integer);
+begin
+ FLastMousePos := Point(X, Y);
+ TestMousePos();
+
+ inherited;
+end;
+
+//procedure TX2CustomMenuBar.MouseUp(Button: TMouseButton; Shift: TShiftState;
+// X, Y: Integer);
+//begin
+// inherited;
+//end;
+
+procedure TX2CustomMenuBar.CMMouseLeave(var Message: TMessage);
+begin
+ FLastMousePos := Point(-1, -1);
+ FHotItem := nil;
+ Invalidate();
+end;
+
+procedure TX2CustomMenuBar.TestMousePos();
+var
+ hitTest: TX2MenuBarHitTest;
+
+begin
+ hitTest := Self.HitTest(FLastMousePos.X, FLastMousePos.Y);
+ if hitTest.Item <> FHotItem then
+ begin
+ FHotItem := hitTest.Item;
+ Invalidate();
+ end;
+end;
+
+
+procedure TX2CustomMenuBar.SetBorderStyle(const Value: TBorderStyle);
+begin
+ if Value <> FBorderStyle then
+ begin
+ FBorderStyle := Value;
+ RecreateWnd();
+ end;
+end;
+
+procedure TX2CustomMenuBar.SetGroups(const Value: TX2MenuBarGroups);
+begin
+ if Value <> FGroups then
+ FGroups.Assign(Value);
+end;
+
+procedure TX2CustomMenuBar.SetImageList(const Value: TCustomImageList);
+begin
+ if Value <> FImageList then
+ begin
+ if Assigned(FImageList) then
+ FImageList.RemoveFreeNotification(Self);
+
+ FImageList := Value;
+
+ if Assigned(FImageList) then
+ FImageList.FreeNotification(Self);
+
+ Invalidate();
+ end;
+end;
+
+procedure TX2CustomMenuBar.SetPainter(const Value: TX2MenuBarPainter);
+begin
+ if FPainter <> Value then
+ begin
+ if Assigned(FPainter) then
+ begin
+ FPainter.DetachObserver(Self);
+ FPainter.RemoveFreeNotification(Self);
+ end;
+
+ FPainter := Value;
+
+ if Assigned(FPainter) then
+ begin
+ FPainter.FreeNotification(Self);
+ FPainter.AttachObserver(Self);
+ end;
+
+ Invalidate;
+ end;
+end;
+
+end.
diff --git a/Source/X2CLmusikCubePainter.pas b/Source/X2CLmusikCubePainter.pas
new file mode 100644
index 0000000..c489ff6
--- /dev/null
+++ b/Source/X2CLmusikCubePainter.pas
@@ -0,0 +1,627 @@
+{
+ :: Implements a musikCube-style painter for the X2MenuBar.
+ ::
+ :: Last changed: $Date$
+ :: Revision: $Rev$
+ :: Author: $Author$
+}
+unit X2CLmusikCubePainter;
+
+interface
+uses
+ Classes,
+ Graphics,
+ ImgList,
+ Windows,
+
+ X2CLMenuBar;
+
+type
+ // #ToDo1 (MvR) 19-3-2006: IsStored implementations
+ // #ToDo1 (MvR) 19-3-2006: cache positions
+ TX2MenuBarmCColor = class(TPersistent)
+ private
+ FBorderAlpha: Byte;
+ FBorderColor: TColor;
+ FFillAlpha: Byte;
+ FFillColor: TColor;
+ FOnChange: TNotifyEvent;
+
+ procedure SetBorderAlpha(const Value: Byte);
+ procedure SetBorderColor(const Value: TColor);
+ procedure SetFillAlpha(const Value: Byte);
+ procedure SetFillColor(const Value: TColor);
+ protected
+ procedure DoChange();
+
+ function MixColors(ABackColor, AForeColor: TColor; AAlpha: Byte): TColor;
+
+ property OnChange: TNotifyEvent read FOnChange write FOnChange;
+ public
+ constructor Create();
+
+ function MixBorder(AColor: TColor): TColor;
+ function MixFill(AColor: TColor): TColor;
+ published
+ property BorderColor: TColor read FBorderColor write SetBorderColor;
+ property BorderAlpha: Byte read FBorderAlpha write SetBorderAlpha;
+ property FillColor: TColor read FFillColor write SetFillColor;
+ property FillAlpha: Byte read FFillAlpha write SetFillAlpha;
+ end;
+
+ TX2MenuBarmCColors = class(TPersistent)
+ private
+ FHot: TX2MenuBarmCColor;
+ FNormal: TX2MenuBarmCColor;
+ FSelected: TX2MenuBarmCColor;
+ FOnChange: TNotifyEvent;
+
+ procedure SetHot(const Value: TX2MenuBarmCColor);
+ procedure SetNormal(const Value: TX2MenuBarmCColor);
+ procedure SetSelected(const Value: TX2MenuBarmCColor);
+ protected
+ procedure DoChange();
+ procedure ColorChange(Sender: TObject);
+
+ property OnChange: TNotifyEvent read FOnChange write FOnChange;
+ public
+ constructor Create();
+ destructor Destroy(); override;
+ published
+ property Hot: TX2MenuBarmCColor read FHot write SetHot;
+ property Normal: TX2MenuBarmCColor read FNormal write SetNormal;
+ property Selected: TX2MenuBarmCColor read FSelected write SetSelected;
+ end;
+
+ // #ToDo1 (MvR) 19-3-2006: Custom base class
+ TX2MenuBarmusikCubePainter = class(TX2MenuBarPainter)
+ private
+ FColor: TColor;
+ FGroupColors: TX2MenuBarmCColors;
+ FGroupHeight: Integer;
+ FIndicatorColors: TX2MenuBarmCColors;
+ FItemColors: TX2MenuBarmCColors;
+ FItemHeight: Integer;
+
+ procedure SetColor(const Value: TColor);
+ procedure SetGroupColors(const Value: TX2MenuBarmCColors);
+ procedure SetGroupHeight(const Value: Integer);
+ procedure SetIndicatorColors(const Value: TX2MenuBarmCColors);
+ procedure SetItemColors(const Value: TX2MenuBarmCColors);
+ procedure SetItemHeight(const Value: Integer);
+ protected
+ procedure ColorChange(Sender: TObject);
+
+ function GetColor(AColors: TX2MenuBarmCColors; AState: TX2MenuBarDrawStates): TX2MenuBarmCColor;
+ procedure DrawBlended(ACanvas: TCanvas; AImageList: TCustomImageList; AX, AY, AImageIndex: Integer; AAlpha: Byte);
+
+ function GetGroupHeaderHeight(AGroup: TX2MenuBarGroup): Integer; override;
+ function GetGroupHeight(AGroup: TX2MenuBarGroup): Integer; override;
+ function GetItemHeight(AItem: TX2MenuBarItem): Integer; override;
+
+ procedure DrawBackground(ACanvas: TCanvas; const ABounds: TRect); override;
+ procedure DrawGroupHeader(ACanvas: TCanvas; AGroup: TX2MenuBarGroup; const ABounds: TRect; AState: TX2MenuBarDrawStates); override;
+ procedure DrawItem(ACanvas: TCanvas; AItem: TX2MenuBarItem; const ABounds: TRect; AState: TX2MenuBarDrawStates); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy(); override;
+
+ procedure ResetColors();
+ published
+ property AnimationStyle;
+ property AnimationTime;
+ property Color: TColor read FColor write SetColor stored False;
+ property GroupColors: TX2MenuBarmCColors read FGroupColors write SetGroupColors stored False;
+ property GroupHeight: Integer read FGroupHeight write SetGroupHeight stored False;
+ property IndicatorColors: TX2MenuBarmCColors read FIndicatorColors write SetIndicatorColors stored False;
+ property ItemColors: TX2MenuBarmCColors read FItemColors write SetItemColors stored False;
+ property ItemHeight: Integer read FItemHeight write SetItemHeight stored False;
+ end;
+
+implementation
+uses
+ SysUtils;
+
+type
+ PRGBArray = ^TRGBArray;
+ TRGBArray = array[Word] of TRGBTriple;
+
+
+{ TX2MenuBarmusikCubePainter }
+constructor TX2MenuBarmusikCubePainter.Create(AOwner: TComponent);
+begin
+ inherited;
+
+ FColor := clBtnFace;
+ FGroupColors := TX2MenuBarmCColors.Create();
+ FGroupHeight := 22;
+ FIndicatorColors := TX2MenuBarmCColors.Create();
+ FItemColors := TX2MenuBarmCColors.Create();
+ FItemHeight := 22;
+
+ FGroupColors.OnChange := ColorChange;
+ FIndicatorColors.OnChange := ColorChange;
+ FItemColors.OnChange := ColorChange;
+
+ ResetColors();
+end;
+
+destructor TX2MenuBarmusikCubePainter.Destroy();
+begin
+ FreeAndNil(FItemColors);
+ FreeAndNil(FIndicatorColors);
+ FreeAndNil(FGroupColors);
+
+ inherited;
+end;
+
+
+procedure TX2MenuBarmusikCubePainter.ResetColors();
+begin
+ { Group buttons }
+ with GroupColors.Hot do
+ begin
+ BorderColor := clBtnShadow;
+ FillAlpha := 128;
+ FillColor := clBtnShadow;
+ end;
+
+ with GroupColors.Normal do
+ begin
+ BorderAlpha := 64;
+ BorderColor := clBtnShadow;
+ FillAlpha := 64;
+ FillColor := clBtnShadow;
+ end;
+
+ with GroupColors.Selected do
+ begin
+ BorderColor := clBtnShadow;
+ FillColor := clBtnHighlight;
+ end;
+
+ { Indicator }
+ with IndicatorColors.Selected do
+ begin
+ BorderAlpha := 252;
+ BorderColor := clHighlight;
+ FillAlpha := 252;
+ FillColor := clHighlight;
+ end;
+
+ { Item buttons }
+ with ItemColors.Hot do
+ begin
+ BorderColor := clBtnShadow;
+ FillAlpha := 114;
+ FillColor := clBtnHighlight;
+ end;
+
+ with ItemColors.Normal do
+ begin
+ BorderAlpha := 50;
+ BorderColor := clBtnHighlight;
+ FillAlpha := 50;
+ FillColor := clBtnHighlight;
+ end;
+
+ with ItemColors.Selected do
+ begin
+ BorderColor := clBtnShadow;
+ FillColor := clBtnHighlight;
+ end;
+end;
+
+
+function TX2MenuBarmusikCubePainter.GetColor(AColors: TX2MenuBarmCColors;
+ AState: TX2MenuBarDrawStates): TX2MenuBarmCColor;
+begin
+ if mdsSelected in AState then
+ Result := AColors.Selected
+ else if mdsHot in AState then
+ Result := AColors.Hot
+ else
+ Result := AColors.Normal;
+end;
+
+procedure TX2MenuBarmusikCubePainter.DrawBlended(ACanvas: TCanvas;
+ AImageList: TCustomImageList;
+ AX, AY, AImageIndex: Integer;
+ AAlpha: Byte);
+var
+ backBuffer: Graphics.TBitmap;
+ iconBuffer: Graphics.TBitmap;
+ sourceRect: TRect;
+ destRect: TRect;
+ sourceRow: PRGBArray;
+ destRow: PRGBArray;
+ xPos: Integer;
+ yPos: Integer;
+ backAlpha: Integer;
+ iconAlpha: Integer;
+
+begin
+ backBuffer := Graphics.TBitmap.Create();
+ try
+ backBuffer.PixelFormat := pf24bit;
+ backBuffer.Width := AImageList.Width;
+ backBuffer.Height := AImageList.Height;
+
+ destRect := Rect(0, 0, backBuffer.Width, backBuffer.Height);
+ sourceRect := destRect;
+ OffsetRect(sourceRect, AX, AY);
+ backBuffer.Canvas.CopyRect(destRect, ACanvas, sourceRect);
+
+ iconBuffer := Graphics.TBitmap.Create();
+ try
+ iconBuffer.Assign(backBuffer);
+ AImageList.Draw(iconBuffer.Canvas, 0, 0, AImageIndex);
+
+ backAlpha := AAlpha;
+ iconAlpha := 256 - AAlpha;
+
+ for yPos := 0 to Pred(iconBuffer.Height) do
+ begin
+ sourceRow := iconBuffer.ScanLine[yPos];
+ destRow := backBuffer.ScanLine[yPos];
+
+ for xPos := 0 to Pred(iconBuffer.Width) do
+ with destRow^[xPos] do
+ begin
+ rgbtRed := ((rgbtRed * backAlpha) +
+ (sourceRow^[xPos].rgbtRed * iconAlpha)) shr 8;
+ rgbtGreen := ((rgbtGreen * backAlpha) +
+ (sourceRow^[xPos].rgbtGreen * iconAlpha)) shr 8;
+ rgbtBlue := ((rgbtBlue * backAlpha) +
+ (sourceRow^[xPos].rgbtBlue * iconAlpha)) shr 8;
+ end;
+ end;
+ finally
+ FreeAndNil(iconBuffer);
+ end;
+
+ ACanvas.Draw(AX, AY, backBuffer);
+ finally
+ FreeAndNil(backBuffer);
+ end;
+end;
+
+
+function TX2MenuBarmusikCubePainter.GetGroupHeaderHeight(AGroup: TX2MenuBarGroup): Integer;
+begin
+ Result := FGroupHeight;
+end;
+
+function TX2MenuBarmusikCubePainter.GetGroupHeight(AGroup: TX2MenuBarGroup): Integer;
+begin
+ Result := (AGroup.Items.Count * FGroupHeight);
+end;
+
+function TX2MenuBarmusikCubePainter.GetItemHeight(AItem: TX2MenuBarItem): Integer;
+begin
+ Result := FItemHeight;
+end;
+
+
+procedure TX2MenuBarmusikCubePainter.DrawBackground(ACanvas: TCanvas;
+ const ABounds: TRect);
+begin
+ with ACanvas do
+ begin
+ Brush.Color := FColor;
+ FillRect(ABounds);
+ end;
+end;
+
+procedure TX2MenuBarmusikCubePainter.DrawGroupHeader(ACanvas: TCanvas;
+ AGroup: TX2MenuBarGroup;
+ const ABounds: TRect;
+ AState: TX2MenuBarDrawStates);
+var
+ groupColor: TX2MenuBarmCColor;
+ textBounds: TRect;
+
+begin
+ with ACanvas do
+ begin
+ groupColor := GetColor(GroupColors, AState);
+
+ Brush.Color := groupColor.MixFill(Color);
+ Brush.Style := bsSolid;
+ Pen.Color := groupColor.MixBorder(Color);
+ Pen.Style := psSolid;
+ Rectangle(ABounds);
+
+ textBounds := ABounds;
+ Inc(textBounds.Left, 12); // #ToDo3 (MvR) 19-3-2006: GroupIndent property?
+
+ ACanvas.Font.Style := [fsBold];
+ DrawText(ACanvas, AGroup.Caption, textBounds);
+ end;
+end;
+
+
+procedure TX2MenuBarmusikCubePainter.DrawItem(ACanvas: TCanvas;
+ AItem: TX2MenuBarItem;
+ const ABounds: TRect;
+ AState: TX2MenuBarDrawStates);
+var
+ itemColor: TX2MenuBarmCColor;
+ itemBounds: TRect;
+ indicatorBounds: TRect;
+ indicatorColor: TX2MenuBarmCColor;
+ textBounds: TRect;
+ imageList: TCustomImageList;
+ imgY: Integer;
+
+begin
+ with ACanvas do
+ begin
+ itemColor := GetColor(ItemColors, AState);
+ indicatorColor := GetColor(IndicatorColors, AState);
+
+ itemBounds := ABounds;
+ indicatorBounds := itemBounds;
+ indicatorBounds.Right := indicatorBounds.Left + 6;
+ Brush.Color := indicatorColor.MixFill(Color);
+ Brush.Style := bsSolid;
+ Pen.Color := indicatorColor.MixBorder(Color);
+ Pen.Style := psSolid;
+ Rectangle(itemBounds);
+
+ itemBounds.Left := indicatorBounds.Right;
+ Brush.Color := itemColor.MixFill(Color);
+ Brush.Style := bsSolid;
+ Pen.Color := itemColor.MixBorder(Color);
+ Pen.Style := psSolid;
+ Rectangle(itemBounds);
+
+ textBounds := itemBounds;
+ Inc(textBounds.Left, 4);
+
+ imageList := MenuBar.ImageList;
+ if Assigned(imageList) then
+ begin
+ if AItem.ImageIndex > -1 then
+ begin
+ imgY := textBounds.Top + ((textBounds.Bottom - textBounds.Top -
+ imageList.Height) div 2);
+
+ if (mdsHot in AState) or (mdsSelected in AState) then
+ imageList.Draw(ACanvas, textBounds.Left, imgY, AItem.ImageIndex)
+ else
+ DrawBlended(ACanvas, imageList, textBounds.Left, imgY,
+ AItem.ImageIndex, 128);
+ end;
+
+ Inc(textBounds.Left, imageList.Width + 4);
+ end;
+
+ if mdsSelected in AState then
+ ACanvas.Font.Style := [fsBold]
+ else
+ ACanvas.Font.Style := [];
+
+ DrawText(ACanvas, AItem.Caption, textBounds);
+ end;
+end;
+
+procedure TX2MenuBarmusikCubePainter.ColorChange(Sender: TObject);
+begin
+ NotifyObservers();
+end;
+
+
+procedure TX2MenuBarmusikCubePainter.SetIndicatorColors(const Value: TX2MenuBarmCColors);
+begin
+ if Value <> FIndicatorColors then
+ begin
+ FIndicatorColors.Assign(Value);
+ NotifyObservers();
+ end;
+end;
+
+procedure TX2MenuBarmusikCubePainter.SetItemColors(const Value: TX2MenuBarmCColors);
+begin
+ if Value <> FItemColors then
+ begin
+ FItemColors.Assign(Value);
+ NotifyObservers();
+ end;
+end;
+
+procedure TX2MenuBarmusikCubePainter.SetItemHeight(const Value: Integer);
+begin
+ if Value <> FItemHeight then
+ begin
+ FItemHeight := Value;
+ NotifyObservers();
+ end;
+end;
+
+procedure TX2MenuBarmusikCubePainter.SetColor(const Value: TColor);
+begin
+ if Value <> FColor then
+ begin
+ FColor := Value;
+ NotifyObservers();
+ end;
+end;
+
+procedure TX2MenuBarmusikCubePainter.SetGroupColors(const Value: TX2MenuBarmCColors);
+begin
+ if Value <> FGroupColors then
+ begin
+ FGroupColors.Assign(Value);
+ NotifyObservers();
+ end;
+end;
+
+procedure TX2MenuBarmusikCubePainter.SetGroupHeight(const Value: Integer);
+begin
+ if Value <> FGroupHeight then
+ begin
+ FGroupHeight := Value;
+ NotifyObservers();
+ end;
+end;
+
+
+{ TX2MenuBarmCColor }
+constructor TX2MenuBarmCColor.Create();
+begin
+ inherited;
+
+ FBorderAlpha := 255;
+ FBorderColor := clNone;
+ FFillAlpha := 255;
+ FFillColor := clNone;
+end;
+
+
+procedure TX2MenuBarmCColor.DoChange();
+begin
+ if Assigned(FOnChange) then
+ FOnChange(Self);
+end;
+
+
+function TX2MenuBarmCColor.MixColors(ABackColor, AForeColor: TColor;
+ AAlpha: Byte): TColor;
+var
+ cBack: Cardinal;
+ cFore: Cardinal;
+ bBack: Byte;
+
+begin
+ { Source: X2UtGraphics.BlendColors }
+ cBack := ColorToRGB(ABackColor);
+ cFore := ColorToRGB(AForeColor);
+ bBack := 255 - AAlpha;
+
+ 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;
+
+
+procedure TX2MenuBarmCColor.SetBorderAlpha(const Value: Byte);
+begin
+ if Value <> FBorderAlpha then
+ begin
+ FBorderAlpha := Value;
+ DoChange();
+ end;
+end;
+
+procedure TX2MenuBarmCColor.SetBorderColor(const Value: TColor);
+begin
+ if Value <> FBorderColor then
+ begin
+ FBorderColor := 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();
+ end;
+end;
+
+
+{ TX2MenuBarmCColors }
+constructor TX2MenuBarmCColors.Create();
+begin
+ inherited;
+
+ FHot := TX2MenuBarmCColor.Create();
+ FNormal := TX2MenuBarmCColor.Create();
+ FSelected := TX2MenuBarmCColor.Create();
+
+ FHot.OnChange := ColorChange;
+ FNormal.OnChange := ColorChange;
+ FSelected.OnChange := ColorChange;
+end;
+
+destructor TX2MenuBarmCColors.Destroy();
+begin
+ FreeAndNil(FSelected);
+ FreeAndNil(FNormal);
+ FreeAndNil(FHot);
+
+ inherited;
+end;
+
+
+procedure TX2MenuBarmCColors.DoChange();
+begin
+ if Assigned(FOnChange) then
+ FOnChange(Self);
+end;
+
+procedure TX2MenuBarmCColors.ColorChange(Sender: TObject);
+begin
+ DoChange();
+end;
+
+
+procedure TX2MenuBarmCColors.SetHot(const Value: TX2MenuBarmCColor);
+begin
+ if FHot <> Value then
+ begin
+ FHot.Assign(Value);
+ DoChange();
+ end;
+end;
+
+procedure TX2MenuBarmCColors.SetNormal(const Value: TX2MenuBarmCColor);
+begin
+ if FNormal <> Value then
+ begin
+ FNormal.Assign(Value);
+ DoChange();
+ end;
+end;
+
+procedure TX2MenuBarmCColors.SetSelected(const Value: TX2MenuBarmCColor);
+begin
+ if FNormal <> Value then
+ begin
+ FSelected.Assign(Value);
+ DoChange();
+ end;
+end;
+
+end.
diff --git a/Test/MenuBar/MainForm.dfm b/Test/MenuBar/MainForm.dfm
new file mode 100644
index 0000000..4f56e3b
--- /dev/null
+++ b/Test/MenuBar/MainForm.dfm
@@ -0,0 +1,278 @@
+object frmMain: TfrmMain
+ Left = 300
+ Top = 219
+ Caption = 'X2MenuBar Test'
+ ClientHeight = 360
+ ClientWidth = 550
+ Color = clBtnFace
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'Tahoma'
+ Font.Style = []
+ OldCreateOrder = False
+ Position = poScreenCenter
+ PixelsPerInch = 96
+ TextHeight = 13
+ object bvlMenu: TBevel
+ Left = 137
+ Top = 0
+ Width = 8
+ Height = 360
+ Align = alLeft
+ Shape = bsLeftLine
+ ExplicitLeft = 141
+ end
+ object lblAnimationTime: TLabel
+ Left = 364
+ Top = 32
+ Width = 98
+ Height = 13
+ Caption = 'Animation time (ms):'
+ end
+ object mbTest: TX2MenuBar
+ Left = 0
+ Top = 0
+ Width = 137
+ Height = 360
+ Align = alLeft
+ Groups = <
+ item
+ Caption = 'Share'
+ 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>
+ end
+ item
+ Caption = 'Group'
+ Expanded = False
+ Items = <
+ item
+ Caption = 'Menu Item'
+ ImageIndex = -1
+ end
+ item
+ Caption = 'Menu Item'
+ ImageIndex = -1
+ end
+ item
+ Caption = 'Menu Item'
+ ImageIndex = -1
+ end>
+ end
+ item
+ Caption = 'Group without items'
+ Expanded = False
+ Items = <>
+ end>
+ ImageList = glMenu
+ Painter = mbPainter
+ end
+ object seAnimationTime: TJvSpinEdit
+ Left = 364
+ Top = 48
+ Width = 81
+ Height = 21
+ CheckMinValue = True
+ ButtonKind = bkStandard
+ Value = 250.000000000000000000
+ TabOrder = 1
+ OnChange = seAnimationTimeChange
+ end
+ object Panel1: TPanel
+ Left = 220
+ Top = 80
+ Width = 133
+ Height = 153
+ BevelOuter = bvNone
+ TabOrder = 2
+ object rbmusikCube: TRadioButton
+ Left = 0
+ Top = 0
+ Width = 113
+ Height = 17
+ Caption = 'musikCube style'
+ Checked = True
+ TabOrder = 0
+ TabStop = True
+ end
+ object rbUnameIT: TRadioButton
+ Left = 0
+ Top = 20
+ Width = 113
+ Height = 17
+ Caption = 'Uname-IT style'
+ Enabled = False
+ TabOrder = 1
+ end
+ end
+ object Panel2: TPanel
+ Left = 364
+ Top = 80
+ Width = 129
+ Height = 153
+ BevelOuter = bvNone
+ TabOrder = 3
+ object rbSliding: TRadioButton
+ Left = 0
+ Top = 20
+ Width = 113
+ Height = 17
+ Caption = 'Sliding animation'
+ Checked = True
+ TabOrder = 0
+ TabStop = True
+ OnClick = AnimationClick
+ end
+ object rbNoAnimation: TRadioButton
+ Left = 0
+ Top = 0
+ Width = 113
+ Height = 17
+ Caption = 'No animation'
+ TabOrder = 1
+ OnClick = AnimationClick
+ end
+ object rbFade: TRadioButton
+ Left = 0
+ Top = 40
+ Width = 113
+ Height = 17
+ Caption = 'Fading animation'
+ Enabled = False
+ TabOrder = 2
+ end
+ end
+ object gcMenu: TX2GraphicContainer
+ Graphics = <
+ item
+ Name = 'ShareFile'
+ Picture.Data = {
+ 0A54504E474F626A65637489504E470D0A1A0A0000000D494844520000001000
+ 00001008060000001FF3FF61000001844944415478DAA5D2CD4B02411400F0B7
+ DB2DA27FAB4EE22102A1A0C0FCA0837A4989683734C7A072A12C45502902FB00
+ E95487FEA20E1D24337777E635B33BBB389B5E6A60F6ED1EDE6FDE9BB71AFC73
+ 69C14BADF98A223A8EEB7DDB41B4FD38B11D1112D661A23F1728A657E69E5428
+ F761796911869F5F0A32174044102551E6BF17C90364B76270F7F4A6202140AE
+ 5FB09459554E1589942B8CF9C0F4E280A600A6F58C462E3613A01C70F9B61DCA
+ 4F1F83D51CA0656EEB2A501FA0918FAB2D88646FA3D74A108D6A0F2E2A496D26
+ 20127D80972E93998208A00B97951D1530CE076816E2E052FFF238E125B228C4
+ 1F06E941230AEC9F3CE2F1DE1A7CBB2CAC00652B4CB6C2E49D1C912E07522A50
+ 22F7484AEB30B2250018224C2607509974A0719C5681BC798B75630386131AA9
+ 80274B2C68A5C22BB8AA46809C71C347B3091F631ACC414564152E8FD55A079A
+ 24A302A9621B5BB524BC8F9CA951AA80F72FF07D76DA8516C9AAC0EE411B755D
+ 0790339045841719DC8BA86241D37F4FE1AFEB07F8392D2050E7313500000000
+ 49454E44AE426082}
+ end
+ item
+ Name = 'ShareFolder'
+ Picture.Data = {
+ 0A54504E474F626A65637489504E470D0A1A0A0000000D494844520000001000
+ 00001008060000001FF3FF610000025B4944415478DAAD936D48535118C7FF77
+ 775BEAD8ACA123CB2834EC9B2DB2B0328CCC284B461192146A48040505D36A05
+ 154826A64D53A490303F6510C528421B6B2CC4C0E5170317ABA859099ACEBBF7
+ B6BBFBD2F172433F680875E0CF797BFE3FCE79CE7928FC63A3961B38D201BB3F
+ 82524100E6140AA0A7D28ADA65039C2D88159DF3A7AA52F5D2FCF90D0AA60650
+ 4B02BCBDD8C504512288284CB23088EA0C63F18569FACFFE92007727BCB47E4B
+ 9E5A9385F4753B9091530EB5D6009AD690DD28519C2813B66B5A1CB9B908C075
+ 0762B139042EEE412CF01D51BF0789F04F4064C1712C36EEAE275119787A350B
+ C79A64C0609B2209958E5E633C4FF9DE36A0B07610D1D97EA8523448D56AB122
+ 2D8D642E8EC98FA3D0E79442AD31E289250F15CD32C0D942058ACE0EA7ABD236
+ C1D19C8E7D973F93D521804B4A4649624292CFF3151B0AEAF1F8E26654B6CA00
+ C76DA53BFF68DFB6CCDC9DB037ADC5FE2BA3C4F41AE009804BCC03F8047E787D
+ C8DE5E8547751538619501F62674AF5A5F525350D9AD1A68CCC5018B8BE4AA5F
+ 324060E57EEE041CC4A40026A6C3CBAE07A8BA2B03061A5141F1F4BDBD752FF4
+ AF5ACB70E8928D24FC1931B20B00736312ACA010F42760EB79839ACE05AF3070
+ 2BC5A6CBDA6A9AF10DA1DCFC1008F649999704228508669605331E86776C06D3
+ 939189EA0E6453F31F0367D49AD55DF1F0246D32B713402F3125C04C45C8BD43
+ 98188F89D15032405E72F8781B0E2E5A0BCEAE7C8E99784F97551FC627B70BDF
+ BEFCE2E3117E4AE031625809CB9EEBF8F0D7627A77BFE0D4D8D88855A9440022
+ 1C27DB71FABF55E352ED373075032024CD24170000000049454E44AE426082}
+ end
+ item
+ Name = 'ShareWebcam'
+ Picture.Data = {
+ 0A54504E474F626A65637489504E470D0A1A0A0000000D494844520000001000
+ 00001008060000001FF3FF61000002C14944415478DABD935D48935118C7FF9B
+ DB9CD38913155CB586D008C30F9A95A8217927A14157DE441FE88521A4828108
+ 0A8992621745A80C477AB3A048D44A08A18589BA959AE0D4A09CBAE936F7E55E
+ 759B7BDFB91EDF20E82E283A70381CCE797EFFE739E7FF08F09743F04F00D5D5
+ BA94C4C4E47A954AA171BB0F6452292B92CB25C24824088E63A32C1BE658F630
+ B2BFBF175E5B5B5B0F0643AF8DC6E79F7F011A1B87DE3435555C0D8582181F37
+ 637BFB3BEAEA6ED28918BBBB3EC4C589F8AB1C071C1C846136CFC52626DE0D8D
+ 8E0EDEE6011D1D2F772A2B0BD2392E0A936915878711C46231088502582C6FB1
+ B4B44CC0079899998048C48132A1A8D42D9DAEEB240F686919F017179F4D6118
+ 8ED4BD9048E22016FF9C16CB14525353A056E7C26AB5109C4166A692A0566F6F
+ EFC3341ED0DDFDC25759A9552C2CAC8061F6715C7B2C968868D405AD36076EB7
+ 874A0990BA020A453A8145181B1BF1F7F575A7F280F6F621574D4D4586DDEE81
+ D7CBC066B3D2EA446E6E16BABA9E906A0C39392AE4E79F874A758E32946078F8
+ 95BBBFBF278307B4B50D6CD6D65E3FB5B9E982CFC7606BCB4EEA3EACAE2E2110
+ 5042A3C9C6E4A40EA5A525042A444282140683C1A6D33D56F180E6E6A75F1B1A
+ 6E683636B649790F3B3B0E04832EACAF7F83D13887B4B44CC8E52C0A0B8B9097
+ 7701F1F1F1D0EBF52B7A7D6F360FA8AFEFFAD4DA7AB7C06ADD86C7B34BC10C1C
+ 0E3BA4D2E35F311F7B014AE50994945C21F544242727D1BB3D9A32189E5DE601
+ 55558D239D9DF7AE310C4BEA7EAA5100A7D3857098A1E010EDC5C8CA3A43CA32
+ BACD61717131363030747F76F6430F0F282FBF73A9ACACE47D51915666B3B9C8
+ 386421B11432593C418294CD163DAC2DE2743AE697972DC66834326A327D34FD
+ D60BE5E5B72EAAD5A7079392E41AB2AE9BCC6275B91CCB3E5FE08B40C0CE1F1D
+ F917A6A767427FD24C429A47FFAD1B7F00ED1B51200D4AE2740000000049454E
+ 44AE426082}
+ end
+ item
+ Name = 'ShareWebcamVideo'
+ Picture.Data = {
+ 0A54504E474F626A65637489504E470D0A1A0A0000000D494844520000001000
+ 00001008060000001FF3FF61000002EA4944415478DAA5935D48935118C7FFF3
+ DDAB6BCEF9FDED44DC4CA15E8761412A1296A121285ED595DD7521298C125341
+ E9622B584CE6BCF122454891AE9424432B3FC8A4FC203F32D1E9FCAA95D36DCD
+ B5BDAF7BB78E2B040BA2E8DC9CAFE7FC9EE7FCCFF90BF09F4DF0EB82CFE713E8
+ F5FA149AA6198FC7C3884422262C2C8C118BC5A91CC7EDBBDDAE75ABD5BAC4B2
+ 9C4EA5524D1E03747777574B2492A688888830D2432A952238580C9AA6C82E8F
+ 830316DBDB7632077A7B7B5FD7D737E41C017A7A7A8A939393FB188611DA6C36
+ 2426268265DDB05A2D9899716373D30BA39187CD7608FA86ADCD06D7E0D0A0D8
+ 0F50ABD585342D7CEA703828A55289E8E818242424203C5C82AE2E0789909183
+ FB70BB59389D2E02F66274F4BA6361615CEA075455DD1C11894EE43FEC7C8C2B
+ C59791794A8EA2A26212ECC4F47436380EE430878D8D31D8ED6FC93A199BDEAC
+ 4FCD0CA4F801776A6B9D731F56C553CB1C3EED72A82C4FC2A5C2622814C99898
+ 9061656519F3F3F7B1B7B785A8A818040444212DEDCCAC56AB52FA013535B7ED
+ E65D56FA688405EF0DC5D59CAF60329290937B0E7373720C0CA840511C76763E
+ FB01F1F1371014343B6B3034FE005456560E9D4C935FACD6AF03541CCAB35791
+ 9A1082D34C3A9697F33035A5267A444128CC464848162C163BD1A97FB2B5557D
+ F667053525F0F17D2C1527E81B36212B6E1D79F917E0724988FAB9100804F078
+ 78A2C5A1802EA2831B1919CFFB753A6DC9D133D6D5D5DD22719AF434B9D0E9E2
+ 488981E4B942313C1C47EECCC3EBF591B9070E871B4AA58FC09E7536371B2A8E
+ 7DA4F6F6F677A5A5A59966B39964B1C164B2A0A34388C04090CC3C2223BD2828
+ A0C978D16B327D2CD56A1F3C3906D0E974E3656565E7799EF7976DB57E415BDB
+ 26C46211C94A932A8CBEA5A5B5171415D8A8D1685EFDE605F2A1AE51146590C9
+ 64110A8582F8C2EBBFF7E2E27B9FD1B8F6322040D8A4D1DC1BFBA39988418288
+ 894A481515B1B1B185168BE51531D8DD969696D1BF72E3BFB6EF2C065120000A
+ A5C30000000049454E44AE426082}
+ end>
+ Left = 180
+ Top = 8
+ end
+ object glMenu: TX2GraphicList
+ Container = gcMenu
+ Left = 208
+ Top = 8
+ end
+ object mbPainter: TX2MenuBarmusikCubePainter
+ Left = 152
+ Top = 8
+ end
+end
diff --git a/Test/MenuBar/MainForm.pas b/Test/MenuBar/MainForm.pas
new file mode 100644
index 0000000..8f34385
--- /dev/null
+++ b/Test/MenuBar/MainForm.pas
@@ -0,0 +1,52 @@
+unit MainForm;
+
+interface
+uses
+ Classes,
+ Controls,
+ Forms,
+ ImgList,
+
+ PNGImage,
+ X2CLGraphicList,
+ X2CLMenuBar,
+ X2CLmusikCubePainter, StdCtrls, ExtCtrls, Mask, JvExMask, JvSpin;
+
+type
+ TfrmMain = class(TForm)
+ mbTest: TX2MenuBar;
+ mbPainter: TX2MenuBarmusikCubePainter;
+ gcMenu: TX2GraphicContainer;
+ glMenu: TX2GraphicList;
+ bvlMenu: TBevel;
+ rbmusikCube: TRadioButton;
+ rbSliding: TRadioButton;
+ lblAnimationTime: TLabel;
+ seAnimationTime: TJvSpinEdit;
+ Panel1: TPanel;
+ Panel2: TPanel;
+ rbNoAnimation: TRadioButton;
+ rbFade: TRadioButton;
+ rbUnameIT: TRadioButton;
+ procedure AnimationClick(Sender: TObject);
+ procedure seAnimationTimeChange(Sender: TObject);
+ end;
+
+implementation
+
+{$R *.dfm}
+
+procedure TfrmMain.AnimationClick(Sender: TObject);
+begin
+ if rbSliding.Checked then
+ mbPainter.AnimationStyle := asSlide
+ else
+ mbPainter.AnimationStyle := asNone;
+end;
+
+procedure TfrmMain.seAnimationTimeChange(Sender: TObject);
+begin
+ mbPainter.AnimationTime := seAnimationTime.AsInteger;
+end;
+
+end.
diff --git a/Test/MenuBar/MenuBarGroup.bdsgroup b/Test/MenuBar/MenuBarGroup.bdsgroup
new file mode 100644
index 0000000..6ac8695
--- /dev/null
+++ b/Test/MenuBar/MenuBarGroup.bdsgroup
@@ -0,0 +1,20 @@
+
+
+
+
+
+
+
+
+
+
+ MenuBarTest.bdsproj
+ ..\..\Packages\D2006\X2CLMB.bdsproj
+ ..\..\Packages\D2006\X2CLMBD.bdsproj
+ ..\..\..\..\Archive\Tests\2006\ColorBlender\ColorBlender.bdsproj
+ MenuBarTest.exe X2CLMB.bpl X2CLMBD.bpl ColorBlender.exe
+
+
+
+
diff --git a/Test/MenuBar/MenuBarTest.bdsproj b/Test/MenuBar/MenuBarTest.bdsproj
new file mode 100644
index 0000000..41f7d5d
--- /dev/null
+++ b/Test/MenuBar/MenuBarTest.bdsproj
@@ -0,0 +1,172 @@
+
+
+
+
+
+
+
+
+
+
+
+ MenuBarTest.dpr
+
+
+ 7.0
+
+
+ 8
+ 0
+ 1
+ 1
+ 0
+ 0
+ 1
+ 1
+ 1
+ 0
+ 0
+ 1
+ 0
+ 1
+ 1
+ 1
+ 0
+ 0
+ 0
+ 0
+ 0
+ 1
+ 0
+ 1
+ 1
+ 1
+ True
+ True
+ WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
+
+ False
+
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ True
+ False
+ False
+ False
+ True
+ True
+ True
+ True
+ True
+ True
+
+
+
+ 0
+ 0
+ False
+ 1
+ False
+ False
+ False
+ 16384
+ 1048576
+ 4194304
+
+
+
+
+
+
+
+ ..\..\Source
+
+
+
+ False
+
+
+
+
+
+ False
+
+
+ True
+ False
+
+
+ False
+ False
+ 1
+ 0
+ 0
+ 0
+ False
+ False
+ False
+ False
+ False
+ 1043
+ 1252
+
+
+
+
+ 1.0.0.0
+
+
+
+
+
+ 1.0.0.0
+
+
+
+
+
+
diff --git a/Test/MenuBar/MenuBarTest.cfg b/Test/MenuBar/MenuBarTest.cfg
new file mode 100644
index 0000000..30e5130
--- /dev/null
+++ b/Test/MenuBar/MenuBarTest.cfg
@@ -0,0 +1,42 @@
+-$A8
+-$B-
+-$C+
+-$D+
+-$E-
+-$F-
+-$G+
+-$H+
+-$I+
+-$J-
+-$K-
+-$L+
+-$M-
+-$N+
+-$O+
+-$P+
+-$Q-
+-$R-
+-$S-
+-$T-
+-$U-
+-$V+
+-$W-
+-$X+
+-$YD
+-$Z1
+-cg
+-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
+-H+
+-W+
+-M
+-$M16384,1048576
+-K$00400000
+-LE"C:\Documents and Settings\PsychoMark\My Documents\Borland Studio Projects\Bpl"
+-LN"C:\Documents and Settings\PsychoMark\My Documents\Borland Studio Projects\Bpl"
+-U"..\..\Source"
+-O"..\..\Source"
+-I"..\..\Source"
+-R"..\..\Source"
+-w-UNSAFE_TYPE
+-w-UNSAFE_CODE
+-w-UNSAFE_CAST
diff --git a/Test/MenuBar/MenuBarTest.dpr b/Test/MenuBar/MenuBarTest.dpr
new file mode 100644
index 0000000..1c023f5
--- /dev/null
+++ b/Test/MenuBar/MenuBarTest.dpr
@@ -0,0 +1,16 @@
+program MenuBarTest;
+
+uses
+ Forms,
+ MainForm in 'MainForm.pas' {frmMain};
+
+{$R *.res}
+
+var
+ frmMain: TfrmMain;
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TfrmMain, frmMain);
+ Application.Run;
+end.
diff --git a/Test/MenuBar/MenuBarTest.res b/Test/MenuBar/MenuBarTest.res
new file mode 100644
index 0000000..ba1ed6e
Binary files /dev/null and b/Test/MenuBar/MenuBarTest.res differ