Changed: refactored animation class

Added: resolving animation
Added: Uname-IT painter
Added: various options (auto-collapse, auto-select, etc)

Packages/X2CLMBReg.pas

@@ -15,14 +15,16 @@ uses
   Classes,
   DesignIntf,
   X2CLMenuBar,
-  X2CLmusikCubePainter;
+  X2CLmusikCubeMenuBarPainter,
+  X2CLunaMenuBarPainter;
 
 {.$R ..\Resources\MenuBar.dcr}
 
 procedure Register;
 begin
   RegisterComponents('X2Software', [TX2MenuBar,
-                                    TX2MenuBarmusikCubePainter]);
+                                    TX2MenuBarmusikCubePainter,
+                                    TX2MenuBarunaPainter]);
 end;
 
 end.

Source/X2CLmusikCubeMenuBarPainter.pas

@@ -5,7 +5,7 @@
   :: Revision:        $Rev$
   :: Author:          $Author$
 }
-unit X2CLmusikCubePainter;
+unit X2CLmusikCubeMenuBarPainter;
 
 interface
 uses
@@ -74,7 +74,7 @@ type
   end;
 
   // #ToDo1 (MvR) 19-3-2006: Custom base class
-  TX2MenuBarmusikCubePainter = class(TX2MenuBarPainter)
+  TX2MenuBarmusikCubePainter = class(TX2CustomMenuBarPainter)
   private
     FColor:             TColor;
     FGroupColors:       TX2MenuBarmCColors;
@@ -122,10 +122,6 @@ implementation
 uses
   SysUtils;
 
-type
-  PRGBArray = ^TRGBArray;
-  TRGBArray = array[Word] of TRGBTriple;
-
 
 { TX2MenuBarmusikCubePainter }
 constructor TX2MenuBarmusikCubePainter.Create(AOwner: TComponent);
@@ -184,9 +180,9 @@ begin
   with IndicatorColors.Selected do
   begin
     BorderAlpha := 252;
-    BorderColor := clHighlight;
+    BorderColor := clActiveCaption;
     FillAlpha   := 252;
-    FillColor   := clHighlight;
+    FillColor   := clActiveCaption;
   end;
 
   { Item buttons }

Source/X2CLunaMenuBarPainter.pas

