xpbarmenu.pas

xpmenu,一个可以使界面美化的控件.你可以设置成你自己所喜欢的.

{
/// FileName:XPMenu.pas

XPMenu for Delphi
Author: Khaled Shagrouni
URL: http://www.shagrouni.com
e-mail: [e-mail]
Version 1.504, Septemper 5, 2001

/// Under Lines Add By Kingron
Modified: Kingron
Data: 2001.09.29
E_Mail:[e-mail]
WWW: http://Kingron.myetang.com

I hold the copyright of the modificatory code,If you make any modifications to
the code, please send them to me.Any question the component,Please Mail to me

Note:
   - I Only Test the Component Under Win2K & Win98SE,May be not fit other OS.
/// End Add

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:
========

/// Under Lines Add By Kingron
2001.10.4
   - Fix Some Bugs,Ex:FlatMenu's Memory Hole~~~!
2001.10.1
   - Optimize the Draw Speed For Win9x
   - Fix The MenuItem Bitmap Transparent bug under Win9x
   - Fix Other Bugs Under Win9x
   - Fix Top MenuItem Bitmap Draw Bug.
   - Use Double buffer to Draw the Bar(Text Only),Improve the Draw Speed.
2001.09.30
   - Support Event Process.
     OnDrawItem,OnMeasureItem,OnDrawBar,OnMeasureBar
   - Adding a Example For Delphi 5.0.
   - Fix a bug: Count Bar Height Error when user define the System Menu appearance
   - Fix the Default MenuItem Display.
   - Fix some Bugs Under Win9x.
2001.09.29
   - Left Bar Support Stretch(Bitmap Only).
   - Fix some Bugs
   - Support 3D Style
2001.09.28
   - Adding Left Bar,Support Bitmap and Text.
   - Left Bar(Text Only) Support Gradient Color.

Known Bugs:
   - Under Win9x,the FlatMenu property has some problam.
     if use the component under Win9x,Please don't set the FlatMenu to False.
   - Under Win9x,if you both use the ImageList and MenuItem.Bitmap,the Bar Height calc err.
     You can use the Event to Special Process to avoid it!
   - If SubMenu Level more than 3,Draw Speed Very Slow~~~~~~~
     Because the Component recursion search all MenuItem of the Form!
     I hope I can improve the arithmetic to fix this soon, help from others appreciated.
   - if User Change The System Menu appearance,the Bar Calc Err.
     Please Process SYSTEM SETTING CHANGE Message,Set the property UseSystemColors:=False then
     Set the Property UseSystemColors := True
   - May be not compatibly with other program,Ex: ScreenSave,Meet it infrequent.
   - Under Win9x,if not use the Gradient Propety,the IconBack has some problem.
   - Big Bug:Resource Not Free~~~~,Checking~~~~~~
     OK: Don't use FlatMenu,the property Cause the Memory hole when the program running~~~~
         But when the program exit,the Memory get back.
/// End Add

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 XPBarMenu;

interface

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

/// Under Lines Add By Kingron
type
  TBarStyle = (bsText, bsBitmap, bsNone);
  TDrawBarEvent = procedure(Sender: TObject; ACanvas: TCanvas; ARect: TRect; var CanDraw: Boolean) of object;
  TMeasureBarEvent = procedure(Sender: TObject; ACanvas: TCanvas; var ARect, BarRect: TRect) of object;
/// End Add

type
  TXPBarMenu = 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;

    /// Under Lines Add By Kingron
    FItemHeight: integer;
    FFrame3D: boolean;
    FOnDrawBar: TDrawBarEvent;
    FOnMeasureBar: TMeasureBarEvent;
    FBarStretch: boolean;
    FBarCaption: string;
    FBarWidth: integer;
    FBarColorStart: TColor;
    FBarColorEnd: TColor;
    FBarBitmap: TBitmap;
    FBarFont: TFont;
    FBarStyle: TBarStyle;
    FOnDrawItem: TMenuDrawItemEvent;
    FOnMeasureItem: TMenuMeasureItemEvent;
    FBarColorStep: integer;
    /// End Add

    procedure SetActive(const Value: boolean);
    procedure SetForm(const Value: TForm);
    procedure SetFont(const Value: TFont);
    procedure SetMenuBarColor(const Value: TColor);
    procedure SetUseSystemColors(const Value: boolean);
    procedure SetOverrideOwnerDraw(const Value: boolean);

    /// Under Lines Add By Kingron
    function CanDrawBar: boolean;
    procedure SetBarFont(const Value: TFont);
    procedure SetBarBitmap(const Value: TBitmap);
    procedure SetBarColorStep(const Value: integer);
    function _IsOSoK:boolean;
    /// End Add

  protected
    /// Under Lines Add By Kingron
    procedure DrawBar(Sender: TObject; ACanvas: TCanvas; ARect: TRect);
    /// End Add

    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 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
    /// Under Lines Add By Kingron
    property BarStretch: boolean read FBarStretch write FBarStretch default true;
    property Frame3D: boolean read FFrame3D write FFrame3D default false;
    property BarWidth: integer read FBarWidth write FBarWidth default 22;
    property BarCaption: string read FBarCaption write FBarCaption;
    property BarBitmap: TBitmap read FBarBitmap write SetBarBitmap;
    property BarColorStart: TColor read FBarColorStart write FBarColorStart default clBlue;
    property BarColorEnd: TColor read FBarColorEnd write FBarColorEnd default clBlack;
    property BarColorStep: integer read FBarColorStep write SetBarColorStep default 100;
    property BarStyle: TBarStyle read FBarStyle write FBarStyle default bsText;
    property BarFont: TFont read FBarFont write SetBarFont;
    property ItemHeight: integer read FItemHeight write FItemHeight default 0;
    property OnDrawItem: TMenuDrawItemEvent read FOnDrawItem write FOnDrawItem;
    property OnMeasureItem: TMenuMeasureItemEvent read FOnMeasureItem write FOnMeasureItem;
    property OnDrawBar: TDrawBarEvent read FOnDrawBar write FOnDrawBar;
    property OnMeasureBar: TMeasureBarEvent read FOnMeasureBar write FOnMeasureBar;
    /// End Add
    property Font: TFont read FFont write SetFont;
    property Color: TColor read FColor write FColor default clMenu;
    property IconBackColor: TColor read FIconBackColor write FIconBackColor default clMenu;
    property MenuBarColor: TColor read FMenuBarColor write SetMenuBarColor default clMenu;
    property SelectColor: TColor read FSelectColor write FSelectColor default clHighlight;
    property SelectBorderColor: TColor read FSelectBorderColor write FSelectBorderColor default clActiveBorder;
    property SelectFontColor: TColor read FSelectFontColor write FSelectFontColor default clHighlightText;
    property DisabledColor: TColor read FDisabledColor write FDisabledColor default clGray;
    property SeparatorColor: TColor read FSeparatorColor write FSeparatorColor default clGray;
    property CheckedColor: TColor read FCheckedColor write FCheckedColor;
    property IconWidth: integer read FIconWidth write FIconWidth;
    property DrawSelect: boolean read FDrawSelect write FDrawSelect;
    property UseSystemColors: boolean read FUseSystemColors  write SetUseSystemColors;
    property OverrideOwnerDraw: boolean read FOverrideOwnerDraw  write SetOverrideOwnerDraw;

    property Gradient: boolean read FGradient write FGradient default true;
    property FlatMenu: boolean read FFlatMenu write FFlatMenu;
    property AutoDetect: boolean read FAutoDetect write FAutoDetect;
    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('Standard', [TXPBarMenu]); ///Registry Control Pages Modified By Kingron
end;

{ TXPBarMenue }

constructor TXPBarMenu.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FFont := TFont.Create;
  GetSystemMenuFont(FFont);
  FForm := Owner as TForm;

  FUseSystemColors := true;

  FColor := clMenu;
  FIconBackColor := clMenu;
  FSelectColor := clHighlight;
  FSelectBorderColor := clActiveBorder;
  FMenuBarColor := clMenu;
  FDisabledColor := clGray;
  FSeparatorColor := clGray;
  FCheckedColor := clHighlight;
  FSelectFontColor := clHighlightText;

  FIconWidth := 24;
  FDrawSelect := true;

  ///Under Line Add By Kingron
  FFlatMenu := True;
  FActive := True;
  FAutoDetect := True;
  FGradient := True;
  FFrame3D := False;
  FBarStretch := True;
  FBarCaption := FForm.Caption; /// Bar Default Caption
  FItemHeight := 0; /// Default Item Height
  FBarWidth := 22; /// Bar Width
  FBarColorStart := clBlue; /// The First Color
  FBarColorEnd := clBlack; /// The Second Color
  FBarColorStep := 100;
  FBarFont := TFont.Create; /// Bar Text Font
  FBarFont.Assign(FFont); /// Bar Font Init
  FBarFont.Color := clWhite;
  FBarBitmap := TBitmap.Create; /// Bar Bitmap
  FBarStyle := bsText; /// Bar Style
  /// End Add

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

end;

destructor TXPBarMenu.Destroy;
begin