Delphi控件源码

开发平台：
C++ Builder

am2000menuitem.pas：源码内容
							
{*******************************************************}
{                                                       }
{       AnimatedMenus/2000                              }
{       TMenuItem2000                                   }
{                                                       }
{       Copyright (c) 1997-99 AnimatedMenus.com         }
{       All rights reserved.                            }
{                                                       }
{*******************************************************}
unit am2000menuitem;
{$I am2000.inc}
interface
uses
  Windows, SysUtils, Classes, Controls, Graphics, Menus,
  am2000options, am2000bitmap, am2000button, am2000buttonarray,
  am2000editbox;
type
  // shortcut type
  T_AM2000_ShortCut = Type String;
  // options for menu item
  T_AM2000_ControlType = (ctlNone, ctlButton, ctlButtonArray, ctlEditbox,
    ctlBitmap, ctlFont);
  // descendant of TPopupMenu
  T_AM2000_PopupMenu = class(TPopupMenu)
  end;
  // menu item
  TMenuItem2000 = class;
  // edit menu item events
//  T_AM2000_EditingEvent = procedure(Sender: TObject; Item: TMenuItem2000;
//    var AllowEdit: Boolean) of object;
//  T_AM2000_EditedEvent = procedure(Sender: TObject; Item: TMenuItem2000;
//    var S: string) of object;
  // TMenuItem2000
  TMenuItem2000 = class(TMenuItem)
  private
    // improvements
    FPopupMenu      : T_AM2000_PopupMenu;
    FControl        : T_AM2000_ControlType;
    FControlOptions : T_AM2000_ControlOptions;
    FHidden         : Boolean;
    FAttachMenu     : T_AM2000_PopupMenu;
    FOptions        : T_AM2000_MenuOptions;
    FShortCut       : T_AM2000_ShortCut;
    FDefaultBitmapIndex : Integer;
{$IFNDEF Delphi4OrHigher}
    FBitmap         : TBitmap;
    FImageIndex     : Integer;
{$ENDIF}
    FNumGlyphs      : Integer;
    FFalseBreak     : Integer;
    function GetItem(Index: Integer): TMenuItem2000;
    function GetCaption: String;
    function GetEnabled: Boolean;
    function GetVisible: Boolean;
    function GetParent: TMenuItem2000;
    function GetBitmap: TBitmap;
    function GetChecked: Boolean;
{$IFDEF Delphi4OrHigher}
    function GetAction: TBasicAction;
{$ENDIF}
    procedure SetCaption(const Value: String);
    procedure SetEnabled(Value: Boolean);
    procedure SetVisible(Value: Boolean);
    procedure SetControl(Value: T_AM2000_ControlType);
    procedure SetBitmap(Value: TBitmap);
{$IFDEF Delphi4OrHigher}
    procedure SetAction(Value: TBasicAction);
{$ENDIF}    
    function IsBitmapStored:   Boolean;
    function IsOptionsStored:  Boolean;
    function GetOptions: T_AM2000_MenuOptions;
    procedure SetOptions(Value: T_AM2000_MenuOptions);
    function IsHintStored:     Boolean;
    function IsShortCutStored: Boolean;
    function GetShortCut: T_AM2000_ShortCut;
    function GetHint:     String;
    procedure SetShortCut(Value: T_AM2000_ShortCut);
    procedure SetHint(Value: String);
    procedure SetDefaultIndex(Value: Integer);
    procedure SetChecked(Value: Boolean);
    procedure Update(UpdateDesigner, UpdateMenuBar: Integer);  
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    property Parent        : TMenuItem2000  read GetParent;
    property Items[Index: Integer]: TMenuItem2000 read GetItem; default;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Insert(Index: Integer; Item: TMenuItem2000);
    function IndexOf(Item: TMenuItem2000): Integer;
    procedure Add(Item: TMenuItem2000);
    procedure Remove(Item: TMenuItem2000);
    procedure Delete(Index: Integer);
    procedure TurnSiblingsOff;
    function GetBitmapEx: TBitmap;
    function IsTopLevelItem   : Boolean;
    function IsBitmapAssigned : Boolean;
    function IsOptionsAssigned: Boolean;
    // control support
    function AsButtonArray    : T_AM2000_ButtonArrayOptions;
    function AsButton         : T_AM2000_ButtonOptions;
    function AsBitmap         : T_AM2000_BitmapOptions;
    function AsEdit           : T_AM2000_EditboxOptions;
    // bounds measuring functions
    function GetWidth(Canvas: TCanvas): Integer; 
    function GetHeight(ItemHeight: Integer): Integer;
    procedure Assign(Source: TPersistent); override;
{$IFDEF Delphi4OrHigher}
    procedure InitiateAction; override;
{$ENDIF}    
  published
    property Bitmap        : TBitmap
      read GetBitmap write SetBitmap stored IsBitmapStored;
    property Caption       : String
      read GetCaption write SetCaption;
    property Checked       : Boolean
      read GetChecked write SetChecked default False;
    property Control       : T_AM2000_ControlType
      read FControl write SetControl default ctlNone;
    property ControlOptions: T_AM2000_ControlOptions
      read FControlOptions write FControlOptions stored True;
    property Enabled       : Boolean
      read GetEnabled write SetEnabled default True;
    property Hidden        : Boolean
      read FHidden write FHidden default False;
    property PopupMenu     : T_AM2000_PopupMenu
      read FPopupMenu write FPopupMenu;
    property Visible       : Boolean
      read GetVisible write SetVisible default True;
    property DefaultIndex  : Integer
      read FDefaultBitmapIndex write SetDefaultIndex default -1;
    property AttachMenu    : T_AM2000_PopupMenu
      read FAttachMenu write FAttachMenu;
    property Options       : T_AM2000_MenuOptions
      read GetOptions write SetOptions stored IsOptionsStored;
    property Hint          : String
      read GetHint write SetHint stored IsHintStored;
    property ShortCut      : T_AM2000_ShortCut
      read GetShortCut write SetShortCut stored IsShortCutStored;
    property NumGlyphs     : Integer
      read FNumGlyphs write FNumGlyphs default 1;
{$IFNDEF Delphi4OrHigher}
    property ImageIndex    : Integer
      read FImageIndex write FImageIndex default -1;
{$ENDIF}
{$IFDEF Delphi4OrHigher}
    property Action        : TBasicAction
      read GetAction write SetAction;
{$ENDIF}
    property Break         : Integer
      read FFalseBreak default 0;
  end;
  // TEditableMenuItem98
  // This class was designed because of error in Delphi:
  // you cannot register another menu designer when you already have default designer
  // This class are incompatible with TMenuItem nor TMenuItem2000 but acts like layer
  // between your application and the TMenuItem2000 components stored in FItems property
  // It has only minimal set of properties and methods so please verify your applications
  // for bugs
  // Also you can use Items2000 property of TMainMenu2000 and TPopupMenu2000 components
  // to direct access real TMenuItem2000 components.
  TEditableMenuItem2000 = class(TComponent)
  private
    function GetHandle: HMenu;
    function GetCount: Integer;
    function GetItem(Index: Integer): TMenuItem2000;
  public                                  
    property Handle        : HMenu        read GetHandle;
    property Count         : Integer      read GetCount;
    property Items[Index: Integer]: TMenuItem2000 read GetItem; default;
    procedure Insert(Index: Integer; Item: TMenuItem2000);
    procedure Delete(Index: Integer);
    function IndexOf(Item: TMenuItem2000): Integer;
    procedure Add(Item: TMenuItem2000);
    procedure Remove(Item: TMenuItem2000);
  end;
