jvmenus.pas

East make Tray Icon in delphi

    property OnMeasureItem: TMeasureMenuItemEvent read FOnMeasureItem write FOnMeasureItem;
  end;

  // the event trigerred when the margin of a menu must be drawn
  TJvDrawLeftMarginEvent = procedure(Sender: TMenu; Rect: TRect) of object;

  { TJvCustomMenuItemPainter }

  // This class is the base class for all the menu item painters.
  // Each instance of TJvMainMenu and TJvPopupMenu will contain one
  // instance of one of the descendent which will be be in charge
  // of the painting of menu items. There is one descendent per
  // style in the TJvMenuStyle enumeration
  TJvCustomMenuItemPainter = class(TComponent)
  private
    // property fields
    FImageBackgroundColor: TColor;
    FLeftMargin: Cardinal;
    FOnDrawLeftMargin: TJvDrawLeftMarginEvent;

    // other usage fields
    FMainMenu: TJvMainMenu;
    FPopupMenu: TJvPopupMenu;
    FOnDrawItem: TDrawMenuItemEvent;
    FImageMargin: TJvImageMargin;
    FImageSize: TJvMenuImageSize;

    FItem: TMenuItem;
    FState: TMenuOwnerDrawState;

    FImageIndex: Integer;
    FGlyph: TGraphic;
    FNumGlyphs: Integer;
    FParentMenu: TMenu;
    procedure SetLeftMargin(const Value: Cardinal);
    procedure SetImageBackgroundColor(const Value: TColor);
    function GetMenu: TMenu;
    procedure SetMenu(const Value: TMenu);
    function GetCanvas: TCanvas;

    procedure EmptyDrawItem(Sender: TObject;ACanvas: TCanvas; ARect: TRect; Selected: Boolean);
  protected
    function GetTextWidth(Item: TMenuItem): Integer;
    function GetCheckMarkHeight: Integer; virtual;
    function GetCheckMarkWidth: Integer; virtual;
    function GetComponentState: TComponentState;
    function GetDisabledImages: TImageList;
    function GetDrawHighlight: Boolean; virtual;
    function GetGrayColor: TColor; virtual;
    function GetHotImages: TImageList;
    function GetImageHeight: Integer; virtual;
    function GetImageWidth: Integer; virtual;
    function GetImages: TImageList;
    function GetIsPopup: Boolean;
    function GetIsRightToLeft: Boolean;
    function GetShowCheckMarks: Boolean;
    function GetTextMargin: Integer; virtual;
    function GetTextVAlignment: TJvVerticalAlignment;

    function UseImages: Boolean;
    function UseHotImages: Boolean;
    function UseDisabledImages: Boolean;

    // This procedure will update the fields that are
    // instances of objects derived from TPersistent. This
    // allows for modification in the painter without any impact
    // on the values in the user's object (in his menu)
    procedure UpdateFieldsFromMenu; virtual;

    // draws the background required for a checked item
    // doesn't draw the mark, simply the grey matrix that
    // is shown behind the mark or image
    procedure DrawGlyphCheck(ARect: TRect); virtual;

    // prepare the paint by assigning various fields
    procedure PreparePaint(Item: TMenuItem; ItemRect: TRect;
      State: TMenuOwnerDrawState; Measure: Boolean); virtual;

    // draws the item background
    // does nothing by default
    procedure DrawItemBackground(ARect: TRect); virtual;

    // draws the check mark background
    // does nothing by default
    procedure DrawCheckMarkBackground(ARect: TRect); virtual;

    // draws the image background
    // does nothing by default
    procedure DrawImageBackground(ARect: TRect); virtual;

    // draws the background of the text
    // does nothing by default
    procedure DrawTextBackground(ARect: TRect); virtual;

    // draws a frame for the menu item.
    // will only be called if the menu item is selected (mdSelected in State)
    // and does nothing by default
    procedure DrawSelectedFrame(ARect: TRect); virtual;

    // Draws a disabled bitmap at the given coordinates.
    // The disabled bitmap will be created from the given bitmap.
    // This is only called when the glyph property of the item index
    // is not empty or when the graphic set in the OnItemParams event
    // was a TBitmap or when no image is available for a checked item
    procedure DrawDisabledBitmap(X, Y: Integer; Bitmap: TBitmap); virtual;

    // Draws the menu bitmap at the given coordinates.
    // This is only called when the glyph property of the item index
    // is not empty or when the graphic set in the OnItemParams event
    // was a TBitmap or when no image is available for a checked item
    procedure DrawMenuBitmap(X, Y: Integer; Bitmap: TBitmap); virtual;

    // Draws a disabled image. This is called when the ImageList property
    // is not empty
    procedure DrawDisabledImage(X, Y: Integer); virtual;

    // Draws an enabled image. This is called when the ImageList property
    // is not empty
    procedure DrawEnabledImage(X, Y: Integer); virtual;

    // Draws a check image for the menu item
    // will only be called if the menu item is checked, the menu item is
    // a popup at the time of showing (being a popup meaning not being
    // a top level menu item in a main menu) and the parent menu asks
    // to show check marks or there are no image for the item
    procedure DrawCheckImage(ARect: TRect); virtual;

    // draws the back of an image for a checked menu item.
    // by default, does nothing
    procedure DrawCheckedImageBack(ARect: TRect); virtual;

    // draws the back of an image for a menu item.
    // by default, does nothing
    procedure DrawNotCheckedImageBack(ARect: TRect); virtual;

    // draws a separator
    procedure DrawSeparator(ARect: TRect); virtual;

    // draws the text at the given place.
    // This procedure CAN NOT be called DrawText because BCB users wouldn't be
    // able to override it in a component written in C++. The error would be
    // that the linker cannot find DrawTextA. This comes from windows. which
    // defines this:
    // #define DrawText DrawTextA
    // because of ANSI support (over Unicode). Not using the DrawText name
    // solves this problem.
    procedure DrawItemText(ARect: TRect; const Text: string; Flags: Longint); virtual;

    procedure DrawLeftMargin(ARect: TRect); virtual;
    procedure DefaultDrawLeftMargin(ARect: TRect; StartColor, EndColor: TColor);

    // NEVER STORE Canvas, this value is not to be trusted from the menu
    // it MUST be read everytime it is needed
    property Canvas: TCanvas read GetCanvas;

    // properties read or calculated from the properties of the
    // menu to which the painter is linked
    property CheckMarkHeight: Integer read GetCheckMarkHeight;
    property CheckMarkWidth: Integer read GetCheckMarkWidth;
    property ComponentState: TComponentState read GetComponentState;
    property DisabledImages: TImageList read GetDisabledImages;
    property DrawHighlight: Boolean read GetDrawHighlight;
    property GrayColor: TColor read GetGrayColor;
    property HotImages: TImageList read GetHotImages;
    property Images: TImageList read GetImages;
    property ImageHeight: Integer read GetImageHeight;
    property ImageMargin: TJvImageMargin read FImageMargin;
    property ImageSize: TJvMenuImageSize read FImageSize;
    property ImageWidth: Integer read GetImageWidth;
    property IsPopup: Boolean read GetIsPopup;
    property IsRightToLeft: Boolean read GetIsRightToLeft;
    property ShowCheckMarks: Boolean read GetShowCheckMarks;
    property TextMargin: Integer read GetTextMargin;
    property TextVAlignment: TJvVerticalAlignment read GetTextVAlignment;

    // Left margin properties and events
    property LeftMargin: Cardinal read FLeftMargin write SetLeftMargin default 0;
    property OnDrawLeftMargin: TJvDrawLeftMarginEvent read FOnDrawLeftMargin write FOnDrawLeftMargin;
    property ImageBackgroundColor: TColor read FImageBackgroundColor write SetImageBackgroundColor default DefaultImageBackgroundColor;
  public
    // constructor, will create the objects derived from TPersistent
    // which are stored here (see UpdateFieldsFromMenu)
    constructor Create(AOwner: TComponent); override;

    // This is the menu to which the painter is linked. It MUST be
    // set BEFORE calling any painting function, but no check is made
    // to ensure that this is the case
    property Menu: TMenu read GetMenu write SetMenu;

    // destroys the objects created in create
    destructor Destroy; override;

    // indicates in Width and Height the size of the given menu item
    // if it was painted with this painter
    procedure Measure(Item: TMenuItem; var Width, Height: Integer); virtual;

    // will paint the given item in the given rectangle
    // will call the various virtual functions depending on the
    // state of the menu item
    procedure Paint(Item: TMenuItem; ItemRect: TRect;
      State: TMenuOwnerDrawState); virtual;
  end;

  { TJvOfficeMenuItemPainter }

  // This painter draws an item using the office style
  TJvOfficeMenuItemPainter = class(TJvCustomMenuItemPainter)
  protected
    procedure CleanupGlyph(BtnRect: TRect);
    procedure DrawFrame(BtnRect: TRect);
    function GetDrawHighlight: Boolean; override;
    procedure DrawSelectedFrame(ARect: TRect); override;
    procedure DrawCheckedImageBack(ARect: TRect); override;
    procedure DrawNotCheckedImageBack(ARect: TRect); override;
    procedure UpdateFieldsFromMenu; override;
    function GetTextMargin: Integer; override;
    procedure DrawCheckImage(ARect: TRect); override;
    procedure DrawItemText(ARect: TRect; const Text: string; Flags: Longint); override;
    procedure DrawItemBackground(ARect: TRect); override;
  public
    procedure Paint(Item: TMenuItem; ItemRect: TRect; State: TMenuOwnerDrawState); override;
  published
    property LeftMargin;
    property OnDrawLeftMargin;
  end;

  // this painter draws an item as a lowered or raised button
  TJvBtnMenuItemPainter = class(TJvCustomMenuItemPainter)
  private
    FLowered: Boolean;
  protected
    procedure DrawSelectedFrame(ARect: TRect); override;
    function GetDrawHighlight: Boolean; override;
    function GetGrayColor: TColor; override;
    procedure UpdateFieldsFromMenu; override;
  public
    constructor Create(AOwner: TComponent); overload; override;
    constructor Create(AOwner: TComponent; Lowered: Boolean); reintroduce; overload;
  published
    property Lowered: Boolean read FLowered write FLowered;
    property LeftMargin;
    property OnDrawLeftMargin;
  end;

  // this painter is the standard one and as such doesn't do anything
  // more than the ancestor class except publishing properties
  TJvStandardMenuItemPainter = class(TJvCustomMenuItemPainter)
  protected
    procedure DrawCheckedImageBack(ARect: TRect); override;
    procedure UpdateFieldsFromMenu; override;
    function GetTextMargin: Integer; override;
    function GetImageWidth: Integer; override;
  public
    procedure Paint(Item: TMenuItem; ItemRect: TRect; State: TMenuOwnerDrawState); override;
  published
    property LeftMargin;
    property OnDrawLeftMargin;
  end;

  // this painter calls the user supplied events to render the item
  TJvOwnerDrawMenuItemPainter = class(TJvCustomMenuItemPainter)
  public
    procedure Measure(Item: TMenuItem; var Width, Height: Integer); override;
    procedure Paint(Item: TMenuItem; ItemRect: TRect; State: TMenuOwnerDrawState); override;
  end;

  // this painter draws an item using the XP style (white menus,
  // shadows below images...)
  TJvXPMenuItemPainter = class(TJvCustomMenuItemPainter)
  private
    // property fields
    FSelectionFrameBrush: TBrush;
    FSelectionFramePen: TPen;
    FShadowColor: TColor;
    FSeparatorColor: TColor;
    FCheckedImageBackColorSelected: TColor;
    FCheckedImageBackColor: TColor;
    // other usage fields
    FSelRect: TRect;
    FCheckedPoint: TPoint;
  protected
    procedure DrawBitmapShadow(X, Y: Integer; B: TBitmap);
    procedure DrawImageBackground(ARect: TRect); override;
    procedure DrawCheckMarkBackground(ARect: TRect); override;
    procedure PreparePaint(Item: TMenuItem; Rect: TRect;
      State: TMenuOwnerDrawState; Measure: Boolean); override;
    procedure DrawCheckedImageBack(ARect: TRect); override;
    procedure DrawEnabledImage(X, Y: Integer); override;
    procedure DrawItemBackground(ARect: TRect); override;
    procedure DrawMenuBitmap(X, Y: Integer; Bitmap: TBitmap); override;
    procedure DrawDisabledImage(X, Y: Integer); override;
    procedure DrawSelectedFrame(ARect: TRect); override;
    procedure DrawSeparator(ARect: TRect); override;
    procedure DrawItemText(ARect: TRect; const Text: string; Flags: Longint); override;
    function GetDrawHighlight: Boolean; override;
    procedure UpdateFieldsFromMenu; override;
    function GetTextMargin: Integer; override;
    procedure DrawCheckImage(ARect: TRect); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Measure(Item: TMenuItem; var Width, Height: Integer); override;
    procedure Paint(Item: TMenuItem; ItemRect: TRect;
      State: TMenuOwnerDrawState); override;
  published
    property ImageBackgroundColor default DefaultXPImageBackgroundColor;
    property SelectionFrameBrush: TBrush read FSelectionFrameBrush;
    property SelectionFramePen: TPen read FSelectionFramePen;
    property SeparatorColor: TColor read FSeparatorColor write FSeparatorColor default DefaultXPSeparatorColor;
    property ShadowColor: TColor read FShadowColor write FShadowColor default DefaultXPShadowColor;
    property CheckedImageBackColor: TColor read FCheckedImageBackColor write FCheckedImageBackColor default DefaultXPCheckedImageBackColor;
    property CheckedImageBackColorSelected: TColor read FCheckedImageBackColorSelected write FCheckedImageBackColorSelected default DefaultXPCheckedImageBackColorSelected;
  end;

