GitHub-Mirror/x2cl
1
0
Fork 0
mirror of synced 2024-11-21 17:43:51 +00:00
Code Issues Projects Releases Wiki Activity

Added: OnExpand/Collapse events

Browse Source 
Added: Fade + Fade/Slide animations
Changed: Animation properties moved from Painter to MenuBar
Changed: concrete animation classes moved to separate unit
Changed: custom Scroller replaced for standard Windows scrollbar
This commit is contained in:
Mark van Renswoude 2006-04-02 20:00:02 +00:00
parent 9a1dd7da01
commit b5eb0c6ad3
7 changed files with 1025 additions and 875 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1212
Source/X2CLMenuBar.pas
View File

File diff suppressed because it is too large Load Diff

383
Source/X2CLMenuBarAnimators.pas Normal file
View File

@ -0,0 +1,383 @@
{
:: Implements the animators for the MenuBar.
::
:: Though they are tightly interlinked (for now), this keeps the units clean.
::
:: Last changed: $Date$
:: Revision: $Rev$
:: Author: $Author$
}
unit X2CLMenuBarAnimators;
interface
uses
Classes,
Graphics,
Windows,
X2CLMenuBar;
type
{
:$ Implements a sliding animation
}
TX2MenuBarSlideAnimator = class(TX2CustomMenuBarAnimator)
private
FSlideHeight: Integer;
protected
function GetHeight(): Integer; override;
public
procedure Update(); override;
procedure Draw(ACanvas: TCanvas; const ABounds: TRect); override;
end;
{
:$ Implements a dissolve animation
}
TX2MenuBarDissolveAnimator = class(TX2CustomMenuBarAnimator)
private
FItemsState: Graphics.TBitmap;
FMask: Graphics.TBitmap;
FPixels: TList;
protected
procedure SetExpanding(const Value: Boolean); override;
property ItemsState: Graphics.TBitmap read FItemsState;
property Mask: Graphics.TBitmap read FMask;
public
constructor Create(AItemsBuffer: Graphics.TBitmap); override;
destructor Destroy(); override;
procedure Update(); override;
procedure Draw(ACanvas: TCanvas; const ABounds: TRect); override;
end;
{
:$ Implements a fade animation
}
TX2MenuBarFadeAnimator = class(TX2CustomMenuBarAnimator)
private
FAlpha: Byte;
public
constructor Create(AItemsBuffer: Graphics.TBitmap); override;
procedure Update(); override;
procedure Draw(ACanvas: TCanvas; const ABounds: TRect); override;
end;
{
:$ Implements a sliding fade animation
}
TX2MenuBarSlideFadeAnimator = class(TX2MenuBarFadeAnimator)
private
FSlideHeight: Integer;
protected
function GetHeight(): Integer; override;
public
procedure Update(); override;
end;
implementation
uses
SysUtils;
{ TX2MenuBarSlideAnimator }
function TX2MenuBarSlideAnimator.GetHeight(): Integer;
begin
Result := FSlideHeight;
end;
procedure TX2MenuBarSlideAnimator.Update();
var
elapsed: Cardinal;
begin
elapsed := TimeElapsed;
FSlideHeight := Trunc((elapsed / AnimationTime) * ItemsBuffer.Height);
if not Expanding then
FSlideHeight := ItemsBuffer.Height - FSlideHeight;
if FSlideHeight > ItemsBuffer.Height then
FSlideHeight := ItemsBuffer.Height
else if FSlideHeight < 0 then
FSlideHeight := 0;
if elapsed >= AnimationTime then
Terminate();
end;
procedure TX2MenuBarSlideAnimator.Draw(ACanvas: TCanvas; const ABounds: TRect);
var
sourceRect: TRect;
destRect: TRect;
begin
sourceRect := Rect(0, 0, ItemsBuffer.Width, FSlideHeight);
destRect := ABounds;
destRect.Bottom := destRect.Top + FSlideHeight;
ACanvas.CopyRect(destRect, ItemsBuffer.Canvas, sourceRect);
end;
{ TX2MenuBarDissolveAnimator }
constructor TX2MenuBarDissolveAnimator.Create(AItemsBuffer: Graphics.TBitmap);
var
pixelIndex: Integer;
pixelPos: Integer;
tempPos: Pointer;
begin
inherited;
{ The bitmaps need to be 32-bits since we'll be accessing the scanlines as
one big array, not by using Scanline on each row. In 24-bit mode, the
scanlines are still aligned on a 32-bits boundary, thus causing problems. }
ItemsBuffer.PixelFormat := pf32bit;
FMask := Graphics.TBitmap.Create();
FMask.PixelFormat := pf32bit;
FMask.Width := AItemsBuffer.Width;
FMask.Height := AItemsBuffer.Height;
FItemsState := Graphics.TBitmap.Create();
FItemsState.PixelFormat := pf32bit;
FItemsState.Width := AItemsBuffer.Width;
FItemsState.Height := AItemsBuffer.Height;
if RandSeed = 0 then
Randomize();
{ Prepare an array of pixel indices which will be used to pick random
unique pixels in the Update method.
Optimization note: previously the array was ordered and an item would
be randomly picked and deleted in Update. Now we pre-shuffle the list,
then Delete only from the end, which does not reallocate or move any
memory (TList.Count decreases, Capacity stays the same), a LOT faster. }
FPixels := TList.Create();
FPixels.Count := AItemsBuffer.Width * AItemsBuffer.Height;
for pixelIndex := Pred(FPixels.Count) downto 0 do
FPixels[pixelIndex] := Pointer(pixelIndex);
for pixelIndex := Pred(FPixels.Count) downto 0 do
begin
pixelPos := Random(Succ(pixelIndex));
if (pixelPos <> pixelIndex) then
begin
tempPos := FPixels[pixelIndex];
FPixels[pixelIndex] := FPixels[pixelPos];
FPixels[pixelPos] := tempPos;
end;
end;
end;
destructor TX2MenuBarDissolveAnimator.Destroy();
begin
FreeAndNil(FItemsState);
FreeAndNil(FMask);
inherited;
end;
procedure TX2MenuBarDissolveAnimator.Update();
const
RGBBlack: TRGBQuad = (rgbBlue: 0;
rgbGreen: 0;
rgbRed: 0;
rgbReserved: 0);
RGBWhite: TRGBQuad = (rgbBlue: 255;
rgbGreen: 255;
rgbRed: 255;
rgbReserved: 0);
var
totalPixelCount: Integer;
elapsed: Cardinal;
pixelsRemaining: Integer;
pixel: Integer;
pixelIndex: Integer;
pixelCount: Integer;
pixelPos: Integer;
statePixels: PRGBAArray;
maskPixels: PRGBAArray;
itemsPixels: PRGBAArray;
begin
totalPixelCount := ItemsBuffer.Width * ItemsBuffer.Height;
elapsed := TimeElapsed;
pixelsRemaining := totalPixelCount - (Trunc((elapsed / AnimationTime) *
totalPixelCount));
if pixelsRemaining < 0 then
pixelsRemaining := 0;
statePixels := GetScanlinePointer(ItemsState);
maskPixels := GetScanlinePointer(Mask);
itemsPixels := nil;
if Expanding then
itemsPixels := GetScanlinePointer(ItemsBuffer);
for pixel := Pred(FPixels.Count - pixelsRemaining) downto 0 do
begin
pixelCount := FPixels.Count;
pixelIndex := Pred(pixelCount);
pixelPos := Integer(FPixels[pixelIndex]);
FPixels.Delete(pixelIndex);
if Expanding then
begin
{ Make the pixel visible }
statePixels^[pixelPos] := itemsPixels^[pixelPos];
maskPixels^[pixelPos] := RGBBlack;
end else
begin
{ Make the pixel invisible }
statePixels^[pixelPos] := RGBBlack;
maskPixels^[pixelPos] := RGBWhite;
end;
end;
if elapsed >= AnimationTime then
Terminate();
end;
procedure TX2MenuBarDissolveAnimator.Draw(ACanvas: TCanvas; const ABounds: TRect);
var
boundsRegion: THandle;
oldCopyMode: TCopyMode;
begin
boundsRegion := CreateRectRgn(ABounds.Left, ABounds.Top, ABounds.Right,
ABounds.Bottom);
oldCopyMode := ACanvas.CopyMode;
try
SelectClipRgn(ACanvas.Handle, boundsRegion);
ACanvas.CopyMode := cmSrcAnd;
ACanvas.Draw(ABounds.Left, ABounds.Top, Mask);
ACanvas.CopyMode := cmSrcPaint;
ACanvas.Draw(ABounds.Left, ABounds.Top, ItemsState);
finally
SelectClipRgn(ACanvas.Handle, 0);
ACanvas.CopyMode := oldCopyMode;
end;
end;
procedure TX2MenuBarDissolveAnimator.SetExpanding(const Value: Boolean);
begin
if Value then
begin
{ Start with an invisible group }
FMask.Canvas.Brush.Color := clWhite;
with FItemsState.Canvas do
begin
Brush.Color := clBlack;
FillRect(Rect(0, 0, FItemsState.Width, FItemsState.Height));
end;
end else
begin
{ Start with a visible group }
FMask.Canvas.Brush.Color := clBlack;
FItemsState.Canvas.Draw(0, 0, ItemsBuffer);
end;
FMask.Canvas.FillRect(Rect(0, 0, FMask.Width, FMask.Height));
inherited;
end;
{ TX2MenuBarFadeAnimator }
constructor TX2MenuBarFadeAnimator.Create(AItemsBuffer: Graphics.TBitmap);
begin
inherited;
ItemsBuffer.PixelFormat := pf32bit;
end;
procedure TX2MenuBarFadeAnimator.Update();
var
elapsed: Cardinal;
newAlpha: Integer;
begin
elapsed := TimeElapsed;
newAlpha := Trunc((elapsed / AnimationTime) * 255);
if Expanding then
newAlpha := 255 - newAlpha;
if newAlpha > 255 then
newAlpha := 255
else if newAlpha < 0 then
newAlpha := 0;
FAlpha := newAlpha;
if elapsed >= AnimationTime then
Terminate();
end;
procedure TX2MenuBarFadeAnimator.Draw(ACanvas: TCanvas; const ABounds: TRect);
var
backBuffer: Graphics.TBitmap;
sourceRect: TRect;
destRect: TRect;
begin
if ABounds.Bottom - ABounds.Top <= 0 then
exit;
backBuffer := Graphics.TBitmap.Create();
try
backBuffer.PixelFormat := pf32bit;
backBuffer.Width := ItemsBuffer.Width;
backBuffer.Height := ItemsBuffer.Height;
destRect := Rect(0, 0, backBuffer.Width, backBuffer.Height);
backBuffer.Canvas.CopyRect(destRect, ACanvas, ABounds);
X2CLMenuBar.DrawBlended(backBuffer, ItemsBuffer, FAlpha);
sourceRect := Rect(0, 0, ItemsBuffer.Width, Self.Height);
destRect := ABounds;
destRect.Bottom := destRect.Top + Self.Height;
ACanvas.CopyRect(destRect, backBuffer.Canvas, sourceRect);
finally
FreeAndNil(backBuffer);
end;
end;
{ TX2MenuBarSlideFadeAnimator }
function TX2MenuBarSlideFadeAnimator.GetHeight(): Integer;
begin
Result := FSlideHeight;
end;
procedure TX2MenuBarSlideFadeAnimator.Update();
var
elapsed: Cardinal;
begin
elapsed := TimeElapsed;
FSlideHeight := Trunc((elapsed / AnimationTime) * ItemsBuffer.Height);
if not Expanding then
FSlideHeight := ItemsBuffer.Height - FSlideHeight;
if FSlideHeight > ItemsBuffer.Height then
FSlideHeight := ItemsBuffer.Height
else if FSlideHeight < 0 then
FSlideHeight := 0;
inherited;
end;
end.

