{
XPMenu for Delphi
Author: Khaled Shagrouni
URL: http://www.shagrouni.com
e-mail: shagrouni@hotmail.com
Version 1.505, October 3, 2001


XPMenu is a Delphi component to mimic Office XP menu and toolbar style.
Copyright (C) 2001 Khaled Shagrouni.

This component is FREEWARE with source code. I still hold the copyright.
If you have any ideas for improvement or bug reports, don't hesitate to e-mail me.



History:
========
Oct 3, 2001, V1.505
   - Supporting ControlBar. Added by Michiel van Oudheusden:
       michiel@iego-development.nl
Sept 5, 2001, V1.504
   - Removing some problematic code lines in the procedure: ToolBarDrawButton.
     This code causes unwanted effect on desktop when activating the component
     at run time with form contains a ToolBarButton with MenuItem.
Sept 4, 2001, V1.503
   - Bug fixed.
Sept 3, 2001, V1.502
   - Bugs fixed.
Sept 1, 2001, V1.501
   - Some minor changes and bugs fixed.
July 29, 2001, V1.501 (Beta)
   - Adding AutoDetect property.
   - Compatibility issues with Delphi4.
July 25, 2001, V1.5
   - Support for TToolbar.
   - Getting closer to XP style appearance.
   - New options.
june 23, 2001
   - Compatibility issues with Delphi4.
   - Changing the way of menus itration.
   - Making the blue select rectangle little thinner.

june 21, 2001
  Bug fixes:
   - Items correctly sized even if no image list assigned.
   - Shaded colors for top menu items if fixed for some menu bar colors.
  (Actually the bugs was due to two statements deleted by me stupidly/accidentally)

June 19, 2001
  This component is based on code which I have posted at Delphi3000.com
  (http://www.delphi3000/articles/article_2246.asp) and Borland Code-Central
  (http://codecentral.borland.com/codecentral/ccweb.exe/listing?id=16120).



Installation

A. Unzip the files: XPMENU.PAS and XPMENU.DCR Into the same directory.
B. From Delphi menu, Select File| New: Package.
C. Press Add, and browse to add the unit XPMENU.PAS.
D. Press Install.
E. The component is now installed in a new 'XP' page.
F. Save the package.


If you have a previous version installed:
Replace the old files (xpmenu.pas and xpmenu.dcr) with the new one,
open the package and recompile.
If you encounter any problems remove all the compiled units .dcu, .bpl, .dcp
(try to locate them also in 'C:\Program Files\Borland\DelphiX\Projects\Bpl' and
'C:\Program Files\Borland\DelphiX\lib'), then install pre-compiled units again.

--------------------------------------------------------------------------------


Notes on proprties:

Active property:
 To activate/deactivate xpMenu, also, set this property to True when new items
 added at run time.

AutoDetect property:
 Set this property to True to force xpMenu to include new added items
 automatically.

UseSystemColors property:
 The global windows color scheme will be used, setting this property to true
 will override other color related properties.

OverrideOwnerDraw property:
 By default, xpMenu will not affect menu items that has owner draw handler
 assigned (any code in OnDrawItem event). To override any custom draw set this property to true.

Gradient property:
 IconBackcolor will be used as a gradient color for the entire menu,
 Color property wil be ignored.

FlatMenu property:
 To turn menu's border to flat (drop-down and pop-up menu). Any way, a flat
 effect will not appear until a menu item is selected, also unwanted effect
 come across if there is submenu item selected. I hope I can fix this soon,
 help from others appreciated.

Form property:
 The default is the host form, if you want to target a different
 form other than the one hosting the component; set Form property to that form.



--------------------------------------------------------------------------------


ImageLists:
  For toolbars only ImageList assigned to Images property is used; xpMenu
  automatically generate dim and grayed images for non-hot and disabled items.

Buttons with tbsDivider style:
 xpMenu cannot draw toolbar buttons with tbsDivider style, Windows override any
 owner draw for this style (I am using Win 98). To work around this, set the
 button style to tbsSeparator and set its Tag property to none zero value.

Creation order:
 Make sure that the creation order of TXPMenu comes after any menu or toolbar
 component. To change the creation order, choose Edit | Creation Order from
 Delphi menu to open the Creation Order dialog box.


--------------------------------------------------------------------------------


Known issues:

 - xpMenu supports menus only in Delphi 4.
 - xpMenu doesn't detect menus and toolbars inside Frame, the work-around for
   this is to add xpMenu component in the Frame it self.

--------------------------------------------------------------------------------

Tips:

How to create menu toolbar:
 (Extracted from Delphi Help - TToolButton.MenuItem)

 To create an "IE4-style" (Office-style) toolbar that corresponds to
 an existing menu:
  1 Drop a ToolBar on the form and add a ToolButton for each top-level menu
    item you wish to create.
  2 Set the MenuItem property of each ToolButton to correspond to the top level
    menu items.
  3 Set the Grouped property of each ToolButton to True.
  4 Clear the MainMenu property of the Form (if it is assigned)

Images in toolbars and menus:
 To make an image transparent, be sure to fill the background with a unique
 color-a color your image is not using. Also, make sure that the color of the
 bottom leftmost pixel shown onscreen has the same background color; xpMenu will
 use this pixel to determine the transparent color.


}
//____________________________________________________________________________


{$IFDEF VER130}
{$DEFINE VER5U}
{$ENDIF}

{$IFDEF VER140}
{$DEFINE VER5U}
{$ENDIF}


unit Bc_XPMenu;

interface

uses
  Windows, SysUtils, Classes, Graphics, Controls, ComCtrls,  Forms,
  Menus, Messages, Commctrl, ExtCtrls;

type
  TXPMenu = class(TComponent)
  private
    FActive: boolean;
    FForm: TForm;
    FFont: TFont;
    FColor: TColor;
    FIconBackColor: TColor;
    FMenuBarColor: TColor;
    FCheckedColor: TColor;
    FSeparatorColor: TColor;
    FSelectBorderColor: TColor;
    FSelectColor: TColor;
    FDisabledColor: TColor;
    FSelectFontColor: TColor;
    FIconWidth: integer;
    FDrawSelect: boolean;
    FUseSystemColors: boolean;

    FFColor, FFIconBackColor, FFSelectColor, FFSelectBorderColor,
    FFSelectFontColor, FCheckedAreaColor, FCheckedAreaSelectColor,
    FFCheckedColor, FFMenuBarColor, FFDisabledColor, FFSeparatorColor,
    FMenuBorderColor, FMenuShadowColor: TColor;

    Is16Bit: boolean;
    FOverrideOwnerDraw: boolean;
    FGradient: boolean;
    FFlatMenu: boolean;
    FAutoDetect: boolean;

    procedure SetActive(const Value: boolean);
    procedure SetAutoDetect(const Value: boolean);
    procedure SetForm(const Value: TForm);
    procedure SetFont(const Value: TFont);
    procedure SetColor(const Value: TColor);
    procedure SetIconBackColor(const Value: TColor);
    procedure SetMenuBarColor(const Value: TColor);
    procedure SetCheckedColor(const Value: TColor);
    procedure SetDisabledColor(const Value: TColor);
    procedure SetSelectColor(const Value: TColor);
    procedure SetSelectBorderColor(const Value: TColor);
    procedure SetSeparatorColor(const Value: TColor);
    procedure SetSelectFontColor(const Value: TColor);
    procedure SetIconWidth(const Value: integer);
    procedure SetDrawSelect(const Value: boolean);
    procedure SetUseSystemColors(const Value: boolean);
    procedure SetOverrideOwnerDraw(const Value: boolean);
    procedure SetGradient(const Value: boolean);
    procedure SetFlatMenu(const Value: boolean);

  protected
    procedure InitMenueItems(Form: TScrollingWinControl; Enable: boolean);
    procedure DrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
      Selected: Boolean);
    procedure MenueDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
      Selected: Boolean);
    {$IFDEF VER5U}
    procedure ToolBarDrawButton(Sender: TToolBar;
      Button: TToolButton; State: TCustomDrawState; var DefaultDraw: Boolean);
    {$ENDIF}
    procedure ControlBarPaint(Sender: TObject; Control: TControl;
      Canvas: TCanvas; var ARect: TRect; var Options: TBandPaintOptions);

    procedure ActivateMenuItem(MenuItem: TMenuItem);
    procedure SetGlobalColor(ACanvas: TCanvas);
    procedure DrawTopMenuItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
      IsRightToLeft: boolean);
    procedure DrawCheckedItem(FMenuItem: TMenuItem; Selected,
     HasImgLstBitmap: boolean; ACanvas: TCanvas; CheckedRect: TRect);
    procedure DrawTheText(txt, ShortCuttext: string; ACanvas: TCanvas;
     TextRect: TRect; Selected, Enabled, Default, TopMenu,
     IsRightToLeft: boolean; TextFormat: integer);
    procedure DrawIcon(Sender: TObject; ACanvas: TCanvas; B: TBitmap;
     IconRect: Trect; Hot, Selected, Enabled, Checked, FTopMenu,
     IsRightToLeft: boolean);
    procedure DrawArrow(ACanvas: TCanvas; X, Y: integer);
    procedure MeasureItem(Sender: TObject; ACanvas: TCanvas;
      var Width, Height: Integer);

    function GetImageExtent(MenuItem: TMenuItem): TPoint;
    function TopMenuFontColor(ACanvas: TCanvas; Color: TColor): TColor;
    procedure DrawGradient(ACanvas: TCanvas; ARect: TRect;
     IsRightToLeft: boolean);

    procedure DrawWindowBorder(hWnd: HWND; IsRightToLeft: boolean);
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;


  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Form: TForm read FForm write SetForm;
  published
    property Font: TFont read FFont write SetFont;
    property Color: TColor read FColor write SetColor;
    property IconBackColor: TColor read FIconBackColor write SetIconBackColor;
    property MenuBarColor: TColor read FMenuBarColor write SetMenuBarColor;
    property SelectColor: TColor read FSelectColor write SetSelectColor;
    property SelectBorderColor: TColor read FSelectBorderColor
     write SetSelectBorderColor;
    property SelectFontColor: TColor read FSelectFontColor
     write SetSelectFontColor;
    property DisabledColor: TColor read FDisabledColor write SetDisabledColor;
    property SeparatorColor: TColor read FSeparatorColor
     write SetSeparatorColor;
    property CheckedColor: TColor read FCheckedColor write SetCheckedColor;
    property IconWidth: integer read FIconWidth write SetIconWidth;
    property DrawSelect: boolean read FDrawSelect write SetDrawSelect;
    property UseSystemColors: boolean read FUseSystemColors
     write SetUseSystemColors;
    property OverrideOwnerDraw: boolean read FOverrideOwnerDraw
     write SetOverrideOwnerDraw;

    property Gradient: boolean read FGradient write SetGradient;
    property FlatMenu: boolean read FFlatMenu write SetFlatMenu;
    property AutoDetect: boolean read FAutoDetect write SetAutoDetect;
    property Active: boolean read FActive write SetActive;
  end;