{ Utility routines }

procedure SetDefaultMenuFont(AFont: TFont);
function UseFlatMenubars: Boolean;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvMenus.pas,v $';
    Revision: '$Revision: 1.74 $';
    Date: '$Date: 2005/03/09 14:57:27 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  CommCtrl, Consts, Math,
  {$IFDEF HAS_UNIT_TYPES}
  Types,
  {$ENDIF HAS_UNIT_TYPES}
  JvConsts, JvJCLUtils, JvJVCLUtils;

const
  Separator = '-';

  // The space between a menu item text and its shortcut
  ShortcutSpacing = '        ';

function CreateMenuItemPainterFromStyle(Style: TJvMenuStyle; Menu: TMenu): TJvCustomMenuItemPainter;
begin
  case Style of
    msOwnerDraw:
      Result := TJvOwnerDrawMenuItemPainter.Create(Menu);
    msBtnLowered:
      Result := TJvBtnMenuItemPainter.Create(Menu, True);
    msBtnRaised:
      Result := TJvBtnMenuItemPainter.Create(Menu, False);
    msOffice:
      Result := TJvOfficeMenuItemPainter.Create(Menu);
    msXP:
      Result := TJvXPMenuItemPainter.Create(Menu);
  else
    Result := TJvStandardMenuItemPainter.Create(Menu);
  end;
  Result.Menu := Menu;
end;

function IsItemPopup(Item: TMenuItem): Boolean;
begin
  Result := (Item.Parent = nil) or (Item.Parent.Parent <> nil) or
    not (Item.Parent.Owner is TMainMenu);
end;

function IsWinXP_UP: Boolean;
begin
  Result := (Win32Platform = VER_PLATFORM_WIN32_NT) and
    ((Win32MajorVersion > 5) or
    (Win32MajorVersion = 5) and (Win32MinorVersion >= 1));
end;

function UseFlatMenubars: Boolean;
const
  SPI_GETFLATMENU = $1022;
var
  B: BOOL;
begin
  Result := IsWinXP_UP and SystemParametersInfo(SPI_GETFLATMENU, 0, @B, 0) and B;
end;