// compatibility
function NewMenu(Owner: TComponent; const AName: string; Items: array of TMenuItem): TMainMenu;
function NewPopupMenu(Owner: TComponent; const AName: string;
  Alignment: TPopupAlignment; AutoPopup: Boolean; Items: array of TMenuItem): TPopupMenu;
function NewSubMenu(const ACaption: string; hCtx: Word; const AName: string;
  Items: array of TMenuItem2000): TMenuItem2000;
function NewItem(const ACaption: string; AShortCut: TShortCut;
  AChecked, AEnabled: Boolean; AOnClick: TNotifyEvent; hCtx: Word;
  const AName: string): TMenuItem2000;
function NewLine: TMenuItem2000;
function NewItem2000(const ACaption, AShortCut: string;
  AChecked, AEnabled: Boolean; AOnClick: TNotifyEvent; hCtx: Word;
  const AName: string): TMenuItem2000;
function NewLine2000: TMenuItem2000;
function GetMainShortCut(const S: String): String;
procedure SetState(var its: T_AM2000_ItemState; Value: T_AM2000_its; Condition: Boolean);
// drawing routines - both for TMenuItem and TMenuItem2000
// draws menu item when TMenuItem or TMenuItem2000 component doesn't present
// (like Window menu's menu items in Delphi 2 & 3)
procedure DrawMenuItemWin32(DrawRect: P_AM2000_DrawMenuItemRect);
// draws TMenuItem2000 with ControlStyle = ctlNone and TMenuItem
procedure DrawMenuItem(DrawRect: P_AM2000_DrawMenuItemRect);
{ Drawing routines }
procedure DrawCaption(Canvas: TCanvas;
            Caption: String;
            Alignment: T_AM2000_Alignment;
            Rect: TRect);
procedure DrawSubmenuTriangle(Canvas: TCanvas;
            Draw: Boolean;
            Alignment: T_AM2000_Alignment;
            Rect: TRect);
procedure DrawSeparator(Canvas: TCanvas;
            State: T_AM2000_ItemState;
            Options: T_AM2000_BaseOptions;
            Rect: TRect);
procedure DrawBackground(Canvas: TCanvas;
            State: T_AM2000_ItemState;
            Options: T_AM2000_BaseOptions;
            Rect: TRect);
procedure DrawBitmap(Canvas: TCanvas;
            Bitmap: HBitmap;
            BitmapIndex: Integer;
            NumGlyphs: Integer;
            Bitmap2: HBitmap;
            State: T_AM2000_ItemState;
            Options: T_AM2000_BaseOptions;
            Rect: TRect;
            Images: TImageList);
procedure DrawPatternBackground(Canvas: TCanvas;
            Rect: TRect);
function CreatePattern(Color1, Color2: TColor): TBitmap;
implementation
uses
  CommCtrl,
  {$IFDEF Delphi4OrHigher} ActnList, {$ENDIF}
  am2000utils, am2000menubar, am2000mainmenu, am2000popupmenu, am2000const, am2000cache;
{ Routines }
function NewMenu(Owner: TComponent; const AName: string; Items: array of TMenuItem): TMainMenu;
begin
  raise EMenuError.Create(SNoNewMenu);
end;
function NewPopupMenu(Owner: TComponent; const AName: string;
  Alignment: TPopupAlignment; AutoPopup: Boolean; Items: array of TMenuItem): TPopupMenu;
begin
  raise EMenuError.Create(SNoNewPopupMenu);
end;
function NewSubMenu(const ACaption: string; hCtx: Word; const AName: string;
  Items: array of TMenuItem2000): TMenuItem2000;
var
  I: Integer;
begin
  Result := TMenuItem2000.Create(nil);
  for I := Low(Items) to High(Items) do
    Result.Add(Items[I]);
  Result.Caption := ACaption;
  Result.HelpContext := hCtx;
  Result.Name := AName;
end;
function NewItem(const ACaption: string; AShortCut: TShortCut;
  AChecked, AEnabled: Boolean; AOnClick: TNotifyEvent; hCtx: Word;
  const AName: string): TMenuItem2000;
begin
  Result:= TMenuItem2000.Create(nil);
  with Result do begin
    Caption:= ACaption;
    ShortCut:= ShortCutToText(AShortCut);
    OnClick:= AOnClick;
    HelpContext:= hCtx;
    Checked:= AChecked;
    Enabled:= AEnabled;
    Name:= AName;
  end;
end;
function NewLine: TMenuItem2000;
begin
  Result:= TMenuItem2000.Create(nil);
  Result.Caption:= '-';
end;
function NewItem2000(const ACaption, AShortCut: string;
  AChecked, AEnabled: Boolean; AOnClick: TNotifyEvent; hCtx: Word;
  const AName: string): TMenuItem2000;