function GetShadeColor(ACanvas: TCanvas; clr: TColor; Value: integer): TColor;
function NewColor(ACanvas: TCanvas; clr: TColor; Value: integer): TColor;
procedure DimBitmap(ABitmap: TBitmap; Value: integer);
function GrayColor(ACanvas: TCanvas; clr: TColor; Value: integer): TColor;
procedure GrayBitmap(ABitmap: TBitmap; Value: integer);
procedure DrawBitmapShadow(B: TBitmap; ACanvas: TCanvas; X, Y: integer;
  ShadowColor: TColor);



procedure GetSystemMenuFont(Font: TFont);
procedure Register;

implementation


procedure Register;
begin
  RegisterComponents('XP', [TXPMenu]);
end;

{ TXPMenue }

constructor TXPMenu.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FFont := TFont.Create;
  GetSystemMenuFont(FFont);
  if Owner is TForm then      // 2001-10-23: ja
    FForm := Owner as TForm;

  FUseSystemColors := true;


  FColor := clBtnFace;
  FIconBackColor := clBtnFace;
  FSelectColor := clHighlight;
  FSelectBorderColor := clHighlight;
  FMenuBarColor := clBtnFace;
  FDisabledColor := clInactiveCaption;
  FSeparatorColor := clBtnFace;
  FCheckedColor := clHighlight;
  FSelectFontColor := FFont.Color;

  FIconWidth := 24;
  FDrawSelect := true;

  if FActive then
  begin
    InitMenueItems(FForm, true);
  end;

end;

destructor TXPMenu.Destroy;
begin
  InitMenueItems(FForm, false);
  FFont.Free;

  inherited;
end;



procedure TXPMenu.ActivateMenuItem(MenuItem: TMenuItem);

  procedure Activate(MenuItem: TMenuItem);
  begin
    if addr(MenuItem.OnDrawItem) <> addr(TXPMenu.DrawItem) then
    begin
      if (not assigned(MenuItem.OnDrawItem)) or (FOverrideOwnerDraw) then
        MenuItem.OnDrawItem := DrawItem;
      if (not assigned(MenuItem.OnMeasureItem)) or (FOverrideOwnerDraw) then
        MenuItem.OnMeasureItem := MeasureItem;
    end
  end;

var
  i, j: integer;
begin

  Activate(MenuItem);
  for i := 0 to MenuItem.Parent.Count -1 do
  begin
    Activate(MenuItem.Parent.Items[i]);
    for j := 0 to MenuItem.Parent.Items[i].Count - 1 do
      ActivateMenuItem(MenuItem.Parent.Items[i].Items[j]);
  end;

end;

procedure TXPMenu.InitMenueItems(Form: TScrollingWinControl; Enable: boolean);

  procedure Activate(MenuItem: TMenuItem);
  begin
    if Enable then
    begin
      if (not assigned(MenuItem.OnDrawItem)) or (FOverrideOwnerDraw) then
        MenuItem.OnDrawItem := DrawItem;
      if (not assigned(MenuItem.OnMeasureItem)) or (FOverrideOwnerDraw) then
        MenuItem.OnMeasureItem := MeasureItem;
    end
    else
    begin
      if addr(MenuItem.OnDrawItem) = addr(TXPMenu.DrawItem) then
        MenuItem.OnDrawItem := nil;
      if addr(MenuItem.OnMeasureItem) = addr(TXPMenu.MeasureItem) then
        MenuItem.OnMeasureItem := nil;
    end;
  end;

  procedure ItrateMenu(MenuItem: TMenuItem);
  var
    i: integer;
  begin
    Activate(MenuItem);
    for i := 0 to MenuItem.Count - 1 do
      ItrateMenu(MenuItem.Items[i]);
  end;


var
  i, x: integer;
begin
  Exit; // 2001-10-23: ja: added this
  for i := 0 to Form.ComponentCount - 1 do
  begin
    if Form.Components[i] is TMainMenu then
    begin
      for x := 0 to TMainMenu(Form.Components[i]).Items.Count - 1 do
      begin
        TMainMenu(Form.Components[i]).OwnerDraw := Enable;
        Activate(TMainMenu(Form.Components[i]).Items[x]);
        ItrateMenu(TMainMenu(Form.Components[i]).Items[x]);
      end;
    end;
    if Form.Components[i] is TPopupMenu then
    begin
      for x := 0 to TPopupMenu(Form.Components[i]).Items.Count - 1 do
      begin
        TPopupMenu(FForm.Components[i]).OwnerDraw := Enable;
        Activate(TMainMenu(Form.Components[i]).Items[x]);
        ItrateMenu(TMainMenu(Form.Components[i]).Items[x]);
      end;
    end;

    {$IFDEF VER5U}
    if Form.Components[i] is TToolBar then
      if not (csDesigning in ComponentState) then
      begin
        if not TToolBar(Form.Components[i]).Flat then
          TToolBar(Form.Components[i]).Flat := true;

        if Enable then
        begin
          for x := 0 to TToolBar(FForm.Components[i]).ButtonCount - 1 do
            if (not assigned(TToolBar(Form.Components[i]).OnCustomDrawButton))
              or (FOverrideOwnerDraw) then
            begin
              TToolBar(FForm.Components[i]).OnCustomDrawButton :=
                ToolBarDrawButton;

            end;
        end
        else
        begin
          if addr(TToolBar(Form.Components[i]).OnCustomDrawButton) =
            addr(TXPMenu.ToolBarDrawButton) then
            TToolBar(Form.Components[i]).OnCustomDrawButton := nil;

        end;
      end;
    {$ENDIF}
    // Controlbar code. Added by Michiel van Oudheusden (27 sep 2001)
    if Form.Components[i] is TControlBar then
      if not (csDesigning in ComponentState) then
      begin
        if Enable then
        begin
          if (not assigned(TControlBar(Form.Components[i]).OnBandPaint))
            or (FOverrideOwnerDraw) then
          begin
            TControlBar(FForm.Components[i]).OnBandPaint := ControlBarPaint;
          end;
        end
        else
        begin
          if addr(TControlBar(Form.Components[i]).OnBandPaint) =
            addr(TXPMenu.ControlBarPaint) then
            TControlBar(Form.Components[i]).OnBandPaint := nil;
        end;
      end;



  end;