124
Source/X2CLmusikCubeMenuBarPainter.pas
View File

@ -96,22 +96,17 @@ type
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;
function GetScrollerClass(): TX2CustomMenuBarScrollerClass; 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;
@ -120,80 +115,11 @@ type
property ItemHeight: Integer read FItemHeight write SetItemHeight stored False;
end;
TX2MenuBarmusikCubeScroller = class(TX2MenuBarScrollbarScroller)
private
function GetPainter(): TX2MenuBarmusikCubePainter;
protected
procedure DrawArrowButton(ACanvas: TCanvas; const ABounds: TRect; ADirection: TScrollbarArrowDirection); override;
procedure DrawBackground(ACanvas: TCanvas; const ABounds: TRect); override;
procedure DrawThumb(ACanvas: TCanvas; const ABounds: TRect); override;
property Painter: TX2MenuBarmusikCubePainter read GetPainter;
end;
implementation
uses
SysUtils;
{ TX2MenuBarmusikCubeScroller }
procedure TX2MenuBarmusikCubeScroller.DrawArrowButton(ACanvas: TCanvas;
const ABounds: TRect;
ADirection: TScrollbarArrowDirection);
const
ArrowChars: array[TScrollbarArrowDirection] of Char = ('t', 'u');
var
oldFont: TFont;
begin
// #ToDo1 (MvR) 1-4-2006: use separate colors
with Painter.GroupColors.Normal do
begin
ACanvas.Brush.Color := MixFill(Painter.Color);
ACanvas.Pen.Color := MixBorder(Painter.Color);
ACanvas.Rectangle(ABounds);
end;
oldFont := TFont.Create();
oldFont.Assign(ACanvas.Font);
try
ACanvas.Font.Color := clWindowText;
ACanvas.Font.Name := 'Marlett';
ACanvas.Font.Size := 10;
ACanvas.Font.Style := [];
DrawText(ACanvas, ArrowChars[ADirection], ABounds, taCenter,
taVerticalCenter);
finally
ACanvas.Font.Assign(oldFont);
FreeAndNil(oldFont);
end;
end;
procedure TX2MenuBarmusikCubeScroller.DrawBackground(ACanvas: TCanvas;
const ABounds: TRect);
begin
with Painter.ItemColors.Hot do
begin
ACanvas.Brush.Color := MixFill(Painter.Color);
ACanvas.FillRect(ABounds);
end;
end;
procedure TX2MenuBarmusikCubeScroller.DrawThumb(ACanvas: TCanvas;
const ABounds: TRect);
begin
//
end;
function TX2MenuBarmusikCubeScroller.GetPainter(): TX2MenuBarmusikCubePainter;
begin
Result := (inherited MenuBar.Painter as TX2MenuBarmusikCubePainter);
end;
{ TX2MenuBarmusikCubePainter }
constructor TX2MenuBarmusikCubePainter.Create(AOwner: TComponent);
begin
@ -300,12 +226,6 @@ var
iconBuffer: Graphics.TBitmap;
sourceRect: TRect;
destRect: TRect;
sourceRow: PRGBAArray;
destRow: PRGBAArray;
xPos: Integer;
yPos: Integer;
backAlpha: Integer;
iconAlpha: Integer;
begin
backBuffer := Graphics.TBitmap.Create();
@ -324,25 +244,7 @@ begin
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
rgbRed := ((rgbRed * backAlpha) +
(sourceRow^[xPos].rgbRed * iconAlpha)) shr 8;
rgbGreen := ((rgbGreen * backAlpha) +
(sourceRow^[xPos].rgbGreen * iconAlpha)) shr 8;
rgbBlue := ((rgbBlue * backAlpha) +
(sourceRow^[xPos].rgbBlue * iconAlpha)) shr 8;
end;
end;
X2CLMenuBar.DrawBlended(backBuffer, iconBuffer, AAlpha);
finally
FreeAndNil(iconBuffer);
end;
@ -359,23 +261,12 @@ 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;
function TX2MenuBarmusikCubePainter.GetScrollerClass: TX2CustomMenuBarScrollerClass;
begin
// Result := TX2MenuBarmusikCubeScroller;
Result := TX2MenuBarScrollbarScroller;
end;
procedure TX2MenuBarmusikCubePainter.DrawBackground(ACanvas: TCanvas;
const ABounds: TRect);
begin
@ -410,6 +301,11 @@ begin
Dec(textBounds.Right, 2);
ACanvas.Font.Style := [fsBold];
if AGroup.Enabled then
ACanvas.Font.Color := clWindowText
else
ACanvas.Font.Color := clGrayText;
DrawText(ACanvas, AGroup.Caption, textBounds, taLeftJustify,
taVerticalCenter, False, csEllipsis);
end;
@ -472,12 +368,16 @@ begin
Inc(textBounds.Left, imageList.Width + 4);
end;
if mdsSelected in AState then
if not AItem.Visible then
{ Design-time }
ACanvas.Font.Style := [fsItalic]
else if mdsSelected in AState then
ACanvas.Font.Style := [fsBold]
else
ACanvas.Font.Style := [];
DrawText(ACanvas, AItem.Caption, textBounds);
DrawText(ACanvas, AItem.Caption, textBounds, taLeftJustify, taVerticalCenter,
False, csEllipsis);
end;
end;

