jvmenus.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvMenus.PAS, released on 2002-07-04.

The Initial Developers of the Original Code are: Fedor Koshevnikov, Igor Pavluk and Serge Korolev
Copyright (c) 1997, 1998 Fedor Koshevnikov, Igor Pavluk and Serge Korolev
Copyright (c) 2001,2002 SGB Software
All Rights Reserved.

Contributors: Olivier Sannier [obones att altern dott org]

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvMenus.pas,v 1.74 2005/03/09 14:57:27 marquardt Exp $

unit JvMenus;

{$I jvcl.inc}
{$I vclonly.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  Windows, Messages, SysUtils, Contnrs, Graphics, Controls, Forms, Classes,
  ExtCtrls, ImgList, Menus,
  JvTypes, JvWndProcHook, JVCLVer;

const
  // custom painter constants
  DefaultImageBackgroundColor = clBtnFace;
  DefaultMarginColor: TColor = clBlue;

  // xp painter constants
  DefaultXPImageBackgroundColor = TColor($D1D8D8);
  DefaultXPSeparatorColor = TColor($A6A6A6);
  DefaultXPSFBrushColor = TColor($D2BDB6);
  DefaultXPSFPenColor = TColor($6A240A);
  DefaultXPShadowColor = TColor($9D8D88);
  DefaultXPCheckedImageBackColorSelected = TColor($B59285);
  DefaultXPCheckedImageBackColor = TColor($D8D5D4);

type
  // early declarations
  TJvMainMenu = class;
  TJvPopupMenu = class;
  TJvCustomMenuItemPainter = class;

  { Generic types }

  // size of an image
  TJvMenuImageSize = class(TPersistent)
  private
    FHeight: Integer;
    FWidth: Integer;
  public
    procedure Assign(Source: TPersistent); override;
  published
    property Height: Integer read FHeight write FHeight;
    property Width: Integer read FWidth write FWidth;
  end;

  // margins around an image
  TJvImageMargin = class(TPersistent)
  private
    FTop: Integer;
    FLeft: Integer;
    FRight: Integer;
    FBottom: Integer;
  public
    procedure Assign(Source: TPersistent); override;
  published
    property Left: Integer read FLeft write FLeft;
    property Top: Integer read FTop write FTop;
    property Right: Integer read FRight write FRight;
    property Bottom: Integer read FBottom write FBottom;
  end;

  // the vertical aligment
  TJvVerticalAlignment = (vaTop, vaMiddle, vaBottom);

  { TJvMenuChangeLink}

  // This class should be used by any class that wishes to be notified
  // when the content of the menu has changed. Pass an instance of
  // TJvMenuChangeLink to a TJvMainMenu through RegisterChanges and
  // the OnChange event of your object will be fired whenever it is
  // required. This is done on the same principle as the TImageList.
  // In the JVCL, TJvToolbar uses this principle to automatically
  // adjust its content (and size if autosize is true) when the
  // content of the menu it is linked to has changed.

  // This next type is the event triggered when the menu has changed
  // If Rebuild is true, the menu as had to be rebuilt because of a
  // change in its layout, not in the properties of one of its item.
  // Unfortunately, for a reason yet to be discovered, Rebuild is
  // always false, even when adding or removing items in the menu.
  // As a result any class using this feature should compute its
  // own value for Rebuild and decide upon it, rather than on the
  // original value of Rebuild
  TOnJvMenuChange = procedure(Sender: TJvMainMenu; Source: TMenuItem; Rebuild: Boolean) of object;

  TJvMenuChangeLink = class(TObject)
  private
    FOnChange: TOnJvMenuChange;
  protected
    // triggers the OnChange event.
    // this is protected as it cannot be accessed by any other class
    // except the TJvMainMenu which is located in the same unit
    // (scope only applies outside the unit)
    procedure Change(Sender: TJvMainMenu; Source: TMenuItem; Rebuild: Boolean); dynamic;
  public
    property OnChange: TOnJvMenuChange read FOnChange write FOnChange;
  end;

  { TJvMainMenu }

  // the different styles a menu can get
  TJvMenuStyle = (msStandard, // standard (no raising frames around images)
    msOwnerDraw, // drawn by owner
    msBtnLowered, // drawn as a lowered button
    msBtnRaised, // drawn as a raised button
    msOffice, // drawn as in MSOffice (raising frames around selected images)
    msXP, // drawn as in WinXP (white background, shadow below selected images)
    msItemPainter // drawn by the painter in ItemPainter property
    );

  // the state a menu item can get
  TMenuOwnerDrawState = set of (mdSelected, mdGrayed, mdDisabled, mdChecked,
    mdFocused, mdDefault, mdHotlight, mdInactive);

  // The event trigerred when an item is to be drawn by its owner
  TDrawMenuItemEvent = procedure(Sender: TMenu; Item: TMenuItem; Rect: TRect;
    State: TMenuOwnerDrawState) of object;

  // The event trigerred when the size of an item is required
  TMeasureMenuItemEvent = procedure(Sender: TMenu; Item: TMenuItem; var Width,
    Height: Integer) of object;

  // event trigerred when about to draw the menu item and a
  // glyph for it is required. If no handler is provided, the
  // image list will be asked and if not available, no image
  // will be drawn
  TItemParamsEvent = procedure(Sender: TMenu; Item: TMenuItem;
    State: TMenuOwnerDrawState; AFont: TFont; var Color: TColor;
    var Graphic: TGraphic; var NumGlyphs: Integer) of object;

  // event triggerred when asking for an image index
  // if no handler is provided, the value in the menu item will
  // be used
  TItemImageEvent = procedure(Sender: TMenu; Item: TMenuItem;
    State: TMenuOwnerDrawState; var ImageIndex: Integer) of object;

  // the main menu class
  TJvMainMenu = class(TMainMenu)
  private
    FAboutJVCL: TJVCLAboutInfo;
    FCursor: TCursor;
    FDisabledImages: TImageList;
    FHotImages: TImageList;
    FImageMargin: TJvImageMargin;
    FImages: TImageList;
    FImageSize: TJvMenuImageSize;
    FShowCheckMarks: Boolean;
    FStyle: TJvMenuStyle;
    FTextMargin: Integer;
    FTextVAlignment: TJvVerticalAlignment;

    FOnDrawItem: TDrawMenuItemEvent;
    FOnMeasureItem: TMeasureMenuItemEvent;
    FOnGetItemParams: TItemParamsEvent;

    FImageChangeLink: TChangeLink;
    FOnGetImageIndex: TItemImageEvent;

    FDisabledImageChangeLink: TChangeLink;
    FOnGetDisabledImageIndex: TItemImageEvent;

    FHotImageChangeLink: TChangeLink;
    FOnGetHotImageIndex: TItemImageEvent;

    FChangeLinks: TObjectList;
    FCanvas: TControlCanvas;

    // This is one is used if Style is not msItemPainter
    FStyleItemPainter: TJvCustomMenuItemPainter;

    // This one is for the ItemPainter property
    FItemPainter: TJvCustomMenuItemPainter;
    function GetCanvas: TCanvas;
    procedure SetItemPainter(const Value: TJvCustomMenuItemPainter);
    function GetActiveItemPainter: TJvCustomMenuItemPainter;
    procedure SetStyle(Value: TJvMenuStyle);
    procedure SetDisabledImages(Value: TImageList);
    procedure SetImages(Value: TImageList);
    procedure SetHotImages(Value: TImageList);
  protected
    procedure ImageListChange(Sender: TObject);
    procedure DisabledImageListChange(Sender: TObject);
    procedure HotImageListChange(Sender: TObject);
    function FindForm: TWinControl;
    function NewWndProc(var Msg: TMessage): Boolean;
    procedure CMMenuChanged(var Msg: TMessage); message CM_MENUCHANGED;
    procedure WMDrawItem(var Msg: TWMDrawItem); message WM_DRAWITEM;
    procedure WMMeasureItem(var Msg: TWMMeasureItem); message WM_MEASUREITEM;
    procedure WMMenuSelect(var Msg: TWMMenuSelect); message WM_MENUSELECT;

    procedure Loaded; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure GetImageIndex(Item: TMenuItem; State: TMenuOwnerDrawState; var ImageIndex: Integer); dynamic;
    procedure DrawItem(Item: TMenuItem; Rect: TRect;
      State: TMenuOwnerDrawState); virtual;
    procedure GetItemParams(Item: TMenuItem; State: TMenuOwnerDrawState; AFont: TFont; var Color: TColor; var Graphic: TGraphic;
      var NumGlyphs: Integer); dynamic;
    procedure MeasureItem(Item: TMenuItem; var Width, Height: Integer); dynamic;
    procedure RefreshMenu(AOwnerDraw: Boolean); virtual;
    function IsOwnerDrawMenu: Boolean;

    // called when the menu has changed. If Rebuild is true, the menu
    // as had to be rebuilt because of a change in its layout, not in
    // the properties of one of its item. Unfortunately, for a reason
    // yet to be discovered, Rebuild is always false, even when adding
    // or removing items in the menu.
    procedure MenuChanged(Sender: TObject; Source: TMenuItem; Rebuild: Boolean); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Refresh;
    procedure DefaultDrawItem(Item: TMenuItem; Rect: TRect;
      State: TMenuOwnerDrawState);

    // change registering methods
    procedure RegisterChanges(ChangeLink: TJvMenuChangeLink);
    procedure UnregisterChanges(ChangeLink: TJvMenuChangeLink);

    // get the canvas of the menu
    property Canvas: TCanvas read GetCanvas;
    // get the currently used painter
    property ActiveItemPainter: TJvCustomMenuItemPainter read GetActiveItemPainter;
  published
    // Style MUST BE before ItemPainter for the properties of the
    // painter to be correctly read from the DFM file.
    property Style: TJvMenuStyle read FStyle write SetStyle default msStandard;
    property AboutJVCL: TJVCLAboutInfo read FAboutJVCL write FAboutJVCL stored False;
    property Cursor: TCursor read FCursor write FCursor default crDefault;
    property DisabledImages: TImageList read FDisabledImages write SetDisabledImages;
    property HotImages: TImageList read FHotImages write SetHotImages;
    property Images: TImageList read FImages write SetImages;
    property ImageMargin: TJvImageMargin read FImageMargin write FImageMargin;
    property ImageSize: TJvMenuImageSize read FImageSize write FImageSize;
    property ItemPainter: TJvCustomMenuItemPainter read FItemPainter write SetItemPainter;
    property OwnerDraw stored False;
    property ShowCheckMarks: Boolean read FShowCheckMarks write FShowCheckMarks default False;
    property TextMargin: Integer read FTextMargin write FTextMargin default 0;
    property TextVAlignment: TJvVerticalAlignment read FTextVAlignment write FTextVAlignment default vaMiddle;

    property OnGetImageIndex: TItemImageEvent read FOnGetImageIndex write FOnGetImageIndex;
    property OnGetDisabledImageIndex: TItemImageEvent read FOnGetDisabledImageIndex write FOnGetDisabledImageIndex;
    property OnGetHotImageIndex: TItemImageEvent read FOnGetHotImageIndex write FOnGetHotImageIndex;
    property OnDrawItem: TDrawMenuItemEvent read FOnDrawItem write FOnDrawItem;
    property OnGetItemParams: TItemParamsEvent read FOnGetItemParams write FOnGetItemParams;
    property OnMeasureItem: TMeasureMenuItemEvent read FOnMeasureItem write FOnMeasureItem;
  end;

  { TJvPopupMenu }

  // The Popup counterpart of TJvMainMenu
  // does basically the same thing, but in a popup menu
  TJvPopupMenu = class(TPopupMenu)
  private
    FAboutJVCL: TJVCLAboutInfo;
    FCursor: TCursor;
    FDisabledImages: TImageList;
    FHotImages: TImageList;
    FImageMargin: TJvImageMargin;
    FImages: TImageList;
    FImageSize: TJvMenuImageSize;
    FShowCheckMarks: Boolean;
    FStyle: TJvMenuStyle;
    FTextMargin: Integer;
    FTextVAlignment: TJvVerticalAlignment;

    FOnDrawItem: TDrawMenuItemEvent;
    FOnMeasureItem: TMeasureMenuItemEvent;
    FOnGetItemParams: TItemParamsEvent;

    FImageChangeLink: TChangeLink;
    FOnGetImageIndex: TItemImageEvent;

    FDisabledImageChangeLink: TChangeLink;
    FOnGetDisabledImageIndex: TItemImageEvent;

    FHotImageChangeLink: TChangeLink;
    FOnGetHotImageIndex: TItemImageEvent;

    FPopupPoint: TPoint;
    FParentBiDiMode: Boolean;
    FCanvas: TControlCanvas;

    // This is one is used if Style is not msItemPainter
    FStyleItemPainter: TJvCustomMenuItemPainter;

    // This one is for the ItemPainter property
    FItemPainter: TJvCustomMenuItemPainter;
    function GetCanvas: TCanvas;
    procedure SetItemPainter(const Value: TJvCustomMenuItemPainter);
    function GetActiveItemPainter: TJvCustomMenuItemPainter;
    procedure SetDisabledImages(Value: TImageList);
    procedure SetImages(Value: TImageList);
    procedure SetHotImages(Value: TImageList);
    procedure SetStyle(Value: TJvMenuStyle);
  protected
    procedure ImageListChange(Sender: TObject);
    procedure DisabledImageListChange(Sender: TObject);
    procedure HotImageListChange(Sender: TObject);
    procedure WndMessage(Sender: TObject; var AMsg: TMessage;
      var Handled: Boolean);
    procedure WMDrawItem(var Msg: TWMDrawItem); message WM_DRAWITEM;
    procedure WMMeasureItem(var Msg: TWMMeasureItem); message WM_MEASUREITEM;
    procedure SetBiDiModeFromPopupControl;

    procedure WriteState(Writer: TWriter); override;
    procedure ReadState(Reader: TReader); override;

    procedure Loaded; override;
    function UseRightToLeftAlignment: Boolean;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure GetImageIndex(Item: TMenuItem; State: TMenuOwnerDrawState;
      var ImageIndex: Integer); dynamic;
    procedure DrawItem(Item: TMenuItem; Rect: TRect;
      State: TMenuOwnerDrawState); virtual;
    procedure GetItemParams(Item: TMenuItem; State: TMenuOwnerDrawState;
      AFont: TFont; var Color: TColor; var Graphic: TGraphic;
      var NumGlyphs: Integer); dynamic;
    procedure MeasureItem(Item: TMenuItem; var Width, Height: Integer); dynamic;
    procedure RefreshMenu(AOwnerDraw: Boolean); virtual;
    function IsOwnerDrawMenu: Boolean;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure Assign(Source: TPersistent); override;
    procedure Refresh;
    procedure Popup(X, Y: Integer); override;
    procedure DefaultDrawItem(Item: TMenuItem; Rect: TRect;
      State: TMenuOwnerDrawState);

    property Canvas: TCanvas read GetCanvas;
    // get the currently used painter
    property ActiveItemPainter: TJvCustomMenuItemPainter read GetActiveItemPainter;
  published
    // Style MUST BE before ItemPainter for the properties of the
    // painter to be correctly read from the DFM file.
    property Style: TJvMenuStyle read FStyle write SetStyle default msStandard;
    property AboutJVCL: TJVCLAboutInfo read FAboutJVCL write FAboutJVCL stored False;
    property Cursor: TCursor read FCursor write FCursor default crDefault;
    property DisabledImages: TImageList read FDisabledImages write SetDisabledImages;
    property HotImages: TImageList read FHotImages write SetHotImages;
    property ImageMargin: TJvImageMargin read FImageMargin write FImageMargin;
    property Images: TImageList read FImages write SetImages;
    property ImageSize: TJvMenuImageSize read FImageSize write FImageSize;
    property ItemPainter: TJvCustomMenuItemPainter read FItemPainter write SetItemPainter;
    property OwnerDraw stored False;
    property ShowCheckMarks: Boolean read FShowCheckMarks write FShowCheckMarks default False;
    property TextMargin: Integer read FTextMargin write FTextMargin default 0;
    property TextVAlignment: TJvVerticalAlignment read FTextVAlignment write FTextVAlignment default vaMiddle;

    property OnGetImageIndex: TItemImageEvent read FOnGetImageIndex write FOnGetImageIndex;
    property OnGetDisabledImageIndex: TItemImageEvent read FOnGetDisabledImageIndex write FOnGetDisabledImageIndex;
    property OnGetHotImageIndex: TItemImageEvent read FOnGetHotImageIndex write FOnGetHotImageIndex;
    property OnDrawItem: TDrawMenuItemEvent read FOnDrawItem write FOnDrawItem;
    property OnGetItemParams: TItemParamsEvent read FOnGetItemParams write FOnGetItemParams;