home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kompon / d45 / XPMENU.ZIP / XPMenu.pas < prev   
Pascal/Delphi Source File  |  2001-07-29  |  51KB  |  2,024 lines
  1. {
  2. XPMenu for Delphi
  3. Author: Khaled Shagrouni
  4. URL: http://www.shagrouni.com
  5. e-mail: shagrouni@hotmail.com
  6. Version 1.501 (BETA), 29 July, 2001
  7.  
  8.  
  9. XPMenu is a Delphi component to mimic Office XP menu and toolbar style.
  10. Copyright (C) 2001 Khaled Shagrouni.
  11.  
  12. This component is FREEWARE with source code. I still hold the copyright.
  13. If you make any modifications to the code, please send them to me.
  14. If you have any ideas for improvement or bug reports, don't hesitate to e-mail me.
  15.  
  16.  
  17.  
  18. History:
  19. ========
  20.  
  21. July 29, 2001, V1.501
  22.    - Adding AutoDetect property.
  23.    - Compatibility issues with Delphi4.
  24. July 25, 2001, V1.5
  25.    - Support for TToolbar.
  26.    - Getting closer to XP style appearance.
  27.    - New options.
  28. june 23, 2001
  29.    - Compatibility issues with Delphi4.
  30.    - Changing the way of menus itration.
  31.    - Making the blue select rectangle little thinner.
  32.  
  33. june 21, 2001
  34.   Bug fixes:
  35.    - Items correctly sized even if no image list assigned.
  36.    - Shaded colors for top menu items if fixed for some menu bar colors.
  37.   (Actually the bugs was due to two statements deleted by me stupidly/accidentally)
  38.  
  39. June 19, 2001
  40.   This component is based on code which I have posted at Delphi3000.com
  41.   (http://www.delphi3000/articles/article_2246.asp) and Borland Code-Central
  42.   (http://codecentral.borland.com/codecentral/ccweb.exe/listing?id=16120).
  43.  
  44.  
  45. }
  46. //____________________________________________________________________________
  47.  
  48.  
  49. {$IFDEF VER130}
  50. {$DEFINE VER5U}
  51. {$ENDIF}
  52.  
  53. {$IFDEF VER140}
  54. {$DEFINE VER5U}
  55. {$ENDIF}
  56.  
  57.  
  58. unit XPMenu;
  59.  
  60. interface
  61.  
  62. uses
  63.   Windows, SysUtils, Classes, Graphics, Controls, ComCtrls,  Forms,
  64.   Menus, Messages, Commctrl;
  65.  
  66. type
  67.   TXPMenu = class(TComponent)
  68.   private
  69.     FActive: boolean;
  70.     FForm: TForm;
  71.     FFont: TFont;
  72.     FColor: TColor;
  73.     FIconBackColor: TColor;
  74.     FMenuBarColor: TColor;
  75.     FCheckedColor: TColor;
  76.     FSeparatorColor: TColor;
  77.     FSelectBorderColor: TColor;
  78.     FSelectColor: TColor;
  79.     FDisabledColor: TColor;
  80.     FSelectFontColor: TColor;
  81.     FIconWidth: integer;
  82.     FDrawSelect: boolean;
  83.     FUseSystemColors: boolean;
  84.  
  85.     FFColor, FFIconBackColor, FFSelectColor, FFSelectBorderColor,
  86.     FFSelectFontColor, FCheckedAreaColor, FCheckedAreaSelectColor,
  87.     FFCheckedColor, FFMenuBarColor, FFDisabledColor, FFSeparatorColor,
  88.     FMenuBorderColor, FMenuShadowColor: TColor;
  89.  
  90.     Is16Bit: boolean;
  91.     FOverrideOwnerDraw: boolean;
  92.     FGradient: boolean;
  93.     ImgLstHandle: HWND;
  94.     ImgLstIndex: integer;
  95.     FFlatMenu: boolean;
  96.     FAutoDetect: boolean;
  97.  
  98.     procedure SetActive(const Value: boolean);
  99.     procedure SetAutoDetect(const Value: boolean);
  100.     procedure SetForm(const Value: TForm);
  101.     procedure SetFont(const Value: TFont);
  102.     procedure SetColor(const Value: TColor);
  103.     procedure SetIconBackColor(const Value: TColor);
  104.     procedure SetMenuBarColor(const Value: TColor);
  105.     procedure SetCheckedColor(const Value: TColor);
  106.     procedure SetDisabledColor(const Value: TColor);
  107.     procedure SetSelectColor(const Value: TColor);
  108.     procedure SetSelectBorderColor(const Value: TColor);
  109.     procedure SetSeparatorColor(const Value: TColor);
  110.     procedure SetSelectFontColor(const Value: TColor);
  111.     procedure SetIconWidth(const Value: integer);
  112.     procedure SetDrawSelect(const Value: boolean);
  113.     procedure SetUseSystemColors(const Value: boolean);
  114.     procedure SetOverrideOwnerDraw(const Value: boolean);
  115.     procedure SetGradient(const Value: boolean);
  116.     procedure SetFlatMenu(const Value: boolean);
  117.  
  118.  
  119.  
  120.   protected
  121.     procedure InitMenueItems(Enable: boolean);
  122.     procedure DrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
  123.       Selected: Boolean);
  124.     procedure MenueDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
  125.       Selected: Boolean);
  126.     procedure ActivateMenuItem(MenuItem: TMenuItem);
  127.     procedure SetGlobalColor(ACanvas: TCanvas);
  128.     procedure DrawTopMenuItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
  129.       IsRightToLeft: boolean);
  130.     procedure DrawCheckedItem(FMenuItem: TMenuItem; Selected,
  131.      HasImgLstBitmap: boolean; ACanvas: TCanvas; CheckedRect: TRect);
  132.     procedure DrawTheText(txt, ShortCuttext: string; ACanvas: TCanvas;
  133.      TextRect: TRect; Selected, Enabled, Default, TopMenu,
  134.      IsRightToLeft: boolean; TextFormat: integer);
  135.     procedure DrawIcon(Sender: TObject; ACanvas: TCanvas; B: TBitmap;
  136.      IconRect: Trect; Hot, Selected, Enabled, Checked, FTopMenu,
  137.      IsRightToLeft: boolean);
  138.     procedure DrawArrow(ACanvas: TCanvas; X, Y: integer);
  139.     procedure MeasureItem(Sender: TObject; ACanvas: TCanvas;
  140.       var Width, Height: Integer);
  141.  
  142.     function GetImageExtent(MenuItem: TMenuItem): TPoint;
  143.     procedure ToolBarDrawButton(Sender: TToolBar;
  144.       Button: TToolButton; State: TCustomDrawState; var DefaultDraw: Boolean);
  145.  
  146.     function TopMenuFontColor(ACanvas: TCanvas; Color: TColor): TColor;
  147.     procedure DrawGradient(ACanvas: TCanvas; ARect: TRect;
  148.      IsRightToLeft: boolean);
  149.  
  150.     procedure DrawWindowBorder(hWnd: HWND; IsRightToLeft: boolean);
  151.     procedure Notification(AComponent: TComponent;
  152.       Operation: TOperation); override;
  153.  
  154.  
  155.   public
  156.     constructor Create(AOwner: TComponent); override;
  157.     destructor Destroy; override;
  158.     property Form: TForm read FForm write SetForm;
  159.   published
  160.     property Font: TFont read FFont write SetFont;
  161.     property Color: TColor read FColor write SetColor;
  162.     property IconBackColor: TColor read FIconBackColor write SetIconBackColor;
  163.     property MenuBarColor: TColor read FMenuBarColor write SetMenuBarColor;
  164.     property SelectColor: TColor read FSelectColor write SetSelectColor;
  165.     property SelectBorderColor: TColor read FSelectBorderColor
  166.      write SetSelectBorderColor;
  167.     property SelectFontColor: TColor read FSelectFontColor
  168.      write SetSelectFontColor;
  169.     property DisabledColor: TColor read FDisabledColor write SetDisabledColor;
  170.     property SeparatorColor: TColor read FSeparatorColor
  171.      write SetSeparatorColor;
  172.     property CheckedColor: TColor read FCheckedColor write SetCheckedColor;
  173.     property IconWidth: integer read FIconWidth write SetIconWidth;
  174.     property DrawSelect: boolean read FDrawSelect write SetDrawSelect;
  175.     property UseSystemColors: boolean read FUseSystemColors
  176.      write SetUseSystemColors;
  177.     property OverrideOwnerDraw: boolean read FOverrideOwnerDraw
  178.      write SetOverrideOwnerDraw;
  179.  
  180.     property Gradient: boolean read FGradient write SetGradient;
  181.     property FlatMenu: boolean read FFlatMenu write SetFlatMenu;
  182.     property AutoDetect: boolean read FAutoDetect write SetAutoDetect;
  183.     property Active: boolean read FActive write SetActive;
  184.   end;
  185.  
  186. function GetShadeColor(ACanvas: TCanvas; clr: TColor; Value: integer): TColor;
  187. function NewColor(ACanvas: TCanvas; clr: TColor; Value: integer): TColor;
  188. procedure DimBitmap(ABitmap: TBitmap; Value: integer);
  189. function GrayColor(ACanvas: TCanvas; clr: TColor; Value: integer): TColor;
  190. procedure GrayBitmap(ABitmap: TBitmap; Value: integer);
  191. procedure DrawBitmapShadow(B: TBitmap; ACanvas: TCanvas; X, Y: integer;
  192.   ShadowColor: TColor);
  193.  
  194.  
  195.  
  196. procedure GetSystemMenuFont(Font: TFont);
  197. procedure Register;
  198.  
  199. implementation
  200.  
  201.  
  202. procedure Register;
  203. begin
  204.   RegisterComponents('XP', [TXPMenu]);
  205. end;
  206.  
  207. { TXPMenue }
  208.  
  209. constructor TXPMenu.Create(AOwner: TComponent);
  210. begin
  211.   inherited Create(AOwner);
  212.   FFont := TFont.Create;
  213.   GetSystemMenuFont(FFont);
  214.   FForm := TForm(Owner);
  215.  
  216.   FUseSystemColors := true;
  217.  
  218.  
  219.   FColor := clBtnFace;
  220.   FIconBackColor := clBtnFace;
  221.   FSelectColor := clHighlight;
  222.   FSelectBorderColor := clHighlight;
  223.   FMenuBarColor := clBtnFace;
  224.   FDisabledColor := clInactiveCaption;
  225.   FSeparatorColor := clBtnFace;
  226.   FCheckedColor := clHighlight;
  227.   FSelectFontColor := FFont.Color;
  228.  
  229.   FIconWidth := 24;
  230.   FDrawSelect := true;
  231.  
  232.   if FActive then
  233.   begin
  234.     InitMenueItems(true);
  235.   end;
  236.  
  237. end;
  238.  
  239. destructor TXPMenu.Destroy;
  240. begin
  241.   InitMenueItems(false);
  242.   FFont.Free;
  243.  
  244.   inherited;
  245. end;
  246.  
  247.  
  248.  
  249. procedure TXPMenu.ActivateMenuItem(MenuItem: TMenuItem);
  250.  
  251.   procedure Activate(MenuItem: TMenuItem);
  252.   begin
  253.     if addr(MenuItem.OnDrawItem) <> addr(TXPMenu.DrawItem) then
  254.     begin
  255.       if (not assigned(MenuItem.OnDrawItem)) or (FOverrideOwnerDraw) then
  256.         MenuItem.OnDrawItem := DrawItem;
  257.       if (not assigned(MenuItem.OnMeasureItem)) or (FOverrideOwnerDraw) then
  258.         MenuItem.OnMeasureItem := MeasureItem;
  259.     end
  260.   end;
  261.  
  262. var
  263.   i, j: integer;
  264. begin
  265.  
  266.   Activate(MenuItem);
  267.   for i := 0 to MenuItem.Parent.Count -1 do
  268.   begin
  269.     Activate(MenuItem.Parent.Items[i]);
  270.     for j := 0 to MenuItem.Parent.Items[i].Count - 1 do
  271.       ActivateMenuItem(MenuItem.Parent.Items[i].Items[j]);
  272.   end;
  273.  
  274. end;
  275.  
  276. procedure TXPMenu.InitMenueItems(Enable: boolean);
  277.  
  278.   procedure Activate(MenuItem: TMenuItem);
  279.   begin
  280.     if Enable then
  281.     begin
  282.       if (not assigned(MenuItem.OnDrawItem)) or (FOverrideOwnerDraw) then
  283.         MenuItem.OnDrawItem := DrawItem;
  284.       if (not assigned(MenuItem.OnMeasureItem)) or (FOverrideOwnerDraw) then
  285.         MenuItem.OnMeasureItem := MeasureItem;
  286.     end
  287.     else
  288.     begin
  289.       if addr(MenuItem.OnDrawItem) = addr(TXPMenu.DrawItem) then
  290.         MenuItem.OnDrawItem := nil;
  291.       if addr(MenuItem.OnMeasureItem) = addr(TXPMenu.MeasureItem) then
  292.         MenuItem.OnMeasureItem := nil;
  293.     end;
  294.   end;
  295.  
  296.   procedure ItrateMenu(MenuItem: TMenuItem);
  297.   var
  298.     i: integer;
  299.   begin
  300.     Activate(MenuItem);
  301.     for i := 0 to MenuItem.Count - 1 do
  302.       ItrateMenu(MenuItem.Items[i]);
  303.   end;
  304.  
  305.  
  306. var
  307.   i, x: integer;
  308. begin
  309.   for i := 0 to FForm.ComponentCount - 1 do
  310.   begin
  311.     if FForm.Components[i] is TMainMenu then
  312.     begin
  313.       for x := 0 to TMainMenu(FForm.Components[i]).Items.Count - 1 do
  314.       begin
  315.         TMainMenu(FForm.Components[i]).OwnerDraw := Enable;//Thanks Yann.
  316.         Activate(TMainMenu(FForm.Components[i]).Items[x]);
  317.         ItrateMenu(TMainMenu(FForm.Components[i]).Items[x]);
  318.       end;
  319.     end;
  320.     if FForm.Components[i] is TPopupMenu then
  321.     begin
  322.       for x := 0 to TPopupMenu(FForm.Components[i]).Items.Count - 1 do
  323.       begin
  324.         TPopupMenu(FForm.Components[i]).OwnerDraw := Enable;
  325.         Activate(TMainMenu(FForm.Components[i]).Items[x]);
  326.         ItrateMenu(TMainMenu(FForm.Components[i]).Items[x]);
  327.       end;
  328.     end;
  329.  
  330.     if FForm.Components[i] is TToolBar then
  331.       if not (csDesigning in ComponentState) then
  332.       begin
  333.         if not TToolBar(FForm.Components[i]).Flat then
  334.           TToolBar(FForm.Components[i]).Flat := true;
  335.  
  336.         if Enable then
  337.         begin
  338.           for x := 0 to TToolBar(FForm.Components[i]).ButtonCount - 1 do
  339.             if (not assigned(TToolBar(FForm.Components[i]).OnCustomDrawButton))
  340.               or (FOverrideOwnerDraw) then
  341.             begin
  342.               TToolBar(FForm.Components[i]).OnCustomDrawButton :=
  343.                 ToolBarDrawButton;
  344.  
  345.             end;
  346.         end
  347.         else
  348.         begin
  349.           if addr(TToolBar(FForm.Components[i]).OnCustomDrawButton) =
  350.             addr(TXPMenu.ToolBarDrawButton) then
  351.             TToolBar(FForm.Components[i]).OnCustomDrawButton := nil;
  352.  
  353.         end;
  354.       end;
  355.   end;
  356. end;
  357.  
  358. procedure TXPMenu.DrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
  359.   Selected: Boolean);
  360. begin
  361.   if FActive then
  362.     MenueDrawItem(Sender, ACanvas, ARect, Selected);
  363. end;
  364.  
  365.  
  366.  
  367. function TXPMenu.GetImageExtent(MenuItem: TMenuItem): TPoint;
  368. var
  369.   HasImgLstBitmap: boolean;
  370.   B: TBitmap;
  371.   FTopMenu: boolean;
  372. begin
  373.   FTopMenu := false;
  374.   B := TBitmap.Create;
  375.   B.Width := 0;
  376.   B.Height := 0;
  377.   Result.x := 0;
  378.   Result.Y := 0;
  379.   HasImgLstBitmap := false;
  380.  
  381.   if FForm.Menu <> nil then
  382.     if MenuItem.GetParentComponent.Name = FForm.Menu.Name then
  383.     begin
  384.       FTopMenu := true;
  385.       if FForm.Menu.Images <> nil then
  386.         if MenuItem.ImageIndex <> -1 then
  387.           HasImgLstBitmap := true;
  388.  
  389.     end;
  390.  
  391.   if (MenuItem.Parent.GetParentMenu.Images <> nil)
  392.   {$IFDEF VER5U}
  393.   or (MenuItem.Parent.SubMenuImages <> nil)
  394.   {$ENDIF}
  395.   then
  396.   begin
  397.     if MenuItem.ImageIndex <> -1 then
  398.       HasImgLstBitmap := true
  399.     else
  400.       HasImgLstBitmap := false;
  401.   end;
  402.  
  403.   if HasImgLstBitmap then
  404.   begin
  405.   {$IFDEF VER5U}
  406.     if MenuItem.Parent.SubMenuImages <> nil then
  407.       MenuItem.Parent.SubMenuImages.GetBitmap(MenuItem.ImageIndex, B)
  408.     else
  409.   {$ENDIF}
  410.       MenuItem.Parent.GetParentMenu.Images.GetBitmap(MenuItem.ImageIndex, B)
  411.   end
  412.   else
  413.     if MenuItem.Bitmap.Width > 0 then
  414.       B.Assign(TBitmap(MenuItem.Bitmap));
  415.  
  416.   Result.x := B.Width;
  417.   Result.Y := B.Height;
  418.  
  419.   if not FTopMenu then
  420.     if Result.x < FIconWidth then
  421.       Result.x := FIconWidth;
  422.  
  423.   B.Free;
  424. end;
  425.  
  426. procedure TXPMenu.MeasureItem(Sender: TObject; ACanvas: TCanvas;
  427.   var Width, Height: Integer);
  428. var
  429.   s: string;
  430.   W, H: integer;
  431.   P: TPoint;
  432.   IsLine: boolean;
  433. begin
  434.   if FActive then
  435.   begin
  436.     S := TMenuItem(Sender).Caption;
  437.       //------
  438.     if S = '-' then IsLine := true else IsLine := false;
  439.     if IsLine then
  440.  
  441.       //------
  442.       if IsLine then
  443.         S := '';
  444.  
  445.     if Trim(ShortCutToText(TMenuItem(Sender).ShortCut)) <> '' then
  446.       S := S + ShortCutToText(TMenuItem(Sender).ShortCut) + 'WWW';
  447.  
  448.  
  449.  
  450.     ACanvas.Font.Assign(FFont);
  451.     W := ACanvas.TextWidth(s);
  452.     if pos('&', s) > 0 then
  453.       W := W - ACanvas.TextWidth('&');
  454.  
  455.     P := GetImageExtent(TMenuItem(Sender));
  456.  
  457.     W := W + P.x + 10;
  458.  
  459.     if Width < W then
  460.       Width := W;
  461.  
  462.     if IsLine then
  463.       Height := 4
  464.     else
  465.     begin
  466.       H := ACanvas.TextHeight(s) + Round(ACanvas.TextHeight(s) * 0.75);
  467.       if P.y + 4 > H then
  468.         H := P.y + 4;
  469.  
  470.       if Height < H then
  471.         Height := H;
  472.     end;
  473.   end;
  474.  
  475. end;
  476.  
  477. procedure TXPMenu.MenueDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
  478.   Selected: Boolean);
  479. var
  480.   txt: string;
  481.   B: TBitmap;
  482.   IconRect, TextRect, CheckedRect: TRect;
  483.   i, X1, X2: integer;
  484.   TextFormat: integer;
  485.   HasImgLstBitmap: boolean;
  486.   FMenuItem: TMenuItem;
  487.   FMenu: TMenu;
  488.   FTopMenu: boolean;
  489.   ISLine: boolean;
  490.   ImgListHandle: HImageList;        {Commctrl.pas}
  491.   ImgIndex: integer;
  492.   hWndM: HWND;
  493.   hDcM: HDC;
  494. begin
  495.   FTopMenu := false;
  496.   FMenuItem := TMenuItem(Sender);
  497.  
  498.   SetGlobalColor(ACanvas);
  499.  
  500.   if FMenuItem.Caption = '-' then IsLine := true else IsLine := false;
  501.  
  502.   FMenu := FMenuItem.Parent.GetParentMenu;
  503.  
  504.   if FMenu is TMainMenu then
  505.     for i := 0 to FMenuItem.GetParentMenu.Items.Count - 1 do
  506.       if FMenuItem.GetParentMenu.Items[i] = FMenuItem then
  507.       begin
  508.         FTopMenu := True;
  509.         break;
  510.       end;
  511.  
  512.  
  513.   ACanvas.Font.Assign(FFont);
  514.   if FMenu.IsRightToLeft then
  515.     ACanvas.Font.Charset := ARABIC_CHARSET;
  516.  
  517.   Inc(ARect.Bottom, 1);
  518.   TextRect := ARect;
  519.   txt := ' ' + FMenuItem.Caption;
  520.  
  521.   B := TBitmap.Create;
  522.  
  523.   HasImgLstBitmap := false;
  524.  
  525.  
  526.   if FMenuItem.Bitmap.Width > 0 then
  527.     B.Assign(TBitmap(FMenuItem.Bitmap));
  528.  
  529.   if (FMenuItem.Parent.GetParentMenu.Images <> nil)
  530.   {$IFDEF VER5U}
  531.   or (FMenuItem.Parent.SubMenuImages <> nil)
  532.   {$ENDIF}
  533.   then
  534.   begin
  535.     if FMenuItem.ImageIndex <> -1 then
  536.       HasImgLstBitmap := true
  537.     else
  538.       HasImgLstBitmap := false;
  539.   end;
  540.  
  541.  
  542.  
  543.   if FMenu.IsRightToLeft then
  544.   begin
  545.     X1 := ARect.Right - FIconWidth;
  546.     X2 := ARect.Right;
  547.   end
  548.   else
  549.   begin
  550.     X1 := ARect.Left;
  551.     X2 := ARect.Left + FIconWidth;
  552.   end;
  553.   IconRect := Rect(X1, ARect.Top, X2, ARect.Bottom);
  554.  
  555.  
  556.   if HasImgLstBitmap then
  557.   begin
  558.     CheckedRect := IconRect;
  559.     Inc(CheckedRect.Left, 1);
  560.     Inc(CheckedRect.Top, 2);
  561.     Dec(CheckedRect.Right, 3);
  562.     Dec(CheckedRect.Bottom, 2);
  563.  
  564.   end
  565.   else
  566.   begin
  567.     CheckedRect.Left := IconRect.Left +
  568.       (IConRect.Right - IconRect.Left - 10) div 2;
  569.     CheckedRect.Top := IconRect.Top +
  570.       (IConRect.Bottom - IconRect.Top - 10) div 2;
  571.     CheckedRect.Right := CheckedRect.Left + 10;
  572.     CheckedRect.Bottom := CheckedRect.Top + 10;
  573.  
  574.   end;
  575.  
  576.  
  577.   if FMenu.IsRightToLeft then
  578.   begin
  579.     X1 := ARect.Left;
  580.     X2 := ARect.Right - FIconWidth;
  581.     if B.Width > FIconWidth then
  582.       X2 := ARect.Right - B.Width - 4;
  583.   end
  584.   else
  585.   begin
  586.     X1 := ARect.Left + FIconWidth;
  587.     if B.Width > X1 then
  588.       X1 := B.Width + 4;
  589.     X2 := ARect.Right;
  590.   end;
  591.  
  592.   TextRect := Rect(X1, ARect.Top, X2, ARect.Bottom);
  593.  
  594.   if FTopMenu then
  595.   begin
  596.     if not HasImgLstBitmap then
  597.     begin
  598.       TextRect := ARect;
  599.     end
  600.     else
  601.     begin
  602.       if FMenu.IsRightToLeft then
  603.         TextRect.Right := TextRect.Right + 5
  604.       else
  605.         TextRect.Left := TextRect.Left - 5;
  606.     end
  607.  
  608.   end;
  609.  
  610.   if FTopMenu then
  611.   begin
  612.     ACanvas.brush.color := FFMenuBarColor;
  613.     ACanvas.Pen.Color := FFMenuBarColor;
  614.  
  615.     ACanvas.FillRect(ARect);
  616.   end
  617.   else
  618.   begin
  619.     if (Is16Bit and FGradient) then
  620.     begin
  621.       inc(ARect.Right,2);  //needed for RightToLeft
  622.       DrawGradient(ACanvas, ARect, FMenu.IsRightToLeft);
  623.       Dec(ARect.Right,2);
  624.  
  625.     end
  626.     else
  627.     begin
  628.       ACanvas.brush.color := FFColor;
  629.       ACanvas.FillRect(ARect);
  630.  
  631.       ACanvas.brush.color := FFIconBackColor;
  632.       ACanvas.FillRect(IconRect);
  633.     end;
  634.  
  635.  
  636. //------------
  637.   end;
  638.  
  639.  
  640.   if FMenuItem.Enabled then
  641.     ACanvas.Font.Color := FFont.Color
  642.   else
  643.     ACanvas.Font.Color := FDisabledColor;
  644.  
  645.   if Selected and FDrawSelect then
  646.   begin
  647.     ACanvas.brush.Style := bsSolid;
  648.     if FTopMenu then
  649.     begin
  650.       DrawTopMenuItem(FMenuItem, ACanvas, ARect, FMenu.IsRightToLeft);
  651.     end
  652.     else
  653.       //------
  654.       if FMenuItem.Enabled then
  655.       begin
  656.  
  657.         Inc(ARect.Top, 1);
  658.         Dec(ARect.Bottom, 1);
  659.         if FFlatMenu then
  660.           Dec(ARect.Right, 1);
  661.         ACanvas.brush.color := FFSelectColor;
  662.         ACanvas.FillRect(ARect);
  663.         ACanvas.Pen.color := FFSelectBorderColor;
  664.         ACanvas.Brush.Style := bsClear;
  665.         ACanvas.RoundRect(Arect.Left, Arect.top, Arect.Right,
  666.           Arect.Bottom, 0, 0);
  667.         Dec(ARect.Top, 1);
  668.         Inc(ARect.Bottom, 1);
  669.         if FFlatMenu then
  670.           Inc(ARect.Right, 1);
  671.       end;
  672.       //-----
  673.  
  674.   end;
  675.  
  676.   DrawCheckedItem(FMenuItem, Selected, HasImgLstBitmap, ACanvas, CheckedRect);
  677.  
  678. //-----
  679.  
  680.   if HasImgLstBitmap then
  681.   begin
  682.   {$IFDEF VER5U}
  683.     if FMenuItem.Parent.SubMenuImages <> nil then
  684.     begin
  685.       ImgListHandle := FMenuItem.Parent.SubMenuImages.Handle;
  686.       ImgIndex := FMenuItem.ImageIndex;
  687.  
  688.       B.Width := FMenuItem.Parent.SubMenuImages.Width;
  689.       B.Height := FMenuItem.Parent.SubMenuImages.Height;
  690.       B.Canvas.Brush.Color := FFIconBackColor;
  691.       B.Canvas.FillRect(Rect(0, 0, B.Width, B.Height));
  692.       ImageList_DrawEx(ImgListHandle, ImgIndex,
  693.         B.Canvas.Handle, 0, 0, 0, 0, clNone, clNone, ILD_Transparent);
  694.  
  695.     end
  696.     else
  697.   {$ENDIF}
  698.     begin
  699.       ImgListHandle := FMenuItem.Parent.GetParentMenu.Images.Handle;
  700.       ImgIndex := FMenuItem.ImageIndex;
  701.  
  702.       B.Width := FMenuItem.Parent.GetParentMenu.Images.Width;
  703.       B.Height := FMenuItem.Parent.GetParentMenu.Images.Height;
  704.       B.Canvas.Brush.Color := FFIconBackColor;
  705.       B.Canvas.FillRect(Rect(0, 0, B.Width, B.Height));
  706.       ImageList_DrawEx(ImgListHandle, ImgIndex,
  707.         B.Canvas.Handle, 0, 0, 0, 0, clNone, clNone, ILD_Transparent);
  708.  
  709.     end;
  710.   end
  711.  
  712.   else
  713.     if FMenuItem.Bitmap.Width > 0 then
  714.       B.Assign(TBitmap(FMenuItem.Bitmap));
  715.  
  716.  
  717.   DrawIcon(FMenuItem, ACanvas, B, IconRect,
  718.     Selected, False, FMenuItem.Enabled, FMenuItem.Checked,
  719.     FTopMenu, FMenu.IsRightToLeft);
  720.  
  721.  
  722. //--------
  723.   if not IsLine then
  724.   begin
  725.  
  726.     if FMenu.IsRightToLeft then
  727.     begin
  728.       TextFormat := DT_RIGHT + DT_RTLREADING;
  729.       Dec(TextRect.Right, 5);
  730.     end
  731.     else
  732.     begin
  733.       TextFormat := 0;
  734.       Inc(TextRect.Left, 5);
  735.     end;
  736.  
  737.     DrawTheText(txt, ShortCutToText(FMenuItem.ShortCut),
  738.       ACanvas, TextRect,
  739.       Selected, FMenuItem.Enabled, FMenuItem.Default,
  740.       FTopMenu, FMenu.IsRightToLeft, TextFormat);
  741.  
  742. //-----------
  743.  
  744.   end
  745.  
  746.  
  747.   else
  748.   begin
  749.     if FMenu.IsRightToLeft then
  750.     begin
  751.       X1 := TextRect.Left;
  752.       X2 := TextRect.Right - 7;
  753.     end
  754.     else
  755.     begin
  756.       X1 := TextRect.Left + 7;
  757.       X2 := TextRect.Right;
  758.     end;
  759.  
  760.     ACanvas.Pen.Color := FFSeparatorColor;
  761.     ACanvas.MoveTo(X1,
  762.       TextRect.Top +
  763.       Round((TextRect.Bottom - TextRect.Top) / 2));
  764.     ACanvas.LineTo(X2,
  765.       TextRect.Top +
  766.       Round((TextRect.Bottom - TextRect.Top) / 2))
  767.   end;
  768.  
  769.   B.free;
  770.  
  771. //------
  772.  
  773.   if not (csDesigning in ComponentState) then
  774.   begin
  775.     if (FFlatMenu) and (not FTopMenu) then
  776.     begin
  777.       hDcM := ACanvas.Handle;
  778.       hWndM := WindowFromDC(hDcM);
  779.       if hWndM <> FForm.Handle then
  780.       begin
  781.         DrawWindowBorder(hWndM, FMenu.IsRightToLeft);
  782.       end;
  783.     end;
  784.   end;
  785.  
  786. //-----
  787.   ActivateMenuItem(FMenuItem);  // to check for new sub items
  788. end;
  789.  
  790.  
  791. procedure TXPMenu.ToolBarDrawButton(Sender: TToolBar;
  792.   Button: TToolButton; State: TCustomDrawState; var DefaultDraw: Boolean);
  793.  
  794. var
  795.   ACanvas: TCanvas;
  796.  
  797.   ARect, HoldRect: TRect;
  798.   B: TBitmap;
  799.   HasBitmap: boolean;
  800.   BitmapWidth: integer;
  801.   TextFormat: integer;
  802.   XButton: TToolButton;
  803.   HasBorder: boolean;
  804.   HasBkg: boolean;
  805.   IsTransparent: boolean;
  806.   FBSelectColor: TColor;
  807.  
  808.   procedure DrawBorder;
  809.   var
  810.     BRect, WRect: TRect;
  811.     procedure DrawRect;
  812.     begin
  813.       ACanvas.Pen.color := FFSelectBorderColor;
  814.       ACanvas.MoveTo(WRect.Left, WRect.Top);
  815.       ACanvas.LineTo(WRect.Right, WRect.Top);
  816.       ACanvas.LineTo(WRect.Right, WRect.Bottom);
  817.       ACanvas.LineTo(WRect.Left, WRect.Bottom);
  818.       ACanvas.LineTo(WRect.Left, WRect.Top);
  819.     end;
  820.  
  821.   begin
  822.     BRect := HoldRect;
  823.     Dec(BRect.Bottom, 1);
  824.     Inc(BRect.Top, 1);
  825.     Dec(BRect.Right, 1);
  826.  
  827.     WRect := BRect;
  828.     if Button.Style = tbsDropDown then
  829.     begin
  830.       Dec(WRect.Right, 13);
  831.       DrawRect;
  832.  
  833.       WRect := BRect;
  834.       Inc(WRect.Left, WRect.Right - WRect.Left - 13);
  835.       DrawRect;
  836.     end
  837.     else
  838.     begin
  839.  
  840.       DrawRect;
  841.     end;
  842.   end;
  843.  
  844. begin
  845.   B := nil;
  846.  
  847.   HasBitmap := (TToolBar(Button.Parent).Images <> nil) and
  848.     (Button.ImageIndex <> -1) and
  849.     (Button.ImageIndex <= TToolBar(Button.Parent).Images.Count - 1);
  850.  
  851.  
  852.   IsTransparent := TToolBar(Button.Parent).Transparent;
  853.  
  854.   ACanvas := Sender.Canvas;
  855.   SetGlobalColor(ACanvas);
  856.  
  857.   if (Is16Bit) and (not UseSystemColors) then
  858.     FBSelectColor := NewColor(ACanvas, FSelectColor, 68)
  859.   else
  860.     FBSelectColor := FFSelectColor;
  861.  
  862.  
  863.   HoldRect := Button.BoundsRect;
  864.  
  865.   ARect := HoldRect;
  866.  
  867.   //if FUseSystemColors then
  868.   begin
  869.     if (Button.MenuItem <> nil) then
  870.     begin
  871.       if (TToolBar(Button.Parent).Font.Name <> FFont.Name) or
  872.          (TToolBar(Button.Parent).Font.Size <> FFont.Size) then
  873.       begin
  874.         TToolBar(Button.Parent).Font.Assign(FFont);
  875.         Button.AutoSize := false;
  876.         Button.AutoSize := true;
  877.       end;
  878.     end
  879.   end;
  880.  
  881.   if Is16Bit then
  882.     ACanvas.brush.color := NewColor(ACanvas, clBtnFace, 16)
  883.   else
  884.     ACanvas.brush.color := clBtnFace;
  885.  
  886.   if not IsTransparent then
  887.     ACanvas.FillRect(ARect);
  888.  
  889.   HasBorder := false;
  890.   HasBkg := false;
  891.  
  892.   if (cdsHot in State) then
  893.   begin
  894.     if (cdsChecked in State) or (Button.Down) or (cdsSelected in State) then
  895.       ACanvas.Brush.Color := FCheckedAreaSelectColor
  896.     else
  897.       ACanvas.brush.color := FBSelectColor;
  898.     HasBorder := true;
  899.     HasBkg := true;
  900.   end;
  901.  
  902.   if (cdsChecked in State) and not (cdsHot in State) then
  903.   begin
  904.     ACanvas.Brush.Color := FCheckedAreaColor;
  905.     HasBorder := true;
  906.     HasBkg := true;
  907.   end;
  908.  
  909.   if (cdsIndeterminate in State) and not (cdsHot in State) then
  910.   begin
  911.     ACanvas.Brush.Color := FBSelectColor;
  912.     HasBkg := true;
  913.   end;
  914.  
  915.  
  916.   if (Button.MenuItem <> nil) and (State = []) then
  917.   begin
  918.     ACanvas.brush.color := FFMenuBarColor;
  919.     if not IsTransparent then
  920.       HasBkg := true;
  921.   end;
  922.  
  923.  
  924.   Inc(ARect.Top, 1);
  925.  
  926.   if HasBkg then
  927.     ACanvas.FillRect(ARect);
  928.  
  929.   if HasBorder then
  930.     DrawBorder;
  931.  
  932.  
  933.   if (Button.MenuItem <> nil)
  934.     and (cdsSelected in State) then
  935.   begin
  936.     DrawTopMenuItem(Button, ACanvas, ARect, false);
  937.     DefaultDraw := false;
  938.   end;
  939.  
  940.   ARect := HoldRect;
  941.   DefaultDraw := false;
  942.  
  943.  
  944.  
  945.   if Button.Style = tbsDropDown then
  946.   begin
  947.     ACanvas.Pen.Color := clBlack;
  948.     DrawArrow(ACanvas, (ARect.Right - 14) + ((14 - 5) div 2),
  949.       ARect.Top + ((ARect.Bottom - ARect.Top - 3) div 2) + 1);
  950.   end;
  951.  
  952.   BitmapWidth := 0;
  953.   if HasBitmap then
  954.   begin
  955.  
  956.     try
  957.     B := TBitmap.Create;
  958.  
  959.     B.Width := TToolBar(Button.Parent).Images.Width;
  960.     B.Height := TToolBar(Button.Parent).Images.Height;
  961.     B.Canvas.Brush.Color := ACanvas.Brush.Color;
  962.     B.Canvas.FillRect(Rect(0, 0, B.Width, B.Height));
  963.     ImageList_DrawEx(TToolBar(Button.Parent).Images.Handle, Button.ImageIndex,
  964.       B.Canvas.Handle, 0, 0, 0, 0, clNone, clNone, ILD_Transparent);
  965.  
  966.     ImgLstHandle:= TToolBar(Button.Parent).Images.Handle;
  967.     ImgLstIndex:= Button.ImageIndex;
  968.  
  969.  
  970.  
  971.     BitmapWidth := b.Width;
  972.  
  973.     if Button.Style = tbsDropDown then
  974.       Dec(ARect.Right, 12);
  975.  
  976.  
  977.     if TToolBar(Button.Parent).List then
  978.     begin
  979.  
  980.       if Button.BiDiMode = bdRightToLeft then
  981.       begin
  982.         Dec(ARect.Right, 3);
  983.         ARect.Left := ARect.Right - BitmapWidth;
  984.  
  985.       end
  986.       else
  987.       begin
  988.         Inc(ARect.Left, 3);
  989.         ARect.Right := ARect.Left + BitmapWidth
  990.       end
  991.  
  992.  
  993.     end
  994.     else
  995.       ARect.Left := Round(ARect.Left + (ARect.Right - ARect.Left - B.Width)/2);
  996.  
  997.     inc(ARect.Top, 2);
  998.     ARect.Bottom := ARect.Top + B.Height + 6;
  999.  
  1000.     DrawIcon(Button, ACanvas, B, ARect, (cdsHot in State),
  1001.      (cdsSelected in State), Button.Enabled, (cdsChecked in State), false,
  1002.      false);
  1003.     finally
  1004.     B.Free;
  1005.     end;
  1006.     ARect := HoldRect;
  1007.     DefaultDraw := false;
  1008.   end;
  1009. //-----------
  1010.   if TToolBar(Button.Parent).ShowCaptions then
  1011.   begin
  1012.  
  1013.     if Button.Style = tbsDropDown then
  1014.       Dec(ARect.Right, 12);
  1015.  
  1016.  
  1017.     if not TToolBar(Button.Parent).List then
  1018.     begin
  1019.       TextFormat := DT_Center;
  1020.       ARect.Top := ARect.Bottom - ACanvas.TextHeight(Button.Caption) - 3;
  1021.     end
  1022.     else
  1023.     begin
  1024.       TextFormat := DT_VCENTER;
  1025.       if Button.BiDiMode = bdRightToLeft then
  1026.       begin
  1027.         TextFormat := TextFormat + DT_Right;
  1028.         Dec(ARect.Right, BitmapWidth + 7);
  1029.       end
  1030.       else
  1031.       begin
  1032.         Inc(ARect.Left, BitmapWidth + 6);
  1033.       end
  1034.  
  1035.     end;
  1036.  
  1037.     if (Button.MenuItem <> nil) then
  1038.     begin
  1039.       TextFormat := DT_Center;
  1040.  
  1041.     end;
  1042.  
  1043.     if Button.BiDiMode = bdRightToLeft then
  1044.       TextFormat := TextFormat + DT_RTLREADING;
  1045.  
  1046.     DrawTheText(Button.Caption, '',
  1047.       ACanvas, ARect,
  1048.       (cdsSelected in State), Button.Enabled, false,
  1049.       (Button.MenuItem <> nil),
  1050.       (Button.BidiMode = bdRightToLeft), TextFormat);
  1051.  
  1052.     ARect := HoldRect;
  1053.     DefaultDraw := false;
  1054.   end;
  1055.  
  1056.  
  1057.   if Button.Index > 0 then
  1058.   begin
  1059.     XButton := TToolBar(Button.Parent).Buttons[Button.Index - 1];
  1060.     if (XButton.Style = tbsDivider) or (XButton.Style = tbsSeparator) then
  1061.     begin
  1062.       ARect := XButton.BoundsRect;
  1063.       if Is16Bit then
  1064.         ACanvas.brush.color := NewColor(ACanvas, clBtnFace, 16)
  1065.       else
  1066.         ACanvas.brush.color := clBtnFace;
  1067.  
  1068.       if not IsTransparent then
  1069.         ACanvas.FillRect(ARect);
  1070.      // if (XButton.Style = tbsDivider) then  // Can't get it.
  1071.       if XButton.Tag > 0 then  
  1072.       begin
  1073.         Inc(ARect.Top, 2);
  1074.         Dec(ARect.Bottom, 1);
  1075.  
  1076.         ACanvas.Pen.color := FFDisabledColor;
  1077.         ARect.Left := ARect.Left + (ARect.Right - ARect.Left) div 2;
  1078.         ACanvas.MoveTo(ARect.Left, ARect.Top);
  1079.         ACanvas.LineTo(ARect.Left, ARect.Bottom);
  1080.  
  1081.       end;
  1082.       ARect := Button.BoundsRect;
  1083.       DefaultDraw := false;
  1084.     end;
  1085.  
  1086.   end;
  1087.  
  1088.   if Button.MenuItem <> nil then
  1089.     ActivateMenuItem(Button.MenuItem);
  1090. end;
  1091.  
  1092.  
  1093. procedure TXPMenu.SetGlobalColor(ACanvas: TCanvas);
  1094. begin
  1095. //-----
  1096.  
  1097.   if GetDeviceCaps(ACanvas.Handle, BITSPIXEL) < 16 then
  1098.     Is16Bit := false
  1099.   else
  1100.     Is16Bit := true;
  1101.  
  1102.  
  1103.   FFColor := FColor;
  1104.   FFIconBackColor := FIconBackColor;
  1105.  
  1106.   FFSelectColor := FSelectColor;
  1107.  
  1108.   if Is16Bit then
  1109.   begin
  1110.     FCheckedAreaColor := NewColor(ACanvas, FSelectColor, 75);
  1111.     FCheckedAreaSelectColor := NewColor(ACanvas, FSelectColor, 50);
  1112.  
  1113.     FMenuBorderColor := GetShadeColor(ACanvas, clBtnFace, 90);
  1114.     FMenuShadowColor := GetShadeColor(ACanvas, clBtnFace, 76);
  1115.   end
  1116.   else
  1117.   begin
  1118.     FFSelectColor := FSelectColor;
  1119.     FCheckedAreaColor := clWhite;
  1120.     FCheckedAreaSelectColor := clSilver;
  1121.     FMenuBorderColor := clBtnShadow;
  1122.     FMenuShadowColor := clBtnShadow;
  1123.   end;
  1124.  
  1125.   FFSelectBorderColor := FSelectBorderColor;
  1126.   FFSelectFontColor := FSelectFontColor;
  1127.   FFMenuBarColor := FMenuBarColor;
  1128.   FFDisabledColor := FDisabledColor;
  1129.   FFCheckedColor := FCheckedColor;
  1130.   FFSeparatorColor := FSeparatorColor;
  1131.  
  1132.  
  1133.  
  1134.   if FUseSystemColors then
  1135.   begin
  1136.     GetSystemMenuFont(FFont);
  1137.     FFSelectFontColor := FFont.Color;
  1138.     if not Is16Bit then
  1139.     begin
  1140.       FFColor := clWhite;
  1141.       FFIconBackColor := clBtnFace;
  1142.       FFSelectColor := clWhite;
  1143.       FFSelectBorderColor := clHighlight;
  1144.       FFMenuBarColor := FFIconBackColor;
  1145.       FFDisabledColor := clBtnShadow;
  1146.       FFCheckedColor := clHighlight;
  1147.       FFSeparatorColor := clBtnShadow;
  1148.       FCheckedAreaColor := clWhite;
  1149.       FCheckedAreaSelectColor := clWhite;
  1150.  
  1151.     end
  1152.     else
  1153.     begin
  1154.       FFColor := NewColor(ACanvas, clBtnFace, 86);
  1155.       FFIconBackColor := NewColor(ACanvas, clBtnFace, 16);
  1156.       FFSelectColor := NewColor(ACanvas, clHighlight, 68);
  1157.       FFSelectBorderColor := clHighlight;
  1158.       FFMenuBarColor := clMenu;
  1159.  
  1160.       FFDisabledColor := NewColor(ACanvas, clBtnShadow, 10);
  1161.       FFSeparatorColor := NewColor(ACanvas, clBtnShadow, 25);
  1162.       FFCheckedColor := clHighlight;
  1163.       FCheckedAreaColor := NewColor(ACanvas, clHighlight, 75);
  1164.       FCheckedAreaSelectColor := NewColor(ACanvas, clHighlight, 50);
  1165.  
  1166.     end;
  1167.   end;
  1168.  
  1169. end;
  1170.  
  1171. procedure TXPMenu.DrawTopMenuItem(Sender: TObject; ACanvas: TCanvas;
  1172.   ARect: TRect; IsRightToLeft: boolean);
  1173. var
  1174.   X1, X2: integer;
  1175.   DefColor, HoldColor: TColor;
  1176. begin
  1177.   X1 := ARect.Left;
  1178.   X2 := ARect.Right;
  1179.  
  1180.  
  1181.   ACanvas.brush.Style := bsSolid;
  1182.   ACanvas.brush.color := FFIconBackColor;
  1183.  
  1184.   ACanvas.FillRect(ARect);
  1185.   ACanvas.Pen.Color := FMenuBorderColor;
  1186.  
  1187.   if (not IsRightToLeft) and (Is16Bit) and (Sender is TMenuItem) then
  1188.   begin
  1189.     ACanvas.MoveTo(X1, ARect.Bottom - 1);
  1190.     ACanvas.LineTo(X1, ARect.Top);
  1191.     ACanvas.LineTo(X2 - 8, ARect.Top);
  1192.     ACanvas.LineTo(X2 - 8, ARect.Bottom);
  1193.  
  1194.     DefColor := FFMenuBarColor;
  1195.  
  1196.  
  1197.     HoldColor := GetShadeColor(ACanvas, DefColor, 10);
  1198.     ACanvas.Brush.Style := bsSolid;
  1199.     ACanvas.Brush.Color := HoldColor;
  1200.     ACanvas.Pen.Color := HoldColor;
  1201.  
  1202.     ACanvas.FillRect(Rect(X2 - 7, ARect.Top, X2, ARect.Bottom));
  1203.  
  1204.     HoldColor := GetShadeColor(ACanvas, DefColor, 30);
  1205.     ACanvas.Brush.Color := HoldColor;
  1206.     ACanvas.Pen.Color := HoldColor;
  1207.     ACanvas.FillRect(Rect(X2 - 7, ARect.Top + 3, X2 - 2, ARect.Bottom));
  1208.  
  1209.     HoldColor := GetShadeColor(ACanvas, DefColor, 40 + 20);
  1210.     ACanvas.Brush.Color := HoldColor;
  1211.     ACanvas.Pen.Color := HoldColor;
  1212.     ACanvas.FillRect(Rect(X2 - 7, ARect.Top + 5, X2 - 3, ARect.Bottom));
  1213.  
  1214.     HoldColor := GetShadeColor(ACanvas, DefColor, 60 + 40);
  1215.     ACanvas.Brush.Color := HoldColor;
  1216.     ACanvas.Pen.Color := HoldColor;
  1217.     ACanvas.FillRect(Rect(X2 - 7, ARect.Top + 6, X2 - 5, ARect.Bottom));
  1218.  
  1219.     //---
  1220.  
  1221.     ACanvas.Pen.Color := DefColor;
  1222.     ACanvas.MoveTo(X2 - 5, ARect.Top + 1);
  1223.     ACanvas.LineTo(X2 - 1, ARect.Top + 1);
  1224.     ACanvas.LineTo(X2 - 1, ARect.Top + 6);
  1225.  
  1226.     ACanvas.MoveTo(X2 - 3, ARect.Top + 2);
  1227.     ACanvas.LineTo(X2 - 2, ARect.Top + 2);
  1228.     ACanvas.LineTo(X2 - 2, ARect.Top + 3);
  1229.     ACanvas.LineTo(X2 - 3, ARect.Top + 3);
  1230.  
  1231.  
  1232.  
  1233.     ACanvas.Pen.Color := GetShadeColor(ACanvas, DefColor, 10);
  1234.     ACanvas.MoveTo(X2 - 6, ARect.Top + 3);
  1235.     ACanvas.LineTo(X2 - 3, ARect.Top + 3);
  1236.     ACanvas.LineTo(X2 - 3, ARect.Top + 6);
  1237.     ACanvas.LineTo(X2 - 4, ARect.Top + 6);
  1238.     ACanvas.LineTo(X2 - 4, ARect.Top + 3);
  1239.  
  1240.     ACanvas.Pen.Color := GetShadeColor(ACanvas, DefColor, 30);
  1241.     ACanvas.MoveTo(X2 - 5, ARect.Top + 5);
  1242.     ACanvas.LineTo(X2 - 4, ARect.Top + 5);
  1243.     ACanvas.LineTo(X2 - 4, ARect.Top + 9);
  1244.  
  1245.     ACanvas.Pen.Color := GetShadeColor(ACanvas, DefColor, 40);
  1246.     ACanvas.MoveTo(X2 - 6, ARect.Top + 5);
  1247.     ACanvas.LineTo(X2 - 6, ARect.Top + 7);
  1248.  
  1249.   end
  1250.   else
  1251.   begin
  1252.     ACanvas.Pen.Color := FMenuBorderColor;
  1253.     ACanvas.Brush.Color := FMenuShadowColor;
  1254.  
  1255.     ACanvas.MoveTo(X1, ARect.Bottom - 1);
  1256.     ACanvas.LineTo(X1, ARect.Top);
  1257.     ACanvas.LineTo(X2 - 3, ARect.Top);
  1258.     ACanvas.LineTo(X2 - 3, ARect.Bottom);
  1259.  
  1260.  
  1261.     ACanvas.Pen.Color := ACanvas.Brush.Color;
  1262.     ACanvas.FillRect(Rect(X2 - 2, ARect.Top + 2, X2, ARect.Bottom));
  1263.   end;
  1264.  
  1265. end;
  1266.  
  1267.  
  1268. procedure TXPMenu.DrawCheckedItem(FMenuItem: TMenuItem; Selected,
  1269.  HasImgLstBitmap: boolean; ACanvas: TCanvas; CheckedRect: TRect);
  1270. var
  1271.   X1, X2: integer;
  1272. begin
  1273.   if FMenuItem.RadioItem then
  1274.   begin
  1275.     if FMenuItem.Checked then
  1276.     begin
  1277.  
  1278.       ACanvas.Pen.color := FFSelectBorderColor;
  1279.       if selected then
  1280.         ACanvas.Brush.Color := FCheckedAreaSelectColor
  1281.       else
  1282.         ACanvas.Brush.Color := FCheckedAreaColor;
  1283.       ACanvas.Brush.Style := bsSolid;
  1284.       if HasImgLstBitmap then
  1285.       begin
  1286.         ACanvas.RoundRect(CheckedRect.Left, CheckedRect.Top,
  1287.           CheckedRect.Right, CheckedRect.Bottom,
  1288.           6, 6);
  1289.       end
  1290.       else
  1291.       begin
  1292.         ACanvas.Ellipse(CheckedRect.Left, CheckedRect.Top,
  1293.           CheckedRect.Right, CheckedRect.Bottom);
  1294.       end;
  1295.     end;
  1296.   end
  1297.   else
  1298.   begin
  1299.     if (FMenuItem.Checked) then
  1300.       if (not HasImgLstBitmap) then
  1301.       begin
  1302.         ACanvas.Pen.color := FFCheckedColor;
  1303.         if selected then
  1304.           ACanvas.Brush.Color := FCheckedAreaSelectColor
  1305.         else
  1306.           ACanvas.Brush.Color := FCheckedAreaColor; ;
  1307.         ACanvas.Brush.Style := bsSolid;
  1308.         ACanvas.Rectangle(CheckedRect.Left, CheckedRect.Top,
  1309.           CheckedRect.Right, CheckedRect.Bottom);
  1310.         ACanvas.Pen.color := clBlack;
  1311.         x1 := CheckedRect.Left + 1;
  1312.         x2 := CheckedRect.Top + 5;
  1313.         ACanvas.MoveTo(x1, x2);
  1314.  
  1315.         x1 := CheckedRect.Left + 4;
  1316.         x2 := CheckedRect.Bottom - 2;
  1317.         ACanvas.LineTo(x1, x2);
  1318.            //--
  1319.         x1 := CheckedRect.Left + 2;
  1320.         x2 := CheckedRect.Top + 5;
  1321.         ACanvas.MoveTo(x1, x2);
  1322.  
  1323.         x1 := CheckedRect.Left + 4;
  1324.         x2 := CheckedRect.Bottom - 3;
  1325.         ACanvas.LineTo(x1, x2);
  1326.            //--
  1327.         x1 := CheckedRect.Left + 2;
  1328.         x2 := CheckedRect.Top + 4;
  1329.         ACanvas.MoveTo(x1, x2);
  1330.  
  1331.         x1 := CheckedRect.Left + 5;
  1332.         x2 := CheckedRect.Bottom - 3;
  1333.         ACanvas.LineTo(x1, x2);
  1334.            //-----------------
  1335.  
  1336.         x1 := CheckedRect.Left + 4;
  1337.         x2 := CheckedRect.Bottom - 3;
  1338.         ACanvas.MoveTo(x1, x2);
  1339.  
  1340.         x1 := CheckedRect.Right + 2;
  1341.         x2 := CheckedRect.Top - 1;
  1342.         ACanvas.LineTo(x1, x2);
  1343.            //--
  1344.         x1 := CheckedRect.Left + 4;
  1345.         x2 := CheckedRect.Bottom - 2;
  1346.         ACanvas.MoveTo(x1, x2);
  1347.  
  1348.         x1 := CheckedRect.Right - 2;
  1349.         x2 := CheckedRect.Top + 3;
  1350.         ACanvas.LineTo(x1, x2);
  1351.  
  1352.       end
  1353.       else
  1354.       begin
  1355.         ACanvas.Pen.color := FFSelectBorderColor;
  1356.         if selected then
  1357.           ACanvas.Brush.Color := FCheckedAreaSelectColor
  1358.         else
  1359.           ACanvas.Brush.Color := FCheckedAreaColor;
  1360.         ACanvas.Brush.Style := bsSolid;
  1361.         ACanvas.Rectangle(CheckedRect.Left, CheckedRect.Top,
  1362.           CheckedRect.Right, CheckedRect.Bottom);
  1363.       end;
  1364.   end;
  1365.  
  1366. end;
  1367.  
  1368. procedure TXPMenu.DrawTheText(txt, ShortCuttext: string; ACanvas: TCanvas; TextRect: TRect;
  1369.   Selected, Enabled, Default, TopMenu, IsRightToLeft: boolean; TextFormat: integer);
  1370. var
  1371.   DefColor: TColor;
  1372. begin
  1373.  
  1374.   DefColor := FFont.Color;
  1375.  
  1376.   ACanvas.Font := FFont;
  1377.  
  1378.  
  1379.   if Enabled then
  1380.     DefColor := FFont.Color;
  1381.  
  1382.  
  1383.   if Selected then
  1384.     DefColor := FFSelectFontColor;
  1385.  
  1386.  
  1387.   if not Enabled then
  1388.   begin
  1389.     DefColor := FFDisabledColor;
  1390.     if Selected then
  1391.       if Is16Bit then
  1392.         DefColor := NewColor(ACanvas, FFDisabledColor, 10);
  1393.   end;
  1394.  
  1395.   if (TopMenu and Selected) then
  1396.     DefColor := TopMenuFontColor(ACanvas, FFIconBackColor);
  1397.  
  1398.   ACanvas.Font.color := DefColor;    // will not affect Buttons
  1399.  
  1400.  
  1401.   TextRect.Top := TextRect.Top +
  1402.     ((TextRect.Bottom - TextRect.Top) - ACanvas.TextHeight('W')) div 2;
  1403.  
  1404.   SetBkMode(ACanvas.Handle, TRANSPARENT);
  1405.  
  1406.  
  1407.   if Default and Enabled then
  1408.   begin
  1409.  
  1410.     Inc(TextRect.Left, 1);
  1411.     ACanvas.Font.color := GetShadeColor(ACanvas,
  1412.                               ACanvas.Pixels[TextRect.Left, TextRect.Top], 30);
  1413.     DrawtextEx(ACanvas.Handle,
  1414.       PChar(txt),
  1415.       Length(txt),
  1416.       TextRect, TextFormat, nil);
  1417.     Dec(TextRect.Left, 1);
  1418.  
  1419.  
  1420.     Inc(TextRect.Top, 2);
  1421.     Inc(TextRect.Left, 1);
  1422.     Inc(TextRect.Right, 1);
  1423.  
  1424.  
  1425.     ACanvas.Font.color := GetShadeColor(ACanvas,
  1426.                               ACanvas.Pixels[TextRect.Left, TextRect.Top], 30);
  1427.     DrawtextEx(ACanvas.Handle,
  1428.       PChar(txt),
  1429.       Length(txt),
  1430.       TextRect, TextFormat, nil);
  1431.  
  1432.  
  1433.     Dec(TextRect.Top, 1);
  1434.     Dec(TextRect.Left, 1);
  1435.     Dec(TextRect.Right, 1);
  1436.  
  1437.     ACanvas.Font.color := GetShadeColor(ACanvas,
  1438.                               ACanvas.Pixels[TextRect.Left, TextRect.Top], 40);
  1439.     DrawtextEx(ACanvas.Handle,
  1440.       PChar(txt),
  1441.       Length(txt),
  1442.       TextRect, TextFormat, nil);
  1443.  
  1444.  
  1445.     Inc(TextRect.Left, 1);
  1446.     Inc(TextRect.Right, 1);
  1447.  
  1448.     ACanvas.Font.color := GetShadeColor(ACanvas,
  1449.                               ACanvas.Pixels[TextRect.Left, TextRect.Top], 60);
  1450.     DrawtextEx(ACanvas.Handle,
  1451.       PChar(txt),
  1452.       Length(txt),
  1453.       TextRect, TextFormat, nil);
  1454.  
  1455.     Dec(TextRect.Left, 1);
  1456.     Dec(TextRect.Right, 1);
  1457.     Dec(TextRect.Top, 1);
  1458.  
  1459.     ACanvas.Font.color := DefColor;
  1460.   end;
  1461.  
  1462.  
  1463.   DrawtextEx(ACanvas.Handle,
  1464.     PChar(txt),
  1465.     Length(txt),
  1466.     TextRect, TextFormat, nil);
  1467.  
  1468.  
  1469.   txt := ShortCutText + ' ';
  1470.  
  1471.   if not Is16Bit then
  1472.     ACanvas.Font.color := DefColor
  1473.   else
  1474.     ACanvas.Font.color := GetShadeColor(ACanvas, DefColor, -40);
  1475.  
  1476.  
  1477.  
  1478.   if IsRightToLeft then
  1479.   begin
  1480.     Inc(TextRect.Left, 10);
  1481.     TextFormat := DT_LEFT
  1482.   end
  1483.   else
  1484.   begin
  1485.     Dec(TextRect.Right, 10);
  1486.     TextFormat := DT_RIGHT;
  1487.   end;
  1488.  
  1489.   DrawtextEx(ACanvas.Handle,
  1490.     PChar(txt),
  1491.     Length(txt),
  1492.     TextRect, TextFormat, nil);
  1493.  
  1494. end;
  1495.  
  1496. procedure TXPMenu.DrawIcon(Sender: TObject; ACanvas: TCanvas; B: TBitmap;
  1497.  IconRect: Trect; Hot, Selected, Enabled, Checked, FTopMenu,
  1498.  IsRightToLeft: boolean);
  1499. var
  1500.   DefColor: TColor;
  1501.   X1, X2: integer;
  1502. begin
  1503.   if B <> nil then
  1504.   begin
  1505.     X1 := IconRect.Left;
  1506.     X2 := IconRect.Top + 2;
  1507.     if Sender is TMenuItem then
  1508.     begin
  1509.       inc(X2, 2);
  1510.       if FIconWidth >= B.Width then
  1511.         X1 := X1 + ((FIconWidth - B.Width) div 2) - 1
  1512.       else
  1513.       begin
  1514.         if IsRightToLeft then
  1515.           X1 := IconRect.Right - b.Width - 2
  1516.         else
  1517.           X1 := IconRect.Left + 2;
  1518.       end;
  1519.     end;
  1520.  
  1521.  
  1522.     if (Hot) and (not FTopMenu) and (Enabled) and (not Checked) then
  1523.       if not Selected then
  1524.       begin
  1525.         dec(X1, 1);
  1526.         dec(X2, 1);
  1527.       end;
  1528.  
  1529.     if (not Hot) and (Enabled) and (not Checked) then
  1530.       if Is16Bit then
  1531.         DimBitmap(B, 30);
  1532.  
  1533.     if (not Hot) and (not Enabled) then
  1534.       GrayBitmap(B, 60);
  1535.  
  1536.     if (Hot) and (not Enabled) then
  1537.       GrayBitmap(B, 70);
  1538.  
  1539.  
  1540.  
  1541.     if (Hot) and (Enabled) and (not Checked) then
  1542.     begin
  1543.       if (Is16Bit) and (not UseSystemColors) and (Sender is TToolButton) then
  1544.         DefColor := NewColor(ACanvas, FSelectColor, 68)
  1545.       else
  1546.         DefColor := FFSelectColor;
  1547.  
  1548.       DefColor := GetShadeColor(ACanvas, DefColor, 50);
  1549.       DrawBitmapShadow(B, ACanvas, X1 + 2, X2 + 2, DefColor);
  1550.     end;
  1551.  
  1552.     B.Transparent := true;
  1553.     ACanvas.Draw(X1, X2, B);
  1554.  
  1555.  
  1556.   end;
  1557.  
  1558. end;
  1559.  
  1560. procedure TXPMenu.DrawArrow(ACanvas: TCanvas; X, Y: integer);
  1561. begin
  1562.   ACanvas.MoveTo(X, Y);
  1563.   ACanvas.LineTo(X + 4, Y);
  1564.  
  1565.   ACanvas.MoveTo(X + 1, Y + 1);
  1566.   ACanvas.LineTo(X + 4, Y);
  1567.  
  1568.   ACanvas.MoveTo(X + 2, Y + 2);
  1569.   ACanvas.LineTo(X + 3, Y);
  1570.  
  1571. end;
  1572.  
  1573. function TXPMenu.TopMenuFontColor(ACanvas: TCanvas; Color: TColor): TColor;
  1574. var
  1575.   r, g, b, avg: integer;
  1576. begin
  1577.  
  1578.   Color := ColorToRGB(Color);
  1579.   r := Color and $000000FF;
  1580.   g := (Color and $0000FF00) shr 8;
  1581.   b := (Color and $00FF0000) shr 16;
  1582.  
  1583.   Avg := (r + b) div 2;
  1584.  
  1585.   if (Avg > 150) or (g > 200) then
  1586.     Result := FFont.Color
  1587.   else
  1588.     Result := NewColor(ACanvas, Color, 90);
  1589.    // Result := FColor;
  1590. end;
  1591.  
  1592.  
  1593. procedure TXPMenu.SetActive(const Value: boolean);
  1594. begin
  1595.  
  1596.   FActive := Value;
  1597.  
  1598.   if FActive then
  1599.   begin
  1600.     InitMenueItems(false);
  1601.     InitMenueItems(true);
  1602.   end
  1603.   else
  1604.     InitMenueItems(false);
  1605.  
  1606.   Windows.DrawMenuBar(FForm.Handle);
  1607. end;
  1608.  
  1609. procedure TXPMenu.SetAutoDetect(const Value: boolean);
  1610. begin
  1611.   FAutoDetect := Value;
  1612. end;
  1613.  
  1614. procedure TXPMenu.SetForm(const Value: TForm);
  1615. var
  1616.   Hold: boolean;
  1617. begin
  1618.   if Value <> FForm then
  1619.   begin
  1620.     Hold := Active;
  1621.     Active := false;
  1622.     FForm := Value;
  1623.     if Hold then
  1624.       Active := True;
  1625.   end;
  1626. end;
  1627.  
  1628. procedure TXPMenu.SetFont(const Value: TFont);
  1629. begin
  1630.   FFont.Assign(Value);
  1631.   Windows.DrawMenuBar(FForm.Handle);
  1632.  
  1633. end;
  1634.  
  1635. procedure TXPMenu.SetColor(const Value: TColor);
  1636. begin
  1637.   FColor := Value;
  1638. end;
  1639.  
  1640. procedure TXPMenu.SetIconBackColor(const Value: TColor);
  1641. begin
  1642.   FIconBackColor := Value;
  1643. end;
  1644.  
  1645. procedure TXPMenu.SetMenuBarColor(const Value: TColor);
  1646. begin
  1647.   FMenuBarColor := Value;
  1648.   Windows.DrawMenuBar(FForm.Handle);
  1649. end;
  1650.  
  1651. procedure TXPMenu.SetCheckedColor(const Value: TColor);
  1652. begin
  1653.   FCheckedColor := Value;
  1654. end;
  1655.  
  1656. procedure TXPMenu.SetSeparatorColor(const Value: TColor);
  1657. begin
  1658.   FSeparatorColor := Value;
  1659. end;
  1660.  
  1661. procedure TXPMenu.SetSelectBorderColor(const Value: TColor);
  1662. begin
  1663.   FSelectBorderColor := Value;
  1664. end;
  1665.  
  1666. procedure TXPMenu.SetSelectColor(const Value: TColor);
  1667. begin
  1668.   FSelectColor := Value;
  1669. end;
  1670.  
  1671. procedure TXPMenu.SetDisabledColor(const Value: TColor);
  1672. begin
  1673.   FDisabledColor := Value;
  1674. end;
  1675.  
  1676. procedure TXPMenu.SetSelectFontColor(const Value: TColor);
  1677. begin
  1678.   FSelectFontColor := Value;
  1679. end;
  1680.  
  1681. procedure TXPMenu.SetIconWidth(const Value: integer);
  1682. begin
  1683.   FIconWidth := Value;
  1684. end;
  1685.  
  1686. procedure TXPMenu.SetDrawSelect(const Value: boolean);
  1687. begin
  1688.   FDrawSelect := Value;
  1689. end;
  1690.  
  1691.  
  1692.  
  1693. procedure TXPMenu.SetOverrideOwnerDraw(const Value: boolean);
  1694. begin
  1695.   FOverrideOwnerDraw := Value;
  1696.   if FActive then
  1697.     Active := True;
  1698. end;
  1699.  
  1700.  
  1701. procedure TXPMenu.SetUseSystemColors(const Value: boolean);
  1702. begin
  1703.   FUseSystemColors := Value;
  1704.   Windows.DrawMenuBar(FForm.Handle);
  1705. end;
  1706.  
  1707. procedure TXPMenu.SetGradient(const Value: boolean);
  1708. begin
  1709.   FGradient := Value;
  1710. end;
  1711.  
  1712. procedure TXPMenu.SetFlatMenu(const Value: boolean);
  1713. begin
  1714.   FFlatMenu := Value;
  1715. end;
  1716.  
  1717.  
  1718. procedure GetSystemMenuFont(Font: TFont);
  1719. var
  1720.   FNonCLientMetrics: TNonCLientMetrics;
  1721. begin
  1722.   FNonCLientMetrics.cbSize := Sizeof(TNonCLientMetrics);
  1723.   if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @FNonCLientMetrics,0) then
  1724.   begin
  1725.     Font.Handle := CreateFontIndirect(FNonCLientMetrics.lfMenuFont);
  1726.     Font.Color := clMenuText;
  1727.     if Font.Name = 'MS Sans Serif' then
  1728.       Font.Name := 'Tahoma';
  1729.   end;
  1730. end;
  1731.  
  1732.  
  1733. procedure TXPMenu.DrawGradient(ACanvas: TCanvas; ARect: TRect;
  1734.  IsRightToLeft: boolean);
  1735. var
  1736.   i: integer;
  1737.   v: integer;
  1738.   FRect: TRect;
  1739. begin
  1740.  
  1741.   fRect := ARect;
  1742.   V := 0;
  1743.   if IsRightToLeft then
  1744.   begin
  1745.     fRect.Left := fRect.Right - 1;
  1746.     for i := ARect.Right Downto ARect.Left do
  1747.     begin
  1748.       if (fRect.Left < ARect.Right)
  1749.         and (fRect.Left > ARect.Right - FIconWidth + 5) then
  1750.         inc(v, 3)
  1751.       else
  1752.         inc(v, 1);
  1753.  
  1754.       if v > 96 then v := 96;
  1755.       ACanvas.Brush.Color := NewColor(ACanvas, FFIconBackColor, v);
  1756.       ACanvas.FillRect(fRect);
  1757.  
  1758.       fRect.Left := fRect.Left - 1;
  1759.       fRect.Right := fRect.Left - 1;
  1760.     end;
  1761.   end
  1762.   else
  1763.   begin
  1764.     fRect.Right := fRect.Left + 1;
  1765.     for i := ARect.Left to ARect.Right do
  1766.     begin
  1767.       if (fRect.Left > ARect.Left)
  1768.         and (fRect.Left < ARect.Left + FIconWidth + 5) then
  1769.         inc(v, 3)
  1770.       else
  1771.         inc(v, 1);
  1772.  
  1773.       if v > 96 then v := 96;
  1774.       ACanvas.Brush.Color := NewColor(ACanvas, FFIconBackColor, v);
  1775.       ACanvas.FillRect(fRect);
  1776.  
  1777.       fRect.Left := fRect.Left + 1;
  1778.       fRect.Right := fRect.Left + 1;
  1779.     end;
  1780.   end;
  1781. end;
  1782.  
  1783.  
  1784. procedure TXPMenu.DrawWindowBorder(hWnd: HWND; IsRightToLeft: boolean);
  1785. var
  1786.   WRect, CRect: TRect;
  1787.   dCanvas: TCanvas;
  1788. begin
  1789.  
  1790.   if hWnd <= 0 then
  1791.   begin
  1792.    exit;
  1793.   end;
  1794.   dCanvas := nil;
  1795.   try
  1796.   dCanvas := TCanvas.Create;
  1797.   dCanvas.Handle := GetDc(0);
  1798.  
  1799.   GetClientRect(hWnd, CRect);
  1800.   GetWindowRect(hWnd, WRect);
  1801.  
  1802.   ExcludeClipRect(dCanvas.Handle, CRect.Left, CRect.Top, CRect.Right,
  1803.                   CRect.Bottom);
  1804.  
  1805.   dCanvas.Brush.Style := bsClear;
  1806.  
  1807.  
  1808.   Dec(WRect.Right, 2);
  1809.   Dec(WRect.Bottom, 2);
  1810.  
  1811.   dCanvas.Pen.Color := FMenuBorderColor;
  1812.   dCanvas.Rectangle(WRect.Left, WRect.Top, WRect.Right, WRect.Bottom);
  1813.  
  1814.  
  1815.  
  1816.  
  1817.   if IsRightToLeft then
  1818.   begin
  1819.     dCanvas.Pen.Color := FFColor;
  1820.     dCanvas.Rectangle(WRect.Left + 1, WRect.Top + 1, WRect.Right - 2,
  1821.                       WRect.Top + 3);
  1822.  
  1823.     dCanvas.MoveTo(WRect.Left + 2, WRect.Top + 2);
  1824.     dCanvas.LineTo(WRect.Left + 2, WRect.Bottom - 2);
  1825.  
  1826.  
  1827.     dCanvas.Pen.Color := FFIconBackColor;
  1828.     dCanvas.MoveTo(WRect.Right - 2, WRect.Top + 2);
  1829.     dCanvas.LineTo(WRect.Right - 2, WRect.Bottom - 2);
  1830.  
  1831.     dCanvas.MoveTo(WRect.Right - 2, WRect.Top + 2);
  1832.     dCanvas.LineTo(WRect.Right - 1 - FIconWidth, WRect.Top + 2);
  1833.   end
  1834.   else
  1835.   begin
  1836.     if not FGradient then
  1837.     begin
  1838.       dCanvas.Pen.Color := FFColor;
  1839.       dCanvas.Rectangle(WRect.Left + 1, WRect.Top + 1, WRect.Right - 2,
  1840.                         WRect.Top + 3);
  1841.  
  1842.       dCanvas.Pen.Color := FFIconBackColor;
  1843.       dCanvas.MoveTo(WRect.Left + 1, WRect.Top + 2);
  1844.       dCanvas.LineTo(WRect.Left + 2 + FIconWidth, WRect.Top + 2);
  1845.     end;
  1846.  
  1847.     dCanvas.Pen.Color := FFIconBackColor;
  1848.     dCanvas.MoveTo(WRect.Left + 1, WRect.Top + 1);
  1849.     dCanvas.LineTo(WRect.Left + 1, WRect.Bottom - 2);
  1850.  
  1851.  
  1852.   end;
  1853.  
  1854.   Inc(WRect.Right, 2);
  1855.   Inc(WRect.Bottom, 2);
  1856.  
  1857.   dCanvas.Pen.Color := FMenuShadowColor;
  1858.   dCanvas.Rectangle(WRect.Left +2, WRect.Bottom, WRect.Right, WRect.Bottom - 2);
  1859.   dCanvas.Rectangle(WRect.Right - 2, WRect.Bottom, WRect.Right, WRect.Top + 2);
  1860.  
  1861.  
  1862.   dCanvas.Pen.Color := FFIconBackColor;
  1863.   dCanvas.Rectangle(WRect.Left, WRect.Bottom - 2, WRect.Left + 2, WRect.Bottom);
  1864.   dCanvas.Rectangle(WRect.Right - 2, WRect.Top, WRect.Right, WRect.Top + 2);
  1865.   finally
  1866.   IntersectClipRect(dCanvas.Handle, WRect.Left, WRect.Top, WRect.Right, WRect.Bottom);
  1867.   dCanvas.Free;
  1868.   end;
  1869.  
  1870.  
  1871. end;
  1872.  
  1873.  
  1874.  
  1875. procedure TXPMenu.Notification(AComponent: TComponent;
  1876.   Operation: TOperation);
  1877. begin
  1878.   inherited Notification(AComponent, Operation);
  1879.   if not FAutoDetect then exit;
  1880.   if (Operation = opInsert) and
  1881.      ((AComponent is TMenuItem) or (AComponent is TToolButton)) then
  1882.   begin
  1883.    if (csDesigning in ComponentState) then
  1884.      Active := true
  1885.    else
  1886.      //if ComponentState = [] then
  1887.         Active := true ;
  1888.   end;
  1889.  
  1890.  
  1891. end;
  1892.  
  1893.  
  1894. function GetShadeColor(ACanvas: TCanvas; clr: TColor; Value: integer): TColor;
  1895. var
  1896.   r, g, b: integer;
  1897.  
  1898. begin
  1899.   clr := ColorToRGB(clr);
  1900.   r := Clr and $000000FF;
  1901.   g := (Clr and $0000FF00) shr 8;
  1902.   b := (Clr and $00FF0000) shr 16;
  1903.  
  1904.   r := (r - value);
  1905.   if r < 0 then r := 0;
  1906.   if r > 255 then r := 255;
  1907.  
  1908.   g := (g - value) + 2;
  1909.   if g < 0 then g := 0;
  1910.   if g > 255 then g := 255;
  1911.  
  1912.   b := (b - value);
  1913.   if b < 0 then b := 0;
  1914.   if b > 255 then b := 255;
  1915.  
  1916.   Result := Windows.GetNearestColor(ACanvas.Handle, RGB(r, g, b));
  1917. end;
  1918.  
  1919. function NewColor(ACanvas: TCanvas; clr: TColor; Value: integer): TColor;
  1920. var
  1921.   r, g, b: integer;
  1922.  
  1923. begin
  1924.   if Value > 100 then Value := 100;
  1925.   clr := ColorToRGB(clr);
  1926.   r := Clr and $000000FF;
  1927.   g := (Clr and $0000FF00) shr 8;
  1928.   b := (Clr and $00FF0000) shr 16;
  1929.  
  1930.  
  1931.   r := r + Round((255 - r) * (value / 100));
  1932.   g := g + Round((255 - g) * (value / 100));
  1933.   b := b + Round((255 - b) * (value / 100));
  1934.  
  1935.   Result := Windows.GetNearestColor(ACanvas.Handle, RGB(r, g, b));
  1936.  
  1937. end;
  1938.  
  1939. function GrayColor(ACanvas: TCanvas; clr: TColor; Value: integer): TColor;
  1940. var
  1941.   r, g, b, avg: integer;
  1942.  
  1943. begin
  1944.   if Value > 100 then Value := 100;
  1945.   clr := ColorToRGB(clr);
  1946.   r := Clr and $000000FF;
  1947.   g := (Clr and $0000FF00) shr 8;
  1948.   b := (Clr and $00FF0000) shr 16;
  1949.  
  1950.   Avg := (r + g + b) div 3;
  1951.   Avg := Avg + Value;
  1952.  
  1953.   if Avg > 240 then Avg := 240;
  1954.  
  1955.   Result := Windows.GetNearestColor (ACanvas.Handle,RGB(Avg, avg, avg));
  1956. end;
  1957.  
  1958. procedure GrayBitmap(ABitmap: TBitmap; Value: integer);
  1959. var
  1960.   x, y: integer;
  1961.   LastColor1, LastColor2, Color: TColor;
  1962. begin
  1963.   LastColor1 := 0;
  1964.   LastColor2 := 0;
  1965.  
  1966.   for y := 0 to ABitmap.Height do
  1967.     for x := 0 to ABitmap.Width do
  1968.     begin
  1969.       Color := ABitmap.Canvas.Pixels[x, y];
  1970.       if Color = LastColor1 then
  1971.         ABitmap.Canvas.Pixels[x, y] := LastColor2
  1972.       else
  1973.       begin
  1974.         LastColor2 := GrayColor(ABitmap.Canvas , Color, Value);
  1975.         ABitmap.Canvas.Pixels[x, y] := LastColor2;
  1976.         LastColor1 := Color;
  1977.       end;
  1978.     end;
  1979. end;
  1980.  
  1981. procedure DimBitmap(ABitmap: TBitmap; Value: integer);
  1982. var
  1983.   x, y: integer;
  1984.   LastColor1, LastColor2, Color: TColor;
  1985. begin
  1986.   if Value > 100 then Value := 100;
  1987.   LastColor1 := -1;
  1988.   LastColor2 := -1;
  1989.  
  1990.   for y := 0 to ABitmap.Height - 1 do
  1991.     for x := 0 to ABitmap.Width - 1 do
  1992.     begin
  1993.       Color := ABitmap.Canvas.Pixels[x, y];
  1994.       if Color = LastColor1 then
  1995.         ABitmap.Canvas.Pixels[x, y] := LastColor2
  1996.       else
  1997.       begin
  1998.         LastColor2 := NewColor(ABitmap.Canvas, Color, Value);
  1999.         ABitmap.Canvas.Pixels[x, y] := LastColor2;
  2000.         LastColor1 := Color;
  2001.       end;
  2002.     end;
  2003. end;
  2004.  
  2005. procedure DrawBitmapShadow(B: TBitmap; ACanvas: TCanvas; X, Y: integer;
  2006.   ShadowColor: TColor);
  2007. var
  2008.   BX, BY: integer;
  2009.   TransparentColor: TColor;
  2010. begin
  2011.   TransparentColor := B.Canvas.Pixels[0, B.Height - 1];
  2012.   for BY := 0 to B.Height - 1 do
  2013.     for BX := 0 to B.Width - 1 do
  2014.     begin
  2015.       if B.Canvas.Pixels[BX, BY] <> TransparentColor then
  2016.         ACanvas.Pixels[X + BX, Y + BY] := ShadowColor;
  2017.  
  2018.     end;
  2019. end;
  2020.  
  2021.  
  2022. end.
  2023.  
  2024.