25
Source/X2CLunaMenuBarPainter.pas
View File

@ -15,24 +15,21 @@ uses
X2CLMenuBar;
type
// #ToDo1 (MvR) 27-3-2006: arrow gets cut off one pixel when collapsing a group
TX2MenuBarunaPainter = class(TX2CustomMenuBarPainter)
private
FBlurShadow: Boolean;
procedure SetBlurShadow(const Value: Boolean);
protected
function ApplyMargins(const ABounds: TRect): TRect; override;
function GetSpacing(AElement: TX2MenuBarSpacingElement): Integer; override;
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;
published
property AnimationStyle;
property AnimationTime;
property BlurShadow: Boolean read FBlurShadow write SetBlurShadow;
end;
@ -172,14 +169,6 @@ begin
Result := 22;
end;
function TX2MenuBarunaPainter.GetGroupHeight(AGroup: TX2MenuBarGroup): Integer;
begin
Result := GetSpacing(seBeforeFirstItem) +
(AGroup.Items.Count * (GetSpacing(seBeforeItem) + 21 +
GetSpacing(seAfterItem))) +
GetSpacing(seAfterLastItem);
end;
function TX2MenuBarunaPainter.GetItemHeight(AItem: TX2MenuBarItem): Integer;
begin
Result := 21;
@ -299,8 +288,7 @@ begin
if (mdsSelected in AState) then
begin
{ Focus rectangle }
SetTextColor(ACanvas.Handle, ColorToRGB(clBlack));
DrawFocusRect(ACanvas.Handle, focusBounds);
DrawFocusRect(ACanvas, focusBounds);
{ Arrow }
ACanvas.Brush.Color := clBlue;
@ -326,8 +314,13 @@ begin
Dec(textBounds.Right, 4);
SetBkMode(ACanvas.Handle, TRANSPARENT);
ACanvas.Font.Style := [];
if not AItem.Visible then
{ Design-time }
ACanvas.Font.Style := [fsItalic]
else
ACanvas.Font.Style := [];
DrawText(ACanvas, AItem.Caption, textBounds, taRightJustify, taVerticalCenter,
False, csEllipsis);
end;

