{----------------------------------------------------------------------------- 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 11043 2006-11-26 07:21:48Z marquardt $ 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, JvVCL5Utils; 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; FOnChange: TNotifyEvent; procedure SetHeight(const Value: Integer); procedure SetWidth(const Value: Integer); public procedure Assign(Source: TPersistent); override; procedure DoChange; property OnChange: TNotifyEvent read FOnChange write FOnChange; published property Height: Integer read FHeight write SetHeight; property Width: Integer read FWidth write SetWidth; end; // margins around an image TJvImageMargin = class(TPersistent) private FTop: Integer; FLeft: Integer; FRight: Integer; FBottom: Integer; FOnChange: TNotifyEvent; procedure SetBottom(const Value: Integer); procedure SetLeft(const Value: Integer); procedure SetRight(const Value: Integer); procedure SetTop(const Value: Integer); public procedure Assign(Source: TPersistent); override; procedure DoChange; property OnChange: TNotifyEvent read FOnChange write FOnChange; published property Left: Integer read FLeft write SetLeft; property Top: Integer read FTop write SetTop; property Right: Integer read FRight write SetRight; property Bottom: Integer read FBottom write SetBottom; 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 TCustomImageList. // 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 has 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: TCustomImageList; FHotImages: TCustomImageList; FImageMargin: TJvImageMargin; FImages: TCustomImageList; 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: TCustomImageList); procedure SetImages(Value: TCustomImageList); procedure SetHotImages(Value: TCustomImageList); protected procedure ImageListChange(Sender: TObject); procedure ImageSizeChange(Sender: TObject); procedure ImageMarginChange(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 // has 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); procedure Rebuild(ForceIfLoading: Boolean = False); // 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: TCustomImageList read FDisabledImages write SetDisabledImages; property HotImages: TCustomImageList read FHotImages write SetHotImages; property Images: TCustomImageList 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: TCustomImageList; FHotImages: TCustomImageList; FImageMargin: TJvImageMargin; FImages: TCustomImageList; 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; 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: TCustomImageList); procedure SetImages(Value: TCustomImageList); procedure SetHotImages(Value: TCustomImageList); procedure SetStyle(Value: TJvMenuStyle); protected procedure ImageListChange(Sender: TObject); procedure ImageSizeChange(Sender: TObject); procedure ImageMarginChange(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; {$IFNDEF COMPILER9_UP} procedure SetPopupPoint(const Pt: TPoint); {$ENDIF !COMPILER9_UP} 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); procedure Rebuild(ForceIfLoading: Boolean = False); 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: TCustomImageList read FDisabledImages write SetDisabledImages; property HotImages: TCustomImageList read FHotImages write SetHotImages; property ImageMargin: TJvImageMargin read FImageMargin write FImageMargin; property Images: TCustomImageList 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; 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; FMenuHeight: Integer; FOneItemChecked: Boolean; FItem: TMenuItem; FState: TMenuOwnerDrawState; FImageIndex: Integer; FGlyph: TBitmap; 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 GetDisabledImages: TCustomImageList; function GetDrawHighlight: Boolean; virtual; function GetGrayColor: TColor; virtual; function GetHotImages: TCustomImageList; function GetImageHeight: Integer; virtual; function GetImageWidth: Integer; virtual; function GetImages: TCustomImageList; function GetIsRightToLeft: Boolean; function GetShowCheckMarks: Boolean; function GetTextMargin: Integer; virtual; function GetTextVAlignment: TJvVerticalAlignment; function UseImages: Boolean; function UseHotImages: Boolean; function UseDisabledImages: Boolean; function IsPopup(const Item: TMenuItem): Boolean; // Will force the menu to rebuild itself. procedure ForceMenuRebuild; // 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 DisabledImages: TCustomImageList read GetDisabledImages; property DrawHighlight: Boolean read GetDrawHighlight; property GrayColor: TColor read GetGrayColor; property HotImages: TCustomImageList read GetHotImages; property Images: TCustomImageList read GetImages; property ImageHeight: Integer read GetImageHeight; property ImageMargin: TJvImageMargin read FImageMargin; property ImageSize: TJvMenuImageSize read FImageSize; property ImageWidth: Integer read GetImageWidth; 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; procedure SetSelectionFrameBrush(const Value: TBrush); procedure SetSelectionFramePen(const Value: TPen); 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; procedure DrawBorder(WRect: TRect); procedure DrawItemBorderParts(Item: TMenuItem; Canvas: TCanvas; WRect: TRect); function GetShowingItemsParent(WRect: TRect; StartingItem: TMenuItem): TMenuItem; function GetItemScreenRect(ParentItem: TMenuItem; Index: Integer): TRect; 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 write SetSelectionFrameBrush; property SelectionFramePen: TPen read FSelectionFramePen write SetSelectionFramePen; 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; function StripHotkeyPrefix(const Text: string): string; // MBCS {$IFDEF UNITVERSIONING} const UnitVersioning: TUnitVersionInfo = ( RCSfile: '$URL: https://jvcl.svn.sourceforge.net/svnroot/jvcl/tags/JVCL3_32/run/JvMenus.pas $'; Revision: '$Revision: 11043 $'; Date: '$Date: 2006-11-26 08:21:48 +0100 (dim., 26 nov. 2006) $'; LogPath: 'JVCL\run' ); {$ENDIF UNITVERSIONING} implementation uses CommCtrl, Consts, Math, {$IFDEF HAS_UNIT_TYPES} Types, {$ENDIF HAS_UNIT_TYPES} JclGraphUtils, JvConsts, JvJCLUtils, JvJVCLUtils; const Separator = '-'; // The space between a menu item text and its shortcut ShortcutSpacing = ' '; // Variables usesd by the XP painter to hook into the window procedure // of the window used to render menus var OldMenuWndProcHandle: Integer; currentXPPainter : TJvXPMenuItemPainter; function StripHotkeyPrefix(const Text: string): string; // MBCS var I: Integer; begin if LeadBytes <> [] then begin Result := Text; I := 1; while I <= Length(Result) do begin if Result[I] in LeadBytes then Inc(I) else if Result[I] = cHotkeyPrefix then Delete(Result, I, 1); Inc(I); end; end else Result := StripHotkey(Text); end; 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; procedure MenuWndMessage(Menu: TMenu; var AMsg: TMessage; var Handled: Boolean); var Mesg: TMessage; Item: Pointer; begin with AMsg do case Msg of WM_MEASUREITEM: if (TWMMeasureItem(AMsg).MeasureItemStruct^.CtlType = ODT_MENU) then begin Item := Menu.FindItem(TWMMeasureItem(AMsg).MeasureItemStruct^.itemID, fkCommand); if Item <> nil then begin Mesg := AMsg; TWMMeasureItem(Mesg).MeasureItemStruct^.itemData := Longint(Item); Menu.Dispatch(Mesg); Result := 1; Handled := True; end; end; WM_DRAWITEM: if (TWMDrawItem(AMsg).DrawItemStruct^.CtlType = ODT_MENU) then begin Item := Menu.FindItem(TWMDrawItem(AMsg).DrawItemStruct^.itemID, fkCommand); if Item <> nil then begin Mesg := AMsg; TWMDrawItem(Mesg).DrawItemStruct^.itemData := Longint(Item); Menu.Dispatch(Msg); Result := 1; Handled := True; end; end; WM_MENUSELECT: Menu.Dispatch(AMsg); CM_MENUCHANGED: Menu.Dispatch(AMsg); WM_MENUCHAR: begin Menu.ProcessMenuChar(TWMMenuChar(AMsg)); end; end; end; procedure SetDefaultMenuFont(AFont: TFont); var NCMetrics: TNonCLientMetrics; begin if NewStyleControls then begin NCMetrics.cbSize := SizeOf(TNonCLientMetrics); if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NCMetrics, 0) then begin AFont.Handle := CreateFontIndirect(NCMetrics.lfMenuFont); Exit; end; end; with AFont do begin if NewStyleControls then Name := 'MS Sans Serif' else Name := 'System'; Size := 8; Color := clMenuText; Style := []; end; AFont.Color := clMenuText; end; procedure MenuLine(Canvas: TCanvas; C: TColor; X1, Y1, X2, Y2: Integer); begin with Canvas do begin Pen.Color := C; Pen.Style := psSolid; MoveTo(X1, Y1); LineTo(X2, Y2); end; end; //=== { TJvMenuChangeLink } ================================================== procedure TJvMenuChangeLink.Change(Sender: TJvMainMenu; Source: TMenuItem; Rebuild: Boolean); begin if Assigned(FOnChange) then FOnChange(Sender, Source, Rebuild); end; //=== { TJvMainMenu } ======================================================== constructor TJvMainMenu.Create(AOwner: TComponent); begin inherited Create(AOwner); inherited OwnerDraw := True; RegisterWndProcHook(FindForm, NewWndProc, hoAfterMsg); FStyle := msStandard; FStyleItemPainter := CreateMenuItemPainterFromStyle(FStyle, Self); FChangeLinks := TObjectList.Create(False); FImageMargin := TJvImageMargin.Create; FImageMargin.OnChange := ImageMarginChange; FImageSize := TJvMenuImageSize.Create; FImageSize.OnChange := ImageSizeChange; FImageChangeLink := TChangeLink.Create; FImageChangeLink.OnChange := ImageListChange; FDisabledImageChangeLink := TChangeLink.Create; FDisabledImageChangeLink.OnChange := DisabledImageListChange; FHotImageChangeLink := TChangeLink.Create; FHotImageChangeLink.OnChange := HotImageListChange; // set default values that are not 0 FTextVAlignment := vaMiddle; end; destructor TJvMainMenu.Destroy; begin FImageChangeLink.Free; FHotImageChangeLink.Free; FDisabledImageChangeLink.Free; FStyleItemPainter.Free; FChangeLinks.Free; FImageMargin.Free; FImageSize.Free; UnregisterWndProcHook(FindForm, NewWndProc, hoAfterMsg); inherited Destroy; end; procedure TJvMainMenu.Loaded; begin inherited Loaded; if IsOwnerDrawMenu then RefreshMenu(True); end; function TJvMainMenu.GetCanvas: TCanvas; begin Result := FCanvas; end; function TJvMainMenu.IsOwnerDrawMenu: Boolean; begin Result := True; //(FStyle <> msStandard) or (Assigned(FImages) and (FImages.Count > 0)); end; procedure TJvMainMenu.MenuChanged(Sender: TObject; Source: TMenuItem; Rebuild: Boolean); var I: Integer; begin if csLoading in ComponentState then Exit; for I := 0 to FChangeLinks.Count - 1 do TJvMenuChangeLink(FChangeLinks[I]).Change(Self, Source, Rebuild); inherited MenuChanged(Sender, Source, Rebuild); end; procedure TJvMainMenu.Notification(AComponent: TComponent; Operation: TOperation); begin inherited Notification(AComponent, Operation); if Operation = opRemove then begin if AComponent = FImages then SetImages(nil); if AComponent = FDisabledImages then SetDisabledImages(nil); if AComponent = FHotImages then SetHotImages(nil); if AComponent = FItemPainter then ItemPainter := nil; end; end; procedure TJvMainMenu.ImageListChange(Sender: TObject); begin if Sender = FImages then RefreshMenu(IsOwnerDrawMenu); end; procedure TJvMainMenu.ImageMarginChange(Sender: TObject); begin Rebuild; end; procedure TJvMainMenu.ImageSizeChange(Sender: TObject); begin Rebuild; end; procedure TJvMainMenu.SetImages(Value: TCustomImageList); var OldOwnerDraw: Boolean; begin OldOwnerDraw := IsOwnerDrawMenu; if FImages <> nil then FImages.UnregisterChanges(FImageChangeLink); FImages := Value; if Value <> nil then begin FImages.RegisterChanges(FImageChangeLink); FImages.FreeNotification(Self); end; if IsOwnerDrawMenu <> OldOwnerDraw then RefreshMenu(not OldOwnerDraw); // To be used in a standard (non JV) toolbar and to have the editor show // the images in the ImageIndex property of the menu items inherited Images := Value; end; procedure TJvMainMenu.DisabledImageListChange(Sender: TObject); begin if Sender = FDisabledImages then RefreshMenu(IsOwnerDrawMenu); end; procedure TJvMainMenu.SetDisabledImages(Value: TCustomImageList); var OldOwnerDraw: Boolean; begin OldOwnerDraw := IsOwnerDrawMenu; if FDisabledImages <> nil then FDisabledImages.UnregisterChanges(FDisabledImageChangeLink); FDisabledImages := Value; if Value <> nil then begin FDisabledImages.RegisterChanges(FDisabledImageChangeLink); FDisabledImages.FreeNotification(Self); end; if IsOwnerDrawMenu <> OldOwnerDraw then RefreshMenu(not OldOwnerDraw); end; procedure TJvMainMenu.HotImageListChange(Sender: TObject); begin if Sender = FHotImages then RefreshMenu(IsOwnerDrawMenu); end; procedure TJvMainMenu.SetHotImages(Value: TCustomImageList); var OldOwnerDraw: Boolean; begin OldOwnerDraw := IsOwnerDrawMenu; if FHotImages <> nil then FHotImages.UnregisterChanges(FHotImageChangeLink); FHotImages := Value; if Value <> nil then begin FHotImages.RegisterChanges(FHotImageChangeLink); FHotImages.FreeNotification(Self); end; if IsOwnerDrawMenu <> OldOwnerDraw then RefreshMenu(not OldOwnerDraw); end; procedure TJvMainMenu.SetStyle(Value: TJvMenuStyle); begin if FStyle <> Value then begin // store the new style FStyle := Value; // delete the old painter and create a new internal painter // according to the style, but only if the style is not // msItemPainter if (Style <> msItemPainter) or (ItemPainter = nil) then begin ItemPainter := nil; FStyleItemPainter.Free; FStyleItemPainter := CreateMenuItemPainterFromStyle(Value, Self); end; // refresh RefreshMenu(IsOwnerDrawMenu); end; end; function TJvMainMenu.FindForm: TWinControl; begin Result := FindControl(WindowHandle); if (Result = nil) and (Owner is TWinControl) then Result := TWinControl(Owner); end; procedure TJvMainMenu.Rebuild(ForceIfLoading: Boolean); var DummyItem: TMenuItem; begin if not ForceIfLoading and (csLoading in ComponentState) then Exit; // Ideally, we would like to call RebuildHandle in TMenuItem but this // method is private. As a result, we add and immediately remove a fake // item. This in turn triggers the call to RebuildHandle. DummyItem := TMenuItem.Create(nil); try Items.Add(DummyItem); Items.Remove(DummyItem); finally DummyItem.Free; end; end; procedure TJvMainMenu.Refresh; begin RefreshMenu(IsOwnerDrawMenu); end; procedure TJvMainMenu.RefreshMenu(AOwnerDraw: Boolean); begin Self.OwnerDraw := AOwnerDraw and not (csDesigning in ComponentState); end; procedure TJvMainMenu.DefaultDrawItem(Item: TMenuItem; Rect: TRect; State: TMenuOwnerDrawState); begin if Canvas.Handle <> 0 then begin GetActiveItemPainter.Menu := Self; GetActiveItemPainter.Paint(Item, Rect, State); end; end; procedure TJvMainMenu.DrawItem(Item: TMenuItem; Rect: TRect; State: TMenuOwnerDrawState); begin if Canvas.Handle <> 0 then begin GetActiveItemPainter.Menu := Self; GetActiveItemPainter.Paint(Item, Rect, State); end; end; procedure TJvMainMenu.RegisterChanges(ChangeLink: TJvMenuChangeLink); begin FChangeLinks.Add(ChangeLink); end; procedure TJvMainMenu.UnregisterChanges(ChangeLink: TJvMenuChangeLink); begin FChangeLinks.Remove(ChangeLink); end; procedure TJvMainMenu.MeasureItem(Item: TMenuItem; var Width, Height: Integer); begin if Assigned(FOnMeasureItem) then FOnMeasureItem(Self, Item, Width, Height) end; {procedure TJvMainMenu.WndMessage(Sender: TObject; var AMsg: TMessage; var Handled: Boolean); begin if IsOwnerDrawMenu then MenuWndMessage(Self, AMsg, Handled); end;} function TJvMainMenu.NewWndProc(var Msg: TMessage): Boolean; var Handled: Boolean; begin if IsOwnerDrawMenu then MenuWndMessage(Self, Msg, Handled); // let others listen in too... Result := False; //handled; end; procedure TJvMainMenu.GetItemParams(Item: TMenuItem; State: TMenuOwnerDrawState; AFont: TFont; var Color: TColor; var Graphic: TGraphic; var NumGlyphs: Integer); begin if Assigned(FOnGetItemParams) then FOnGetItemParams(Self, Item, State, AFont, Color, Graphic, NumGlyphs); if (Item <> nil) and (Item.Caption = Separator) then Graphic := nil; end; procedure TJvMainMenu.GetImageIndex(Item: TMenuItem; State: TMenuOwnerDrawState; var ImageIndex: Integer); begin if Assigned(FImages) and (Item <> nil) and (Item.Caption <> Separator) and Assigned(FOnGetImageIndex) then FOnGetImageIndex(Self, Item, State, ImageIndex); end; procedure TJvMainMenu.CMMenuChanged(var Msg: TMessage); begin inherited; end; procedure TJvMainMenu.WMDrawItem(var Msg: TWMDrawItem); var State: TMenuOwnerDrawState; SaveIndex: Integer; Item: TMenuItem; begin with Msg.DrawItemStruct^ do begin State := TMenuOwnerDrawState(WordRec(LongRec(itemState).Lo).Lo); {if (mdDisabled in State) then State := State - [mdSelected];} Item := TMenuItem(Pointer(itemData)); if Assigned(Item) and (FindItem(Item.Command, fkCommand) = Item) then begin FCanvas := TControlCanvas.Create; try SaveIndex := SaveDC(hDC); try Canvas.Handle := hDC; SetDefaultMenuFont(Canvas.Font); Canvas.Font.Color := clMenuText; Canvas.Brush.Color := clMenu; if mdDefault in State then Canvas.Font.Style := Canvas.Font.Style + [fsBold]; if (mdSelected in State) and not (Style in [msBtnLowered, msBtnRaised]) then begin Canvas.Brush.Color := clHighlight; Canvas.Font.Color := clHighlightText; end; with rcItem do IntersectClipRect(Canvas.Handle, Left, Top, Right, Bottom); DrawItem(Item, rcItem, State); Canvas.Handle := 0; finally RestoreDC(hDC, SaveIndex); end; finally Canvas.Free; end; end; end; end; procedure TJvMainMenu.WMMeasureItem(var Msg: TWMMeasureItem); var Item: TMenuItem; SaveIndex: Integer; DC: HDC; begin with Msg.MeasureItemStruct^ do begin Item := FindItem(itemID, fkCommand); if Assigned(Item) then begin DC := GetWindowDC(0); try FCanvas := TControlCanvas.Create; try SaveIndex := SaveDC(DC); try FCanvas.Handle := DC; FCanvas.Font := Screen.MenuFont; if Item.Default then Canvas.Font.Style := Canvas.Font.Style + [fsBold]; GetActiveItemPainter.Menu := Self; GetActiveItemPainter.Measure(Item, Integer(itemWidth), Integer(itemHeight)); //MeasureItem(Item, Integer(itemWidth), Integer(itemHeight)); finally FCanvas.Handle := 0; RestoreDC(DC, SaveIndex); end; finally Canvas.Free; end; finally ReleaseDC(0, DC); end; end; end; end; procedure TJvMainMenu.WMMenuSelect(var Msg: TWMMenuSelect); var MenuItem: TMenuItem; FindKind: TFindItemKind; MenuID: Integer; begin if FCursor <> crDefault then with Msg do begin FindKind := fkCommand; if MenuFlag and MF_POPUP <> 0 then begin FindKind := fkHandle; MenuID := GetSubMenu(Menu, IDItem); end else MenuID := IDItem; MenuItem := TMenuItem(FindItem(MenuID, FindKind)); if (MenuItem <> nil) and (IsItemPopup(MenuItem) or (MenuItem.Count = 0)) and (MenuFlag and MF_HILITE <> 0) then SetCursor(Screen.Cursors[FCursor]) else SetCursor(Screen.Cursors[crDefault]); end; end; procedure TJvMainMenu.SetItemPainter(const Value: TJvCustomMenuItemPainter); begin if Value <> FItemPainter then begin // Remove menu from current item painter if FItemPainter <> nil then FItemPainter.Menu := nil; // set value and if not nil, setup the painter correctly FItemPainter := Value; if FItemPainter <> nil then begin Style := msItemPainter; FItemPainter.FreeNotification(Self); FItemPainter.Menu := Self; end else Style := msStandard; Refresh; end; end; function TJvMainMenu.GetActiveItemPainter: TJvCustomMenuItemPainter; begin if (Style = msItemPainter) and (ItemPainter <> nil) then Result := ItemPainter else Result := FStyleItemPainter; end; //=== { TJvPopupList } ======================================================= type TJvPopupList = class(TList) private procedure WndProc(var Message: TMessage); public Window: HWND; procedure Add(Popup: TPopupMenu); procedure Remove(Popup: TPopupMenu); end; var PopupList: TJvPopupList = nil; procedure TJvPopupList.WndProc(var Message: TMessage); var I: Integer; MenuItem: TMenuItem; FindKind: TFindItemKind; ContextID: Integer; Handled: Boolean; begin try case Message.Msg of WM_MEASUREITEM, WM_DRAWITEM: for I := 0 to Count - 1 do begin Handled := False; TJvPopupMenu(Items[I]).WndMessage(nil, Message, Handled); if Handled then Exit; end; WM_COMMAND: for I := 0 to Count - 1 do if TJvPopupMenu(Items[I]).DispatchCommand(Message.WParam) then Exit; WM_INITMENUPOPUP: for I := 0 to Count - 1 do with TWMInitMenuPopup(Message) do if TJvPopupMenu(Items[I]).DispatchPopup(MenuPopup) then Exit; WM_MENUSELECT: with TWMMenuSelect(Message) do begin FindKind := fkCommand; if MenuFlag and MF_POPUP <> 0 then begin FindKind := fkHandle; ContextID := GetSubMenu(Menu, IDItem); end else ContextID := IDItem; for I := 0 to Count - 1 do begin MenuItem := TJvPopupMenu(Items[I]).FindItem(ContextID, FindKind); if MenuItem <> nil then begin Application.Hint := MenuItem.Hint; with TJvPopupMenu(Items[I]) do if FCursor <> crDefault then if (MenuFlag and MF_HILITE <> 0) then SetCursor(Screen.Cursors[FCursor]) else SetCursor(Screen.Cursors[crDefault]); Exit; end; end; Application.Hint := ''; end; WM_MENUCHAR: for I := 0 to Count - 1 do with TJvPopupMenu(Items[I]) do if (Handle = HMenu(Message.LParam)) or (FindItem(Message.LParam, fkHandle) <> nil) then begin ProcessMenuChar(TWMMenuChar(Message)); Exit; end; WM_HELP: with PHelpInfo(Message.LParam)^ do begin for I := 0 to Count - 1 do if TJvPopupMenu(Items[I]).Handle = hItemHandle then begin ContextID := TMenu(Items[I]).GetHelpContext(iCtrlID, True); if ContextID = 0 then ContextID := TMenu(Items[I]).GetHelpContext(hItemHandle, False); if Screen.ActiveForm = nil then Exit; if (biHelp in Screen.ActiveForm.BorderIcons) then Application.HelpCommand(HELP_CONTEXTPOPUP, ContextID) else Application.HelpContext(ContextID); Exit; end; end; end; with Message do Result := DefWindowProc(Window, Msg, WParam, LParam); except Application.HandleException(Self); end; end; procedure TJvPopupList.Add(Popup: TPopupMenu); begin if Count = 0 then Window := AllocateHWnd(WndProc); inherited Add(Popup); end; procedure TJvPopupList.Remove(Popup: TPopupMenu); begin inherited Remove(Popup); if Count = 0 then DeallocateHWnd(Window); end; //=== { TJvPopupMenu } ======================================================= constructor TJvPopupMenu.Create(AOwner: TComponent); begin inherited Create(AOwner); if PopupList = nil then PopupList := TJvPopupList.Create; FStyle := msStandard; FStyleItemPainter := CreateMenuItemPainterFromStyle(FStyle, Self); FCursor := crDefault; FImageMargin := TJvImageMargin.Create; FImageMargin.OnChange := ImageMarginChange; FImageSize := TJvMenuImageSize.Create; FImageSize.OnChange := ImageSizeChange; PopupList.Add(Self); FImageChangeLink := TChangeLink.Create; FImageChangeLink.OnChange := ImageListChange; FDisabledImageChangeLink := TChangeLink.Create; FDisabledImageChangeLink.OnChange := DisabledImageListChange; FHotImageChangeLink := TChangeLink.Create; FHotImageChangeLink.OnChange := HotImageListChange; SetPopupPoint(Point(-1, -1)); // Set default values that are not 0 FTextVAlignment := vaMiddle; end; destructor TJvPopupMenu.Destroy; begin FImageChangeLink.Free; FDisabledImageChangeLink.Free; FHotImageChangeLink.Free; FImageMargin.Free; FImageSize.Free; FStyleItemPainter.Free; // This test is only False if finalization is called before destroy. // An example of this happening is when using TJvAppInstances if Assigned(PopupList) then PopupList.Remove(Self); inherited Destroy; end; procedure TJvPopupMenu.Loaded; begin inherited Loaded; if IsOwnerDrawMenu then RefreshMenu(True); end; function TJvPopupMenu.GetCanvas: TCanvas; begin Result := FCanvas; end; procedure TJvPopupMenu.Notification(AComponent: TComponent; Operation: TOperation); begin inherited Notification(AComponent, Operation); if Operation = opRemove then begin if AComponent = FImages then SetImages(nil); if AComponent = FDisabledImages then SetDisabledImages(nil); if AComponent = FHotImages then SetHotImages(nil); if AComponent = FItemPainter then ItemPainter := nil; end; end; procedure TJvPopupMenu.ImageListChange(Sender: TObject); begin if Sender = FImages then RefreshMenu(IsOwnerDrawMenu); end; procedure TJvPopupMenu.ImageMarginChange(Sender: TObject); begin Rebuild; end; procedure TJvPopupMenu.ImageSizeChange(Sender: TObject); begin Rebuild; end; procedure TJvPopupMenu.SetImages(Value: TCustomImageList); var OldOwnerDraw: Boolean; begin OldOwnerDraw := IsOwnerDrawMenu; if FImages <> nil then FImages.UnregisterChanges(FImageChangeLink); FImages := Value; if Value <> nil then begin FImages.RegisterChanges(FImageChangeLink); FImages.FreeNotification(Self); end; if IsOwnerDrawMenu <> OldOwnerDraw then RefreshMenu(not OldOwnerDraw); // To have the editor show the images in the ImageIndex property of // the menu items inherited Images := Value; end; procedure TJvPopupMenu.DisabledImageListChange(Sender: TObject); begin if Sender = FDisabledImages then RefreshMenu(IsOwnerDrawMenu); end; procedure TJvPopupMenu.SetDisabledImages(Value: TCustomImageList); var OldOwnerDraw: Boolean; begin OldOwnerDraw := IsOwnerDrawMenu; if FDisabledImages <> nil then FDisabledImages.UnregisterChanges(FDisabledImageChangeLink); FDisabledImages := Value; if Value <> nil then begin FDisabledImages.RegisterChanges(FDisabledImageChangeLink); FDisabledImages.FreeNotification(Self); end; if IsOwnerDrawMenu <> OldOwnerDraw then RefreshMenu(not OldOwnerDraw); end; procedure TJvPopupMenu.HotImageListChange(Sender: TObject); begin if Sender = FHotImages then RefreshMenu(IsOwnerDrawMenu); end; procedure TJvPopupMenu.SetHotImages(Value: TCustomImageList); var OldOwnerDraw: Boolean; begin OldOwnerDraw := IsOwnerDrawMenu; if FHotImages <> nil then FImages.UnregisterChanges(FHotImageChangeLink); FHotImages := Value; if Value <> nil then begin FHotImages.RegisterChanges(FHotImageChangeLink); FHotImages.FreeNotification(Self); end; if IsOwnerDrawMenu <> OldOwnerDraw then RefreshMenu(not OldOwnerDraw); end; function FindPopupControl(const Pos: TPoint): TControl; var Window: TWinControl; begin Result := nil; Window := FindVCLWindow(Pos); if Window <> nil then begin Result := Window.ControlAtPos(Pos, False); if Result = nil then Result := Window; end; end; {$IFNDEF COMPILER9_UP} type TPopupMenuPrivate = class(TMenu) public FPopupPoint: TPoint; end; procedure TJvPopupMenu.SetPopupPoint(const Pt: TPoint); begin TPopupMenuPrivate(Self).FPopupPoint := Pt; end; {$ENDIF !COMPILER9_UP} procedure TJvPopupMenu.SetBiDiModeFromPopupControl; var AControl: TControl; begin if not SysLocale.MiddleEast then Exit; if FParentBiDiMode then begin AControl := FindPopupControl(PopupPoint); if AControl <> nil then BiDiMode := AControl.BiDiMode else BiDiMode := Application.BiDiMode; end; end; function TJvPopupMenu.UseRightToLeftAlignment: Boolean; var AControl: TControl; begin Result := False; if not SysLocale.MiddleEast then Exit; if FParentBiDiMode then begin AControl := FindPopupControl(PopupPoint); if AControl <> nil then Result := AControl.UseRightToLeftAlignment else Result := Application.UseRightToLeftAlignment; end else Result := (BiDiMode <> bdLeftToRight); end; procedure TJvPopupMenu.Popup(X, Y: Integer); const Flags: array[Boolean, TPopupAlignment] of Word = ((TPM_LEFTALIGN, TPM_RIGHTALIGN, TPM_CENTERALIGN), (TPM_RIGHTALIGN, TPM_LEFTALIGN, TPM_CENTERALIGN)); Buttons: array[TTrackButton] of Word = (TPM_RIGHTBUTTON, TPM_LEFTBUTTON); begin SetPopupPoint(Point(X, Y)); FParentBiDiMode := ParentBiDiMode; try SetBiDiModeFromPopupControl; DoPopup(Self); if IsOwnerDrawMenu then RefreshMenu(True); // Those three lines are as close as we can get to the orignal source // code in the VCL. Note that for the "Items.Handle" line, it seems // it does nothing as it does not store the property value, but there is // a getter on that property and will eventually make a series of calls // that are close enough to RebuildHandle. // This is required to fix Mantis 3029, this bug having appeared following // the change of value of SysLocal.MiddleEast which is always True when // a program compiled in D2005 or upper is run on Windows XP or upper. Items.RethinkHotkeys; Items.RethinkLines; Items.Handle; AdjustBiDiBehavior; TrackPopupMenu(Items.Handle, Flags[UseRightToLeftAlignment, Alignment] or Buttons[TrackButton], X, Y, 0 { reserved }, PopupList.Window, nil); finally ParentBiDiMode := FParentBiDiMode; end; end; procedure TJvPopupMenu.Refresh; begin RefreshMenu(IsOwnerDrawMenu); end; function TJvPopupMenu.IsOwnerDrawMenu: Boolean; begin Result := (FStyle <> msStandard) or (Assigned(FImages) and (FImages.Count > 0)); end; procedure TJvPopupMenu.RefreshMenu(AOwnerDraw: Boolean); begin Self.OwnerDraw := AOwnerDraw and not (csDesigning in ComponentState); end; procedure TJvPopupMenu.SetStyle(Value: TJvMenuStyle); begin if FStyle <> Value then begin FStyle := Value; // delete the old painter and create a new internal painter // according to the style, but only if the style is not // msItemPainter if Style <> msItemPainter then begin ItemPainter := nil; FStyleItemPainter.Free; FStyleItemPainter := CreateMenuItemPainterFromStyle(Value, Self); end; RefreshMenu(IsOwnerDrawMenu); end; end; procedure TJvPopupMenu.DefaultDrawItem(Item: TMenuItem; Rect: TRect; State: TMenuOwnerDrawState); begin if Canvas.Handle <> 0 then begin GetActiveItemPainter.Menu := Self; GetActiveItemPainter.Paint(Item, Rect, State); end; end; procedure TJvPopupMenu.DrawItem(Item: TMenuItem; Rect: TRect; State: TMenuOwnerDrawState); begin if Canvas.Handle <> 0 then begin GetActiveItemPainter.Menu := Self; GetActiveItemPainter.Paint(Item, Rect, State); end; end; procedure TJvPopupMenu.MeasureItem(Item: TMenuItem; var Width, Height: Integer); begin if Assigned(FOnMeasureItem) then FOnMeasureItem(Self, Item, Width, Height) end; procedure TJvPopupMenu.WndMessage(Sender: TObject; var AMsg: TMessage; var Handled: Boolean); begin if IsOwnerDrawMenu then MenuWndMessage(Self, AMsg, Handled); end; procedure TJvPopupMenu.GetItemParams(Item: TMenuItem; State: TMenuOwnerDrawState; AFont: TFont; var Color: TColor; var Graphic: TGraphic; var NumGlyphs: Integer); begin if Assigned(FOnGetItemParams) then FOnGetItemParams(Self, Item, State, AFont, Color, Graphic, NumGlyphs); if (Item <> nil) and (Item.Caption = Separator) then Graphic := nil; end; procedure TJvPopupMenu.GetImageIndex(Item: TMenuItem; State: TMenuOwnerDrawState; var ImageIndex: Integer); begin if Assigned(FImages) and (Item <> nil) and (Item.Caption <> Separator) and Assigned(FOnGetImageIndex) then FOnGetImageIndex(Self, Item, State, ImageIndex); end; procedure TJvPopupMenu.WMDrawItem(var Msg: TWMDrawItem); var State: TMenuOwnerDrawState; SaveIndex: Integer; Item: TMenuItem; // MarginRect: TRect; begin with Msg.DrawItemStruct^ do begin State := TMenuOwnerDrawState(WordRec(LongRec(itemState).Lo).Lo); Item := TMenuItem(Pointer(itemData)); if Assigned(Item) and (FindItem(Item.Command, fkCommand) = Item) then begin FCanvas := TControlCanvas.Create; try SaveIndex := SaveDC(hDC); try Canvas.Handle := hDC; SetDefaultMenuFont(Canvas.Font); Canvas.Font.Color := clMenuText; Canvas.Brush.Color := clMenu; if mdDefault in State then Canvas.Font.Style := Canvas.Font.Style + [fsBold]; if (mdSelected in State) and not (Style in [msBtnLowered, msBtnRaised]) then begin Canvas.Brush.Color := clHighlight; Canvas.Font.Color := clHighlightText; end; with rcItem do IntersectClipRect(Canvas.Handle, Left, Top, Right, Bottom); DrawItem(Item, rcItem, State); Canvas.Handle := 0; finally RestoreDC(hDC, SaveIndex); end; finally Canvas.Free; end; end; end; end; procedure TJvPopupMenu.WMMeasureItem(var Msg: TWMMeasureItem); var Item: TMenuItem; SaveIndex: Integer; DC: HDC; begin with Msg.MeasureItemStruct^ do begin Item := FindItem(itemID, fkCommand); if Assigned(Item) then begin DC := GetWindowDC(0); try FCanvas := TControlCanvas.Create; try SaveIndex := SaveDC(DC); try FCanvas.Handle := DC; FCanvas.Font := Screen.MenuFont; if Item.Default then Canvas.Font.Style := Canvas.Font.Style + [fsBold]; GetActiveItemPainter.Menu := Self; GetActiveItemPainter.Measure(Item, Integer(itemWidth), Integer(itemHeight)); //MeasureItem(Item, Integer(itemWidth), Integer(itemHeight)); finally FCanvas.Handle := 0; RestoreDC(DC, SaveIndex); end; finally Canvas.Free; end; finally ReleaseDC(0, DC); end; end; end; end; procedure TJvPopupMenu.Assign(Source: TPersistent); begin if Source is TJvPopupMenu then begin AutoHotkeys := TJvPopupMenu(Source).AutoHotkeys; AutoLineReduction := TJvPopupMenu(Source).AutoLineReduction; BiDiMode := TJvPopupMenu(Source).BiDiMode; Cursor := TJvPopupMenu(Source).Cursor; DisabledImages := TJvPopupMenu(Source).DisabledImages; HotImages := TJvPopupMenu(Source).HotImages; ImageMargin.Assign(TJvPopupMenu(Source).ImageMargin); Images := TJvPopupMenu(Source).Images; ImageSize.Assign(TJvPopupMenu(Source).ImageSize); ParentBiDiMode := TJvPopupMenu(Source).ParentBiDiMode; ShowCheckMarks := TJvPopupMenu(Source).ShowCheckMarks; Style := TJvPopupMenu(Source).Style; Tag := TJvPopupMenu(Source).Tag; TextMargin := TJvPopupMenu(Source).TextMargin; TextVAlignment := TJvPopupMenu(Source).TextVAlignment; end else if Source is TJvMainMenu then begin AutoHotkeys := TJvMainMenu(Source).AutoHotkeys; AutoLineReduction := TJvMainMenu(Source).AutoLineReduction; BiDiMode := TJvMainMenu(Source).BiDiMode; Cursor := TJvMainMenu(Source).Cursor; DisabledImages := TJvMainMenu(Source).DisabledImages; HotImages := TJvMainMenu(Source).HotImages; ImageMargin.Assign(TJvMainMenu(Source).ImageMargin); Images := TJvMainMenu(Source).Images; ImageSize.Assign(TJvMainMenu(Source).ImageSize); ParentBiDiMode := TJvMainMenu(Source).ParentBiDiMode; ShowCheckMarks := TJvMainMenu(Source).ShowCheckMarks; Style := TJvMainMenu(Source).Style; Tag := TJvMainMenu(Source).Tag; TextMargin := TJvMainMenu(Source).TextMargin; TextVAlignment := TJvMainMenu(Source).TextVAlignment; end else inherited Assign(Source); end; procedure TJvPopupMenu.ReadState(Reader: TReader); begin // Reader.ReadComponent(FJvMenuItemPainter); inherited ReadState(Reader); end; procedure TJvPopupMenu.Rebuild(ForceIfLoading: Boolean); var DummyItem: TMenuItem; begin if not ForceIfLoading and (csLoading in ComponentState) then Exit; // Ideally, we would like to call RebuildHandle in TMenuItem but this // method is private. As a result, we add and immediately remove a fake // item. This in turn triggers the call to RebuildHandle. DummyItem := TMenuItem.Create(nil); try Items.Add(DummyItem); Items.Remove(DummyItem); finally DummyItem.Free; end; end; procedure TJvPopupMenu.WriteState(Writer: TWriter); begin inherited WriteState(Writer); // Writer.WriteComponent(FJvMenuItemPainter); end; procedure TJvPopupMenu.SetItemPainter(const Value: TJvCustomMenuItemPainter); begin if Value <> FItemPainter then begin // Remove menu from current item painter if FItemPainter <> nil then FItemPainter.Menu := nil; // set value and if not nil, setup the painter correctly FItemPainter := Value; if FItemPainter <> nil then begin Style := msItemPainter; FItemPainter.FreeNotification(Self); FItemPainter.Menu := Self; end; Refresh; end; end; function TJvPopupMenu.GetActiveItemPainter: TJvCustomMenuItemPainter; begin if (Style = msItemPainter) and (ItemPainter <> nil) then Result := ItemPainter else Result := FStyleItemPainter; end; //=== { TJvCustomMenuItemPainter } =========================================== constructor TJvCustomMenuItemPainter.Create(AOwner: TComponent); begin inherited Create(AOwner); // affect default values that are not 0 FImageBackgroundColor := DefaultImageBackgroundColor; FImageMargin := TJvImageMargin.Create; FImageSize := TJvMenuImageSize.Create; FGlyph := TBitmap.Create; end; destructor TJvCustomMenuItemPainter.Destroy; begin FGlyph.Free; FImageSize.Free; FImageMargin.Free; inherited Destroy; end; procedure TJvCustomMenuItemPainter.DrawDisabledBitmap(X, Y: Integer; Bitmap: TBitmap); var Bmp: TBitmap; GrayColor, SaveColor: TColor; IsHighlight: Boolean; begin if (mdSelected in FState) then GrayColor := clGrayText else GrayColor := clBtnShadow; IsHighlight := NewStyleControls and ((not (mdSelected in FState)) or (GetNearestColor(Canvas.Handle, ColorToRGB(clGrayText)) = GetNearestColor(Canvas.Handle, ColorToRGB(clHighlight)))); if Bitmap.Monochrome then begin SaveColor := Canvas.Brush.Color; try if IsHighlight then begin Canvas.Brush.Color := clBtnHighlight; SetTextColor(Canvas.Handle, clWhite); SetBkColor(Canvas.Handle, clBlack); BitBlt(Canvas.Handle, X + 1, Y + 1, Bitmap.Width, Bitmap.Height, Bitmap.Canvas.Handle, 0, 0, ROP_DSPDxax); end; Canvas.Brush.Color := GrayColor; SetTextColor(Canvas.Handle, clWhite); SetBkColor(Canvas.Handle, clBlack); BitBlt(Canvas.Handle, X, Y, Bitmap.Width, Bitmap.Height, Bitmap.Canvas.Handle, 0, 0, ROP_DSPDxax); finally Canvas.Brush.Color := SaveColor; end; end else begin Bmp := CreateDisabledBitmapEx(Bitmap, clBlack, clMenu, clBtnHighlight, GrayColor, IsHighlight); try DrawBitmapTransparent(Canvas, X, Y, Bmp, clMenu); finally Bmp.Free; end; end; end; procedure TJvCustomMenuItemPainter.DrawMenuBitmap(X, Y: Integer; Bitmap: TBitmap); begin if mdDisabled in FState then DrawDisabledBitmap(X, Y, Bitmap) else begin if Bitmap.Monochrome and (not FItem.Checked or ShowCheckMarks) then BitBlt(Canvas.Handle, X, Y, Bitmap.Width, Bitmap.Height, Bitmap.Canvas.Handle, 0, 0, SRCCOPY) else DrawBitmapTransparent(Canvas, X, Y, Bitmap, Bitmap.TransparentColor and not PaletteMask); end; end; procedure TJvCustomMenuItemPainter.DrawCheckImage(ARect: TRect); var Bmp: TBitmap; begin Bmp := TBitmap.Create; try with Bmp do begin Width := GetSystemMetrics(SM_CXMENUCHECK); Height := GetSystemMetrics(SM_CYMENUCHECK); end; if FItem.RadioItem then with Bmp do begin DrawFrameControl(Canvas.Handle, Bounds(0, 0, Width, Height), DFC_MENU, DFCS_MENUBULLET); Monochrome := True; Inc(ARect.Top); // the bullet must be shifted one pixel towards the bottom end else with Bmp do begin DrawFrameControl(Canvas.Handle, Bounds(0, 0, Width, Height), DFC_MENU, DFCS_MENUCHECK); Monochrome := True; end; case TextVAlignment of vaMiddle: Inc(ARect.Top, ((ARect.Bottom - ARect.Top + 1) - Bmp.Height) div 2); vaBottom: ARect.Top := ARect.Bottom - Bmp.Height; end; // draw the check mark bitmap, always centered horizontally DrawMenuBitmap(ARect.Left + (ARect.Right - ARect.Left + 1 - Bmp.Width) div 2, ARect.Top, Bmp); finally Bmp.Free; end; end; procedure TJvCustomMenuItemPainter.DrawGlyphCheck(ARect: TRect); var SaveColor: TColor; Bmp: TBitmap; begin InflateRect(ARect, -1, -1); SaveColor := Canvas.Brush.Color; try if not (mdSelected in FState) then Bmp := AllocPatternBitmap(clMenu, clBtnHighlight) else Bmp := nil; try if Bmp <> nil then Canvas.Brush.Bitmap := Bmp else Canvas.Brush.Color := clMenu; Canvas.FillRect(ARect); finally Canvas.Brush.Bitmap := nil; end; finally Canvas.Brush.Color := SaveColor; end; Frame3D(Canvas, ARect, GrayColor, clBtnHighlight, 1); end; function TJvCustomMenuItemPainter.GetDisabledImages: TCustomImageList; begin if Assigned(FMainMenu) then Result := FMainMenu.DisabledImages else if Assigned(FPopupMenu) then Result := FPopupMenu.DisabledImages else Result := nil; end; function TJvCustomMenuItemPainter.GetHotImages: TCustomImageList; begin if Assigned(FMainMenu) then Result := FMainMenu.HotImages else if Assigned(FPopupMenu) then Result := FPopupMenu.HotImages else Result := nil; end; function TJvCustomMenuItemPainter.GetImages: TCustomImageList; var Item: TMenuItem; begin Item := FItem.Parent; while Assigned(Item) and not Assigned(Item.SubMenuImages) do Item := Item.Parent; if Assigned(Item) and Assigned(Item.SubMenuImages) then Result := TCustomImageList(Item.SubMenuImages) else if Assigned(FMainMenu) then Result := FMainMenu.Images else if Assigned(FPopupMenu) then Result := FPopupMenu.Images else Result := nil; end; function TJvCustomMenuItemPainter.GetShowCheckMarks: Boolean; begin if Assigned(FMainMenu) then Result := FMainMenu.ShowCheckMarks else if Assigned(FPopupMenu) then Result := FPopupMenu.ShowCheckMarks else Result := False; end; function TJvCustomMenuItemPainter.UseImages: Boolean; begin Result := Assigned(Images) and (FImageIndex >= 0) and (FImageIndex < Images.Count) and Images.HandleAllocated; end; function TJvCustomMenuItemPainter.UseHotImages: Boolean; begin Result := Assigned(HotImages) and (FImageIndex >= 0) and (FImageIndex < HotImages.Count) and HotImages.HandleAllocated; end; function TJvCustomMenuItemPainter.UseDisabledImages: Boolean; begin Result := Assigned(DisabledImages) and (FImageIndex >= 0) and (FImageIndex < DisabledImages.Count) and DisabledImages.HandleAllocated; end; procedure TJvCustomMenuItemPainter.DrawItemText(ARect: TRect; const Text: string; Flags: Longint); begin if Length(Text) = 0 then Exit; if (FParentMenu <> nil) and (FParentMenu.IsRightToLeft) then begin if Flags and DT_LEFT = DT_LEFT then Flags := Flags and (not DT_LEFT) or DT_RIGHT else if Flags and DT_RIGHT = DT_RIGHT then Flags := Flags and (not DT_RIGHT) or DT_LEFT; Flags := Flags or DT_RTLREADING; end; case TextVAlignment of vaMiddle: Inc(ARect.Top, ((ARect.Bottom - ARect.Top + 1) - Canvas.TextHeight(StripHotkeyPrefix(Text))) div 2); vaBottom: ARect.Top := ARect.Bottom - Canvas.TextHeight(StripHotkeyPrefix(Text)); end; // if a top level menu item then draw text centered horizontally if not IsPopup(FItem) then ARect.Left := ARect.Left + ((ARect.Right - ARect.Left) - Canvas.TextWidth(StripHotkeyPrefix(Text))) div 2; if mdDisabled in FState then begin if DrawHighlight then begin Canvas.Font.Color := clBtnHighlight; OffsetRect(ARect, 1, 1); Windows.DrawText(Canvas.Handle, PChar(Text), Length(Text), ARect, Flags); OffsetRect(ARect, -1, -1); end; Canvas.Font.Color := GrayColor; end; Windows.DrawText(Canvas.Handle, PChar(Text), Length(Text), ARect, Flags) end; procedure TJvCustomMenuItemPainter.PreparePaint(Item: TMenuItem; ItemRect: TRect; State: TMenuOwnerDrawState; Measure: Boolean); var BackColor: TColor; Graphic: TGraphic; Bmp: TBitmap; begin UpdateFieldsFromMenu; FItem := Item; FState := State; FImageIndex := FItem.ImageIndex; FGlyph.Assign(Item.Bitmap); BackColor := Canvas.Brush.Color; FNumGlyphs := 1; Graphic := nil; if Assigned(FMainMenu) then FMainMenu.GetItemParams(FItem, FState, Canvas.Font, BackColor, Graphic, FNumGlyphs) else if Assigned(FPopupMenu) then FPopupMenu.GetItemParams(FItem, FState, Canvas.Font, BackColor, Graphic, FNumGlyphs); if Assigned(Graphic) then FGlyph.Assign(Graphic); // Force glyph to fit inside its allocated space, if it's not empty and it // does not fit into the glyph allocated space if not FGlyph.Empty and ((ImageWidth <> FGlyph.Width) or (ImageHeight <> FGlyph.Height)) then begin Bmp := TBitmap.Create; try Bmp.Width := ImageWidth; Bmp.Height := ImageHeight; Bmp.Canvas.StretchDraw(Rect(0, 0, Bmp.Width, Bmp.Height), FGlyph); FGlyph.Width := Bmp.Width; FGlyph.Height := Bmp.Height; FGlyph.Canvas.Draw(0, 0, Bmp); finally Bmp.Free; end; end; if not Measure then begin if (BackColor <> clNone) then begin Canvas.Brush.Color := BackColor; Canvas.FillRect(ItemRect); end; end; if Assigned(FMainMenu) then FMainMenu.GetImageIndex(FItem, FState, FImageIndex) else if Assigned(FPopupMenu) then FPopupMenu.GetImageIndex(FItem, FState, FImageIndex); end; procedure TJvCustomMenuItemPainter.Paint(Item: TMenuItem; ItemRect: TRect; State: TMenuOwnerDrawState); var MaxWidth, I: Integer; Bmp: TBitmap; // the rect that will contain the size of the menu item caption CaptionRect: TRect; // The rect in which to draw the check mark for the item CheckMarkRect: TRect; // The rect in which to draw the image, with or without the image margins ImageRect: TRect; ImageAndMarginRect: TRect; // The rect in which to draw the text, with or without the margins TextRect: TRect; TextAndMarginRect: TRect; // The rect where the Left margin has to be drawn (its height is the height of the entire menu, not just the item) LeftMarginRect: TRect; // The item rect, whithout the left margin ItemRectNoLeftMargin: TRect; TmpWidth, TmpHeight : Integer; begin // We must do this to prevent the code in Menus.pas from drawing // the item before us, thus trigerring rendering glitches, especially // when a top menuitem that has an image index not equal to -1 Item.OnDrawItem := EmptyDrawItem; // calculate areas for the different parts of the item to be drawn if IsPopup(Item) then begin // As the margin is to be drawn for the entire height of the menu, // we need to retrieve its height. // There are multiple ways to do this: // 1. Get the canvas' associated window and take its size. // This does not work well under XP with shade/slide effects on as the // call to WindowFromDC often returns 0 (Mantis 3197). // 2. Measure every item in the menu. // This is very "tedious" and as such is only done when drawing the first // element. Note that this does not mean only once as the first element // will be redrawn as soon as its status changes. // // Solution 2 is then used as it offers the biggest reliability to retrieve // the menus total height and also allows to store if there is at least one // item with a checkmark shown. if {(LeftMargin > 0) and }Assigned(Item.Parent) and (Item = Item.Parent.Items[0]) then begin FMenuHeight := 0; FOneItemChecked := False; for I := 0 to Item.Parent.Count-1 do begin Measure(Item.Parent.Items[i], TmpWidth, TmpHeight); Inc(FMenuHeight, tmpHeight); FOneItemChecked := FOneItemChecked or Item.Parent.Items[I].Checked; end; end; // Prepare the painting only now so as to not trigger Mantis 3636. // This is required because Measure will call PreparePaint which will // set values such as FItem, FState and FImageIndex. // Note that we cannot modify prepare paint to NOT set those values // when measuring because many of the "width" related functions do need // a valid FItem member. PreparePaint(Item, ItemRect, State, False); // different values depending on the reading convention if IsRightToLeft then begin CheckMarkRect := Rect(ItemRect.Right - CheckMarkWidth + 1, ItemRect.Top, ItemRect.Right, ItemRect.Bottom); ImageAndMarginRect := Rect(CheckMarkRect.Left - 1 - ImageMargin.Left - ImageWidth - ImageMargin.Right, ItemRect.Top, CheckMarkRect.Left - 1, ItemRect.Bottom); TextAndMarginRect := Rect(ItemRect.Left, ItemRect.Top, ImageAndMarginRect.Left - 1, ItemRect.Bottom); ItemRectNoLeftMargin := Rect(ItemRect.Left, ItemRect.Top, Cardinal(ItemRect.Right)-LeftMargin, ItemRect.Bottom); OffsetRect(CheckMarkRect, -LeftMargin, 0); OffsetRect(ImageAndMarginRect, -LeftMargin, 0); OffsetRect(TextAndMarginRect, -LeftMargin, 0); LeftMarginRect := Rect(ItemRect.Right, 0, Cardinal(ItemRect.Right) - LeftMargin, FMenuHeight); end else begin CheckMarkRect := Rect(ItemRect.Left, ItemRect.Top, ItemRect.Left + CheckMarkWidth - 1, ItemRect.Bottom); ImageAndMarginRect := Rect(CheckMarkRect.Right + 1, ItemRect.Top, CheckMarkRect.Right + 1 + ImageMargin.Left + ImageWidth + ImageMargin.Right - 1, ItemRect.Bottom); TextAndMarginRect := Rect(ImageAndMarginRect.Right + 1, ItemRect.Top, ItemRect.Right, ItemRect.Bottom); ItemRectNoLeftMargin := Rect(Cardinal(ItemRect.Left)+LeftMargin, ItemRect.Top, ItemRect.Right, ItemRect.Bottom); OffsetRect(CheckMarkRect, LeftMargin, 0); OffsetRect(ImageAndMarginRect, LeftMargin, 0); OffsetRect(TextAndMarginRect, LeftMargin, 0); LeftMarginRect := Rect(ItemRect.Left, 0, Cardinal(ItemRect.Left) + LeftMargin, FMenuHeight); end; ImageRect := Rect(ImageAndMarginRect.Left + ImageMargin.Left, ImageAndMarginRect.Top + ImageMargin.Top, ImageAndMarginRect.Right - ImageMargin.Right, ImageAndMarginRect.Bottom - ImageMargin.Bottom); TextRect := Rect(TextAndMarginRect.Left + TextMargin, TextAndMarginRect.Top, TextAndMarginRect.Right, TextAndMarginRect.Bottom); end else begin // prepare the painting (see above) PreparePaint(Item, ItemRect, State, False); TextAndMarginRect := ItemRect; ItemRectNoLeftMargin := ItemRect; TextRect := ItemRect; end; // first, draw the background of the entire item DrawItemBackground(ItemRect); // draw the margin, if any. Do it all the time to go against erasing // created by the operating system itself. if (LeftMargin > 0) then DrawLeftMargin(LeftMarginRect); // draw the background of each separate part if IsPopup(Item) then begin if ShowCheckMarks then DrawCheckMarkBackground(CheckMarkRect); DrawImageBackground(ImageAndMarginRect); end; DrawTextBackground(TextAndMarginRect); // if the item is selected, then draw the frame to represent that if mdSelected in State then DrawSelectedFrame(ItemRectNoLeftMargin); if Assigned(Item) then begin FParentMenu := Item.GetParentMenu; // if item is checked and if we show check marks and if // the item is a popup (ie, not a top item), then we draw // the check image if Item.Checked and ShowCheckMarks and IsPopup(Item) then DrawCheckImage(CheckMarkRect); // It is now time to draw the image. The image will not be // drawn for root menu items (non popup). if IsPopup(Item) then begin // if we have a valid image from the list to use for this item if UseImages then begin // Draw the corresponding back of an item // if the item is to be drawn checked or not if Item.Checked and not ShowCheckMarks then DrawCheckedImageBack(ImageAndMarginRect) else DrawNotCheckedImageBack(ImageAndMarginRect); // then, draw the correct image, according to the state // of the item if (mdDisabled in State) then DrawDisabledImage(ImageRect.Left, ImageRect.Top) else DrawEnabledImage(ImageRect.Left, ImageRect.Top) end // else, we may have a valid glyph, but we won't use it if // the item is a separator else if Assigned(FGlyph) and not FGlyph.Empty and (Item.Caption <> Separator) then begin // Draw the corresponding back of an item // if the item is to be drawn checked or not if Item.Checked and not ShowCheckMarks then DrawCheckedImageBack(ImageAndMarginRect) else DrawNotCheckedImageBack(ImageAndMarginRect); if FGlyph is TBitmap then begin // in the case of a bitmap, we may have more than one glyph // in the graphic. If so, we draw only the one that corresponds // to the current state of the item // if not, we simply draw the bitmap if FNumGlyphs in [2..5] then begin I := 0; if mdDisabled in State then I := 1 else if mdChecked in State then I := 3 else if mdSelected in State then I := 2; if I > FNumGlyphs - 1 then I := 0; Bmp := TBitmap.Create; try AssignBitmapCell(FGlyph, Bmp, FNumGlyphs, 1, I); DrawMenuBitmap(ImageRect.Left, ImageRect.Top, Bmp); finally Bmp.Free; end; end else DrawMenuBitmap(ImageRect.Left, ImageRect.Top, FGlyph); end else begin Canvas.Draw(ImageRect.Left, ImageRect.Top, FGlyph); end; end // at last, if there is no image given by the user, there may // be a check mark to draw instead else if Item.Checked and not ShowCheckMarks then begin DrawCheckedImageBack(ImageAndMarginRect); DrawCheckImage(ImageRect); end; end; // now that the image and check mark are drawn, we can // draw the text of the item (or a separator) if Item.Caption = Separator then begin DrawSeparator(ItemRectNoLeftMargin) end else begin // find the largest text element Windows.DrawText(Canvas.Handle, PChar(Item.Caption), Length(Item.Caption), CaptionRect, DT_CALCRECT or DT_EXPANDTABS or DT_LEFT or DT_SINGLELINE); MaxWidth := CaptionRect.Right - CaptionRect.Left; if (Item.Parent <> nil) and (Item.ShortCut <> scNone) then begin for I := 0 to Item.Parent.Count - 1 do begin Windows.DrawText(Canvas.Handle, PChar(Item.Parent.Items[I].Caption+ShortcutSpacing), Length(Item.Parent.Items[I].Caption+ShortcutSpacing), CaptionRect, DT_CALCRECT or DT_EXPANDTABS or DT_LEFT or DT_SINGLELINE); MaxWidth := Max(CaptionRect.Right - CaptionRect.Left, MaxWidth); end; end; // draw the text Canvas.Brush.Style := bsClear; DrawItemText(TextRect, Item.Caption, DT_EXPANDTABS or DT_LEFT or DT_SINGLELINE); if (Item.ShortCut <> scNone) and (Item.Count = 0) and IsPopup(Item) then begin // draw the shortcut DrawItemText(Rect(TextRect.Left + MaxWidth, TextRect.Top, TextRect.Right, TextRect.Bottom), ShortCutToText(Item.ShortCut), DT_EXPANDTABS or DT_LEFT or DT_SINGLELINE); end; end; end else begin MessageBox('!!! asked to draw nil item !!!'#13#10 + 'Please report this to the JVCL team, ' + 'detailing the precise conditions in ' + 'which this error occured.'#13#10 + 'Thank you for your cooperation.', 'error in menu painter', MB_ICONERROR); end; end; procedure TJvCustomMenuItemPainter.DrawSelectedFrame; begin // Do nothing by default end; procedure TJvCustomMenuItemPainter.DrawCheckedImageBack(ARect: TRect); begin // do nothing by default end; procedure TJvCustomMenuItemPainter.DrawNotCheckedImageBack(ARect: TRect); begin // do nothing by default end; function TJvCustomMenuItemPainter.GetDrawHighlight: Boolean; begin Result := NewStyleControls and (not (mdSelected in FState) or (GetNearestColor(Canvas.Handle, ColorToRGB(clGrayText)) = GetNearestColor(Canvas.Handle, ColorToRGB(clHighlight))) ); end; function TJvCustomMenuItemPainter.GetGrayColor: TColor; begin if mdSelected in FState then Result := clGrayText else Result := clBtnShadow; end; function TJvCustomMenuItemPainter.IsPopup(const Item: TMenuItem): Boolean; begin Result := (Item.Parent = nil) or (Item.Parent.Parent <> nil) or not (Item.Parent.Owner is TMainMenu); end; function TJvCustomMenuItemPainter.GetTextWidth(Item: TMenuItem): Integer; var I: Integer; MaxWidth: Integer; tmpWidth: Integer; ShortcutWidth: Integer; OneItemHasChildren: Boolean; CaptionRect: TRect; begin if IsPopup(Item) then begin // The width of the text is splitted in three parts: // Text Shortcut SubMenuArrow. // with the two last ones being not compulsory CaptionRect := Rect(0, 0, 0, 0); Windows.DrawText(Canvas.Handle, PChar(Item.Caption), Length(Item.Caption), CaptionRect, DT_CALCRECT or DT_EXPANDTABS or DT_LEFT or DT_SINGLELINE); MaxWidth := CaptionRect.Right - CaptionRect.Left; ShortcutWidth := 0; OneItemHasChildren := False; // Find the widest item in the menu being displayed if Item.Parent <> nil then begin // If the current item is the first one and it's not // alone, then discard its width because for some reason // the canvas is never correct. {if Item = Item.Parent.Items[0] then begin if Item.Parent.Count > 1 then Result := 0 else Result := MaxWidth; Exit; end;} for I := 0 to Item.Parent.Count - 1 do begin Windows.DrawText(Canvas.Handle, PChar(Item.Parent.Items[I].Caption), Length(Item.Parent.Items[I].Caption), CaptionRect, DT_CALCRECT or DT_EXPANDTABS or DT_LEFT or DT_SINGLELINE); tmpWidth := CaptionRect.Right - CaptionRect.Left; if tmpWidth > MaxWidth then MaxWidth := tmpWidth; // if the item has childs, then add the required // width for an arrow. It is considered to be the width of // two spaces. if Item.Parent.Items[I].Count > 0 then OneItemHasChildren := True; if Item.Parent.Items[I].ShortCut <> scNone then begin Windows.DrawText(Canvas.Handle, PChar(ShortCutToText(Item.Parent.Items[I].ShortCut)), Length(ShortCutToText(Item.Parent.Items[I].ShortCut)), CaptionRect, DT_CALCRECT or DT_EXPANDTABS or DT_LEFT or DT_SINGLELINE); tmpWidth := CaptionRect.Right - CaptionRect.Left; if tmpWidth > ShortcutWidth then ShortcutWidth := tmpWidth; end; end; end; Result := MaxWidth; // If there was a shortcut in any of the items, if ShortcutWidth <> 0 then begin // add its width to the current width, plus the spacing Inc(Result, ShortcutWidth); Inc(Result, Canvas.TextWidth(ShortcutSpacing)); end else if OneItemHasChildren then Inc(Result, Canvas.TextWidth(' ')); end else Result := Canvas.TextWidth(StripHotkeyPrefix(Item.Caption)); end; procedure TJvCustomMenuItemPainter.Measure(Item: TMenuItem; var Width, Height: Integer); var SavedOneItemChecked: Boolean; begin PreparePaint(Item, Rect(0, 0, 0, 0), [], True); if IsPopup(Item) then begin SavedOneItemChecked := FOneItemChecked; FOneItemChecked := Item.Checked; Width := LeftMargin + Cardinal(CheckMarkWidth + ImageMargin.Left + ImageWidth + ImageMargin.Right + TextMargin + GetTextWidth(Item)); if Item.Caption = Separator then Height := Max(Canvas.TextHeight(Separator) div 2, 9) else begin Height := Max(GetSystemMetrics(SM_CYMENU), Canvas.TextHeight(Item.Caption)); Height := Max(Height, CheckMarkHeight); Height := Max(Height, ImageMargin.Top + ImageHeight + ImageMargin.Bottom); end; FOneItemChecked := SavedOneItemChecked; end else begin Width := TextMargin + GetTextWidth(Item); Height := Max(GetSystemMetrics(SM_CYMENU), Canvas.TextHeight(Item.Caption)); end; end; procedure TJvCustomMenuItemPainter.DrawItemBackground(ARect: TRect); begin // do nothing end; procedure TJvCustomMenuItemPainter.DrawDisabledImage(X, Y: Integer); begin if UseDisabledImages then ImageList_Draw(DisabledImages.Handle, FImageIndex, Canvas.Handle, X, Y, ILD_NORMAL) else ImageListDrawDisabled(Images, Canvas, X, Y, FImageIndex, clBtnHighlight, GrayColor, DrawHighlight) end; procedure TJvCustomMenuItemPainter.DrawEnabledImage(X, Y: Integer); begin if UseHotImages and (mdSelected in FState) then ImageList_Draw(HotImages.Handle, FImageIndex, Canvas.Handle, X, Y, ILD_NORMAL) else ImageList_Draw(Images.Handle, FImageIndex, Canvas.Handle, X, Y, ILD_NORMAL); end; {function TJvCustomMenuItemPainter.GetShadowColor: TColor; begin if Assigned(FMainMenu) then Result := FMainMenu.ShadowColor else if Assigned(FPopupMenu) then Result := FPopupMenu.ShadowColor; end;} procedure TJvCustomMenuItemPainter.DrawSeparator(ARect: TRect); var LineTop: Integer; begin LineTop := (ARect.Top + ARect.Bottom) div 2 - 1; if NewStyleControls then begin Canvas.Pen.Width := 1; MenuLine(Canvas, clBtnShadow, ARect.Left - 1, LineTop, ARect.Right, LineTop); MenuLine(Canvas, clBtnHighlight, ARect.Left, LineTop + 1, ARect.Right, LineTop + 1); end else begin Canvas.Pen.Width := 2; MenuLine(Canvas, clMenuText, ARect.Left, LineTop + 1, ARect.Right, LineTop + 1); end; end; procedure TJvCustomMenuItemPainter.DrawImageBackground(ARect: TRect); begin // do nothing by default end; function TJvCustomMenuItemPainter.GetIsRightToLeft: Boolean; begin Result := (FItem.GetParentMenu <> nil) and (FItem.GetParentMenu.BiDiMode <> bdLeftToRight); end; function TJvCustomMenuItemPainter.GetCheckMarkHeight: Integer; begin if ShowCheckMarks then Result := GetSystemMetrics(SM_CYMENUCHECK) else Result := 0; end; function TJvCustomMenuItemPainter.GetCheckMarkWidth: Integer; begin if ShowCheckMarks then Result := GetSystemMetrics(SM_CXMENUCHECK) else Result := 0; end; function TJvCustomMenuItemPainter.GetImageHeight: Integer; begin if Assigned(Images) then Result := Images.Height else begin Result := ImageSize.Height; if Result = 0 then begin if Assigned(FGlyph) and not FGlyph.Empty then Result := 16 // hard coded as in Borland's VCL else if FOneItemChecked then Result := GetSystemMetrics(SM_CYMENUCHECK); end; end; end; function TJvCustomMenuItemPainter.GetImageWidth: Integer; begin if Assigned(Images) then Result := Images.Width else begin Result := ImageSize.Width; if Result = 0 then begin if Assigned(FGlyph) and not FGlyph.Empty then Result := 16 // hard coded as in Borland's VCL else if FOneItemChecked then Result := GetSystemMetrics(SM_CXMENUCHECK); end; end; end; function TJvCustomMenuItemPainter.GetTextMargin: Integer; begin if Assigned(FMainMenu) then Result := FMainMenu.TextMargin else if Assigned(FPopupMenu) then Result := FPopupMenu.TextMargin else Result := 0; end; procedure TJvCustomMenuItemPainter.DrawCheckMarkBackground(ARect: TRect); begin // do nothing by default end; procedure TJvCustomMenuItemPainter.DrawTextBackground(ARect: TRect); begin // do nothing by default end; function TJvCustomMenuItemPainter.GetTextVAlignment: TJvVerticalAlignment; begin if Assigned(FMainMenu) then Result := FMainMenu.TextVAlignment else if Assigned(FPopupMenu) then Result := FPopupMenu.TextVAlignment else Result := vaMiddle; end; procedure TJvCustomMenuItemPainter.ForceMenuRebuild; begin if csLoading in ComponentState then Exit; if Assigned(FMainMenu) then FMainMenu.Rebuild else if Assigned(FPopupMenu) then FPopupMenu.Rebuild; end; procedure TJvCustomMenuItemPainter.UpdateFieldsFromMenu; begin if Assigned(FMainMenu) then begin FOnDrawItem := FMainMenu.OnDrawItem; FImageMargin.Assign(FMainMenu.ImageMargin); FImageSize.Assign(FMainMenu.ImageSize); end else if Assigned(FPopupMenu) then begin FOnDrawItem := FPopupMenu.OnDrawItem; FImageMargin.Assign(FPopupMenu.ImageMargin); FImageSize.Assign(FPopupMenu.ImageSize); end; end; procedure TJvCustomMenuItemPainter.DefaultDrawLeftMargin(ARect: TRect; StartColor, EndColor: TColor); var R: Integer; begin with ARect do begin R := Right - 3; // Draw the gradient GradientFillRect(Canvas, Rect(Left, Top, R, Bottom), StartColor, EndColor, fdTopToBottom, 32); // Draw the separating line MenuLine(Canvas, clBtnFace, Right - 3, Top, Right - 3, Bottom); MenuLine(Canvas, clBtnShadow, Right - 2, Top, Right - 2, Bottom); MenuLine(Canvas, clBtnHighlight, Right - 1, Top, Right - 1, Bottom); end; end; procedure TJvCustomMenuItemPainter.DrawLeftMargin(ARect: TRect); begin if Assigned(FOnDrawLeftMargin) then FOnDrawLeftMargin(Self.FParentMenu, ARect) else begin DefaultDrawLeftMargin(ARect, DefaultMarginColor, RGB( GetRValue(DefaultMarginColor) div 4, GetGValue(DefaultMarginColor) div 4, GetBValue(DefaultMarginColor) div 4)); end; end; procedure TJvCustomMenuItemPainter.SetLeftMargin(const Value: Cardinal); begin if FLeftMargin <> Value then begin FLeftMargin := Value; // Force a rebuild as the width of the items has changed ForceMenuRebuild; end; end; procedure TJvCustomMenuItemPainter.SetImageBackgroundColor(const Value: TColor); begin FImageBackgroundColor := Value; end; function TJvCustomMenuItemPainter.GetMenu: TMenu; begin if Assigned(FMainMenu) then Result := FMainMenu else if Assigned(FPopupMenu) then Result := FPopupMenu else Result := nil; end; procedure TJvCustomMenuItemPainter.SetMenu(const Value: TMenu); begin // Note: One may be tempted to store the value of the Canvas // property. This is not a good idea as the Canvas may only be // created when the menu is about to be displayed, thus being // nil right now. if Value is TJvMainMenu then begin FMainMenu := TJvMainMenu(Value); FPopupMenu := nil; end else if Value is TJvPopupMenu then begin FMainMenu := nil; FPopupMenu := TJvPopupMenu(Value); end else begin FMainMenu := nil; FPopupMenu := nil; end; end; function TJvCustomMenuItemPainter.GetCanvas: TCanvas; begin if Assigned(FMainMenu) then Result := FMainMenu.Canvas else if Assigned(FPopupMenu) then Result := FPopupMenu.Canvas else Result := nil; end; procedure TJvCustomMenuItemPainter.EmptyDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; Selected: Boolean); begin // Do nothing, on purpose end; //=== { TJvBtnMenuItemPainter } ============================================== constructor TJvBtnMenuItemPainter.Create(AOwner: TComponent; Lowered: Boolean); begin inherited Create(AOwner); FLowered := Lowered; end; constructor TJvBtnMenuItemPainter.Create(AOwner: TComponent); begin inherited Create(AOwner); FLowered := True; end; procedure TJvBtnMenuItemPainter.DrawSelectedFrame(ARect: TRect); begin if FLowered then Frame3D(Canvas, ARect, clBtnShadow, clBtnHighlight, 1) else Frame3D(Canvas, ARect, clBtnHighlight, clBtnShadow, 1); end; function TJvBtnMenuItemPainter.GetDrawHighlight: Boolean; begin Result := NewStyleControls; end; function TJvBtnMenuItemPainter.GetGrayColor: TColor; begin Result := clBtnShadow; end; procedure TJvBtnMenuItemPainter.UpdateFieldsFromMenu; begin inherited UpdateFieldsFromMenu; FImageMargin.Top := FImageMargin.Top + 1; FImageMargin.Bottom := FImageMargin.Bottom + 1; end; //=== { TJvOfficeMenuItemPainter } =========================================== procedure TJvOfficeMenuItemPainter.Paint(Item: TMenuItem; ItemRect: TRect; State: TMenuOwnerDrawState); begin inherited Paint(Item, ItemRect, State); end; procedure TJvOfficeMenuItemPainter.CleanupGlyph(BtnRect: TRect); var SaveBrush: TBrush; // to save brush begin SaveBrush := Canvas.Brush; Canvas.Brush.Color := ImageBackgroundColor; Inc(BtnRect.Right); Dec(BtnRect.Left); Canvas.FillRect(BtnRect); Canvas.Brush := SaveBrush; end; procedure TJvOfficeMenuItemPainter.DrawFrame(BtnRect: TRect); begin CleanupGlyph(BtnRect); Frame3D(Canvas, BtnRect, clBtnHighlight, clBtnShadow, 1); end; procedure TJvOfficeMenuItemPainter.DrawSelectedFrame(ARect: TRect); begin if not IsPopup(FItem) then begin CleanupGlyph(ARect); Frame3D(Canvas, ARect, clBtnShadow, clBtnHighlight, 1); end; end; procedure TJvOfficeMenuItemPainter.DrawCheckedImageBack(ARect: TRect); begin CleanupGlyph(ARect); DrawGlyphCheck(ARect); end; procedure TJvOfficeMenuItemPainter.DrawNotCheckedImageBack(ARect: TRect); begin if (mdSelected in FState) and IsPopup(FItem) then DrawFrame(ARect); end; function TJvOfficeMenuItemPainter.GetDrawHighlight: Boolean; begin Result := NewStyleControls and (not (mdSelected in FState) or (not IsPopup(FItem)) or (GetNearestColor(Canvas.Handle, ColorToRGB(clGrayText)) = GetNearestColor(Canvas.Handle, ColorToRGB(clHighlight))) ); end; procedure TJvOfficeMenuItemPainter.UpdateFieldsFromMenu; begin inherited UpdateFieldsFromMenu; FImageMargin.Left := FImageMargin.Left + 2; FImageMargin.Top := FImageMargin.Top + 2; FImageMargin.Right := FImageMargin.Right + 3; FImageMargin.Bottom := FImageMargin.Bottom + 2; end; function TJvOfficeMenuItemPainter.GetTextMargin: Integer; begin Result := inherited GetTextMargin + 3; end; procedure TJvOfficeMenuItemPainter.DrawCheckImage(ARect: TRect); begin inherited DrawCheckImage(Rect(ARect.Left + 2, ARect.Top, ARect.Right, ARect.Bottom - 1)); end; procedure TJvOfficeMenuItemPainter.DrawItemText(ARect: TRect; const Text: string; Flags: Integer); begin if not IsPopup(FItem) then Canvas.Font.Color := clMenuText; inherited DrawItemText(Rect(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom - 1), Text, Flags); end; procedure TJvOfficeMenuItemPainter.DrawItemBackground(ARect: TRect); begin inherited DrawItemBackground(ARect); if not IsPopup(FItem) and (mdHotlight in FState) then DrawFrame(ARect); end; //=== { TJvXPMenuItemPainter } =============================================== constructor TJvXPMenuItemPainter.Create(AOwner: TComponent); begin inherited Create(AOwner); FSelectionFrameBrush := TBrush.Create; FSelectionFramePen := TPen.Create; FSelRect := Rect(0, 0, 0, 0); FCheckedPoint := Point(0, 0); // affect default values that are not 0 FShadowColor := DefaultXPShadowColor; FImageBackgroundColor := DefaultXPImageBackgroundColor; FSelectionFrameBrush.Color := DefaultXPSFBrushColor; FSelectionFrameBrush.Style := bsSolid; FSelectionFramePen.Color := DefaultXPSFPenColor; FSelectionFramePen.Style := psSolid; FSeparatorColor := DefaultXPSeparatorColor; FCheckedImageBackColor := DefaultXPCheckedImageBackColor; FCheckedImageBackColorSelected := DefaultXPCheckedImageBackColorSelected; end; destructor TJvXPMenuItemPainter.Destroy; begin FSelectionFrameBrush.Free; FSelectionFramePen.Free; inherited Destroy; end; procedure TJvXPMenuItemPainter.DrawCheckedImageBack(ARect: TRect); begin with Canvas do begin Pen.Assign(SelectionFramePen); Brush.Style := bsSolid; if mdSelected in FState then Brush.Color := CheckedImageBackColorSelected //SRGB(133,146,181) else Brush.Color := CheckedImageBackColor; //RGB(212,213,216); Rectangle(ARect.Left, ARect.Top + 1, ARect.Right - 3, ARect.Bottom - 2); end; end; procedure TJvXPMenuItemPainter.DrawBitmapShadow(X, Y: Integer; B: TBitmap); var BX, BY: Integer; TransparentColor: TColor; begin TransparentColor := B.Canvas.Pixels[0, B.Height - 1]; for BY := 0 to B.Height - 1 do for BX := 0 to B.Width - 1 do if B.Canvas.Pixels[BX, BY] <> TransparentColor then Canvas.Pixels[X + BX, Y + BY] := ShadowColor; end; procedure TJvXPMenuItemPainter.DrawBorder(WRect: TRect); var Canvas: TJvDesktopCanvas; RightToLeft: Boolean; I: Integer; ShowingItemsParent: TMenuItem; begin // Local value, just in case FItem is nil, which could theoretically happen // as DrawBorder is called from the replacement window procedure. RightToLeft := Menu.BiDiMode <> bdLeftToRight; // To draw the border, the easiest way is to actually draw on the desktop Canvas := TJvDesktopCanvas.Create; try with Canvas do begin Brush.Style := bsClear; Pen.Color := RGB(102, 102, 102); Pen.Style := psSolid; // dark contour Rectangle(WRect); // two white lines above bottom Pen.Color := clWhite; MoveTo(WRect.Left + 1, WRect.Bottom - 2); LineTo(WRect.Right - 1, WRect.Bottom - 2); MoveTo(WRect.Left + 1, WRect.Bottom - 3); LineTo(WRect.Right - 1, WRect.Bottom - 3); // two white lines below top MoveTo(WRect.Left + 1, WRect.Top + 1); LineTo(WRect.Right - 1, WRect.Top + 1); MoveTo(WRect.Left + 1, WRect.Top + 2); LineTo(WRect.Right - 1, WRect.Top + 2); // three lines before right if RightToLeft then Pen.Color := ImageBackgroundColor else Pen.Color := clWhite; MoveTo(WRect.Right - 2, WRect.Top + 3); LineTo(WRect.Right - 2, WRect.Bottom - 3); MoveTo(WRect.Right - 3, WRect.Top + 3); LineTo(WRect.Right - 3, WRect.Bottom - 3); // two lines after left if RightToLeft then Pen.Color := clWhite else Pen.Color := ImageBackgroundColor; MoveTo(WRect.Left + 1, WRect.Top + 3); LineTo(WRect.Left + 1, WRect.Bottom - 3); MoveTo(WRect.Left + 2, WRect.Top + 3); LineTo(WRect.Left + 2, WRect.Bottom - 3); // Try to find which (sub)items are showing in order to paint the // bits of items that are in the border (eg selected/checked). // To do that, we first find the parent, possibly recursively, and // once we get it, we loop on its children. ShowingItemsParent := GetShowingItemsParent(WRect, Menu.Items); if Assigned(ShowingItemsParent) then begin for I := 0 to ShowingItemsParent.Count - 1 do begin DrawItemBorderParts(ShowingItemsParent.Items[I], Canvas, WRect); end; end; end; finally Canvas.Free; end; end; procedure TJvXPMenuItemPainter.DrawDisabledImage(X, Y: Integer); begin // to take the margin into account if IsRightToLeft then Inc(X, 3) else Dec(X, 3); if UseDisabledImages then ImageList_Draw(DisabledImages.Handle, FImageIndex, Canvas.Handle, X, Y, ILD_NORMAL) else //TODO: Change to draw greyscale image ImageListDrawDisabled(Images, Canvas, X, Y, FImageIndex, clBtnHighlight, GrayColor, DrawHighlight); end; procedure TJvXPMenuItemPainter.DrawEnabledImage(X, Y: Integer); var TmpBitmap: TBitmap; begin // to take the margin into account if IsRightToLeft then Inc(X, 3) else Dec(X, 3); if (mdSelected in FState) then begin // draw shadow for selected and enbled item // first, create a bitmap from the correct image TmpBitmap := TBitmap.Create; if UseHotImages then begin TmpBitmap.Width := HotImages.Width; TmpBitmap.Height := HotImages.Height; TmpBitmap.Canvas.Brush.Color := Canvas.Brush.Color; TmpBitmap.Canvas.FillRect(Rect(0, 0, TmpBitmap.Width, TmpBitmap.Height)); ImageList_DrawEx(HotImages.Handle, FImageIndex, TmpBitmap.Canvas.Handle, 0, 0, 0, 0, clNone, clNone, ILD_TRANSPARENT); end else begin TmpBitmap.Width := Images.Width; TmpBitmap.Height := Images.Height; TmpBitmap.Canvas.Brush.Color := Canvas.Brush.Color; TmpBitmap.Canvas.FillRect(Rect(0, 0, TmpBitmap.Width, TmpBitmap.Height)); ImageList_DrawEx(Images.Handle, FImageIndex, TmpBitmap.Canvas.Handle, 0, 0, 0, 0, clNone, clNone, ILD_TRANSPARENT); end; // then effectively draw the shadow DrawBitmapShadow(X + 1, Y + 1, TmpBitmap); TmpBitmap.Free; // shift the image to the top and left Dec(X); Dec(Y); end; // and call inherited to draw the image inherited DrawEnabledImage(X, Y); end; procedure TJvXPMenuItemPainter.DrawItemBackground(ARect: TRect); const COLOR_MENUBAR = 30; begin with Canvas do begin if IsPopup(FItem) then begin // popup items, always white background Brush.Color := clWhite; Brush.Style := bsSolid; FillRect(ARect); end else begin // top level items, depends on the Hotlight status if mdHotlight in FState then begin Brush.Assign(SelectionFrameBrush); Pen.Assign(SelectionFramePen); Rectangle(ARect); end else if UseFlatMenubars then begin Brush.Color := GetSysColor(COLOR_MENUBAR); Brush.Style := bsSolid; Pen.Style := psSolid; Pen.Color := Brush.Color; FillRect(ARect); end else begin Brush.Color := clBtnFace; Brush.Style := bsSolid; Pen.Style := psSolid; Pen.Color := Brush.Color; Rectangle(ARect); end; end; end; end; procedure TJvXPMenuItemPainter.DrawItemBorderParts(Item: TMenuItem; Canvas: TCanvas; WRect: TRect); var ItemInfo: MENUITEMINFO; ItemRect: TRect; begin ItemInfo.cbSize := sizeof(ItemInfo); ItemInfo.fMask := MIIM_STATE; if GetMenuItemInfo(Item.Parent.Handle, Item.MenuIndex, True, ItemInfo) then begin ItemRect := GetItemScreenRect(Item.Parent, Item.MenuIndex); with Canvas do begin // If the item is selected (Highlighted), then the closing borders // of the selection rectangle are in the border of the menu window. // Hence, we must draw them here. if (ItemInfo.fState and MFS_HILITE) = MFS_HILITE then begin Brush.Style := bsClear; Pen.Assign(SelectionFramePen); MoveTo(WRect.Left + 2, ItemRect.Top + 0); LineTo(WRect.Left + 2, ItemRect.Bottom - 1); MoveTo(WRect.Right - 3, ItemRect.Top + 0); LineTo(WRect.Right - 3, ItemRect.Bottom - 1); // change the pen for the next instructions to draw in // the correct color for a selected item. Pen.Style := psSolid; Pen.Color := SelectionFrameBrush.Color; if IsRightToLeft then begin MoveTo(WRect.Right - 4, ItemRect.Top); LineTo(WRect.Right - 4, ItemRect.Bottom - 1); Pixels[WRect.Right - 4, ItemRect.Top] := SelectionFramePen.Color; Pixels[WRect.Right - 4, ItemRect.Bottom - 2] := SelectionFramePen.Color; end else begin MoveTo(WRect.Left + 3, ItemRect.Top); LineTo(WRect.Left + 3, ItemRect.Bottom - 1); Pixels[WRect.Left + 3, ItemRect.Top] := SelectionFramePen.Color; Pixels[WRect.Left + 3, ItemRect.Bottom - 2] := SelectionFramePen.Color; end; end; // If the item is checked then the left closing border of the checkbox // rectangle is in the border of the menu window. // Hence, we must draw it here. if (ItemInfo.fState and MFS_CHECKED) = MFS_CHECKED then begin // change the pen for the next instructions to draw in // the correct color for a selected item. Pen.Assign(SelectionFramePen); if IsRightToLeft then begin MoveTo(WRect.Right - 4, ItemRect.Top); LineTo(WRect.Right - 4, ItemRect.Bottom - 1); end else begin MoveTo(WRect.Left + 3, ItemRect.Top+1); LineTo(WRect.Left + 3, ItemRect.Bottom - 2); end; end; end; end; end; procedure TJvXPMenuItemPainter.DrawMenuBitmap(X, Y: Integer; Bitmap: TBitmap); begin if mdDisabled in FState then DrawDisabledBitmap(X, Y, Bitmap) else begin // if selected, then draw shadow and shift real image towards // top and left, but only if draw bitmap was called because // of a user supplied glyph if (mdSelected in FState) and Assigned(FGlyph) then begin DrawBitmapShadow(X + 1, Y + 1, Bitmap); Dec(X); Dec(Y); end; if Bitmap.Monochrome and (not FItem.Checked or ShowCheckMarks) then BitBlt(Canvas.Handle, X, Y, Bitmap.Width, Bitmap.Height, Bitmap.Canvas.Handle, 0, 0, SRCCOPY) else DrawBitmapTransparent(Canvas, X, Y, Bitmap, Bitmap.TransparentColor and not PaletteMask); end; end; procedure TJvXPMenuItemPainter.DrawSelectedFrame(ARect: TRect); begin with Canvas do begin Font.Color := clMenuText; if IsPopup(FItem) then begin Brush.Assign(SelectionFrameBrush); Pen.Style := psClear; Rectangle(0, ARect.Top, ARect.Right + 4, ARect.Bottom - 1); Pen.Assign(SelectionFramePen); Brush.Style := bsClear; MoveTo(0, ARect.Top); LineTo(ARect.Right + 4, ARect.Top); MoveTo(0, ARect.Bottom - 2); LineTo(ARect.Right + 4, ARect.Bottom - 2); end else begin Brush.Color := clSilver; Brush.Style := bsSolid; Pen.Color := clGray; Pen.Style := psSolid; Rectangle(ARect); end; end; end; procedure TJvXPMenuItemPainter.Measure(Item: TMenuItem; var Width, Height: Integer); begin inherited Measure(Item, Width, Height); if Item.Caption = Separator then Height := 3 else Inc(Height, 2); end; // This is the replacement Window Procedure for the window that is used // to render the menus. Basically, it calls DrawBorder when it receives // an WM_NCPAINT message so that it overrides the default behaviour of // the Win32 API. // Note: We use a global variable to keep track of the current XPPainter // and not the SetProp and GetProp APIs. This is because it turned out that // the value read by GetProp was correct but its cast back to the item // painter address was not. So we use the global variable approach, ensuring // it gets reinitialized whenever the window disappears; function XPMenuItemPainterWndProc(hwnd : THandle; uMsg : UINT; wParam : WPARAM; lParam : LPARAM): LRESULT; stdcall; var WindowRect: TRect; begin Result := CallWindowProc(Pointer(OldMenuWndProcHandle), hwnd, uMsg, wParam, lParam); case uMsg of WM_NCPAINT: begin if GetWindowRect(hwnd, WindowRect) and Assigned(currentXPPainter) then begin currentXPPainter.DrawBorder(WindowRect); end; end; WM_SHOWWINDOW: begin if wParam = 0 then begin SetWindowLong(hwnd, GWL_WNDPROC, OldMenuWndProcHandle); currentXPPainter := nil; end; end; WM_NCDESTROY: begin SetWindowLong(hwnd, GWL_WNDPROC, OldMenuWndProcHandle); currentXPPainter := nil; end; end; end; procedure TJvXPMenuItemPainter.Paint(Item: TMenuItem; ItemRect: TRect; State: TMenuOwnerDrawState); var CanvasWindow: HWND; WRect: TRect; tmpWndProcHandle : Integer; begin FItem := Item; // draw the contour of the window if IsPopup(Item) and not (csDesigning in ComponentState) then begin CanvasWindow := WindowFromDC(Canvas.Handle); if not (Assigned(FMainMenu) and (FMainMenu.GetOwner <> nil) and (FMainMenu.GetOwner is TForm) and (TForm(FMainMenu.GetOwner).Handle = CanvasWindow)) then begin // If we have a window, that has a WndProc, which is different from our // replacement WndProc and we are not at design time, then install // our replacement WndProc. // Once this is done, we can draw the border in the appropriate rect. if CanvasWindow <> 0 then begin tmpWndProcHandle := GetWindowLong(CanvasWindow, GWL_WNDPROC); if (tmpWndProcHandle <> 0) and (tmpWndProcHandle <> Integer(@XPMenuItemPainterWndProc)) and not (csDesigning in Menu.ComponentState) then begin OldMenuWndProcHandle := tmpWndProcHandle; currentXPPainter := Self; SetWindowLong(CanvasWindow, GWL_WNDPROC, Integer(@XPMenuItemPainterWndProc)); end; GetWindowRect(CanvasWindow, WRect); DrawBorder(WRect); end; end; end; // then draw the items inherited Paint(Item, ItemRect, State); end; procedure TJvXPMenuItemPainter.PreparePaint(Item: TMenuItem; Rect: TRect; State: TMenuOwnerDrawState; Measure: Boolean); begin // to prevent erasing when the item is selected Canvas.Brush.Color := clNone; inherited PreparePaint(Item, Rect, State, Measure); end; procedure TJvXPMenuItemPainter.SetSelectionFrameBrush(const Value: TBrush); begin FSelectionFrameBrush.Assign(Value); end; procedure TJvXPMenuItemPainter.SetSelectionFramePen(const Value: TPen); begin FSelectionFramePen.Assign(Value); end; procedure TJvXPMenuItemPainter.DrawSeparator(ARect: TRect); begin // draw the separating line if IsRightToLeft then MenuLine(Canvas, SeparatorColor, ARect.Left, ARect.Top + 1, ARect.Right - CheckMarkWidth - ImageMargin.Left - ImageWidth - ImageMargin.Right - TextMargin, ARect.Top + 1) else MenuLine(Canvas, SeparatorColor, ARect.Left + CheckMarkWidth + ImageMargin.Left + ImageWidth + ImageMargin.Right + TextMargin, ARect.Top + 1, ARect.Right, ARect.Top + 1); end; procedure TJvXPMenuItemPainter.DrawImageBackground(ARect: TRect); begin with Canvas do begin // draw the gray background in the area Brush.Color := ImageBackgroundColor; Brush.Style := bsSolid; Pen.Style := psClear; Rectangle(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom + 1); end; end; procedure TJvXPMenuItemPainter.DrawCheckMarkBackground(ARect: TRect); begin DrawImageBackground(ARect); end; function TJvXPMenuItemPainter.GetDrawHighlight: Boolean; begin Result := NewStyleControls and (not (mdSelected in FState) or (not IsPopup(FItem)) or (GetNearestColor(Canvas.Handle, ColorToRGB(clGrayText)) = GetNearestColor(Canvas.Handle, ColorToRGB(clHighlight))) ); end; function TJvXPMenuItemPainter.GetItemScreenRect(ParentItem: TMenuItem; Index: Integer): TRect; begin // Contrary to what the MSDN writes, the first parameter to this function // MUST be 0 even for top level menu items... GetMenuItemRect(0, ParentItem.Handle, Index, Result); end; function TJvXPMenuItemPainter.GetShowingItemsParent(WRect: TRect; StartingItem: TMenuItem): TMenuItem; var ItemRect: TRect; I: Integer; begin Result := nil; if StartingItem.Count = 0 then Exit; ItemRect := GetItemScreenRect(StartingItem, 0); if RectIncludesRect(ItemRect, WRect) then begin Result := StartingItem; end else begin I := 0; while not Assigned(Result) and (I < StartingItem.Count) do begin Result := GetShowingItemsParent(WRect, StartingItem[I]); Inc(I); end; end; end; procedure TJvXPMenuItemPainter.UpdateFieldsFromMenu; begin inherited UpdateFieldsFromMenu; FImageMargin.Left := FImageMargin.Left + 6; FImageMargin.Top := FImageMargin.Top + 4; FImageMargin.Right := FImageMargin.Right + 4; FImageMargin.Bottom := FImageMargin.Bottom + 4; end; procedure TJvXPMenuItemPainter.DrawItemText(ARect: TRect; const Text: string; Flags: Integer); begin inherited DrawItemText(Rect(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom - 1), Text, Flags); end; function TJvXPMenuItemPainter.GetTextMargin: Integer; begin Result := inherited GetTextMargin + 2; end; procedure TJvXPMenuItemPainter.DrawCheckImage(ARect: TRect); begin inherited DrawCheckImage(Rect(ARect.Left - 2, ARect.Top, ARect.Right - 2, ARect.Bottom - 1)); end; //=== { TJvStandardMenuItemPainter } ========================================= procedure TJvStandardMenuItemPainter.DrawCheckedImageBack(ARect: TRect); begin inherited DrawCheckedImageBack(ARect); end; procedure TJvStandardMenuItemPainter.UpdateFieldsFromMenu; begin inherited UpdateFieldsFromMenu; end; function TJvStandardMenuItemPainter.GetTextMargin: Integer; begin Result := inherited GetTextMargin + 2; end; function TJvStandardMenuItemPainter.GetImageWidth: Integer; var I: Integer; begin Result := inherited GetImageWidth; // If any of the items has a checkmark then we need to // ensure the width of the "image" is enough to display a check // mark, and this for all items if FItem.Parent <> nil then for I := 0 to FItem.Parent.Count - 1 do if FItem.Parent.Items[I].Checked then begin Result := Max(Result, GetSystemMetrics(SM_CXMENUCHECK)); Break; end; end; procedure TJvStandardMenuItemPainter.Paint(Item: TMenuItem; ItemRect: TRect; State: TMenuOwnerDrawState); begin inherited Paint(Item, ItemRect, State); end; //=== { TJvOwnerDrawMenuItemPainter } ======================================== procedure TJvOwnerDrawMenuItemPainter.Measure(Item: TMenuItem; var Width, Height: Integer); begin if Assigned(FMainMenu) then begin if Assigned(FMainMenu.OnMeasureItem) then FMainMenu.OnMeasureItem(FMainMenu, Item, Width, Height); end else if Assigned(FPopupMenu) then begin if Assigned(FPopupMenu.OnMeasureItem) then FPopupMenu.OnMeasureItem(FPopupMenu, Item, Width, Height); end; end; procedure TJvOwnerDrawMenuItemPainter.Paint(Item: TMenuItem; ItemRect: TRect; State: TMenuOwnerDrawState); begin if Assigned(FMainMenu) then begin if Assigned(FMainMenu.OnDrawItem) then FMainMenu.OnDrawItem(FMainMenu, Item, ItemRect, State); end else if Assigned(FPopupMenu) then begin if Assigned(FPopupMenu.OnDrawItem) then FPopupMenu.OnDrawItem(FPopupMenu, Item, ItemRect, State); end; end; //=== { TJvImageMargin } ===================================================== procedure TJvImageMargin.Assign(Source: TPersistent); begin if Source is TJvImageMargin then begin Left := TJvImageMargin(Source).Left; Right := TJvImageMargin(Source).Right; Top := TJvImageMargin(Source).Top; Bottom := TJvImageMargin(Source).Bottom; end else inherited Assign(Source); end; procedure TJvImageMargin.DoChange; begin if Assigned(OnChange) then OnChange(Self); end; procedure TJvImageMargin.SetBottom(const Value: Integer); begin if FBottom <> Value then begin FBottom := Value; DoChange; end; end; procedure TJvImageMargin.SetLeft(const Value: Integer); begin if FLeft <> Value then begin FLeft := Value; DoChange; end; end; procedure TJvImageMargin.SetRight(const Value: Integer); begin if FRight <> Value then begin FRight := Value; DoChange; end; end; procedure TJvImageMargin.SetTop(const Value: Integer); begin if FTop <> Value then begin FTop := Value; DoChange; end; end; //=== { TJvMenuImageSize } =================================================== procedure TJvMenuImageSize.Assign(Source: TPersistent); begin if Source is TJvMenuImageSize then begin Height := TJvMenuImageSize(Source).Height; Width := TJvMenuImageSize(Source).Width; end else inherited Assign(Source); end; procedure TJvMenuImageSize.DoChange; begin if Assigned(OnChange) then OnChange(Self); end; procedure TJvMenuImageSize.SetHeight(const Value: Integer); begin if FHeight <> Value then begin FHeight := Value; DoChange; end; end; procedure TJvMenuImageSize.SetWidth(const Value: Integer); begin if FWidth <> Value then begin FWidth := Value; DoChange; end; end; initialization {$IFDEF UNITVERSIONING} RegisterUnitVersion(HInstance, UnitVersioning); {$ENDIF UNITVERSIONING} finalization FreeAndNil(PopupList); {$IFDEF UNITVERSIONING} UnregisterUnitVersion(HInstance); {$ENDIF UNITVERSIONING} end.