end;

procedure TXPMenu.DrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
  Selected: Boolean);
begin
  if FActive then
    MenueDrawItem(Sender, ACanvas, ARect, Selected);
end;



function TXPMenu.GetImageExtent(MenuItem: TMenuItem): TPoint;
var
  HasImgLstBitmap: boolean;
  B: TBitmap;
  FTopMenu: boolean;
begin
  FTopMenu := false;
  B := TBitmap.Create;
  B.Width := 0;
  B.Height := 0;
  Result.x := 0;
  Result.Y := 0;
  HasImgLstBitmap := false;

  if FForm.Menu <> nil then
    if MenuItem.GetParentComponent.Name = FForm.Menu.Name then
    begin
      FTopMenu := true;
      if FForm.Menu.Images <> nil then
        if MenuItem.ImageIndex <> -1 then
          HasImgLstBitmap := true;

    end;

  if (MenuItem.Parent.GetParentMenu.Images <> nil)
  {$IFDEF VER5U}
  or (MenuItem.Parent.SubMenuImages <> nil)
  {$ENDIF}
  then
  begin
    if MenuItem.ImageIndex <> -1 then
      HasImgLstBitmap := true
    else
      HasImgLstBitmap := false;
  end;

  if HasImgLstBitmap then
  begin
  {$IFDEF VER5U}
    if MenuItem.Parent.SubMenuImages <> nil then
      MenuItem.Parent.SubMenuImages.GetBitmap(MenuItem.ImageIndex, B)
    else
  {$ENDIF}
      MenuItem.Parent.GetParentMenu.Images.GetBitmap(MenuItem.ImageIndex, B)
  end
  else
    if MenuItem.Bitmap.Width > 0 then
      B.Assign(TBitmap(MenuItem.Bitmap));

  Result.x := B.Width;
  Result.Y := B.Height;

  if not FTopMenu then
    if Result.x < FIconWidth then
      Result.x := FIconWidth;

  B.Free;
end;

procedure TXPMenu.MeasureItem(Sender: TObject; ACanvas: TCanvas;
  var Width, Height: Integer);
var
  s: string;
  W, H: integer;
  P: TPoint;
  IsLine: boolean;
begin
  if FActive then
  begin
    S := TMenuItem(Sender).Caption;
      //------
    if S = '-' then IsLine := true else IsLine := false;
    if IsLine then

      //------
      if IsLine then
        S := '';

    if Trim(ShortCutToText(TMenuItem(Sender).ShortCut)) <> '' then
      S := S + ShortCutToText(TMenuItem(Sender).ShortCut) + 'WWW';



    ACanvas.Font.Assign(FFont);
    W := ACanvas.TextWidth(s);
    if pos('&', s) > 0 then
      W := W - ACanvas.TextWidth('&');

    P := GetImageExtent(TMenuItem(Sender));

    W := W + P.x + 10;

    if Width < W then
      Width := W;

    if IsLine then
      Height := 4
    else
    begin
      H := ACanvas.TextHeight(s) + Round(ACanvas.TextHeight(s) * 0.75);
      if P.y + 4 > H then
        H := P.y + 4;

      if Height < H then
        Height := H;
    end;
  end;

end;

procedure TXPMenu.MenueDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
  Selected: Boolean);
var
  txt: string;
  B: TBitmap;
  IconRect, TextRect, CheckedRect: TRect;
  i, X1, X2: integer;
  TextFormat: integer;
  HasImgLstBitmap: boolean;
  FMenuItem: TMenuItem;
  FMenu: TMenu;
  FTopMenu: boolean;
  ISLine: boolean;
  ImgListHandle: HImageList;        {Commctrl.pas}
  ImgIndex: integer;
  hWndM: HWND;
  hDcM: HDC;
begin


  FTopMenu := false;
  FMenuItem := TMenuItem(Sender);

  SetGlobalColor(ACanvas);

  if FMenuItem.Caption = '-' then IsLine := true else IsLine := false;

  FMenu := FMenuItem.Parent.GetParentMenu;

  if FMenu is TMainMenu then
    for i := 0 to FMenuItem.GetParentMenu.Items.Count - 1 do
      if FMenuItem.GetParentMenu.Items[i] = FMenuItem then
      begin
        FTopMenu := True;
        break;
      end;


  ACanvas.Font.Assign(FFont);
  if FMenu.IsRightToLeft then
    ACanvas.Font.Charset := ARABIC_CHARSET;

  Inc(ARect.Bottom, 1);
  TextRect := ARect;
  txt := ' ' + FMenuItem.Caption;

  B := TBitmap.Create;

  HasImgLstBitmap := false;


  if FMenuItem.Bitmap.Width > 0 then
    B.Assign(TBitmap(FMenuItem.Bitmap));

  if (FMenuItem.Parent.GetParentMenu.Images <> nil)
  {$IFDEF VER5U}
  or (FMenuItem.Parent.SubMenuImages <> nil)
  {$ENDIF}
  then
  begin
    if FMenuItem.ImageIndex <> -1 then
      HasImgLstBitmap := true
    else
      HasImgLstBitmap := false;
  end;



  if FMenu.IsRightToLeft then
  begin
    X1 := ARect.Right - FIconWidth;
    X2 := ARect.Right;
  end
  else
  begin
    X1 := ARect.Left;
    X2 := ARect.Left + FIconWidth;
  end;
  IconRect := Rect(X1, ARect.Top, X2, ARect.Bottom);


  if HasImgLstBitmap then
  begin
    CheckedRect := IconRect;
    Inc(CheckedRect.Left, 1);
    Inc(CheckedRect.Top, 2);
    Dec(CheckedRect.Right, 3);
    Dec(CheckedRect.Bottom, 2);

  end
  else
  begin
    CheckedRect.Left := IconRect.Left +
      (IConRect.Right - IconRect.Left - 10) div 2;
    CheckedRect.Top := IconRect.Top +
      (IConRect.Bottom - IconRect.Top - 10) div 2;
    CheckedRect.Right := CheckedRect.Left + 10;
    CheckedRect.Bottom := CheckedRect.Top + 10;

  end;


  if FMenu.IsRightToLeft then
  begin
    X1 := ARect.Left;
    X2 := ARect.Right - FIconWidth;
    if B.Width > FIconWidth then
      X2 := ARect.Right - B.Width - 4;
  end
  else
  begin
    X1 := ARect.Left + FIconWidth;
    if B.Width > X1 then
      X1 := B.Width + 4;
    X2 := ARect.Right;
  end;

  TextRect := Rect(X1, ARect.Top, X2, ARect.Bottom);

  if FTopMenu then
  begin
    if not HasImgLstBitmap then
    begin
      TextRect := ARect;
    end
    else
    begin
      if FMenu.IsRightToLeft then
        TextRect.Right := TextRect.Right + 5
      else
        TextRect.Left := TextRect.Left - 5;
    end

  end;

  if FTopMenu then
  begin
    ACanvas.brush.color := FFMenuBarColor;
    ACanvas.Pen.Color := FFMenuBarColor;

    ACanvas.FillRect(ARect);
  end
  else
  begin
    if (Is16Bit and FGradient) then
    begin
      if FMenu.IsRightToLeft then                          // 2001-10-23: ja, required so that menubar at right side works
        inc(ARect.Right,2);  //needed for RightToLeft
      DrawGradient(ACanvas, ARect, FMenu.IsRightToLeft);
      if FMenu.IsRightToLeft then                          // 2001-10-23: ja
        Dec(ARect.Right,2);

    end
    else
    begin
      ACanvas.brush.color := FFColor;
      if (not FMenuItem.Enabled) and (Selected) then
      else
        ACanvas.FillRect(ARect);

      ACanvas.brush.color := FFIconBackColor;
      if (not FMenuItem.Enabled) and (Selected) then
      else
        ACanvas.FillRect(IconRect);
    end;