@@ -0,0 +1,335 @@
+{
+  :: Implements a Uname-IT-style painter for the X2MenuBar.
+  ::
+  :: Last changed:    $Date$
+  :: Revision:        $Rev$
+  :: Author:          $Author$
+}
+unit X2CLunaMenuBarPainter;
+
+interface
+uses
+  Graphics,
+  Windows,
+
+  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;
+
+implementation
+uses
+  Classes,
+  ImgList,
+  SysUtils;
+
+
+
+procedure Blur(ASource: Graphics.TBitmap);
+var
+  refBitmap:      Graphics.TBitmap;
+  lines:          array[0..2] of PRGBArray;
+  lineDest:       PRGBArray;
+  lineIndex:      Integer;
+  line:           PRGBArray;
+  xPos:           Integer;
+  yPos:           Integer;
+  maxX:           Integer;
+  maxY:           Integer;
+  sumRed:         Integer;
+  sumGreen:       Integer;
+  sumBlue:        Integer;
+  samples:        Integer;
+
+begin
+  ASource.PixelFormat := pf24bit;
+  refBitmap           := Graphics.TBitmap.Create();
+  try
+    refBitmap.Assign(ASource);
+
+    for lineIndex := Low(lines) to High(lines) do
+      lines[lineIndex]  := nil;
+
+    maxY  := Pred(ASource.Height);
+    for yPos := 0 to maxY do
+    begin
+      for lineIndex := Low(lines) to High(lines) - 1 do
+        lines[lineIndex]  := lines[Succ(lineIndex)];
+
+      if yPos = maxY then
+        lines[High(lines)]  := nil
+      else
+        lines[High(lines)]  := refBitmap.ScanLine[Succ(yPos)];
+        
+      lineDest            := ASource.ScanLine[yPos];
+      maxX                := Pred(ASource.Width);
+
+      for xPos := 0 to maxX do
+      begin
+        sumBlue   := 0; 
+        sumGreen  := 0;
+        sumRed    := 0;
+        samples   := 0;
+
+        for lineIndex := Low(lines) to High(lines) do
+          if Assigned(lines[lineIndex]) then
+          begin
+            line  := lines[lineIndex];
+
+            with line^[xPos] do
+            begin
+              Inc(sumBlue, rgbtBlue);
+              Inc(sumGreen, rgbtGreen);
+              Inc(sumRed, rgbtRed);
+              Inc(samples);
+            end;
+
+            if xPos > 0 then
+              with line^[Pred(xPos)] do
+              begin
+                Inc(sumBlue, rgbtBlue);
+                Inc(sumGreen, rgbtGreen);
+                Inc(sumRed, rgbtRed);
+                Inc(samples);
+              end;
+
+            if xPos < maxX then
+              with line^[Succ(xPos)] do
+              begin
+                Inc(sumBlue, rgbtBlue);
+                Inc(sumGreen, rgbtGreen);
+                Inc(sumRed, rgbtRed);
+                Inc(samples);
+              end;
+          end;
+
+        if samples > 0 then
+          with lineDest^[xPos] do
+          begin
+            rgbtBlue  := sumBlue div samples;
+            rgbtGreen := sumGreen div samples;
+            rgbtRed   := sumRed div samples;
+          end;
+      end;
+    end;
+  finally
+    FreeAndNil(refBitmap);
+  end;
+end;
+
+
+{ TX2MenuBarunaPainter }
+procedure TX2MenuBarunaPainter.SetBlurShadow(const Value: Boolean);
+begin
+  if Value <> FBlurShadow then
+  begin
+    FBlurShadow := Value;
+    NotifyObservers();
+  end;
+end;
+
+
+function TX2MenuBarunaPainter.ApplyMargins(const ABounds: TRect): TRect;
+begin
+  Result  := inherited ApplyMargins(ABounds);
+  InflateRect(Result, -10, -10);
+end;
+
+function TX2MenuBarunaPainter.GetSpacing(AElement: TX2MenuBarSpacingElement): Integer;
+begin
+  Result  := inherited GetSpacing(AElement);
+  
+  case AElement of
+    seBeforeGroupHeader,
+    seAfterGroupHeader:   Result  := 5;
+    seAfterLastItem:      Result  := 10;
+    seBeforeItem,
+    seAfterItem:          Result  := 4;
+  end;
+end;
+
+function TX2MenuBarunaPainter.GetGroupHeaderHeight(AGroup: TX2MenuBarGroup): Integer;
+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;
+end;
+
+
+procedure TX2MenuBarunaPainter.DrawBackground(ACanvas: TCanvas;
+                                              const ABounds: TRect);
+begin
+  ACanvas.Brush.Color := clWindow;
+  ACanvas.FillRect(ABounds);
+end;
+
+procedure TX2MenuBarunaPainter.DrawGroupHeader(ACanvas: TCanvas;
+                                               AGroup: TX2MenuBarGroup;
+                                               const ABounds: TRect;
+                                               AState: TX2MenuBarDrawStates);
+  procedure DrawShadowOutline(AShadowCanvas: TCanvas; AShadowBounds: TRect);
+  begin
+    // #ToDo1 (MvR) 27-3-2006: make the color a property
+    if BlurShadow then
+    begin
+      AShadowCanvas.Brush.Color := $00c3c3c3;
+      AShadowCanvas.Pen.Color   := $00c3c3c3;
+    end else
+    begin
+      AShadowCanvas.Brush.Color := $00404040;
+      AShadowCanvas.Pen.Color   := $00404040;
+    end;
+
+    AShadowCanvas.RoundRect(AShadowBounds.Left + 2,
+                            AShadowBounds.Top + 2,
+                            AShadowBounds.Right + 2,
+                            AShadowBounds.Bottom + 2, 5, 5);
+  end;
+
+var
+  textRect:         TRect;
+  imageList:        TCustomImageList;
+  imagePos:         TPoint;
+  shadowBitmap:     Graphics.TBitmap;
+
+begin
+  if not ((mdsSelected in AState) or (mdsGroupSelected in AState)) then
+  begin
+    { Shadow }
+    if BlurShadow then
+    begin
+      shadowBitmap  := Graphics.TBitmap.Create();
+      try
+        shadowBitmap.PixelFormat  := pf24bit;
+        shadowBitmap.Width        := (ABounds.Right - ABounds.Left + 4);
+        shadowBitmap.Height       := (ABounds.Bottom - ABounds.Top + 4);
+
+        DrawBackground(shadowBitmap.Canvas, Rect(0, 0, shadowBitmap.Width,
+                                                 shadowBitmap.Height));
+        DrawShadowOutline(shadowBitmap.Canvas, Rect(0, 0, shadowBitmap.Width - 4,
+                          shadowBitmap.Height - 4));
+
+        Blur(shadowBitmap);
+        ACanvas.Draw(ABounds.Left, ABounds.Top, shadowBitmap);
+      finally
+        FreeAndNil(shadowBitmap);
+      end
+    end else
+      DrawShadowOutline(ACanvas, ABounds);
+  end;
+
+  ACanvas.Brush.Color := $00E9E9E9;
+
+  { Rounded rectangle }
+  if (mdsSelected in AState) or (mdsHot in AState) or
+     (mdsGroupSelected in AState) then
+    ACanvas.Pen.Color := $00BE6363
+  else
+    ACanvas.Pen.Color := clBlack;
+
+  ACanvas.Font.Color  := ACanvas.Pen.Color;
+  ACanvas.RoundRect(ABounds.Left, ABounds.Top, ABounds.Right, ABounds.Bottom, 5, 5);
+
+  textRect            := ABounds;
+  Inc(textRect.Left, 4);
+  Dec(textRect.Right, 4);
+
+  { Image }
+  imageList := AGroup.MenuBar.ImageList;
+  if Assigned(imageList) then
+  begin
+    if AGroup.ImageIndex > -1 then
+    begin
+      imagePos.X  := textRect.Left;
+      imagePos.Y  := ABounds.Top + ((ABounds.Bottom - ABounds.Top - imageList.Height) div 2);
+      imageList.Draw(ACanvas, imagePos.X, imagePos.Y, AGroup.ImageIndex);
+    end;
+
+    Inc(textRect.Left, imageList.Width + 4);
+  end;
+
+  { Text }
+  ACanvas.Font.Style  := [fsBold];
+  DrawText(ACanvas, AGroup.Caption, textRect, taLeftJustify, taVerticalCenter,
+           False, csEllipsis);
+end;
+
+procedure TX2MenuBarunaPainter.DrawItem(ACanvas: TCanvas; AItem: TX2MenuBarItem;
+                                        const ABounds: TRect;
+                                        AState: TX2MenuBarDrawStates);
+var
+  focusBounds:      TRect;
+  textBounds:       TRect;
+  arrowPoints:      array[0..2] of TPoint;
+
+begin
+  focusBounds := ABounds;
+  Dec(focusBounds.Right, 10);
+
+  if (mdsSelected in AState) then
+  begin
+    { Focus rectangle }
+    SetTextColor(ACanvas.Handle, ColorToRGB(clBlack));
+    DrawFocusRect(ACanvas.Handle, focusBounds);
+
+    { Arrow }
+    ACanvas.Brush.Color := clBlue;
+    ACanvas.Pen.Color   := clBlue;
+
+    arrowPoints[0].X    := ABounds.Right - 8;
+    arrowPoints[0].Y    := ABounds.Top + ((ABounds.Bottom - ABounds.Top - 15) div 2) + 7;
+    arrowPoints[1].X    := Pred(ABounds.Right);
+    arrowPoints[1].Y    := arrowPoints[0].Y - 7;
+    arrowPoints[2].X    := Pred(ABounds.Right);
+    arrowPoints[2].Y    := arrowPoints[0].Y + 7;
+    ACanvas.Polygon(arrowPoints);
+  end;
+
+  { Text }
+  if (mdsSelected in AState) or (mdsHot in AState) then
+    ACanvas.Font.Color  := clBlack
+  else
+    ACanvas.Font.Color  := $00404040;
+
+  textBounds  := focusBounds;
+  Inc(textBounds.Left, 4);
+  Dec(textBounds.Right, 4);
+
+  SetBkMode(ACanvas.Handle, TRANSPARENT);
+  ACanvas.Font.Style  := [];
+  
+  DrawText(ACanvas, AItem.Caption, textBounds, taRightJustify, taVerticalCenter,
+           False, csEllipsis);
+end;
+
+end.