begin
  Result:= TMenuItem2000.Create(nil);
  with Result do begin
    Caption:= ACaption;
    ShortCut:= AShortCut;
    OnClick:= AOnClick;
    HelpContext:= hCtx;
    Checked:= AChecked;
    Enabled:= AEnabled;
    Name:= AName;
  end;
end;
function NewLine2000: TMenuItem2000;
begin
  Result:= NewLine;
end;
function GetMainShortCut(const S: String): String;
var
  I: Integer;
begin
  I:= Pos(';', S);
  if I < 1 then I:= Length(S) +1;
  Result:= Trim(Copy(S, 1, I -1));
end;
{ SetState }
procedure SetState(var its: T_AM2000_ItemState; Value: T_AM2000_its; Condition: Boolean);
begin
  if Condition
  then Include(its, Value)
  else Exclude(its, Value);
end;
{ Drawing routines }
{ Drawing routines }
procedure DrawCaption(
  Canvas: TCanvas;
  Caption: String;
  Alignment: T_AM2000_Alignment;
  Rect: TRect);
var
  Flags, Lines, DY, P: Integer;
  S: String;
  R: TRect;
begin
  Flags:= dt_DrawTextFlags or dt_WordBreak;
  // caption alignment
  if (Alignment = taCenter)
  then Flags:= Flags or dt_Center;
  if (Alignment = taRightJustify) or (Alignment = taRightToLeft)
  then Flags:= Flags or dt_Right;
  Lines:= GetNumLines(Caption);
  // draw caption
  DY:= (Rect.Bottom - Rect.Top) div Lines;
  R:= Rect;
  R.Bottom:= R.Top + DY;
  S:= Caption;
  repeat
    P:= Pos('n', S);
    if P = 0 then P:= Pos(#13, S);
    if P = 0 then P:= Length(S) +1;
    DrawText(Canvas.Handle, PChar(Copy(S, 1, P -1)), -1, R, Flags);
    OffsetRect(R, 0, DY);
    if (P < Length(S))
    and (S[P] = #13)
    then Delete(S, 1, P)
    else Delete(S, 1, P +1);
  until S = '';
end;
procedure DrawSubmenuTriangle(
  Canvas: TCanvas;
  Draw: Boolean;
  Alignment: T_AM2000_Alignment;
  Rect: TRect);
var
  DX: Integer;
begin
  if (not Draw)
  or (Rect.Left = Rect.Right)
  then Exit;
  Canvas.Pen.Color:= Canvas.Font.Color;
  Canvas.Brush.Color:= Canvas.Font.Color;
  Canvas.Brush.Style:= bsSolid;
  DX:= (Rect.Top + Rect.Bottom - 5) div 2;
  if Alignment <> taRightToLeft then
    Canvas.PolyGon([
      Point(Rect.Right -8, DX),
      Point(Rect.Right -8, DX +6),
      Point(Rect.Right -5, DX +3)])
  else
    Canvas.PolyGon([
      Point(Rect.Left  +8, DX),
      Point(Rect.Left  +8, DX +6),
      Point(Rect.Left  +5, DX +3)])
end;
procedure DrawSeparator(
  Canvas: TCanvas;
  State: T_AM2000_ItemState;
  Options: T_AM2000_BaseOptions;
  Rect: TRect);
var
  Y, DX: Integer;
begin
  Exclude(State, isSelected);
  // hide separator
  if (isHiddenPrev in State) and (isHiddenSucc in State)
  then Include(State, isHidden);
  DrawBackground(Canvas, State, Options, Rect);
  Y:= (Rect.Top + Rect.Bottom) div 2;
  if mfNoShortDividers in Options.Flags
  then DX:= 2
  else DX:= 14;
  if Options.Colors.Line <> clNone then begin
    Canvas.Pen.Color:= Options.Colors.Line;
    Canvas.PolyLine([Point(Rect.Left + DX, Y), Point(Rect.Right - DX, Y)]);
  end;
  if Options.Colors.LineShadow <> clNone then begin
    Canvas.Pen.Color:= Options.Colors.LineShadow;
    Canvas.PolyLine([Point(Rect.Left + DX, Y +1), Point(Rect.Right - DX, Y +1)]);
  end;
end;
procedure DrawPatternBackground(
  Canvas: TCanvas;
  Rect: TRect);
var
  DC: HDC;
  C2, bpx: Integer;
begin
  if not Assigned(Pattern) then begin
    // test display's device capabilities
    DC:= CreateDC('DISPLAY', nil, nil, nil);
    bpx:= GetDeviceCaps(DC, BitsPixel);
    DeleteDC(DC);
    if bpx > 8
    then C2:= clBtnFace
    else C2:= clBtnHighlight;
    // show pattern background if bits per pixel > 8 
    Pattern:= CreatePattern(clBtnHighlight, C2);
  end;
  
  Canvas.Brush.Bitmap:= Pattern;
  Canvas.FillRect(Rect);
end;
procedure DrawSolidBackground(
  Canvas: TCanvas;
  Rect: TRect;
  Color: TColor);
begin
  // set brush style
  if Canvas.Brush.Style <> bsSolid
  then Canvas.Brush.Style:= bsSolid;
  // erase bitmap
  if Canvas.Brush.Bitmap <> nil
  then Canvas.Brush.Bitmap:= nil;
  // set canvas color
  if Canvas.Brush.Color <> Color
  then Canvas.Brush.Color:= Color;
  // fill
  Canvas.FillRect(Rect);
end;
procedure DrawBackground(
  Canvas: TCanvas;
  State: T_AM2000_ItemState;
  Options: T_AM2000_BaseOptions;
  Rect: TRect);
begin
  // no background on graphic backround
  if (isGraphBack in State)
  and not (isSelected in State)
  then Exit;
  if (isSelected in State)
  and ((not (isDisabled in State))
  or (not (mfNoHighDisabled in Options.Flags)))
  then begin
    // for hidden menu items
    if isHidden in State then InflateRect(Rect, 1, -1);
    DrawSolidBackground(Canvas, Rect, Options.Colors.Highlight);
  end
  else
    if isHidden in State then begin
      // draw pattern background
      if isNoLeftSunken in State
      then Dec(Rect.Left)
      else Dec(Rect.Left, 2);
      if isNoRightSunken in State
      then Inc(Rect.Right)
      else Inc(Rect.Right, 2);
      DrawPatternBackground(Canvas, Rect);
      InflateRect(Rect, 0, -1);
      // draw borders
      if not (isHiddenPrev in State) then begin
        Canvas.Pen.Color:= Options.Colors.Line;
        Canvas.Polygon([Point(Rect.Left, Rect.Top -1), Point(Rect.Right -1, Rect.Top -1)]);
      end;
      if not (isHiddenSucc in State) then begin
        Canvas.Pen.Color:= Options.Colors.LineShadow;
        Canvas.Polygon([Point(Rect.Left, Rect.Bottom), Point(Rect.Right -1, Rect.Bottom)]);
      end;
    end
    else
      DrawSolidBackground(Canvas, Rect, Options.Colors.Menu);
end;
procedure DrawBitmap(
  Canvas: TCanvas;
  Bitmap: HBitmap;
  BitmapIndex: Integer;
  NumGlyphs: Integer;
  Bitmap2: HBitmap;
  State: T_AM2000_ItemState;
  Options: T_AM2000_BaseOptions;
  Rect: TRect;
  Images: TImageList);
var
  bmprect, markrect: TRect;
  nobmp: Boolean;
  Glyph: Integer;
  procedure DrawBmp(Canvas: TCanvas; Bitmap: HBitmap;
    BitmapIndex: Integer);
    // draws bitmap
  begin
    // is it a bitmap?
    if BitmapIndex = -1
    // yes
    then TransBlt(Canvas, bmprect.Left +1, bmprect.Top +1, Glyph, NumGlyphs, Bitmap)
    // no -- it's ImageIndex in the Images
    else ImageList_Draw(Images.Handle, BitmapIndex, Canvas.Handle, bmprect.Left +1, bmprect.Top +1,
      ild_Transparent);
  end;
  procedure DisdBmp(Canvas: TCanvas; Color1, Color2: TColor; Bitmap: HBitmap;
    BitmapIndex: Integer);
    // draws bitmap
  begin
    // is it a bitmap?
    if BitmapIndex = -1
    // yes
    then
      NewDisabledBlt(Canvas, bmprect.Left +1, bmprect.Top +1, Color1, Color2, Bitmap)
    // no -- look for ImageIndex bimap in the Images image list
    else
      ImgDisabledBlt(Canvas, bmprect.Left +1, bmprect.Top +1, Images, BitmapIndex,
        Color1, Color2);
  end;
begin
  if (Rect.Left = Rect.Right)
  then Exit;
  nobmp:= (Bitmap = 0) and (BitmapIndex = -1);
  // draw bitmap background
  if Canvas.Brush.Style <> bsSolid
  then Canvas.Brush.Style:= bsSolid;
  if (Options <> nil)
  and (Canvas.Brush.Color <> Options.Colors.Menu)
  then Canvas.Brush.Color:= Options.Colors.Menu;
  Dec(Rect.Right);
  // calculate bmprect and markrect
  bmprect:= Rect;
  markrect:= Rect;
  if (Options <> nil) and (mfShowCheckMark in Options.Flags)
  then begin
    markrect.Right:= (markrect.Right - markrect.Left) div 2 + markrect.Left;
    bmprect.Left:= markrect.Right +1;
  end;
  // draw solid background
  if (not (isHidden in State)) or (isSelected in State) then begin
    if (Options <> nil) and (not (nobmp or (mfNoBitmapRect in Options.Flags)))
    then begin
      Inc(bmprect.Right);
      Canvas.FillRect(bmprect);
      Dec(bmprect.Right);
    end;
    if isChecked in State then begin
      Inc(markrect.Right);
      Canvas.FillRect(markrect);
      Dec(markrect.Right);
    end;
  end;
  // draw background and rect
  if isSelected in State then begin
    if not (nobmp or (mfNoBitmapRect in Options.Flags)) 
    then DrawEdge(Canvas.Handle, bmprect, bdr_RaisedInner, bf_Rect);
    if isChecked in State
    then DrawEdge(Canvas.Handle, markrect, bdr_SunkenOuter, bf_Rect);
  end
  else
    if isChecked in State then begin
      DrawPatternBackground(Canvas, markrect);
      DrawEdge(Canvas.Handle, markrect, bdr_SunkenOuter, bf_Rect);
    end;
  Inc(Rect.Right);
  if isChecked in State then Inc(Rect.Left);
  // select bitmap icon
  if (NumGlyphs > 1) and (isDisabled in State)
  then
    Glyph:= 1
  else
  if (NumGlyphs > 2) and ((isChecked in State)
  or ((isActivated in State) and (isSelected in State)))
  then
    Glyph:= 2
  else
  if (NumGlyphs > 3) and (isSelected in State)
  then
    Glyph:= 3
  else
    Glyph:= 0;
  // draw bitmaps
  if ((not nobmp) or (Options = nil))
  and ((not (isDisabled in State))
  or (NumGlyphs > 1))
  then
    DrawBmp(Canvas, Bitmap, BitmapIndex)
  else
    DisdBmp(Canvas, Options.Colors.DisabledText, Options.Colors.DisabledShadow, Bitmap,
      BitmapIndex);
  // draw mark
  if (isChecked in State)
  and (nobmp
  or ((Options <> nil) and (mfShowCheckMark in Options.Flags)))
  then
    if (isDisabled in State)
    then
      NewDisabledBlt(Canvas, markrect.Left +1, markrect.Top +1, Options.Colors.DisabledText,
        Options.Colors.DisabledShadow, Bitmap2)
    else
      TransBlt(Canvas, markrect.Left +1, markrect.Top +1, 0, 0, Bitmap2);
end;
function CreatePattern(Color1, Color2: TColor): TBitmap;
var
  X, Y: Integer;
begin
  Result:= TBitmap.Create;
  Result.Width:= 8;
  Result.Height:= 8;
  for Y:= 0 to 7 do
    for X:= 0 to 7 do
      if (Y mod 2) = (X mod 2)
      then Result.Canvas.Pixels[X, Y]:= Color1
      else Result.Canvas.Pixels[X, Y]:= Color2;
end;
procedure DrawTextItem(
  Canvas: TCanvas;
  Options: T_AM2000_BaseOptions;
  Caption: String;
  Shortcut: String;
  Bitmap: HBitmap;
  BitmapIndex: Integer;
  NumGlyphs: Integer;
  State: T_AM2000_ItemState;
  MouseState: T_AM2000_MouseState;
  mir: T_AM2000_MenuItemRect;
  Images: TImageList);
var
  OldFontStyle: TFontStyles;
  ScAlign: T_AM2000_Alignment;
  P: Integer;
  Bitmap2: HBitmap;
begin
  DrawBackground(Canvas, State, Options, mir.LineRect);
  if isHidden in State then begin
    Inc(mir.Top);
    Dec(mir.Height, 2);
  end;
  // draw bitmap
  if isRadio in State
  then Bitmap2:= bmpRadioItem
  else Bitmap2:= bmpCheckMark;
  DrawBitmap(Canvas, Bitmap, BitmapIndex, NumGlyphs, Bitmap2, State, Options, mir.BitmapRect, Images);
  // draw caption
  OldFontStyle:= Canvas.Font.Style;
  if (isDefault in State) and (not (fsBold in OldFontStyle)) then
    Canvas.Font.Style:= Canvas.Font.Style + [fsBold];
  // shortcut's alignment
  if (Options.Alignment = taRightToLeft)
  or (mfStandardAlign in Options.Flags)
  then ScAlign:= taLeftJustify
  else ScAlign:= taRightJustify;
  Canvas.Brush.Style:= bsClear;
  // little interesting thing!
  P:= Pos(#9, Caption);
  if (P <> 0)
  and (ShortCut = '')
  then begin
    Shortcut:= Copy(Caption, P +1, MaxInt);
    Caption:= Copy(Caption, 1, P -1);
  end;
  // draw the caption
  if not (isDisabled in State)
  then               // enabled
    if isSelected in State
    then Canvas.Font.Color:= Options.Colors.HighlightText
    else Canvas.Font.Color:= Options.Colors.MenuText
  else begin         // disabled
    // draw the shadow if not selected
    if (not (isSelected in State))
    or (mfNoHighDisabled in Options.Flags)
    then begin
      Canvas.Font.Color:= Options.Colors.DisabledShadow;
      mir.IncreaseOffset;
      DrawCaption(Canvas, Caption, Options.Alignment, mir.ItemRect);
      DrawCaption(Canvas, Shortcut, ScAlign, mir.ShortcutRect);
      DrawSubmenuTriangle(Canvas, isSubmenu in State, Options.Alignment, mir.TriangleRect);
      mir.DecreaseOffset;
      Canvas.Brush.Style:= bsClear;
    end;
    Canvas.Font.Color:= Options.Colors.DisabledText;
  end;
  // caption, shortcut & triangle
  DrawCaption(Canvas, Caption, Options.Alignment, mir.ItemRect);
  DrawCaption(Canvas, Shortcut, ScAlign, mir.ShortcutRect);
  DrawSubmenuTriangle(Canvas, isSubmenu in State, Options.Alignment, mir.TriangleRect);
  // disabled menu items
  if Canvas.Font.Style <> OldFontStyle then
    Canvas.Font.Style:= OldFontStyle;
end;
{ Main drawing functions }
procedure DrawMenuItemWin32;
var
  Caption: String;
  Bitmap: HBitmap;
begin
  with DrawRect^ do begin
    mii.fMask:= $3F;
    mii.dwTypeData:= PChar(@Z);
    mii.cch:= SizeOf(Z) -1;
    if not GetMenuItemInfo(Handle, Index, True, mii) then Exit;
    // separator
    if mii.fType and mft_Separator <> 0 then begin
      DrawSeparator(Canvas, State, Options, mir.LineRect);
      Exit;
    end;
    // set caption
    if mii.fState and mfs_Checked <> 0
    then Bitmap:= mii.hbmpChecked
    else Bitmap:= mii.hbmpUnchecked;
    Caption:= StrPas(Z);
    // load bitmap
    case mii.wID of
      sc_Restore:  Bitmap:= MenuItemCache['SYSTEMRESTORE' ].Bitmap;
      sc_Move:     Bitmap:= MenuItemCache['SYSTEMMOVE'    ].Bitmap;
      sc_Size:     Bitmap:= MenuItemCache['SYSTEMSIZE'    ].Bitmap;
      sc_Minimize: Bitmap:= MenuItemCache['SYSTEMMINIMIZE'].Bitmap;
      sc_Maximize: Bitmap:= MenuItemCache['SYSTEMMAXIMIZE'].Bitmap;
      sc_Close:    Bitmap:= MenuItemCache['SYSTEMCLOSE'   ].Bitmap;
    end;
    // draw item
    SetState(State, isChecked, mii.fState and mfs_Checked <> 0);
    SetState(State, isDisabled, mii.fState and (mfs_Disabled + mfs_Grayed) <> 0);
    SetState(State, isDefault, mii.fState and mfs_Default <> 0);
    SetState(State, isRadio, mii.fType and mft_RadioCheck <> 0);
    SetState(State, isSubmenu, mii.hSubmenu <> 0);
    DrawTextItem(Canvas, Options, Caption, '', Bitmap, -1, 0, State, MouseState, mir, nil);
  end;
end;
procedure DrawMenuItem;
var
  Caption, Shortcut: String;
  Bitmap: HBitmap;
  Item2000: TMenuItem2000;
  BitmapIndex: Integer;
  NumGlyphs: Integer;
begin
  Bitmap:= 0;
  BitmapIndex:= -1;
  with DrawRect^ do begin
    Item2000:= TMenuItem2000(Item);
    // separator
    if Item.Caption = '-' then begin
      DrawSeparator(Canvas, State, Options, mir.LineRect);
      Exit;
    end;
    // get caption
    Caption:= Item.Caption;
    // get shortcut
    if Item is TMenuItem2000
    then ShortCut:= GetMainShortCut(Item2000.ShortCut)
    else Shortcut:= ShortcutToText(Item.ShortCut);
    // get user bitmap
    if Item is TMenuItem2000
    then NumGlyphs:= Item2000.NumGlyphs
    else NumGlyphs:= 0;
    // advanced bitmap
    if (Item is TMenuItem2000)
    and (Item2000.IsBitmapAssigned)
    then Bitmap:= Item2000.Bitmap.Handle
    // ordinal bitmap's ImageIndex
    else
    if
    (Images <> nil) and
{$IFDEF Delphi4OrHigher}
    (Item.ImageIndex <> -1)
{$ELSE}
    (Item is TMenuItem2000) and (Item2000.ImageIndex <> -1)
{$ENDIF}
    then BitmapIndex:= Item2000.ImageIndex
    // no advanced bitmap
    else
{$IFDEF Delphi4OrHigher}
      Bitmap:= Item.Bitmap.Handle;
{$ELSE}
      Bitmap:= 0;
{$ENDIF}
    // initiate action
{$IFDEF Delphi4OrHigher}
    if not (csDesigning in Item.ComponentState)
    then Item.InitiateAction;
{$ENDIF}
    // draw item
    SetState(State, isChecked, Item.Checked);
    SetState(State, isDisabled, not Item.Enabled);
    SetState(State, isDefault, Item.Default);
    SetState(State, isRadio, Item.RadioItem);
    SetState(State, isSubmenu, (Item.Count > 0) or ((Item is TMenuItem2000) and (Item2000.AttachMenu <> nil)));
    DrawTextItem(Canvas, Options, Caption, Shortcut, Bitmap, BitmapIndex, NumGlyphs, State, MouseState,
      mir, Images);
  end;
end;
{ TMenuItem2000 }
constructor TMenuItem2000.Create(AOwner: TComponent);
begin
  inherited;
{$IFNDEF Delphi4OrHigher}
  FImageIndex:= -1;
{$ENDIF}
  FControlOptions:= T_AM2000_ControlOptions.Create(Self);
  FDefaultBitmapIndex:= -1;
  FNumGlyphs:= 1;
end;
destructor TMenuItem2000.Destroy;
var
  OldParent: TMenuItem2000;
begin
  if (not (csLoading in ComponentState))
  and (not (csDestroying in ComponentState))
  then OldParent:= Parent
  else OldParent:= nil;
  // if this menu item uses AutoBitmap, it should
  // release it before destroying the bitmap
  if (MenuItemCache <> nil)
{$IFDEF Delphi4OrHigher}
  and (not Bitmap.Empty)
  and (((Caption <> '')
  and (MenuItemCache[Caption].Bitmap = Bitmap.Handle))
  or (DefaultIndex <> -1))
  then Bitmap.ReleaseHandle;
{$ELSE}
  and (FBitmap <> nil)
  and (not FBitmap.Empty)
  and (((Caption <> '')
  and (MenuItemCache[Caption].Bitmap = FBitmap.Handle))
  or (DefaultIndex <> -1))
  then FBitmap.ReleaseHandle;
  FBitmap.Free;
{$ENDIF}
  FOptions.Free;
  FControlOptions.Free;
  inherited;
  // update parent
  if (OldParent <> nil)
  and (OldParent is TMenuItem2000)
  then OldParent.Update(0, upForceRebuild);
end;
procedure TMenuItem2000.Insert(Index: Integer; Item: TMenuItem2000);
begin
  inherited Insert(Index, Item);
  Update(0, upForceRebuild);
end;
function TMenuItem2000.IndexOf(Item: TMenuItem2000): Integer;
begin
  Result:= inherited IndexOf(Item);
end;
procedure TMenuItem2000.Add(Item: TMenuItem2000);
begin
  inherited Add(Item);
  Update(0, upForceRebuild);
end;
procedure TMenuItem2000.Remove(Item: TMenuItem2000);
begin
  inherited Remove(Item);
  Update(0, upForceRebuild);
end;
procedure TMenuItem2000.Delete(Index: Integer);
begin
  inherited Delete(Index);
  Update(0, upForceRebuild);
end;
procedure TMenuItem2000.Assign(Source: TPersistent);
begin
  inherited;
end;
function TMenuItem2000.IsTopLevelItem: Boolean;
  // is top level menu item from ActiveMenuBar?
var
  mi: TMenuItem;
begin
  mi:= Parent;
  if (mi = nil) then mi:= Self;
  Result:= (mi <> nil)
    and (ActiveMenuBar <> nil)
    and (ActiveMenuBar.Menu <> nil)
    and (((ActiveMenuBar.Menu is TCustomMainMenu2000)
    and (TCustomMainMenu2000(ActiveMenuBar.Menu).Items2000 = mi))
    or ((ActiveMenuBar.Menu is TCustomPopupMenu2000)
    and (TCustomPopupMenu2000(ActiveMenuBar.Menu).Items2000 = mi))
    or (ActiveMenuBar.Menu.Items = mi));
end;
function TMenuItem2000.IsBitmapAssigned : Boolean;
  // checks if menu item has any bitmap anywhere
begin
  Result:=
{$IFDEF Delphi4OrHigher}
    (not Bitmap.Empty)
{$ELSE}
    (Assigned(FBitmap) and (not FBitmap.Empty))
{$ENDIF}
    or (DefaultIndex <> -1)
    or ((Caption <> '')
    and (MenuItemCache[Caption].Bitmap <> 0));
end;
function TMenuItem2000.IsOptionsAssigned: Boolean;
begin
  Result:= Assigned(FOptions);
end;
function TMenuItem2000.GetParent: TMenuItem2000;
begin
  Result:= TMenuItem2000(inherited Parent);
end;
function TMenuItem2000.IsHintStored: Boolean;
begin
  Result:= Hint <> MenuItemCache[Caption].Hint;
end;
function TMenuItem2000.IsShortCutStored: Boolean;
begin
  Result:= FShortCut <> MenuItemCache[Caption].ShortCuts;
end;
function TMenuItem2000.IsBitmapStored: Boolean;
var
  B: Boolean;
begin
  B:=
{$IFNDEF Delphi4OrHigher}
    (FBitmap = nil) or
{$ENDIF}
    (Bitmap.Handle = 0)
    or (DefaultIndex <> -1)
    or (Bitmap.Handle = MenuItemCache[Caption].Bitmap);
  // necessary for optimization purposes
  Result:= not B;
end;
function TMenuItem2000.GetBitmap: TBitmap;
begin
  if (csDesigning in ComponentState)
  then begin
{$IFDEF Delphi4OrHigher}
    Result:= inherited Bitmap;
{$ELSE}
    if FBitmap = nil then FBitmap:= TBitmap.Create;
    Result:= FBitmap;
{$ENDIF}
  end
  else
    Result:= GetBitmapEx;
end;
function TMenuItem2000.GetBitmapEx: TBitmap;
begin
{$IFDEF Delphi4OrHigher}
  Result:= inherited Bitmap;
{$ELSE}
  if FBitmap = nil then FBitmap:= TBitmap.Create;
  Result:= FBitmap;
{$ENDIF}
  if MenuItemCache = nil
  then Exit;
  if DefaultIndex <> -1
  then
    Result.Handle:= MenuItemCache.GetDefaultBitmap(DefaultIndex)
  else
  if (Caption <> '')
  and (Result.Handle = 0)
  then
    Result.Handle:= MenuItemCache[Caption].Bitmap;
end;
function TMenuItem2000.GetShortCut: T_AM2000_ShortCut;
begin
  Result:= '';
  // inherited shortcut
  if inherited ShortCut <> 0
  then
    Result:= ShortCutToText(inherited ShortCut)
    
  else begin
    Result:= FShortCut;
    if not (csWriting in ComponentState) then begin
      if (Result = '') then Result:= MenuItemCache[Caption].ShortCuts;
      if (Result = #1) then Result:= '';
    end;
  end;
end;
function TMenuItem2000.GetHint: String;
begin
  Result:= inherited Hint;
  if not (csWriting in ComponentState) then begin
    if (Result = '') then Result:= MenuItemCache[Caption].Hint;
    if (Result = #1) then Result:= '';
  end;
end;
procedure TMenuItem2000.SetBitmap(Value: TBitmap);
begin
{$IFDEF Delphi4OrHigher}
  inherited Bitmap:= Value;
{$ELSE}
  if FBitmap = nil then FBitmap := TBitmap.Create;
  FBitmap.Assign(Value);
{$ENDIF}
  // update
  Update(wm_UpdateBitmap, upForceRebuild);
end;
procedure TMenuItem2000.TurnSiblingsOff;
var
  I: Integer;
  SaveIRF: Boolean;
begin
  SaveIRF:= IgnoreRepaintFloating;
  IgnoreRepaintFloating:= True;
  for I:= 0 to Parent.Count -1 do
    if (Parent.Items[I] <> Self)
    and (Parent.Items[I].GroupIndex = GroupIndex)
    then
      with Parent.Items[I] do begin
        case Control of
          ctlNone:        Checked:= False;
          ctlButton:      AsButton.Down:= False;
          ctlButtonArray: AsButtonArray.ItemIndex:= -1;
        end;
        
        Update(wm_UpdateBitmap, upNothing);
      end;
  IgnoreRepaintFloating:= SaveIRF;
end;
procedure TMenuItem2000.SetHint(Value: String);
begin
  if (Value = '')
  and (MenuItemCache[Caption].Hint <> '')
  then inherited Hint:= #1
  else inherited Hint:= Value;
end;
procedure TMenuItem2000.SetShortCut(Value: T_AM2000_ShortCut);
var
  I: Integer;
  S, S1: String;
  SC: TShortCut;
begin
  inherited ShortCut:= 0;
  // if shortcut is empty
  if (Value = '') or (Value = #1)
  then FShortCut:= #1
  else
  // supress checking when loading
  if csLoading in ComponentState
  then begin
    FShortCut:= Value;
  end
  // shortcut checking
  else begin
    S:= '';
    while Value <> '' do begin
      I:= Pos(';', Value);
      if I < 1 then I:= Length(Value) +1;
      S1:= Trim(Copy(Value, 1, I -1));
      System.Delete(Value, 1, I);
      if S1 = '' then System.Break;
      SC:= TextToShortCut(S1);
      if SC = 0
      then raise Exception.Create(SInvalidShortCut + S1 +'''');
      if S <> '' then AppendStr(S, ';');
      AppendStr(S, ShortCutToText(SC));
    end;
    FShortCut:= S;
  end;
end;
function TMenuItem2000.AsButtonArray: T_AM2000_ButtonArrayOptions;
begin
  if FControl = ctlButtonArray
  then Result:= FControlOptions as T_AM2000_ButtonArrayOptions
  else raise EMenuError.Create(Name + SThisIsNotAButtonArray);
end;
function TMenuItem2000.AsButton: T_AM2000_ButtonOptions;
begin
  if FControl = ctlButton
  then Result:= FControlOptions as T_AM2000_ButtonOptions
  else raise EMenuError.Create(Name + SThisIsNotAButton);
end;
function TMenuItem2000.AsBitmap: T_AM2000_BitmapOptions;
begin
  if FControl = ctlBitmap
  then Result:= FControlOptions as T_AM2000_BitmapOptions
  else raise EMenuError.Create(Name + SThisIsNotABitmap);
end;
function TMenuItem2000.AsEdit: T_AM2000_EditboxOptions;
begin
  if FControl = ctlEditbox
  then Result:= FControlOptions as T_AM2000_EditboxOptions
  else raise EMenuError.Create(Name + SThisIsNotAEdit);
end;
function TMenuItem2000.GetItem(Index: Integer): TMenuItem2000;
var
  R: TMenuItem;
begin
  R:= inherited GetItem(Index);
  if Assigned(R)
  then Result:= TMenuItem2000(R)
  else raise EMenuError.Create(SMenuNotFound);
end;
procedure TMenuItem2000.SetCaption(const Value: String);
begin
  inherited Caption:= Value;
  Update(wm_UpdateCaption, upForceRebuild);
end;
procedure TMenuItem2000.SetEnabled(Value: Boolean);
begin
  inherited Enabled:= Value;
  Update(0, upRepaint);
end;
procedure TMenuItem2000.SetVisible(Value: Boolean);
begin
  inherited Visible:= Value;
  Update(0, upForceRebuild);
end;
procedure TMenuItem2000.SetControl(Value: T_AM2000_ControlType);
begin
  if FControl <> Value then begin
    FControl:= Value;
    FControlOptions.Free;
    case FControl of
      ctlButton      :
        FControlOptions:= T_AM2000_ButtonOptions.Create(Self);
      ctlButtonArray :
        FControlOptions:= T_AM2000_ButtonArrayOptions.Create(Self);
      ctlBitmap     :
        FControlOptions:= T_AM2000_BitmapOptions.Create(Self);
      ctlEditbox     :
        FControlOptions:= T_AM2000_EditboxOptions.Create(Self);
      else
        FControlOptions:= T_AM2000_ControlOptions.Create(Self);
    end;
    Update(wm_SelectComponent, 0);
  end;
end;
function TMenuItem2000.IsOptionsStored: Boolean;
begin
  Result:= Count > 0;
end;
function TMenuItem2000.GetOptions: T_AM2000_MenuOptions;
begin
  if Assigned(FOptions)
  and (not (csLoading in ComponentState))
  and (((FOptions.ClassType = T_AM2000_MenuOptions) and ((Count > 0) or (AttachMenu <> nil)))
  or ((FOptions.ClassType = T_AM2000_BaseOptions) and (Count = 0)))
  then begin
    FOptions.Free;
    FOptions:= nil;
  end;
  if not Assigned(FOptions)
  then
    if (Count > 0)
    or (AttachMenu <> nil)
    or (csLoading in ComponentState)
    or (not (csDesigning in ComponentState))
    then FOptions:= T_AM2000_BaseOptions.Create
    else FOptions:= T_AM2000_MenuOptions.Create;
  Result:= FOptions;  
end;
procedure TMenuItem2000.SetOptions(Value: T_AM2000_MenuOptions);
begin
  if not Assigned(FOptions)
  then
    if Count > 0
    then FOptions:= T_AM2000_BaseOptions.Create
    else FOptions:= T_AM2000_MenuOptions.Create;
  FOptions.Assign(Value);
end;
function TMenuItem2000.GetCaption: String;
begin
  Result:= inherited Caption;
end;
function TMenuItem2000.GetEnabled: Boolean;
begin
  Result:= inherited Enabled;
end;
function TMenuItem2000.GetVisible: Boolean;
begin
  Result:= inherited Visible;
end;
function TMenuItem2000.GetWidth(Canvas: TCanvas): Integer;
begin
  Result:= FControlOptions.GetWidth(Canvas);
end;
function TMenuItem2000.GetHeight(ItemHeight: Integer): Integer;
begin
  Result:= FControlOptions.GetHeight(ItemHeight);
end;
procedure TMenuItem2000.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
  if Operation = opRemove then begin
    if (AComponent = AttachMenu) then FAttachMenu:= nil;
    if (AComponent = PopupMenu) then FPopupMenu:= nil;
  end;
end;
{$IFDEF Delphi4OrHigher}
procedure TMenuItem2000.InitiateAction;
var
  I : Integer;
begin
  inherited;
  for I := 0 to Count - 1 do
    with Items[I] do
      if Visible then InitiateAction;
end;
function TMenuItem2000.GetAction: TBasicAction;
begin
  Result:= inherited Action;
end;
procedure TMenuItem2000.SetAction(Value: TBasicAction);
begin
  inherited Action:= Value;
  if Value <> nil then SetCaption(Caption);
  Update(wm_UpdateCaption, upForceRebuild);
end;
{$ENDIF}
procedure TMenuItem2000.Update(UpdateDesigner, UpdateMenuBar: Integer);
var
  hwnd: THandle;
begin
  if Parent = nil then Exit; 
  // update bitmap
  if (UpdateDesigner <> 0)    
  and (not (csLoading in ComponentState))
  then begin
    hwnd:= GetMnuDsgnHandle;
    if hwnd <> 0 then PostMessage(hwnd, UpdateDesigner, 0, LongInt(Self));
  end;
  // update menu bar
  if (not (csLoading in ComponentState))
  and (not (csDestroying in ComponentState))
  and IsTopLevelItem
  and (ActiveMenuBar <> nil)
  and ActiveMenuBar.HandleAllocated
  then PostMessage(ActiveMenuBar.Handle, wm_UpdateMenuBar, UpdateMenuBar, 0);
end;
function TMenuItem2000.GetChecked: Boolean;
begin
  Result:= inherited Checked;
end;
procedure TMenuItem2000.SetChecked(Value: Boolean);
begin
  inherited Checked:= Value;
  Update(wm_UpdateBItmap, upForceRebuild);
end;
procedure TMenuItem2000.SetDefaultIndex(Value: Integer);
begin
  FDefaultBitmapIndex:= Value;
  Update(wm_UpdateBitmap, upForceRebuild);
end;
{ TEditableMenuItem2000 }
function TEditableMenuItem2000.GetHandle: HMenu;
begin
  Result:= TMenu(Owner).Items.Handle;
end;
function TEditableMenuItem2000.GetCount: Integer;
begin
  Result:= TMenu(Owner).Items.Count;
end;
function TEditableMenuItem2000.GetItem(Index: Integer): TMenuItem2000;
begin
  // it's safe because AnimatedMenus/98 doesn't use TMenuItem anymore
  // Only TMenuItem2000
  Result:= TMenuItem2000(TMenu(Owner).Items[Index]);
end;
procedure TEditableMenuItem2000.Insert(Index: Integer; Item: TMenuItem2000);
begin
  TMenu(Owner).Items.Insert(Index, Item);
end;
procedure TEditableMenuItem2000.Delete(Index: Integer);
begin
  TMenu(Owner).Items.Delete(Index);
end;
function TEditableMenuItem2000.IndexOf(Item: TMenuItem2000): Integer;
begin
  Result:= TMenu(Owner).Items.IndexOf(Item);
end;
procedure TEditableMenuItem2000.Add(Item: TMenuItem2000);
begin
  TMenu(Owner).Items.Add(Item);
end;
procedure TEditableMenuItem2000.Remove(Item: TMenuItem2000);
begin
  TMenu(Owner).Items.Remove(Item);
end;
initialization
  RegisterClasses([TMenuItem2000, TEditableMenuItem2000]);
finalization
  Pattern.Free;
end.

						