//------------
  end;


  if FMenuItem.Enabled then
    ACanvas.Font.Color := FFont.Color
  else
    ACanvas.Font.Color := FDisabledColor;

  if Selected and FDrawSelect then
  begin
    ACanvas.brush.Style := bsSolid;
    if FTopMenu then
    begin
      DrawTopMenuItem(FMenuItem, ACanvas, ARect, FMenu.IsRightToLeft);
    end
    else
      //------
      if FMenuItem.Enabled then
      begin

        Inc(ARect.Top, 1);
        Dec(ARect.Bottom, 1);
        if FFlatMenu then
          Dec(ARect.Right, 1);
        ACanvas.brush.color := FFSelectColor;
        ACanvas.FillRect(ARect);
        ACanvas.Pen.color := FFSelectBorderColor;
        ACanvas.Brush.Style := bsClear;
        ACanvas.RoundRect(Arect.Left, Arect.top, Arect.Right,
          Arect.Bottom, 0, 0);
        Dec(ARect.Top, 1);
        Inc(ARect.Bottom, 1);
        if FFlatMenu then
          Inc(ARect.Right, 1);
      end;
      //-----

  end;

  DrawCheckedItem(FMenuItem, Selected, HasImgLstBitmap, ACanvas, CheckedRect);

//-----

  if HasImgLstBitmap then
  begin
  {$IFDEF VER5U}
    if FMenuItem.Parent.SubMenuImages <> nil then
    begin
      ImgListHandle := FMenuItem.Parent.SubMenuImages.Handle;
      ImgIndex := FMenuItem.ImageIndex;

      B.Width := FMenuItem.Parent.SubMenuImages.Width;
      B.Height := FMenuItem.Parent.SubMenuImages.Height;
      B.Canvas.Brush.Color := FFIconBackColor;
      B.Canvas.FillRect(Rect(0, 0, B.Width, B.Height));
      ImageList_DrawEx(ImgListHandle, ImgIndex,
        B.Canvas.Handle, 0, 0, 0, 0, clNone, clNone, ILD_Transparent);

    end
    else
  {$ENDIF}
    begin
      ImgListHandle := FMenuItem.Parent.GetParentMenu.Images.Handle;
      ImgIndex := FMenuItem.ImageIndex;

      B.Width := FMenuItem.Parent.GetParentMenu.Images.Width;
      B.Height := FMenuItem.Parent.GetParentMenu.Images.Height;
      B.Canvas.Brush.Color := FFIconBackColor;
      B.Canvas.FillRect(Rect(0, 0, B.Width, B.Height));
      ImageList_DrawEx(ImgListHandle, ImgIndex,
        B.Canvas.Handle, 0, 0, 0, 0, clNone, clNone, ILD_Transparent);

    end;
  end

  else
    if FMenuItem.Bitmap.Width > 0 then
      B.Assign(TBitmap(FMenuItem.Bitmap));


  DrawIcon(FMenuItem, ACanvas, B, IconRect,
    Selected, False, FMenuItem.Enabled, FMenuItem.Checked,
    FTopMenu, FMenu.IsRightToLeft);


//--------
  if not IsLine then
  begin

    if FMenu.IsRightToLeft then
    begin
      TextFormat := DT_RIGHT + DT_RTLREADING;
      Dec(TextRect.Right, 5);
    end
    else
    begin
      TextFormat := 0;
      Inc(TextRect.Left, 5);
    end;

    DrawTheText(txt, ShortCutToText(FMenuItem.ShortCut),
      ACanvas, TextRect,
      Selected, FMenuItem.Enabled, FMenuItem.Default,
      FTopMenu, FMenu.IsRightToLeft, TextFormat);

//-----------

  end


  else
  begin
    if FMenu.IsRightToLeft then
    begin
      X1 := TextRect.Left;
      X2 := TextRect.Right - 7;
    end
    else
    begin
      X1 := TextRect.Left + 7;
      X2 := TextRect.Right;
    end;

    ACanvas.Pen.Color := FFSeparatorColor;
    ACanvas.MoveTo(X1,
      TextRect.Top +
      Round((TextRect.Bottom - TextRect.Top) / 2));
    ACanvas.LineTo(X2,
      TextRect.Top +
      Round((TextRect.Bottom - TextRect.Top) / 2))
  end;

  B.free;

//------

  if not (csDesigning in ComponentState) then
  begin
    if (FFlatMenu) and (not FTopMenu) and Assigned(FForm) then
    begin
      hDcM := ACanvas.Handle;
      hWndM := WindowFromDC(hDcM);
      if hWndM <> FForm.Handle then
      begin
        DrawWindowBorder(hWndM, FMenu.IsRightToLeft);
      end;
    end;
  end;

//-----
//  ActivateMenuItem(FMenuItem);  // to check for new sub items   // 2001-10-23: ja
end;

{$IFDEF VER5U}
procedure TXPMenu.ToolBarDrawButton(Sender: TToolBar;
  Button: TToolButton; State: TCustomDrawState; var DefaultDraw: Boolean);

var
  ACanvas: TCanvas;

  ARect, HoldRect: TRect;
  B: TBitmap;
  HasBitmap: boolean;
  BitmapWidth: integer;
  TextFormat: integer;
  XButton: TToolButton;
  HasBorder: boolean;
  HasBkg: boolean;
  IsTransparent: boolean;
  FBSelectColor: TColor;

  procedure DrawBorder;
  var
    BRect, WRect: TRect;
    procedure DrawRect;
    begin
      ACanvas.Pen.color := FFSelectBorderColor;
      ACanvas.MoveTo(WRect.Left, WRect.Top);
      ACanvas.LineTo(WRect.Right, WRect.Top);
      ACanvas.LineTo(WRect.Right, WRect.Bottom);
      ACanvas.LineTo(WRect.Left, WRect.Bottom);
      ACanvas.LineTo(WRect.Left, WRect.Top);
    end;

  begin
    BRect := HoldRect;
    Dec(BRect.Bottom, 1);
    Inc(BRect.Top, 1);
    Dec(BRect.Right, 1);

    WRect := BRect;
    if Button.Style = tbsDropDown then
    begin
      Dec(WRect.Right, 13);
      DrawRect;

      WRect := BRect;
      Inc(WRect.Left, WRect.Right - WRect.Left - 13);
      DrawRect;
    end
    else
    begin

      DrawRect;
    end;
  end;

begin

  B := nil;

  HasBitmap := (TToolBar(Button.Parent).Images <> nil) and
    (Button.ImageIndex <> -1) and
    (Button.ImageIndex <= TToolBar(Button.Parent).Images.Count - 1);


  IsTransparent := TToolBar(Button.Parent).Transparent;

  ACanvas := Sender.Canvas;

  SetGlobalColor(ACanvas);

  if (Is16Bit) and (not UseSystemColors) then
    FBSelectColor := NewColor(ACanvas, FSelectColor, 68)
  else
    FBSelectColor := FFSelectColor;


  HoldRect := Button.BoundsRect;

  ARect := HoldRect;

  if Is16Bit then
    ACanvas.brush.color := NewColor(ACanvas, clBtnFace, 16)
  else
    ACanvas.brush.color := clBtnFace;

  if not IsTransparent then
    ACanvas.FillRect(ARect);

  HasBorder := false;
  HasBkg := false;

  if (cdsHot in State) then
  begin
    if (cdsChecked in State) or (Button.Down) or (cdsSelected in State) then
      ACanvas.Brush.Color := FCheckedAreaSelectColor
    else
      ACanvas.brush.color := FBSelectColor;
    HasBorder := true;
    HasBkg := true;
  end;

  if (cdsChecked in State) and not (cdsHot in State) then
  begin
    ACanvas.Brush.Color := FCheckedAreaColor;
    HasBorder := true;
    HasBkg := true;
  end;

  if (cdsIndeterminate in State) and not (cdsHot in State) then
  begin
    ACanvas.Brush.Color := FBSelectColor;
    HasBkg := true;
  end;


  if (Button.MenuItem <> nil) and (State = []) then
  begin
    ACanvas.brush.color := FFMenuBarColor;
    if not IsTransparent then
      HasBkg := true;
  end;


  Inc(ARect.Top, 1);

  if HasBkg then
    ACanvas.FillRect(ARect);

  if HasBorder then
    DrawBorder;


  if (Button.MenuItem <> nil)
    and (cdsSelected in State) then
  begin
    DrawTopMenuItem(Button, ACanvas, ARect, false);
    DefaultDraw := false;
  end;

  ARect := HoldRect;
  DefaultDraw := false;



  if Button.Style = tbsDropDown then
  begin
    ACanvas.Pen.Color := clBlack;
    DrawArrow(ACanvas, (ARect.Right - 14) + ((14 - 5) div 2),
      ARect.Top + ((ARect.Bottom - ARect.Top - 3) div 2) + 1);
  end;

  BitmapWidth := 0;
  if HasBitmap then
  begin

    try
      B := TBitmap.Create;

      B.Width := TToolBar(Button.Parent).Images.Width;
      B.Height := TToolBar(Button.Parent).Images.Height;
      B.Canvas.Brush.Color := ACanvas.Brush.Color;
      B.Canvas.FillRect(Rect(0, 0, B.Width, B.Height));
      ImageList_DrawEx(TToolBar(Button.Parent).Images.Handle, Button.ImageIndex,
        B.Canvas.Handle, 0, 0, 0, 0, clNone, clNone, ILD_Transparent);



      BitmapWidth := b.Width;

      if Button.Style = tbsDropDown then
        Dec(ARect.Right, 12);


      if TToolBar(Button.Parent).List then
      begin

        if Button.BiDiMode = bdRightToLeft then
        begin
          Dec(ARect.Right, 3);
          ARect.Left := ARect.Right - BitmapWidth;

        end
        else
        begin
          Inc(ARect.Left, 3);
          ARect.Right := ARect.Left + BitmapWidth
        end


      end
      else
        ARect.Left := Round(ARect.Left + (ARect.Right - ARect.Left - B.Width)/2);

      inc(ARect.Top, 2);
      ARect.Bottom := ARect.Top + B.Height + 6;

      DrawIcon(Button, ACanvas, B, ARect, (cdsHot in State),
       (cdsSelected in State), Button.Enabled, (cdsChecked in State), false,
       false);
    finally
      B.Free;
    end;
    ARect := HoldRect;
    DefaultDraw := false;
  end;