105
Test/MenuBar/MainForm.dfm
View File

@ -2,8 +2,8 @@ object frmMain: TfrmMain
Left = 300
Top = 219
Caption = 'X2MenuBar Test'
ClientHeight = 381
ClientWidth = 550
ClientHeight = 379
ClientWidth = 548
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
@ -16,13 +16,14 @@ object frmMain: TfrmMain
PixelsPerInch = 96
TextHeight = 13
object bvlMenu: TBevel
Left = 137
Left = 125
Top = 0
Width = 8
Height = 381
Height = 379
Align = alLeft
Shape = bsLeftLine
ExplicitLeft = 141
ExplicitLeft = 148
ExplicitTop = -4
end
object lblAnimationTime: TLabel
Left = 356
@ -34,9 +35,11 @@ object frmMain: TfrmMain
object mbTest: TX2MenuBar
Left = 0
Top = 0
Width = 137
Height = 381
Width = 125
Height = 379
Align = alLeft
AnimationStyle = asSlide
AnimationTime = 250
Groups = <
item
Caption = 'Share'
@ -58,6 +61,14 @@ object frmMain: TfrmMain
item
Caption = 'Video'
ImageIndex = 3
end
item
Caption = 'Invisible item'
Visible = False
end
item
Caption = 'Disabled item'
Enabled = False
end>
end
item
@ -67,7 +78,6 @@ object frmMain: TfrmMain
Items = <
item
Caption = 'Menu Item'
ImageIndex = -1
end>
end
item
@ -78,97 +88,90 @@ object frmMain: TfrmMain
end
item
Caption = 'Biiiiig group.'
ImageIndex = -1
Expanded = False
Items = <
item
Caption = 'Menu Item'
ImageIndex = -1
end
item
Caption = 'Menu Item'
ImageIndex = -1
end
item
Caption = 'Menu Item'
ImageIndex = -1
end
item
Caption = 'Menu Item'
ImageIndex = -1
end
item
Caption = 'Menu Item'
ImageIndex = -1
end
item
Caption = 'Menu Item'
ImageIndex = -1
end
item
Caption = 'Menu Item'
ImageIndex = -1
end
item
Caption = 'Menu Item'
ImageIndex = -1
end
item
Caption = 'Menu Item'
ImageIndex = -1
end
item
Caption = 'Menu Item'
ImageIndex = -1
end
item
Caption = 'Menu Item'
ImageIndex = -1
end
item
Caption = 'Menu Item'
ImageIndex = -1
end
item
Caption = 'Menu Item'
ImageIndex = -1
end
item
Caption = 'Menu Item'
ImageIndex = -1
end
item
Caption = 'Menu Item'
ImageIndex = -1
end
item
Caption = 'Menu Item'
ImageIndex = -1
end
item
Caption = 'Menu Item'
ImageIndex = -1
end
item
Caption = 'Menu Item'
ImageIndex = -1
end
item
Caption = 'Menu Item'
ImageIndex = -1
end
item
Caption = 'Menu Item'
ImageIndex = -1
end
item
Caption = 'Menu Item'
ImageIndex = -1
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>
ImageList = glMenu
Options = [mboAllowCollapseAll]
Painter = mcPainter
ExplicitLeft = 8
end
object seAnimationTime: TJvSpinEdit
Left = 356
@ -221,8 +224,8 @@ object frmMain: TfrmMain
object Panel2: TPanel
Left = 356
Top = 72
Width = 129
Height = 89
Width = 169
Height = 101
BevelOuter = bvNone
TabOrder = 3
object rbSliding: TRadioButton
@ -251,8 +254,8 @@ object frmMain: TfrmMain
Width = 113
Height = 17
Caption = 'Fading animation'
Enabled = False
TabOrder = 3
OnClick = AnimationClick
end
object rbDissolve: TRadioButton
Left = 0
@ -263,10 +266,19 @@ object frmMain: TfrmMain
TabOrder = 2
OnClick = AnimationClick
end
object rbSlideFade: TRadioButton
Left = 0
Top = 80
Width = 153
Height = 17
Caption = 'Fading + sliding animation'
TabOrder = 4
OnClick = AnimationClick
end
end
object chkAutoCollapse: TCheckBox
Left = 212
Top = 192
Top = 200
Width = 89
Height = 17
Caption = 'Auto collapse'
@ -275,7 +287,7 @@ object frmMain: TfrmMain
end
object chkAllowCollapseAll: TCheckBox
Left = 212
Top = 232
Top = 240
Width = 101
Height = 17
Caption = 'Allow collapse all'
@ -284,7 +296,7 @@ object frmMain: TfrmMain
end
object chkAutoSelectItem: TCheckBox
Left = 212
Top = 212
Top = 220
Width = 101
Height = 17
Caption = 'Auto select item'
@ -293,13 +305,25 @@ object frmMain: TfrmMain
end
object chkScrollbar: TCheckBox
Left = 356
Top = 192
Top = 200
Width = 121
Height = 17
Caption = 'Scrollbar'
Checked = True
State = cbChecked
TabOrder = 7
OnClick = chkScrollbarClick
end
object chkHideScrollbar: TCheckBox
Left = 356
Top = 221
Width = 121
Height = 17
Caption = 'Hide Scrollbar'
Checked = True
State = cbChecked
TabOrder = 8
OnClick = chkHideScrollbarClick
end
object gcMenu: TX2GraphicContainer
Graphics = <
@ -415,14 +439,11 @@ object frmMain: TfrmMain
Top = 8
end
object mcPainter: TX2MenuBarmusikCubePainter
AnimationStyle = asSlide
AnimationTime = 250
Left = 152
Top = 8
end
object unaPainter: TX2MenuBarunaPainter
AnimationStyle = asSlide
AnimationTime = 250
BlurShadow = False
Left = 152
Top = 36
end