Test/MenuBar/MainForm.dfm

@@ -12,6 +12,7 @@ object frmMain: TfrmMain
   Font.Style = []
   OldCreateOrder = False
   Position = poScreenCenter
+  OnCreate = FormCreate
   PixelsPerInch = 96
   TextHeight = 13
   object bvlMenu: TBevel
@@ -39,6 +40,7 @@ object frmMain: TfrmMain
     Groups = <
       item
         Caption = 'Share'
+        ImageIndex = 0
         Expanded = True
         Items = <
           item
@@ -60,16 +62,9 @@ object frmMain: TfrmMain
       end
       item
         Caption = '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
@@ -77,11 +72,13 @@ object frmMain: TfrmMain
       end
       item
         Caption = 'Group without items'
+        ImageIndex = 2
         Expanded = False
         Items = <>
       end>
     ImageList = glMenu
-    Painter = mbPainter
+    Options = [mboAllowCollapseAll]
+    Painter = mcPainter
   end
   object seAnimationTime: TJvSpinEdit
     Left = 364
@@ -98,7 +95,7 @@ object frmMain: TfrmMain
     Left = 220
     Top = 80
     Width = 133
-    Height = 153
+    Height = 77
     BevelOuter = bvNone
     TabOrder = 2
     object rbmusikCube: TRadioButton
