bc_xpmenu.pas

Virtual CD Sample driver

{
XPMenu for Delphi
Author: Khaled Shagrouni
URL: http://www.shagrouni.com
e-mail: [e-mail]
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:
       [e-mail]
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)