48
Test/MenuBar/MainForm.pas
View File

@ -9,6 +9,7 @@ uses
ImgList,
Mask,
StdCtrls,
XPMan,
JvExMask,
JvSpin,
@ -41,6 +42,10 @@ type
chkAutoSelectItem: TCheckBox;
chkBlurShadow: TCheckBox;
chkScrollbar: TCheckBox;
chkHideScrollbar: TCheckBox;
rbSlideFade: TRadioButton;
procedure chkHideScrollbarClick(Sender: TObject);
procedure chkScrollbarClick(Sender: TObject);
procedure chkBlurShadowClick(Sender: TObject);
procedure chkAutoSelectItemClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
@ -64,35 +69,29 @@ begin
style := asSlide
else if rbDissolve.Checked then
style := asDissolve
else if rbSlideFade.Checked then
style := asSlideFade
else if rbFade.Checked then
style := asFade
else
style := asNone;
mcPainter.AnimationStyle := style;
unaPainter.AnimationStyle := style;
mbTest.AnimationStyle := style;
end;
procedure TfrmMain.chkAllowCollapseAllClick(Sender: TObject);
begin
if chkAllowCollapseAll.Checked then
mbTest.Options := mbTest.Options + [mboAllowCollapseAll]
else
mbTest.Options := mbTest.Options - [mboAllowCollapseAll];
mbTest.AllowCollapseAll := chkAllowCollapseAll.Checked;
end;
procedure TfrmMain.chkAutoCollapseClick(Sender: TObject);
begin
if chkAutoCollapse.Checked then
mbTest.Options := mbTest.Options + [mboAutoCollapse]
else
mbTest.Options := mbTest.Options - [mboAutoCollapse];
mbTest.AutoCollapse := chkAutoCollapse.Checked;
end;
procedure TfrmMain.chkAutoSelectItemClick(Sender: TObject);
begin
if chkAutoSelectItem.Checked then
mbTest.Options := mbTest.Options + [mboAutoSelectItem]
else
mbTest.Options := mbTest.Options - [mboAutoSelectItem];
mbTest.AutoSelectItem := chkAutoSelectItem.Checked;
end;
procedure TfrmMain.chkBlurShadowClick(Sender: TObject);
@ -100,11 +99,23 @@ begin
unaPainter.BlurShadow := chkBlurShadow.Checked;
end;
procedure TfrmMain.chkHideScrollbarClick(Sender: TObject);
begin
mbTest.HideScrollbar := chkHideScrollbar.Checked;
end;
procedure TfrmMain.chkScrollbarClick(Sender: TObject);
begin
mbTest.Scrollbar := chkScrollbar.Checked;
end;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
chkAutoCollapse.Checked := mboAutoCollapse in mbTest.Options;
chkAutoSelectItem.Checked := mboAutoSelectItem in mbTest.Options;
chkAllowCollapseAll.Checked := mboAllowCollapseAll in mbTest.Options;
chkAutoCollapse.Checked := mbTest.AutoCollapse;
chkAutoSelectItem.Checked := mbTest.AutoSelectItem;
chkAllowCollapseAll.Checked := mbTest.AllowCollapseAll;
chkScrollbar.Checked := mbTest.Scrollbar;
chkHideScrollbar.Checked := mbTest.HideScrollbar;
end;
procedure TfrmMain.PainterClick(Sender: TObject);
@ -126,8 +137,7 @@ end;
procedure TfrmMain.seAnimationTimeChange(Sender: TObject);
begin
mcPainter.AnimationTime := seAnimationTime.AsInteger;
unaPainter.AnimationTime := seAnimationTime.AsInteger;
mbTest.AnimationTime := seAnimationTime.AsInteger;
end;
end.

3
Test/MenuBar/MenuBarTest.dpr
View File

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