@@ -110,22 +107,32 @@ object frmMain: TfrmMain
       Checked = True
       TabOrder = 0
       TabStop = True
+      OnClick = PainterClick
     end
     object rbUnameIT: TRadioButton
       Left = 0
-      Top = 20
+      Top = 17
       Width = 113
       Height = 17
       Caption = 'Uname-IT style'
-      Enabled = False
       TabOrder = 1
+      OnClick = PainterClick
+    end
+    object chkBlurShadow: TCheckBox
+      Left = 20
+      Top = 36
+      Width = 97
+      Height = 17
+      Caption = 'Blur shadow'
+      TabOrder = 2
+      OnClick = chkBlurShadowClick
     end
   end
   object Panel2: TPanel
     Left = 364
     Top = 80
     Width = 129
-    Height = 153
+    Height = 89
     BevelOuter = bvNone
     TabOrder = 3
     object rbSliding: TRadioButton
@@ -135,7 +142,7 @@ object frmMain: TfrmMain
       Height = 17
       Caption = 'Sliding animation'
       Checked = True
-      TabOrder = 0
+      TabOrder = 1
       TabStop = True
       OnClick = AnimationClick
     end
@@ -145,18 +152,54 @@ object frmMain: TfrmMain
       Width = 113
       Height = 17
       Caption = 'No animation'
-      TabOrder = 1
+      TabOrder = 0
       OnClick = AnimationClick
     end
     object rbFade: TRadioButton
       Left = 0
-      Top = 40
+      Top = 60
       Width = 113
       Height = 17
       Caption = 'Fading animation'
       Enabled = False
-      TabOrder = 2
+      TabOrder = 3
     end
+    object rbResolve: TRadioButton
+      Left = 0
+      Top = 40
+      Width = 113
+      Height = 17
+      Caption = 'Resolving animation'
+      TabOrder = 2
+      OnClick = AnimationClick
+    end
+  end
+  object chkAutoCollapse: TCheckBox
+    Left = 220
+    Top = 200
+    Width = 89
+    Height = 17
+    Caption = 'Auto collapse'
+    TabOrder = 4
+    OnClick = chkAutoCollapseClick
+  end
+  object chkAllowCollapseAll: TCheckBox
+    Left = 220
+    Top = 240
+    Width = 101
+    Height = 17
+    Caption = 'Allow collapse all'
+    TabOrder = 6
+    OnClick = chkAllowCollapseAllClick
+  end
+  object chkAutoSelectItem: TCheckBox
+    Left = 220
+    Top = 220
+    Width = 101
+    Height = 17
+    Caption = 'Auto select item'
+    TabOrder = 5
+    OnClick = chkAutoSelectItemClick
   end
   object gcMenu: TX2GraphicContainer
     Graphics = <
@@ -271,8 +314,16 @@ object frmMain: TfrmMain
     Left = 208
     Top = 8
   end
-  object mbPainter: TX2MenuBarmusikCubePainter
+  object mcPainter: TX2MenuBarmusikCubePainter
+    AnimationStyle = asSlide
+    AnimationTime = 250
     Left = 152
     Top = 8
   end
+  object unaPainter: TX2MenuBarunaPainter
+    AnimationStyle = asSlide
+    AnimationTime = 250
+    Left = 152
+    Top = 36
+  end
 end

Test/MenuBar/MainForm.pas

@@ -4,18 +4,24 @@ interface
 uses
   Classes,
   Controls,
