Class TCustomMenus97 (unit Menus97) |
Inherits from
TComponent
constructor Create(AOwner: TComponent);
- TCustomMenus97
destructor Destroy;
Chargement de l'image pour l'option Checked & RadioItem.
procedure NewTFormWndProc(Var Message: TMessage);
procedure Office97Mapping;
procedure FixupReferences;
procedure Loaded;
procedure Notification (AComponent: TComponent; Operation: TOperation);
procedure BrushChange(Sender: TObject);
procedure CalcBannerRect;
function CalcMenuBarHeight: Integer;
and to release Our WndProc instance
function CalcMenuHeight(Item: TMenuItem): Integer;
function CalcMenuWidth(Item: TMenuItem): Integer;
Calcul de la largeur maxi du menu (avec accelerateurs et sous-menus) Max Menu Width Calculation
procedure DrawDisabledImage(Var Rect : TRect; IndexImage : Integer);
procedure DrawDisabledImage95(Var Rect : TRect; IndexImage : Integer);
procedure DrawDisabledImageNT(Var Rect : TRect; IndexImage : Integer);
De larges portions du code de cette procedure proviennent de l'excellent TExplorerButton de Fabrice Deville.
procedure DrawItem(Item: TMenuItem; Rect: TRect; State: TOwnerDrawState);
procedure CNMeasureItem(var Message: TWMMeasureItem); message CN_MEASUREITEM; GradientFill
procedure DrawItemText(Item: TMenuItem; Var Rect: TRect; Text: String);
procedure DrawMenuBarItem(Item: TMenuItem; Var Rect: TRect; State: TOwnerDrawState);
function FindItemByCommand(Command: Word): TMenuItem;
procedure FontChange(Sender: TObject);
procedure GetDefaultMenuFont(Var aFont: TFont);
function GetTextSize(ACanvas: TCanvas; Text: string ): TSize;
procedure GradientFill(DC: HDC; FBeginColor, FEndColor: TColor; R: TRect);
De larges portions du code de cette procedure proviennent de l'excellent TMSOfficeCaption de Warren F.
function HasBanner(Item: TMenuItem): boolean;
procedure HiliteFontChange(Sender: TObject);
procedure InternalModifyMenuTree(MenuItems : TMenuItem; Level: Integer);
Form1.
function IsFontStored: Boolean;
procedure MeasureItem(Item: TMenuItem; var Height, Width: Integer);
procedure ModifyMenuTree(MenuItems : TMenuItem; Restore: Boolean);
procedure InternalModifyMenu(Command: Integer; Caption: String; Restore: Boolean); virtual;procedure TCustomMenus97.
function ProcessAccel(Message: TWMMenuChar ): Integer;
((Self is TCustomPopupMenus97) or (InternalMenu.
procedure ReleaseMDIList;
procedure SetBannerFont(Value: TFont);
procedure SetBrush(Value: TBrush);
procedure SetDefaultFont(Value: Boolean);
procedure SetFont(Value: TFont);
else we call the old DefaultProc.
procedure SetHiliteFont (Value : Tfont);
Procedure SetImages (Value: TImageList);
procedure SetInternalMenu(Value: TMenu);
procedure SetMenus97Look(Value: TMenus97Look);
procedure WMDrawItem(var Message: TWMDrawItem);
procedure TCustomMenus97.
procedure WMMeasureItem(var Message: TWMMeasureItem);
procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;Fin de "TCustomMenus97.
property Banner : Boolean
property BannerColor : TColor
property BannerEndColor : TColor
property BannerFont : TFont
property BannerImage : Integer
property BannerJustification : TBannerJustification
property BannerNumColors : Integer
property BannerText : String
property BannerWidth : Integer
property Brush : TBrush
property Canvas : TCanvas
property DefaultFont : Boolean
property Font : TFont
property HiliteBar : Tcolor
property HiliteFont : TFont
property Images : TImageList
property ItemHeight : Integer
property ItemWidth : Integer
property Menus97Look : TMenus97Look
property InternalMenu : TMenu
event OnDrawItem : TDrawMenuItemEvent
event OnHint : THintEvent
event OnMeasureItem : TMeasureMenuItemEvent
FBanner : Boolean;
FBannerBmp : TBitmap;
FBannerColor : TColor;
FBannerEndColor : TColor;
FBannerFont : TFont;
FBannerImage : Integer;
FBannerJustification : TBannerJustification;
FBannerNumColors : Integer;
FBannerRect : TRect;
FBannerText : String;
FBannerWidth : Integer;
FBrush : TBrush;
FCanvas : TCanvas;
FCheckBitmap : TBitmap;
FDefaultFont : Boolean;
FDefaultHeight : Integer;
FDefaultMargin : Integer;
FFont : TFont;
FHiliteBar : TColor;
FHiliteFont : TFont;
FImageChangeLink : TChangeLink;
FImages : TImageList;
FInitOk : Boolean;
FItemHeight : Integer;
FItemWidth : Integer;
FMDIList : TList;
FMenu : TMenu;
FMenuBarSelID : Integer;
FMenus97Look : TMenus97Look;
FNeedBannerRect : Boolean;
FNewTFormWndProcInstance : Pointer;
FOldTFormWndProc : Pointer;
FOnDrawItem : TDrawMenuItemEvent;
FOnHint : THintEvent;
FOnMeasureItem : TMeasureMenuItemEvent;
FRadioBitmap : TBitmap;
constructor Create(AOwner: TComponent);
TCustomMenus97
destructor Destroy;
Chargement de l'image pour l'option Checked & RadioItem.
procedure NewTFormWndProc(Var Message: TMessage);
procedure Office97Mapping;
procedure FixupReferences;
procedure Loaded;
procedure Notification (AComponent: TComponent; Operation: TOperation);
procedure BrushChange(Sender: TObject);
procedure CalcBannerRect;
function CalcMenuBarHeight: Integer;
and to release Our WndProc instance
function CalcMenuHeight(Item: TMenuItem): Integer;
function CalcMenuWidth(Item: TMenuItem): Integer;
Calcul de la largeur maxi du menu (avec accelerateurs et sous-menus) Max Menu Width Calculation
procedure DrawDisabledImage(Var Rect : TRect; IndexImage : Integer);
procedure DrawDisabledImage95(Var Rect : TRect; IndexImage : Integer);
procedure DrawDisabledImageNT(Var Rect : TRect; IndexImage : Integer);
De larges portions du code de cette procedure proviennent de l'excellent TExplorerButton de Fabrice Deville.
procedure DrawItem(Item: TMenuItem; Rect: TRect; State: TOwnerDrawState);
procedure CNMeasureItem(var Message: TWMMeasureItem); message CN_MEASUREITEM;
GradientFill
procedure DrawItemText(Item: TMenuItem; Var Rect: TRect; Text: String);
procedure DrawMenuBarItem(Item: TMenuItem; Var Rect: TRect; State: TOwnerDrawState);
function FindItemByCommand(Command: Word): TMenuItem;
procedure FontChange(Sender: TObject);
procedure GetDefaultMenuFont(Var aFont: TFont);
function GetTextSize(ACanvas: TCanvas; Text: string ): TSize;
procedure GradientFill(DC: HDC; FBeginColor, FEndColor: TColor; R: TRect);
De larges portions du code de cette procedure proviennent de l'excellent TMSOfficeCaption de Warren F. Young.
function HasBanner(Item: TMenuItem): boolean;
procedure HiliteFontChange(Sender: TObject);
procedure InternalModifyMenuTree(MenuItems : TMenuItem; Level: Integer);
Form1.ListBox1.Items.Add(Name);
function IsFontStored: Boolean;
procedure MeasureItem(Item: TMenuItem; var Height, Width: Integer);
procedure ModifyMenuTree(MenuItems : TMenuItem; Restore: Boolean);
procedure InternalModifyMenu(Command: Integer; Caption: String; Restore: Boolean); virtual;
procedure TCustomMenus97.InternalModifyMenu(Command: Integer; Caption: String; Restore: Boolean);
Var
MI: TMenuItemInfo;
C : array[0..10] of Char;
begin
if ( Caption = '-' ) then Exit;
MI.cbSize:= Sizeof(TMenuItemInfo);
MI.fMask:= MIIM_TYPE or MIIM_DATA;
MI.fType:= 0;
MI.cch:= 0;
MI.dwTypeData:= nil;
GetMenuItemInfo(InternalMenu.Handle, Command, False, MI);
MI.cbSize:= Sizeof(TMenuItemInfo);
MI.fMask:= MIIM_TYPE or MIIM_DATA;
if ( ( MI.fType and MFT_OWNERDRAW ) <> MFT_OWNERDRAW ) then begin
MI.dwItemData:= Integer(Self);
MI.fType:= MFT_OWNERDRAW;//( MI.fType and ( Not MFT_STRING ) ) or MFT_OWNERDRAW;
SetMenuItemInfo(InternalMenu.Handle, Command, False, MI);
end;
end;
function ProcessAccel(Message: TWMMenuChar ): Integer;
((Self is TCustomPopupMenus97) or (InternalMenu.Items[0] = ParentItem )) And ( Banner ) ) then
procedure ReleaseMDIList;
procedure SetBannerFont(Value: TFont);
procedure SetBrush(Value: TBrush);
procedure SetDefaultFont(Value: Boolean);
procedure SetFont(Value: TFont);
else we call the old DefaultProc.
procedure SetHiliteFont (Value : Tfont);
Procedure SetImages (Value: TImageList);
procedure SetInternalMenu(Value: TMenu);
procedure SetMenus97Look(Value: TMenus97Look);
procedure WMDrawItem(var Message: TWMDrawItem);
procedure TCustomMenus97.WMDrawItem(var Message: TWMDrawItem);
begin
CNDrawItem(Message);
end;
procedure WMMeasureItem(var Message: TWMMeasureItem);
procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
Fin de "TCustomMenus97.DrawItem".} (*procedure TCustomMenus97.WMMeasureItem(var Message: TWMMeasureItem);
begin
CNMeasureItem(Message);
end;
property Banner : Boolean
property BannerColor : TColor
property BannerEndColor : TColor
property BannerFont : TFont
property BannerImage : Integer
property BannerJustification : TBannerJustification
property BannerNumColors : Integer
property BannerText : String
property BannerWidth : Integer
property Brush : TBrush
property Canvas : TCanvas
property DefaultFont : Boolean
property Font : TFont
property HiliteBar : Tcolor
property HiliteFont : TFont
property Images : TImageList
property ItemHeight : Integer
property ItemWidth : Integer
property Menus97Look : TMenus97Look
property InternalMenu : TMenu
event OnDrawItem : TDrawMenuItemEvent
event OnHint : THintEvent
event OnMeasureItem : TMeasureMenuItemEvent
FBanner : Boolean;
FBannerBmp : TBitmap;
FBannerColor : TColor;
FBannerEndColor : TColor;
FBannerFont : TFont;
FBannerImage : Integer;
FBannerJustification : TBannerJustification;
FBannerNumColors : Integer;
FBannerRect : TRect;
FBannerText : String;
FBannerWidth : Integer;
FBrush : TBrush;
FCanvas : TCanvas;
FCheckBitmap : TBitmap;
FDefaultFont : Boolean;
FDefaultHeight : Integer;
FDefaultMargin : Integer;
FFont : TFont;
FHiliteBar : TColor;
FHiliteFont : TFont;
FImageChangeLink : TChangeLink;
FImages : TImageList;
FInitOk : Boolean;
FItemHeight : Integer;
FItemWidth : Integer;
FMDIList : TList;
FMenu : TMenu;
FMenuBarSelID : Integer;
FMenus97Look : TMenus97Look;
FNeedBannerRect : Boolean;
FNewTFormWndProcInstance : Pointer;
FOldTFormWndProc : Pointer;
FOnDrawItem : TDrawMenuItemEvent;
FOnHint : THintEvent;
FOnMeasureItem : TMeasureMenuItemEvent;
FRadioBitmap : TBitmap;