//-----------

  if TToolBar(Button.Parent).ShowCaptions then
  begin

    if Button.Style = tbsDropDown then
      Dec(ARect.Right, 12);


    if not TToolBar(Button.Parent).List then
    begin
      TextFormat := DT_Center;
      ARect.Top := ARect.Bottom - ACanvas.TextHeight(Button.Caption) - 3;
    end
    else
    begin
      TextFormat := DT_VCENTER;
      if Button.BiDiMode = bdRightToLeft then
      begin
        TextFormat := TextFormat + DT_Right;
        Dec(ARect.Right, BitmapWidth + 7);
      end
      else
      begin
        Inc(ARect.Left, BitmapWidth + 6);
      end

    end;

    if (Button.MenuItem <> nil) then
    begin
      TextFormat := DT_Center;

    end;

    if Button.BiDiMode = bdRightToLeft then
      TextFormat := TextFormat + DT_RTLREADING;

    DrawTheText(Button.Caption, '',
      ACanvas, ARect,
      (cdsSelected in State), Button.Enabled, false,
      (Button.MenuItem <> nil),
      (Button.BidiMode = bdRightToLeft), TextFormat);

    ARect := HoldRect;
    DefaultDraw := false;
  end;


  if Button.Index > 0 then
  begin
    XButton := TToolBar(Button.Parent).Buttons[Button.Index - 1];
    if (XButton.Style = tbsDivider) or (XButton.Style = tbsSeparator) then
    begin
      ARect := XButton.BoundsRect;
      if Is16Bit then
        ACanvas.brush.color := NewColor(ACanvas, clBtnFace, 16)
      else
        ACanvas.brush.color := clBtnFace;

      if not IsTransparent then
        ACanvas.FillRect(ARect);
     // if (XButton.Style = tbsDivider) then  // Can't get it.
      if XButton.Tag > 0 then
      begin
        Inc(ARect.Top, 2);
        Dec(ARect.Bottom, 1);

        ACanvas.Pen.color := FFDisabledColor;
        ARect.Left := ARect.Left + (ARect.Right - ARect.Left) div 2;
        ACanvas.MoveTo(ARect.Left, ARect.Top);
        ACanvas.LineTo(ARect.Left, ARect.Bottom);

      end;
      ARect := Button.BoundsRect;
      DefaultDraw := false;
    end;

  end;

  if Button.MenuItem <> nil then
    ActivateMenuItem(Button.MenuItem);
end;
{$ENDIF}

// Controlbar Paint. Added by Michiel van Oudheusden (27 sep 2001)
// Paints the bands of a controlbar like the office XP style
procedure TXPMenu.ControlBarPaint(Sender: TObject; Control: TControl;
  Canvas: TCanvas; var ARect: TRect; var Options: TBandPaintOptions);
var
  DRect, CRect: TRect;    // Rectangle for the grabber
  i: Integer;  // For the loop
begin
  SetGlobalColor(Canvas);
  // No frame and grabber drawing. We do it ourselfes
  Options := [];

  // First background
  Canvas.Brush.Color := clBtnFace;//FFIconBackColor;//clBtnFace;
  Canvas.FillRect(ARect);

  // Draw grabber
  with DRect do
  begin
    Left := ARect.Left+5;
    Top := ARect.Top + 5;
    Right := Left + 3;
    Bottom := ARect.Bottom - 5;
  end;

  Canvas.Brush.Color := FFSeparatorColor;//RGB(160,160,160);

  for i := 0 to 14 do
  begin
    CRect := DRect;
    inc(CRect.Top,i);
    CRect.Bottom := CRect.Top + 1;
    if i mod 2 = 0 then
      Canvas.FillRect(CRect);
  end;

end;

procedure TXPMenu.SetGlobalColor(ACanvas: TCanvas);
begin
//-----

  if GetDeviceCaps(ACanvas.Handle, BITSPIXEL) < 16 then
    Is16Bit := false
  else
    Is16Bit := true;


  FFColor := FColor;
  FFIconBackColor := FIconBackColor;

  FFSelectColor := FSelectColor;

  if Is16Bit then
  begin
    FCheckedAreaColor := NewColor(ACanvas, FSelectColor, 75);
    FCheckedAreaSelectColor := NewColor(ACanvas, FSelectColor, 50);

    FMenuBorderColor := GetShadeColor(ACanvas, clBtnFace, 90);
    FMenuShadowColor := GetShadeColor(ACanvas, clBtnFace, 76);
  end
  else
  begin
    FFSelectColor := FSelectColor;
    FCheckedAreaColor := clWhite;
    FCheckedAreaSelectColor := clSilver;
    FMenuBorderColor := clBtnShadow;
    FMenuShadowColor := clBtnShadow;
  end;

  FFSelectBorderColor := FSelectBorderColor;
  FFSelectFontColor := FSelectFontColor;
  FFMenuBarColor := FMenuBarColor;
  FFDisabledColor := FDisabledColor;
  FFCheckedColor := FCheckedColor;
  FFSeparatorColor := FSeparatorColor;



  if FUseSystemColors then
  begin
    GetSystemMenuFont(FFont);
    FFSelectFontColor := FFont.Color;
    if not Is16Bit then
    begin
      FFColor := clWhite;
      FFIconBackColor := clBtnFace;
      FFSelectColor := clWhite;
      FFSelectBorderColor := clHighlight;
      FFMenuBarColor := FFIconBackColor;
      FFDisabledColor := clBtnShadow;
      FFCheckedColor := clHighlight;
      FFSeparatorColor := clBtnShadow;
      FCheckedAreaColor := clWhite;
      FCheckedAreaSelectColor := clWhite;

    end
    else
    begin
      FFColor := NewColor(ACanvas, clBtnFace, 86);
      FFIconBackColor := NewColor(ACanvas, clBtnFace, 16);
      FFSelectColor := NewColor(ACanvas, clHighlight, 68);
      FFSelectBorderColor := clHighlight;
      FFMenuBarColor := clMenu;

      FFDisabledColor := NewColor(ACanvas, clBtnShadow, 10);
      FFSeparatorColor := NewColor(ACanvas, clBtnShadow, 25);
      FFCheckedColor := clHighlight;
      FCheckedAreaColor := NewColor(ACanvas, clHighlight, 75);
      FCheckedAreaSelectColor := NewColor(ACanvas, clHighlight, 50);

    end;
  end;

end;

procedure TXPMenu.DrawTopMenuItem(Sender: TObject; ACanvas: TCanvas;
  ARect: TRect; IsRightToLeft: boolean);
var
  X1, X2: integer;
  DefColor, HoldColor: TColor;