+  ExtCtrls,
   Forms,
   ImgList,
+  Mask,
+  StdCtrls,
 
+  JvExMask,
+  JvSpin,
   PNGImage,
   X2CLGraphicList,
   X2CLMenuBar,
-  X2CLmusikCubePainter, StdCtrls, ExtCtrls, Mask, JvExMask, JvSpin;
+  X2CLmusikCubeMenuBarPainter,
+  X2CLunaMenuBarPainter;
 
 type
   TfrmMain = class(TForm)
     mbTest:               TX2MenuBar;
-    mbPainter: TX2MenuBarmusikCubePainter;
+    mcPainter: TX2MenuBarmusikCubePainter;
     gcMenu: TX2GraphicContainer;
     glMenu: TX2GraphicList;
     bvlMenu: TBevel;
@@ -28,6 +34,18 @@ type
     rbNoAnimation: TRadioButton;
     rbFade: TRadioButton;
     rbUnameIT: TRadioButton;
+    unaPainter: TX2MenuBarunaPainter;
+    rbResolve: TRadioButton;
+    chkAutoCollapse: TCheckBox;
+    chkAllowCollapseAll: TCheckBox;
+    chkAutoSelectItem: TCheckBox;
+    chkBlurShadow: TCheckBox;
+    procedure chkBlurShadowClick(Sender: TObject);
+    procedure chkAutoSelectItemClick(Sender: TObject);
+    procedure FormCreate(Sender: TObject);
+    procedure chkAllowCollapseAllClick(Sender: TObject);
+    procedure chkAutoCollapseClick(Sender: TObject);
+    procedure PainterClick(Sender: TObject);
     procedure AnimationClick(Sender: TObject);
     procedure seAnimationTimeChange(Sender: TObject);
   end;
@@ -37,16 +55,78 @@ implementation
 {$R *.dfm}
 
 procedure TfrmMain.AnimationClick(Sender: TObject);
+var
+  style: TX2MenuBarAnimationStyle;
+
 begin
   if rbSliding.Checked then
-    mbPainter.AnimationStyle  := asSlide
+    style := asSlide
+  else if rbResolve.Checked then
+    style := asResolve
   else
-    mbPainter.AnimationStyle  := asNone;
+    style := asNone;
+
+  mcPainter.AnimationStyle := style;
+  unaPainter.AnimationStyle := style;
+end;
+
+procedure TfrmMain.chkAllowCollapseAllClick(Sender: TObject);
+begin
+  if chkAllowCollapseAll.Checked then
+    mbTest.Options  := mbTest.Options + [mboAllowCollapseAll]
+  else
+    mbTest.Options  := mbTest.Options - [mboAllowCollapseAll];
+end;
+
+procedure TfrmMain.chkAutoCollapseClick(Sender: TObject);
+begin
+  if chkAutoCollapse.Checked then
+    mbTest.Options := mbTest.Options + [mboAutoCollapse]
+  else
+    mbTest.Options := mbTest.Options - [mboAutoCollapse];
+end;
+
+procedure TfrmMain.chkAutoSelectItemClick(Sender: TObject);
+begin
+  if chkAutoSelectItem.Checked then
+    mbTest.Options := mbTest.Options + [mboAutoSelectItem]
+  else
+    mbTest.Options := mbTest.Options - [mboAutoSelectItem];
+end;
+
+procedure TfrmMain.chkBlurShadowClick(Sender: TObject);
+begin
+  unaPainter.BlurShadow := chkBlurShadow.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;
+end;
+
+procedure TfrmMain.PainterClick(Sender: TObject);
+begin
+  if rbmusikCube.Checked then
+  begin
+    mbTest.Painter := mcPainter;
+    chkAutoCollapse.Checked := False;
+    chkAutoSelectItem.Checked := False;
+    chkAllowCollapseAll.Checked := True;
+  end else
+  begin
+    mbTest.Painter := unaPainter;
+    chkAutoCollapse.Checked := True;
+    chkAutoSelectItem.Checked := True;
+    chkAllowCollapseAll.Checked := False;
+  end;
 end;
 
 procedure TfrmMain.seAnimationTimeChange(Sender: TObject);
 begin
-  mbPainter.AnimationTime := seAnimationTime.AsInteger;
+  mcPainter.AnimationTime := seAnimationTime.AsInteger;
+  unaPainter.AnimationTime := seAnimationTime.AsInteger;
 end;
 
 end.