begin
  X1 := ARect.Left;
  X2 := ARect.Right;


  ACanvas.brush.Style := bsSolid;
  ACanvas.brush.color := FFIconBackColor;

  ACanvas.FillRect(ARect);
  ACanvas.Pen.Color := FMenuBorderColor;

  if (not IsRightToLeft) and (Is16Bit) and (Sender is TMenuItem) then
  begin
    ACanvas.MoveTo(X1, ARect.Bottom - 1);
    ACanvas.LineTo(X1, ARect.Top);
    ACanvas.LineTo(X2 - 8, ARect.Top);
    ACanvas.LineTo(X2 - 8, ARect.Bottom);

    DefColor := FFMenuBarColor;


    HoldColor := GetShadeColor(ACanvas, DefColor, 10);
    ACanvas.Brush.Style := bsSolid;
    ACanvas.Brush.Color := HoldColor;
    ACanvas.Pen.Color := HoldColor;

    ACanvas.FillRect(Rect(X2 - 7, ARect.Top, X2, ARect.Bottom));

    HoldColor := GetShadeColor(ACanvas, DefColor, 30);
    ACanvas.Brush.Color := HoldColor;
    ACanvas.Pen.Color := HoldColor;
    ACanvas.FillRect(Rect(X2 - 7, ARect.Top + 3, X2 - 2, ARect.Bottom));

    HoldColor := GetShadeColor(ACanvas, DefColor, 40 + 20);
    ACanvas.Brush.Color := HoldColor;
    ACanvas.Pen.Color := HoldColor;
    ACanvas.FillRect(Rect(X2 - 7, ARect.Top + 5, X2 - 3, ARect.Bottom));

    HoldColor := GetShadeColor(ACanvas, DefColor, 60 + 40);
    ACanvas.Brush.Color := HoldColor;
    ACanvas.Pen.Color := HoldColor;
    ACanvas.FillRect(Rect(X2 - 7, ARect.Top + 6, X2 - 5, ARect.Bottom));

    //---

    ACanvas.Pen.Color := DefColor;
    ACanvas.MoveTo(X2 - 5, ARect.Top + 1);
    ACanvas.LineTo(X2 - 1, ARect.Top + 1);
    ACanvas.LineTo(X2 - 1, ARect.Top + 6);

    ACanvas.MoveTo(X2 - 3, ARect.Top + 2);
    ACanvas.LineTo(X2 - 2, ARect.Top + 2);
    ACanvas.LineTo(X2 - 2, ARect.Top + 3);
    ACanvas.LineTo(X2 - 3, ARect.Top + 3);



    ACanvas.Pen.Color := GetShadeColor(ACanvas, DefColor, 10);
    ACanvas.MoveTo(X2 - 6, ARect.Top + 3);
    ACanvas.LineTo(X2 - 3, ARect.Top + 3);
    ACanvas.LineTo(X2 - 3, ARect.Top + 6);
    ACanvas.LineTo(X2 - 4, ARect.Top + 6);
    ACanvas.LineTo(X2 - 4, ARect.Top + 3);

    ACanvas.Pen.Color := GetShadeColor(ACanvas, DefColor, 30);
    ACanvas.MoveTo(X2 - 5, ARect.Top + 5);
    ACanvas.LineTo(X2 - 4, ARect.Top + 5);
    ACanvas.LineTo(X2 - 4, ARect.Top + 9);

    ACanvas.Pen.Color := GetShadeColor(ACanvas, DefColor, 40);
    ACanvas.MoveTo(X2 - 6, ARect.Top + 5);
    ACanvas.LineTo(X2 - 6, ARect.Top + 7);

  end
  else
  begin
    ACanvas.Pen.Color := FMenuBorderColor;
    ACanvas.Brush.Color := FMenuShadowColor;

    ACanvas.MoveTo(X1, ARect.Bottom - 1);
    ACanvas.LineTo(X1, ARect.Top);
    ACanvas.LineTo(X2 - 3, ARect.Top);
    ACanvas.LineTo(X2 - 3, ARect.Bottom);


    ACanvas.Pen.Color := ACanvas.Brush.Color;
    ACanvas.FillRect(Rect(X2 - 2, ARect.Top + 2, X2, ARect.Bottom));
  end;

end;


procedure TXPMenu.DrawCheckedItem(FMenuItem: TMenuItem; Selected,
 HasImgLstBitmap: boolean; ACanvas: TCanvas; CheckedRect: TRect);
var
  X1, X2: integer;
begin
  if FMenuItem.RadioItem then
  begin
    if FMenuItem.Checked then
    begin

      ACanvas.Pen.color := FFSelectBorderColor;
      if selected then
        ACanvas.Brush.Color := FCheckedAreaSelectColor
      else
        ACanvas.Brush.Color := FCheckedAreaColor;
      ACanvas.Brush.Style := bsSolid;
      if HasImgLstBitmap then
      begin
        ACanvas.RoundRect(CheckedRect.Left, CheckedRect.Top,
          CheckedRect.Right, CheckedRect.Bottom,
          6, 6);
      end
      else
      begin
        ACanvas.Ellipse(CheckedRect.Left, CheckedRect.Top,
          CheckedRect.Right, CheckedRect.Bottom);
      end;
    end;
  end
  else
  begin
    if (FMenuItem.Checked) then
      if (not HasImgLstBitmap) then
      begin
        ACanvas.Pen.color := FFCheckedColor;
        if selected then
          ACanvas.Brush.Color := FCheckedAreaSelectColor
        else
          ACanvas.Brush.Color := FCheckedAreaColor; ;
        ACanvas.Brush.Style := bsSolid;
        ACanvas.Rectangle(CheckedRect.Left, CheckedRect.Top,
          CheckedRect.Right, CheckedRect.Bottom);
        ACanvas.Pen.color := clBlack;
        x1 := CheckedRect.Left + 1;
        x2 := CheckedRect.Top + 5;
        ACanvas.MoveTo(x1, x2);

        x1 := CheckedRect.Left + 4;
        x2 := CheckedRect.Bottom - 2;
        ACanvas.LineTo(x1, x2);
           //--
        x1 := CheckedRect.Left + 2;
        x2 := CheckedRect.Top + 5;
        ACanvas.MoveTo(x1, x2);

        x1 := CheckedRect.Left + 4;
        x2 := CheckedRect.Bottom - 3;
        ACanvas.LineTo(x1, x2);
           //--
        x1 := CheckedRect.Left + 2;
        x2 := CheckedRect.Top + 4;
        ACanvas.MoveTo(x1, x2);

        x1 := CheckedRect.Left + 5;
        x2 := CheckedRect.Bottom - 3;
        ACanvas.LineTo(x1, x2);
           //-----------------

        x1 := CheckedRect.Left + 4;
        x2 := CheckedRect.Bottom - 3;
        ACanvas.MoveTo(x1, x2);

        x1 := CheckedRect.Right + 2;
        x2 := CheckedRect.Top - 1;
        ACanvas.LineTo(x1, x2);
           //--
        x1 := CheckedRect.Left + 4;
        x2 := CheckedRect.Bottom - 2;
        ACanvas.MoveTo(x1, x2);

        x1 := CheckedRect.Right - 2;
        x2 := CheckedRect.Top + 3;
        ACanvas.LineTo(x1, x2);

      end
      else
      begin
        ACanvas.Pen.color := FFSelectBorderColor;
        if selected then
          ACanvas.Brush.Color := FCheckedAreaSelectColor
        else
          ACanvas.Brush.Color := FCheckedAreaColor;
        ACanvas.Brush.Style := bsSolid;
        ACanvas.Rectangle(CheckedRect.Left, CheckedRect.Top,
          CheckedRect.Right, CheckedRect.Bottom);
      end;
  end;

end;

procedure TXPMenu.DrawTheText(txt, ShortCuttext: string; ACanvas: TCanvas; TextRect: TRect;
  Selected, Enabled, Default, TopMenu, IsRightToLeft: boolean; TextFormat: integer);
var
  DefColor: TColor;
begin

  DefColor := FFont.Color;

  ACanvas.Font := FFont;


  if Enabled then
    DefColor := FFont.Color;


  if Selected then
    DefColor := FFSelectFontColor;


  if not Enabled then
  begin
    DefColor := FFDisabledColor;
    //if Selected then
    //  if Is16Bit then
    //    DefColor := NewColor(ACanvas, FFDisabledColor, 10);
  end;

  if (TopMenu and Selected) then
    DefColor := TopMenuFontColor(ACanvas, FFIconBackColor);

  ACanvas.Font.color := DefColor;    // will not affect Buttons


  TextRect.Top := TextRect.Top +
    ((TextRect.Bottom - TextRect.Top) - ACanvas.TextHeight('W')) div 2;

  SetBkMode(ACanvas.Handle, TRANSPARENT);


  if Default and Enabled then
  begin

    Inc(TextRect.Left, 1);
    ACanvas.Font.color := GetShadeColor(ACanvas,
                              ACanvas.Pixels[TextRect.Left, TextRect.Top], 30);
    DrawtextEx(ACanvas.Handle,
      PChar(txt),
      Length(txt),
      TextRect, TextFormat, nil);
    Dec(TextRect.Left, 1);


    Inc(TextRect.Top, 2);
    Inc(TextRect.Left, 1);
    Inc(TextRect.Right, 1);


    ACanvas.Font.color := GetShadeColor(ACanvas,
                              ACanvas.Pixels[TextRect.Left, TextRect.Top], 30);
    DrawtextEx(ACanvas.Handle,
      PChar(txt),
      Length(txt),
      TextRect, TextFormat, nil);


    Dec(TextRect.Top, 1);
    Dec(TextRect.Left, 1);
    Dec(TextRect.Right, 1);

    ACanvas.Font.color := GetShadeColor(ACanvas,
                              ACanvas.Pixels[TextRect.Left, TextRect.Top], 40);
    DrawtextEx(ACanvas.Handle,
      PChar(txt),
      Length(txt),
      TextRect, TextFormat, nil);


    Inc(TextRect.Left, 1);
    Inc(TextRect.Right, 1);

    ACanvas.Font.color := GetShadeColor(ACanvas,
                              ACanvas.Pixels[TextRect.Left, TextRect.Top], 60);
    DrawtextEx(ACanvas.Handle,
      PChar(txt),
      Length(txt),
      TextRect, TextFormat, nil);

    Dec(TextRect.Left, 1);
    Dec(TextRect.Right, 1);
    Dec(TextRect.Top, 1);

    ACanvas.Font.color := DefColor;
  end;

  DrawtextEx(ACanvas.Handle,
      PChar(txt),
      Length(txt),
      TextRect, TextFormat, nil);


  txt := ShortCutText + ' ';

  if not Is16Bit then
    ACanvas.Font.color := DefColor
  else
    ACanvas.Font.color := GetShadeColor(ACanvas, DefColor, -40);



  if IsRightToLeft then
  begin
    Inc(TextRect.Left, 10);
    TextFormat := DT_LEFT
  end
  else
  begin
    Dec(TextRect.Right, 10);
    TextFormat := DT_RIGHT;
  end;

  DrawtextEx(ACanvas.Handle,
    PChar(txt),
    Length(txt),
    TextRect, TextFormat, nil);

end;

procedure TXPMenu.DrawIcon(Sender: TObject; ACanvas: TCanvas; B: TBitmap;
 IconRect: Trect; Hot, Selected, Enabled, Checked, FTopMenu,
 IsRightToLeft: boolean);
var
  DefColor: TColor;
  X1, X2: integer;
begin

  if B <> nil then
  begin
    X1 := IconRect.Left;
    X2 := IconRect.Top + 2;
    if Sender is TMenuItem then
    begin
      inc(X2, 2);
      if FIconWidth >= B.Width then
        X1 := X1 + ((FIconWidth - B.Width) div 2) - 1
      else
      begin
        if IsRightToLeft then
          X1 := IconRect.Right - b.Width - 2
        else
          X1 := IconRect.Left + 2;
      end;
    end;


    if (Hot) and (not FTopMenu) and (Enabled) and (not Checked) then
      if not Selected then
      begin
        dec(X1, 1);
        dec(X2, 1);
      end;

    if (not Hot) and (Enabled) and (not Checked) then
      if Is16Bit then
        DimBitmap(B, 30);


    if not Enabled then
      GrayBitmap(B, 90);

    if (Hot) and (Enabled) and (not Checked) then
    begin
      if (Is16Bit) and (not UseSystemColors) and (Sender is TToolButton) then
        DefColor := NewColor(ACanvas, FSelectColor, 68)
      else
        DefColor := FFSelectColor;

      DefColor := GetShadeColor(ACanvas, DefColor, 50);
      DrawBitmapShadow(B, ACanvas, X1 + 2, X2 + 2, DefColor);
    end;

    B.Transparent := true;
   
    ACanvas.Draw(X1, X2, B);


  end;

end;

procedure TXPMenu.DrawArrow(ACanvas: TCanvas; X, Y: integer);
begin
  ACanvas.MoveTo(X, Y);
  ACanvas.LineTo(X + 4, Y);

  ACanvas.MoveTo(X + 1, Y + 1);
  ACanvas.LineTo(X + 4, Y);

  ACanvas.MoveTo(X + 2, Y + 2);
  ACanvas.LineTo(X + 3, Y);

end;

function TXPMenu.TopMenuFontColor(ACanvas: TCanvas; Color: TColor): TColor;
var
  r, g, b, avg: integer;
begin

  Color := ColorToRGB(Color);
  r := Color and $000000FF;
  g := (Color and $0000FF00) shr 8;
  b := (Color and $00FF0000) shr 16;

  Avg := (r + b) div 2;

  if (Avg > 150) or (g > 200) then
    Result := FFont.Color
  else
    Result := NewColor(ACanvas, Color, 90);
   // Result := FColor;
end;


procedure TXPMenu.SetActive(const Value: boolean);
begin

  FActive := Value;

  if FActive then
  begin
    InitMenueItems(FForm, false);
    InitMenueItems(FForm,true);
  end
  else
    InitMenueItems(FForm, false);

  if FForm <> nil then
    Windows.DrawMenuBar(FForm.Handle);
end;

procedure TXPMenu.SetAutoDetect(const Value: boolean);
begin
  FAutoDetect := Value;
end;

procedure TXPMenu.SetForm(const Value: TForm);
var
  Hold: boolean;
begin
  if Value <> FForm then
  begin
    Hold := Active;
    Active := false;
    FForm := Value;
    if Hold then
      Active := True;
  end;
end;

procedure TXPMenu.SetFont(const Value: TFont);
begin
  FFont.Assign(Value);
  Windows.DrawMenuBar(FForm.Handle);

end;

procedure TXPMenu.SetColor(const Value: TColor);
begin
  FColor := Value;
end;

procedure TXPMenu.SetIconBackColor(const Value: TColor);
begin
  FIconBackColor := Value;
end;

procedure TXPMenu.SetMenuBarColor(const Value: TColor);
begin
  FMenuBarColor := Value;
  Windows.DrawMenuBar(FForm.Handle);
end;

procedure TXPMenu.SetCheckedColor(const Value: TColor);
begin
  FCheckedColor := Value;
end;

procedure TXPMenu.SetSeparatorColor(const Value: TColor);
begin
  FSeparatorColor := Value;
end;

procedure TXPMenu.SetSelectBorderColor(const Value: TColor);
begin
  FSelectBorderColor := Value;
end;

procedure TXPMenu.SetSelectColor(const Value: TColor);
begin
  FSelectColor := Value;
end;

procedure TXPMenu.SetDisabledColor(const Value: TColor);
begin
  FDisabledColor := Value;
end;

procedure TXPMenu.SetSelectFontColor(const Value: TColor);
begin
  FSelectFontColor := Value;
end;

procedure TXPMenu.SetIconWidth(const Value: integer);
begin
  FIconWidth := Value;
end;

procedure TXPMenu.SetDrawSelect(const Value: boolean);
begin
  FDrawSelect := Value;
end;



procedure TXPMenu.SetOverrideOwnerDraw(const Value: boolean);
begin
  FOverrideOwnerDraw := Value;
  if FActive then
    Active := True;
end;


procedure TXPMenu.SetUseSystemColors(const Value: boolean);
begin
  FUseSystemColors := Value;
  Windows.DrawMenuBar(FForm.Handle);
end;

procedure TXPMenu.SetGradient(const Value: boolean);
begin
  FGradient := Value;
end;

procedure TXPMenu.SetFlatMenu(const Value: boolean);
begin
  FFlatMenu := Value;
end;


procedure GetSystemMenuFont(Font: TFont);
var
  FNonCLientMetrics: TNonCLientMetrics;
begin
  FNonCLientMetrics.cbSize := Sizeof(TNonCLientMetrics);
  if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @FNonCLientMetrics,0) then
  begin
    Font.Handle := CreateFontIndirect(FNonCLientMetrics.lfMenuFont);
    Font.Color := clMenuText;
    if Font.Name = 'MS Sans Serif' then
      Font.Name := 'Tahoma';
  end;
end;


procedure TXPMenu.DrawGradient(ACanvas: TCanvas; ARect: TRect;
 IsRightToLeft: boolean);
var
  i: integer;
  v: integer;
  FRect: TRect;
begin

  fRect := ARect;
  V := 0;
  if IsRightToLeft then
  begin
    fRect.Left := fRect.Right - 1;
    for i := ARect.Right Downto ARect.Left do
    begin
      if (fRect.Left < ARect.Right)
        and (fRect.Left > ARect.Right - FIconWidth + 5) then
        inc(v, 3)
      else
        inc(v, 1);

      if v > 96 then v := 96;
      ACanvas.Brush.Color := NewColor(ACanvas, FFIconBackColor, v);
      ACanvas.FillRect(fRect);

      fRect.Left := fRect.Left - 1;
      fRect.Right := fRect.Left - 1;
    end;
  end
  else
  begin
    fRect.Right := fRect.Left + 1;
    for i := ARect.Left to ARect.Right do
    begin
      if (fRect.Left > ARect.Left)
        and (fRect.Left < ARect.Left + FIconWidth + 5) then
        inc(v, 3)
      else
        inc(v, 1);

      if v > 96 then v := 96;
      ACanvas.Brush.Color := NewColor(ACanvas, FFIconBackColor, v);
      ACanvas.FillRect(fRect);

      fRect.Left := fRect.Left + 1;
      fRect.Right := fRect.Left + 1;
    end;
  end;
end;


procedure TXPMenu.DrawWindowBorder(hWnd: HWND; IsRightToLeft: boolean);
var
  WRect, CRect: TRect;
  dCanvas: TCanvas;
begin

  if hWnd <= 0 then
  begin
   exit;
  end;
  dCanvas := nil;
  try
    dCanvas := TCanvas.Create;
    dCanvas.Handle := GetDc(0);

    GetClientRect(hWnd, CRect);
    GetWindowRect(hWnd, WRect);

    ExcludeClipRect(dCanvas.Handle, CRect.Left, CRect.Top, CRect.Right,
                    CRect.Bottom);

    dCanvas.Brush.Style := bsClear;


    Dec(WRect.Right, 2);
    Dec(WRect.Bottom, 2);

    dCanvas.Pen.Color := FMenuBorderColor;
    dCanvas.Rectangle(WRect.Left, WRect.Top, WRect.Right, WRect.Bottom);

    if IsRightToLeft then
    begin
      dCanvas.Pen.Color := FFColor;
      dCanvas.Rectangle(WRect.Left + 1, WRect.Top + 1, WRect.Right - 2,
                        WRect.Top + 3);

      dCanvas.MoveTo(WRect.Left + 2, WRect.Top + 2);
      dCanvas.LineTo(WRect.Left + 2, WRect.Bottom - 2);


      dCanvas.Pen.Color := FFIconBackColor;
      dCanvas.MoveTo(WRect.Right - 2, WRect.Top + 2);
      dCanvas.LineTo(WRect.Right - 2, WRect.Bottom - 2);

      dCanvas.MoveTo(WRect.Right - 2, WRect.Top + 2);
      dCanvas.LineTo(WRect.Right - 1 - FIconWidth, WRect.Top + 2);
    end
    else
    begin
      if not FGradient then
      begin
        dCanvas.Pen.Color := FFColor;
        dCanvas.Rectangle(WRect.Left + 1, WRect.Top + 1, WRect.Right - 2,
                          WRect.Top + 3);

        dCanvas.Pen.Color := FFIconBackColor;
        dCanvas.MoveTo(WRect.Left + 1, WRect.Top + 2);
        dCanvas.LineTo(WRect.Left + 2 + FIconWidth, WRect.Top + 2);
      end;

      dCanvas.Pen.Color := FFIconBackColor;
      dCanvas.MoveTo(WRect.Left + 1, WRect.Top + 1);
      dCanvas.LineTo(WRect.Left + 1, WRect.Bottom - 2);

    end;

    Inc(WRect.Right, 2);
    Inc(WRect.Bottom, 2);

    dCanvas.Pen.Color := FMenuShadowColor;
    dCanvas.Rectangle(WRect.Left +2, WRect.Bottom, WRect.Right, WRect.Bottom - 2);
    dCanvas.Rectangle(WRect.Right - 2, WRect.Bottom, WRect.Right, WRect.Top + 2);


    dCanvas.Pen.Color := FFIconBackColor;
    dCanvas.Rectangle(WRect.Left, WRect.Bottom - 2, WRect.Left + 2, WRect.Bottom);
    dCanvas.Rectangle(WRect.Right - 2, WRect.Top, WRect.Right, WRect.Top + 2);
  finally
    IntersectClipRect(dCanvas.Handle, WRect.Left, WRect.Top, WRect.Right, WRect.Bottom);
    ReleaseDC(0, dCanvas.Handle);
    dCanvas.Free;
  end;


end;



procedure TXPMenu.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if not FAutoDetect then exit;
  if (Operation = opInsert) and
     ((AComponent is TMenuItem) or (AComponent is TToolButton)) then
  begin
   if (csDesigning in ComponentState) then
     Active := true
   else
     //if ComponentState = [] then
        Active := true ;
  end;


end;


function GetShadeColor(ACanvas: TCanvas; clr: TColor; Value: integer): TColor;
var
  r, g, b: integer;

begin
  clr := ColorToRGB(clr);
  r := Clr and $000000FF;
  g := (Clr and $0000FF00) shr 8;
  b := (Clr and $00FF0000) shr 16;

  r := (r - value);
  if r < 0 then r := 0;
  if r > 255 then r := 255;

  g := (g - value) + 2;
  if g < 0 then g := 0;
  if g > 255 then g := 255;

  b := (b - value);
  if b < 0 then b := 0;
  if b > 255 then b := 255;

  Result := Windows.GetNearestColor(ACanvas.Handle, RGB(r, g, b));
end;

function NewColor(ACanvas: TCanvas; clr: TColor; Value: integer): TColor;
var
  r, g, b: integer;

begin
  if Value > 100 then Value := 100;
  clr := ColorToRGB(clr);
  r := Clr and $000000FF;
  g := (Clr and $0000FF00) shr 8;
  b := (Clr and $00FF0000) shr 16;


  r := r + Round((255 - r) * (value / 100));
  g := g + Round((255 - g) * (value / 100));
  b := b + Round((255 - b) * (value / 100));

  Result := Windows.GetNearestColor(ACanvas.Handle, RGB(r, g, b));

end;

function GrayColor(ACanvas: TCanvas; clr: TColor; Value: integer): TColor;
var
  r, g, b, avg: integer;

begin
  if Value > 100 then Value := 100;
  clr := ColorToRGB(clr);
  r := Clr and $000000FF;
  g := (Clr and $0000FF00) shr 8;
  b := (Clr and $00FF0000) shr 16;

  Avg := (r + g + b) div 3;
  Avg := Avg + Value;

  if Avg > 240 then Avg := 240;

  Result := Windows.GetNearestColor (ACanvas.Handle,RGB(Avg, avg, avg));
end;

procedure GrayBitmap(ABitmap: TBitmap; Value: integer);
var
  x, y: integer;
  LastColor1, LastColor2, Color: TColor;
begin
  LastColor1 := 0;
  LastColor2 := 0;

  for y := 0 to ABitmap.Height do
    for x := 0 to ABitmap.Width do
    begin
      Color := ABitmap.Canvas.Pixels[x, y];
      if Color = LastColor1 then
        ABitmap.Canvas.Pixels[x, y] := LastColor2
      else
      begin
        LastColor2 := GrayColor(ABitmap.Canvas , Color, Value);
        ABitmap.Canvas.Pixels[x, y] := LastColor2;
        LastColor1 := Color;
      end;
    end;
end;

procedure DimBitmap(ABitmap: TBitmap; Value: integer);
var
  x, y: integer;
  LastColor1, LastColor2, Color: TColor;
begin
  if Value > 100 then Value := 100;
  LastColor1 := -1;
  LastColor2 := -1;

  for y := 0 to ABitmap.Height - 1 do
    for x := 0 to ABitmap.Width - 1 do
    begin
      Color := ABitmap.Canvas.Pixels[x, y];
      if Color = LastColor1 then
        ABitmap.Canvas.Pixels[x, y] := LastColor2
      else
      begin
        LastColor2 := NewColor(ABitmap.Canvas, Color, Value);
        ABitmap.Canvas.Pixels[x, y] := LastColor2;
        LastColor1 := Color;
      end;
    end;
end;

procedure DrawBitmapShadow(B: TBitmap; ACanvas: TCanvas; X, Y: integer;
  ShadowColor: TColor);
var
  BX, BY: integer;
  TransparentColor: TColor;
begin
  TransparentColor := B.Canvas.Pixels[0, B.Height - 1];
  for BY := 0 to B.Height - 1 do
    for BX := 0 to B.Width - 1 do
    begin
      if B.Canvas.Pixels[BX, BY] <> TransparentColor then
        ACanvas.Pixels[X + BX, Y + BY] := ShadowColor;

    end;
end;



end.

