一个导航菜单控件

                            速达软件都有一个导航菜单,使用非常方便,我用Delphi 写了一个类似的控件,
支持D5,D6
欢迎大家参考、试用,如果有什么意见和建议,请留下墨宝,以便参考。谢谢!!!!

此控件包含三个文件
MyMenu.Pas  控件主文件
Glh.inc    Delphi 版本兼容性设置
MenuReg.Pas  组件编辑器注册
图标文件不便上传,请自行编辑面板图标
需要设置相关路径和所需要的包

将控件所在的路径加入包搜索路径中




unit MyMenu;

//////////////////////////////////////////////////
//          导航菜单 V0.02                      //
//          设计:甘论洪      glh@163.net        //
//          2002.07.20                          //
//                                              //
//////////////////////////////////////////////////



{说明
1.此控件继承与TWinControl,相关帮助请参阅Delphi的TWinControl帮助.
2.控件功能请参见代码中的说明.
3.你可以将此控件用于任何环境,无需注册,也无需任何费用.
4.如果你将此控件转手他人使用,必须公布此控件的原码,
  此控件部分也不能要求除发行成本外的其他费用.
5.软件作者不对由使用此控件造成的任何损失负责.
6.如果你修改了控件代码,烦请将修改部分告诉我,
  如果你愿意,可以将你修改的部分集成到新版本中.
}

{
修改历史
2002.07.30  V0.01  首次发布
2002.08.06  V0.02  增加了图形设置,缺省值设置

}
{$I GLH.Inc}
interface

uses
  Windows, Messages, SysUtils,Extctrls, Classes, Graphics, Controls, Forms,ImgList,
  {$IFDEF GLH_LIB_dELPHI_6} Variants,{$ENDIF}
  Dialogs,Commctrl;
type

  TOnSelect=Procedure(TSendor:TComponent;Index:Integer;Caption:String) Of Object;

  TMenuItemSaveInfo=(msColor,msMouseMoveColor,msSelectColor,msFont);
  TMenuItemSaveInfos=Set Of TMenuItemSaveInfo;

  TGlhMEnuItem=Class;
  TGlhMEnuItems=Class;

  //导航菜单
  TglhMenuBar = class(TCustomControl)
  private
        FBKColor:TColor;
        FMouseMoveIndex:Integer;
        FSelectIndex:Integer;
        FUseMouseMoveColor:Boolean;
        FUseSelectColor:Boolean;
        FItemHeight:Integer;
        FitemVDistence:Integer;
 FOnselect:TOnselect;
        FMouseMove:Boolean;
        FColumnCount:Integer;
        FItemWidth:Integer;
        FItemHDistence:Integer;
        fKeepSelect:Boolean;
        fglhMenuitems:TglhMEnuItems;
        fImages:TCustomImageList;
        fChangeLink:TChangeLink;
        fDefaultColor:TColor;
        fDefaultFont:TFont;
        fDefaultMouseMOveColor:TColor;
        fDefaultSelectColor:TColor;
        FDefaultontSaved:Boolean;

        //属性设置程序

        Procedure SetBKColor(Value:TColor);
        Procedure SetItemHeight(Value:Integer);
        Procedure SetItemVDistence(Value:Integer);
        Procedure SetglhMenuItems(Value:TglhMenuItems);
        Procedure SetUseSelectColor(Value:Boolean);
        Procedure SetUseMouseMoveColor(Value:Boolean);
        Procedure SetColumnCount(Value:Integer);
        Procedure SetItemWidth(Value:Integer);
        Procedure SetItemHDistence(Value:Integer);
        Procedure SetImageList(Value: HImageList);
        Procedure SetIMages(Value:TCustomImageList);

        Procedure SetDefaultColor(VAlue:TColor);
        Procedure SetDefaultMouseMoveColor(VAlue:TColor);
        Procedure SetDefaultSelectColor(VAlue:TColor);
        Procedure SetDefaultFont(VAlue:TFont);


        Function  GetItemRect(Index:Integer):TRect;
        //计算指定菜单项的位置


        Procedure IMageListChange(Sender:TObject);
        //ImageList改变 事件处理

        Procedure DefaultFontChanged(Sender:TObject);
        //DefaultFont改变 事件处理


        Function IsDefaultFontSaved:Boolean;
        //是否保存字体属性到dfm 文件中

        procedure WMSize(var Msg: TWMSize); message WM_SIZE;
        procedure CMMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;

    { Private declarations }
  protected
        procedure Paint;override;


        Procedure PaintItem(Index:Integer);
        //画指定菜单项

        Function  MouseToItem(X,y:Integer):Integer;
        //根据鼠标位置计算所在的菜单项

 procedure MouseDown(Button: TMouseButton; Shift: TShiftState;X, Y: Integer); Override;
     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;


    { Protected declarations }
  public

        Constructor Create(Aowner:TComponent);Override;
        //构造函数

        Destructor  Destroy;Override;
        //析构函数
    { Public declarations }
  published
        Property Align;
        //停靠位置


        Property BKColor:TColor Read FBKColor Write SetBKColor Default clTeal;
        //导航菜单背景色

        Property ItemHeight:Integer Read FItemHeight Write SetItemHeight Default 50;
        //菜单项的高度

        Property ItemVDistence:Integer Read FItemVDistence Write SetItemVDistence Default 10;
        //菜单项垂直方向的间距


 Property ItemHDistence:Integer Read FItemHDistence Write SetItemHDistence Default 10;
        //菜单项水平方向的间距(停靠位置为Top 、Bottom 或None 时有效)

        Property GlhMenuItems:TGlhMenuItems Read FGlhMenuItems Write SetGlhMenuItems;


        Property OnSelect:TOnselect Read FOnselect Write FOnSelect;
        //选择菜单项时产生的事件


 Property UseSelectColor:Boolean Read FUseSelectColor Write SetuseSelectColor Default true;
        //菜单项选择时使用颜色


   Property UseMouseMoveColor:Boolean Read FuseMouseMoveColor Write SetuseMouseMoveColor default false;
        //鼠标在菜单项上移动时使用颜色


        Property ColumnCount:Integer Read FColumnCount Write SetColumnCount Default 0;
        //导航菜单的列数(停靠位置为Top 、Bottom 或None 时有效)



        Property ItemWidth:Integer Read FItemWidth Write SetItemWidth Default 0;
        //菜单项的宽度(停靠位置为Top 、Bottom 或None 时有效)


        Property KeepSelect:Boolean Read FKeepSelect Write fKeepSelect Default true;
        //一直保持菜单选择项


        Property Images:TCustomImageList Read fImages Write SetIMages;
        //图形来源


        Property DefaultColor:TColor Read fDefaultColor Write SetDefaultColor Default $00D7C8A8;
        //MenuItem的缺省颜色值

        Property DefaultMouseMoveColor:TColor Read fDefaultMouseMoveColor Write SetDefaultMouseMoveColor Default clAqua;
        //MenuItem的缺省鼠标移动时的颜色值

        Property DefaultSelectColor:TColor Read fDefaultSelectColor Write SetDefaultSelectColor Default $008FD2DA;
        //MenuItem的选中时的缺省颜色值

        Property DefaultFont:TFont Read fDefaultFont Write SetDefaultFont Stored IsDefaultFontSaved;
        //MenuItem的缺省字体值
    { Published declarations }
  end;
  //菜单项
  TglhMenuItem=Class(TCollectionItem)
  Private
        fFont:TFont;
        fColor:TColor;
        fMouseMOveColor:TColor;
        fSelectColor:TColor;
        fCaption:String;
        fNormalImageIndex:TImageIndex;
        fMouseMoveImageIndex:TIMageIndex;
        fSelectImageIndex:TIMageIndex;
        fMenuItemSaveInfos:TMEnuItemSaveInfos;
        //字体改变事件处理
        Procedure FontChanged(Sender: TObject) ;

        //属性设置
        Procedure SetFont(Value:TFont);
        Procedure SetColor(Value:TColor);
        Procedure SetMouseMoveColor(Value:TColor);
        Procedure SetSelectColor(Value:TColor);

        Procedure SetCaption(Value:String);
        Procedure SetNormalImageIndex(Value:TIMageIndex) ;
        Procedure SetMouseMoveImageIndex(Value:TIMageIndex);
        Procedure SetSelectImageIndex(Value:TIMageIndex);

        //是否保存属性到dfm文件
        Function IsFontStored:Boolean;
        Function IsColorStored:Boolean;
        Function IsMouseMoveColorStored:Boolean;
        Function IsSelectColorStored:Boolean;

        //取缺省设置
        Function DefaultFont:TFont;
        Function DefaultColor:TColor;
        Function DefaultMouseMOveColor:TColor;
        Function DefaultSelectColor:TColor;

        //取Item 所在的MenuBar
        Function GetMenuBar:TglhMenuBar;

  Protected
        //菜单项在属性编辑器中的显示内容
        FUNCTION GetDisplayName:String;Override;
  Public
        //构造函数
        Constructor Create(Collection:TCollection);Override;
        //析构函数
        Destructor  Destroy;Override;
        //对象复制
        Procedure Assign(Source:Tpersistent);Override;

        //处理MenuBar的缺省设置
        Procedure RefreshDefaultFont;
        Procedure RefreshDefaultColor;
        Procedure RefreshDefaultMouseMoveColor;
        Procedure RefreshDefaultSelectColor;

  Published
        //标题
        Property Caption:String Read FCaption Write SetCaption;
        //标题字体
        Property Font:TFont Read FFOnt Write SetFont Stored IsFontStored;

        //菜单项颜色
        Property Color:TColor Read FColor Write SetColor  Stored IsColorStored;

        //鼠标移动时的颜色
        Property MouseMoveColor:TColor Read FMouseMoveColor Write SetMouseMoveColor Stored IsMOuseMOveColorStored;

        //菜单项选中时的颜色
        Property SelectColor:TColor Read FSelectColor Write SetSelectColor Stored IsSelectColorStored;

        //菜单正常图标
        Property NormalImageIndex:TIMageIndex Read fNormalImageIndex Write SetNormalImageIndex Default -1;

        //鼠标在菜单上移动时的图标
        Property MOuseMOveImageIndex:TIMageIndex Read fMOuseMOveImageIndex Write SetMOuseMOveImageIndex Default -1;

        //菜单选中时的图标
        Property SelectImageIndex:TIMageIndex Read fSelectImageIndex Write SetSelectImageIndex Default -1;

  END;


  //菜单项集合
  TGlhMenuItems=Class(TCollection)
  Private
        FglhMenuBar:TglhMenuBAr;
        //取指定菜单项
        Function  GetItem(Index:Integer):TGlhMenuItem;
        //设置指定菜单项
        Procedure SetItem(Index:Integer;Value:TGlhMenuItem);

  Protected


        //菜单项改变时刷新
        Procedure Update(Item: TCollectionItem);Override;
  Public
        //构造函数
        Constructor Create(aOwner:TGlhMenuBar);
        //Destructor  Destroy;Override;
        //增加菜单项
        Function Add:TGlhMenuItem;

        //取所有者
        Function GetOwner:Tpersistent;Override;
        //菜单象列表
        Property Items[Index:Integer]:TGlhMenuItem Read GetItem Write SetItem;Default;
  Published
  END;


procedure Register;

implementation

Constructor TglhMenuBar.Create(Aowner:TComponent);
 BEGIN

        Inherited Create(aowner);
        fGlhMenuItems:=TGlhMEnuitems.Create(Self);
        fChangeLink:=TChangeLink.Create;
        fChangeLink.OnChange :=Self.IMageListChange;
        self.KeepSelect :=true;
        fDefaultFont:=TFont.Create ;
        self.FDefaultontSaved :=false;

        Self.fDefaultColor :=$00D7C8A8;
        Self.fDefaultMouseMoveColor:=clAqua;
        Self.fDefaultSelectColor:=$008FD2DA;

        Self.fDefaultFont.Name :='宋体';
        Self.fDefaultFont.Size :=18;
        Self.fDefaultFont.Style :=[fsBold];
        Self.fDefaultFont.Charset :=GB2312_CHARSET;
        Self.fDefaultFont.OnChange:=SELF.DefaultFontChanged;

        Self.Width:=150;
        self.Align :=alLeft;
        self.BkColor:=clTeal;
        Self.ItemHeight:=50;
        Self.ItemVDistence :=10;
        Self.ItemHDistence :=10;
        FMouseMoveIndex:=-1;
        FSelectIndex:=-1;
        FColumnCount:=1;

        self.UseMouseMoveColor :=false;
        Self.UseSelectColor :=true;
        END;

Destructor  TglhMenuBar.Destroy;
 BEGIN
        fGlhMenuItems.Free ;
        fchangelink.Free ;
        fDefaultFont.Free ;
        Inherited Destroy;
        END;

procedure TglhMenuBar.Paint;
 var
        i:Integer;
 begin

        IF Not KeepSelect THEN
         BEGIN
         self.FMouseMoveIndex :=-1;
         self.FSelectIndex :=-1;
                END;
 Self.Canvas.Brush.Color:=self.BKColor;
        self.Canvas.Pen.Color :=self.BKColor;
        self.Canvas.Rectangle(0,0,width,height);
        FOR I:=0 TO Self.FglhMenuitems.Count-1 DO
         BEGIN
                Paintitem(I);
                END;
        end;

Procedure TglhMenuBar.PaintItem(Index:Integer);
 Var
 R:Trect;
        x,y,IMageIndex:Integer;
 BEGIN


        IF SELF.FGlhMEnuItems.items[Index].Caption ='' THEN Exit;
        r:=self.GetItemRect(Index);
        Self.Canvas.Brush.Color:=self.glhMEnuItems[Index].Color ;
        ImageIndex:=self.GlhMenuItems[Index].NormalImageIndex ;

         IF (FMouseMoveIndex=Index) AND (UseMouseMoveColor) THEN
           Self.Canvas.Brush.Color:=self.GlhMenuItems[Index].MouseMoveColor ;

        IF (FMouseMoveIndex=Index) THEN
                ImageIndex:=Self.GlhMenuItems[Index].MOuseMOveImageIndex ;




       IF (FSelectIndex=Index)  AND UseSelectColor THEN
         Self.Canvas.Brush.Color:=self.GlhMenuItems[Index].SelectColor;

       IF (FSelectIndex=Index)   THEN
                ImageIndex:=Self.GlhMenuItems[Index].SelectImageIndex ;


        Self.Canvas.Pen.Color:=Self.GlhMenuItems[Index].Color ;
        DrawFrameControl(Self.canvas.handle,r,DFC_BUTTON  ,DFCS_BUTTONPUSH    );

        R.Top:=R.Top +1;
        R.Left :=R.Left +1;
        R.Right :=R.Right -1;
        R.Bottom :=R.Bottom -1;
        self.Canvas.Rectangle(r);

        self.Canvas.Font.Assign(self.GlhMenuItems[Index].Font) ;


        x:=2;
        IF Assigned(Self.IMages) AND (IMageIndex<>-1) THEN
                BEGIN
                Y:=R.Top+rOUND((R.Bottom-R.Top-sELF.Images.Height)/2);
                sELF.Images.Draw(Self.Canvas,x,y,IMageIndex);
                X:=Self.Images.Width +15;
                END;

        y:=round(r.top+(r.Bottom-r.Top-self.Canvas.TextHeight('甘'))/2);
        self.Canvas.TextOut(R.LEFT+x,Y,Self.GlhMenuItems.Items[Index].Caption );

        END;

Function  TglhMenuBar.MouseToItem(X,y:Integer):Integer;
 VAR
        I:Integer;
        fRect:TRect;
 BEGIN

        Result:=-1;
        FOR I:=0 TO FglhMenuItems.Count -1 DO
         begin
                fRect:=Self.GetItemRect(i);
                IF (x>=frect.Left) AND (x<=fRect.Right) AND (y>=frect.Top) AND (y<=frect.Bottom) THEN
     begin
                        result:=I;
                        exit;
                        end;
                end;
        END;

Procedure TglhMenuBar.SetBKColor(Value:TColor);
 BEGIN
        FBKColor:=Value;
        Invalidate;
        END;


Procedure TglhMenuBar.SetItemHeight(Value:Integer);
 BEGIN
        FitemHeight:=Value;
        Invalidate;
        END;

Procedure TglhMenuBar.SetUseSelectColor(Value:Boolean);
 BEGIN

        FUseSelectColor:=Value;

        END;

Procedure TglhMenuBar.SetUseMouseMoveColor(Value:Boolean);
 BEGIN
        FUseMouseMoveColor:=Value;

        END;

Procedure TglhMenuBar.SetItemVDistence(Value:Integer);
 BEGIN
        FitemVDistence:=Value;
        Invalidate;
 END;

Procedure TglhMenuBar.SetglhMenuItems(Value:TglhMenuItems);
        BEGIN
        Self.fglhMenuitems.assign(Value);

        END;

procedure TglhMenuBar.SetImageList(Value: HImageList);
        var
        BarInfo: TReBarInfo;
        begin
        if HandleAllocated then
                begin
                if Value = 0 then
                        RecreateWnd
                else
                        begin
                        //BarInfo.cbSize := SizeOf(TReBarInfo);
                        //BarInfo.fMask := RBIM_IMAGELIST;
                        //BarInfo.himl := Value;
                        //Perform(RB_SETBARINFO, 0, Integer(@BarInfo));
                        //Invalidate;
                        end;
                end;
        end;

Procedure TglhMenuBar.SetImages(Value:TCustomImageList);
        VAR
        I:Integer;
        BEGIN
        if FImages <> nil then FImages.UnRegisterChanges(FChangeLink);
        FImages := Value;
        if FImages <> nil then
                begin
                FImages.RegisterChanges(FChangeLink);
                FImages.FreeNotification(Self);
                SetImageList(FImages.Handle);
                end
        else
                SetImageList(0);

          {FOR I:=0 TO Self.GlhMenuItems.Count-1 DO
                BEGIN
                Self.GlhMenuItems[i].NormalImageIndex :=-1;
                Self.GlhMenuItems[i].SelectImageIndex :=-1;
                Self.GlhMenuItems[i].MOuseMOveImageIndex:=-1;
                END;}
        END;

Procedure TglhMenuBar.SetColumnCount(Value:Integer);
 BEGIN
        IF (Align =alLeft) OR (align=alRight) THEN EXIT;
        IF (FColumnCount<>Value) AND  (Value>0) THEN
         BEGIN
                FColumnCount:=Value;
                InValidate;
                END;
        END;

Procedure TglhMenuBar.SetDefaultColor(VAlue:TColor);
        var
        I:Integer;
        BEGIN
        IF fDefaultColor<>Value THEN
                BEGIN
                fDefaultColor:=Value;
                FOR I:=0 TO Self.GlhMenuItems.Count -1 DO
                        Self.GlhMenuItems[i].RefreshDefaultColor ;

                END;
        END;

Procedure TglhMenuBar.SetDefaultMouseMoveColor(VAlue:TColor);
        var
        I:Integer;
        BEGIN
        IF fDefaultMouseMoveColor<>Value THEN
                BEGIN
                fDefaultMouseMoveColor:=Value;
                FOR I:=0 TO Self.GlhMenuItems.Count -1 DO
                        Self.GlhMenuItems[i].RefreshDefaultMOuseMOveColor;

                END;

        END;

Procedure TglhMenuBar.SetDefaultSelectColor(VAlue:TColor);
        Var
        i:Integer;
        BEGIN
        IF fDefaultSelectColor<>Value THEN
                BEGIN
                fDefaultSelectColor:=Value;
                FOR I:=0 TO Self.GlhMenuItems.Count -1 DO
                        Self.GlhMenuItems[i].RefreshDefaultSelectColor;

                END;

        END;

Procedure TglhMenuBar.SetDefaultFont(VAlue:TFont);
        var
        I:Integer;
        BEGIN
        Self.FDefaultontSaved:=true;
        fDefaultFont.Assign(Value);
        FOR I:=0 TO Self.GlhMenuItems.Count -1 DO
                Self.GlhMenuItems[i].RefreshDefaultFont ;

        END;

Procedure TglhMenuBar.SetItemWidth(Value:Integer);
 BEGIN
        IF (Align =alLeft) OR (align=alRight) THEN EXIT;
        IF FItemWidth<>Value THEN
         BEGIN
                FItemWidth:=Value;
                InValidate;
                END;

        END;

Procedure TglhMenuBar.SetItemHDistence(Value:Integer);
 BEGIN
        //IF (Align =alLeft) OR (align=alRight) THEN EXIT;
        IF FItemHDistence<>Value THEN
         BEGIN
                FItemHDistence:=Value;
                InValidate;
                END;

        END;


procedure TglhMenuBar.MouseDown(Button: TMouseButton; Shift: TShiftState;X, Y: Integer);
        VAR
        ItemIndex:Integer;
        OldIndex:Integer;
 BEGIN
        OldIndex:=FSelectIndex;
        ItemIndex:=Mousetoitem(x,y);
        FSelectIndex:=ItemIndex;
         if OldIndex<>FSelectIndex THEN
           BEGIN
           IF OldIndex<>-1 THEN
             PaintItem(OldIndex);
         IF FSelectIndex<>-1 THEN
           PaintItem(FSelectIndex);
                END;
        IF ItemIndex<>-1 THEN
         BEGIN
                IF ASSIGNED(FOnselect) THEN
           FOnselect(sELF,ItemIndex,Self.GlhMenuitems.Items[itemindex].Caption);
                END;

        END;

procedure TglhMenuBar.MouseMove(Shift: TShiftState; X, Y: Integer);
        VAR
        ItemIndex:Integer;
        OldIndex:Integer;
 BEGIN

        IF Not UseMouseMoveColor THEN EXIT;

        OldIndex:=FMouseMoveIndex;
        ItemIndex:=Mousetoitem(x,y);
        IF ItemIndex=OldIndex THEN EXIT;
        IF ItemIndex=-1 THEN
         BEGIN
                IF FMouseMoveIndex<>-1 THEN
                 begin
                        FMouseMoveIndex:=-1 ;
     PaintItem(OldIndex);
                        end
                END
        ELSE
         BEGIN

                FMouseMoveIndex:=ItemIndex;
                PaintItem(FMouseMoveIndex);
                IF (FMouseMoveIndex<>OldIndex)  and (OldIndex<>-1)  THEN
                 BEGIN

                 PaintItem(OldIndex);
                        END;



                END;
        END;

Procedure TglhMenuBar.IMageListChange(Sender:TObject);
        BEGIN
        if HandleAllocated and (Sender = Images) then
                BEGIN
                if Images.HandleAllocated then
                        SetImageList(Images.Handle)
                else
                        SetImageList(0);
                END;
        END;

Procedure TglhMenuBar.DefaultFontChanged(Sender:TObject);
        Var
        I:Integer;
        BEGIN
        Self.FDefaultontSaved:=true;
        FOR I:=0 TO Self.GlhMenuItems.Count -1 DO
                Self.GlhMenuItems[i].RefreshDefaultFont ;

        END;

Function  TglhMenuBar.GetItemRect(Index:Integer):TRect;
 var
        ItemX,ItemY:Integer;
 BEGIN
        IF (Align=alRight) OR (align=alLeft) THEN
         BEGIN
   Result.Top:=Index*(Self.ItemHeight +self.ItemVDistence);
   Result.Bottom:=Result.Top +Self.ItemHeight;
                result.Left :=0;
                Result.Right :=self.Width ;
                END
        ELSE
         BEGIN
                Itemy:=Round(int(Index/ColumnCount));
                Itemx:=Index-ItemY*ColumnCount;
                Result.Left :=itemx*(ItemWidth+ItemHDistence);
                Result.Right:=result.Left +ItemWidth;
                result.Top :=ItemY*(ItemHeight+ItemVDistence);
                Result.Bottom :=Result.Top +itemHeight;
                END;


        END;

procedure TglhMenuBar.WMSize(var Msg: TWMSize);
 BEGIN
        Inherited;
        IF (Self.Align=alTop) Or (Self.Align=alBottom) Or (Self.Align=alNone) THEN
                BEGIN
                IF Self.ColumnCount=1 THEN
                        BEGIN
                        Self.ColumnCount :=3;

                        Self.Height:=(Self.ItemHeight+Self.ItemVDistence)*Round((self.GlhMenuItems.Count+3)/3);
                        END;
                IF Self.ItemWidth =0 THEN
                        Self.ItemWidth:=round(Self.Width/3)-Self.ItemHDistence;  ;

                END;
        Invalidate;
        END;

procedure TglhMenuBar.CMMouseLeave(var Msg: TMessage);
 begin
        IF Self.KeepSelect =false THEN
         BEGIN
   Self.FMouseMoveIndex:=-1;
         Self.FSelectIndex:=-1;
         Invalidate;
                END;
        Inherited;
        end;

Function TglhMenuBar.IsDefaultFontSaved:Boolean;
        BEGIN
        Result:=Self.FDefaultontSaved;
        END;

//TglhMenuItem
Constructor TglhMenuitem.Create(Collection:TCollection);
        BEGIN
        Inherited Create(Collection);

        self.fFont:=TFont.Create;

        Self.fColor :=$00D7C8A8;
        Self.fMouseMoveColor:=clAqua;
        Self.fSelectColor:=$008FD2DA;
        Self.fFont.Name :='宋体';
        Self.fFont.Size :=18;
        Self.fFont.Style :=[fsBold];
        Self.fFont.Charset :=GB2312_CHARSET;

        ffont.OnChange:=self.FontChanged;
        self.NormalImageIndex:=-1;
        self.SelectImageIndex:=-1;
        Self.MOuseMOveImageIndex:=-1;
        END;

Destructor  TglhMenuitem.Destroy;
        BEGIN
        fFont.Free ;
        Inherited Destroy;
        END;

Procedure TglhMenuitem.Assign(Source:Tpersistent);
        BEGIN
        IF Source Is TglhMenuItem THEN
                BEGIN
                FCaption:=TglhMenuItem(Source).Caption;
                fColor:=TglhMenuItem(Source).Color;
                FMouseMOveColor:=TglhMenuItem(Source).MouseMOveColor;
                FSelectColor:=TglhMenuItem(Source).SelectColor;
                fNormalImageIndex:=TglhMenuItem(Source).NormalImageIndex;
                fMouseMoveImageIndex:=TglhMenuItem(Source).MouseMoveImageIndex;
                fSelectImageIndex:=TglhMenuItem(Source).SelectImageIndex;
                fFont.Assign(TglhMenuItem(Source).Font);

                END;

        END;

Procedure TglhMenuitem.RefreshDefaultFont;
        var
        Save: TNotifyEvent;
        begin
        IF msFont In fMenuitemSaveInfos THEN EXIT;
        Save:=ffOnt.OnChange ;
        ffont.OnChange :=Nil;
        Try
                fFont.Assign(DefaultFont);
        finally
                ffont.OnChange :=Save;
        ENd;
        Self.GetMenuBar.Invalidate ;
        END;

Procedure TglhMenuitem.RefreshDefaultColor;
        BEGIN
        IF msColor In fMenuitemSaveInfos THEN EXIT;
        Self.fColor:=DefaultColor;
        self.GetMenuBar.Invalidate ;
        END;

Procedure TglhMenuitem.RefreshDefaultMouseMoveColor;
        BEGIN
        IF msMouseMoveColor In fMenuitemSaveInfos THEN EXIT;
        Self.fMouseMoveColor:=DefaultMouseMoveColor;
        END;

Procedure TglhMenuitem.RefreshDefaultSelectColor;
        BEGIN
        IF msSelectColor In fMenuitemSaveInfos THEN EXIT;
        Self.fSelectColor:=DefaultSelectColor;

        END;

Procedure TglhMenuitem.SetMouseMoveColor(Value:TColor);
 BEGIN
        IF  FMouseMoveColor<>Value THEN
                BEGIN
                Include(fMenuitemSaveInfos,msMouseMoveColor);
                FMouseMoveColor:=Value;
                changed(false);
                END;
        END;

Procedure TglhMenuitem.SetSelectColor(Value:TColor);
 BEGIN
        IF  FSelectColor<>Value THEN
                BEGIN
                Include(fMenuitemSaveInfos,msSelectColor);
                FSelectColor:=Value;
                changed(false);
                END;
        END;

Procedure TglhMenuitem.SetColor(Value:TColor);
 BEGIN
        IF  FColor<>Value THEN
                BEGIN
                Include(fMenuitemSaveInfos,msColor);
                FColor:=Value;
                changed(false);
                END;
        END;

Procedure TglhMenuitem.SetNormalImageIndex(Value:TIMageIndex);
        BEGIN
        IF Self.fNormalImageIndex<>Value THEN
                BEGIN
                Self.fNormalImageIndex:=Value;
                Self.Changed(false);
                END;
        END;

Procedure TglhMenuitem.SetMouseMoveImageIndex(Value:TIMageIndex);
        BEGIN
        IF Self.fMouseMoveImageIndex<>Value THEN
                BEGIN
                Self.fMouseMoveImageIndex:=Value;
                Self.Changed(false);
                END;
        END;

Procedure TglhMenuitem.SetSelectImageIndex(Value:TIMageIndex);
        BEGIN
        IF Self.fSelectImageIndex<>Value THEN
                BEGIN
                Self.fSelectImageIndex:=Value;
                Self.Changed(false);
                END;
        END;

Procedure TglhMenuitem.SetFont(Value:TFont);
 BEGIN
        Include(fMenuitemSaveInfos,msFOnt);
        FFont.Assign(Value);
        Changed(false);
        END;

Procedure TglhMenuitem.SetCaption(Value:String);
 BEGIN
        fCaption:=VAlue;
        Changed(false);
        END;

Function TglhMenuitem.IsFontStored:Boolean;
        BEGIN
        Result:=(msFont In FMenuItemSaveInfos);
        END;

Function TglhMenuitem.IsColorStored:Boolean;
        BEGIN
        Result:=(msColor In FMenuItemSaveInfos);
        END;

Function TglhMenuitem.IsMouseMoveColorStored:Boolean;
        BEGIN
        Result:=(msMouseMOveColor In FMenuItemSaveInfos);
        END;

Function TglhMenuitem.IsSelectColorStored:Boolean;
        BEGIN
        Result:=(msSelectColor In FMenuItemSaveInfos);
        END;


Function TglhMenuitem.DefaultFont:TFont;
        var
        fMEnuBar:TglhMenuBar;
        BEGIN
        fMenuBAr:=Self.GetMenuBar;
        IF Assigned(fMEnuBAr) THEN
                Result:=fMEnubar.DefaultFont
        ELSE
                Result:=self.Font ;
        END;

Function TglhMenuitem.DefaultColor:TColor;
        var
        fMEnuBar:TglhMenuBar;
        BEGIN
        fMenuBAr:=Self.GetMenuBar;
        IF Assigned(fMEnuBAr) THEN
                Result:=fMenuBAr.DefaultColor
        ELSE
                Result:=Self.Color ;

        END;

Function TglhMenuitem.DefaultMouseMOveColor:TColor;
        var
        fMEnuBar:TglhMenuBar;
        BEGIN
        fMenuBAr:=Self.GetMenuBar;
        IF Assigned(fMEnuBAr) THEN
                Result:=fMEnubar.DefaultMouseMoveColor
        ELSE
                Result:=self.MouseMoveColor ;
        END;

Function TglhMenuitem.DefaultSelectColor:TColor;
        var
        fMEnuBar:TglhMenuBar;
        BEGIN
        fMenuBAr:=Self.GetMenuBar;
        IF Assigned(fMEnuBAr) THEN
                Result:=fMEnubar.DefaultSelectColor
        ELSE
                Result:=self.SelectColor ;
        END;

Function TglhMenuitem.GetMenuBar:TglhMenuBar;
        BEGIN
        IF (Assigned(Collection)) AND (Collection Is TGlhMenuItems) THEN
                BEGIN
                Result:=TglhMenuItems(Collection).fGlhMenuBar;
                END
        ELSE
                BEGIN
                Result:=Nil;
                END;


        END;

FUNCTION TglhMenuitem.GetDisplayName:String;
        BEGIN
        Result:=self.Caption;
        IF Result='' THEN
                Result:=Inherited GetdisplayName;
        END;

Procedure TglhMenuitem.FontChanged(Sender: TObject) ;
        BEGIN
        Include(fMenuitemSaveInfos,msFOnt);
        Changed(false);
        END;

//TglhMenuItems
Constructor TGlhMenuItems.Create(aOwner:TGlhMenuBar);
        BEGIN
        Inherited Create(TGlhMenuItem);
        fGlhMenuBar:=aOwner;
        END;

Function   TGlhMenuItems.Add:TGlhMenuItem ;
        BEGIN
        Result:=TGlhMenuItem(Inherited Add);
        END;

Function TGlhMenuItems.GetOwner:TPersistent;
        BEGIN
        Result:=fGlhMenuBar;
        END;

Procedure TGlhMenuItems.Update(Item: TCollectionItem);
        BEGIN
        Self.FglhMenuBar.Invalidate;
        END;

Function TGlhMenuItems.GetItem(Index:Integer):TGlhMenuItem;
        BEGIN
        Result:=TGlhMenuItem(Inherited GetItem(Index));
        END;

Procedure TGlhMenuItems.SetItem(Index:Integer;Value:TGlhMenuItem);
        BEGIN
        Inherited SetItem(Index,Value);
        END;

procedure Register;
begin
  RegisterComponents('glh', [TglhMenuBar]);

end;

end.


//glh.inc

//////////////////////////////////////////
//                          //
//  Delphi 版本兼容性设置      //
//                //
//  设计:甘论洪  glh@163.net  //
//////////////////////////////////////////


{$IFDEF VER100}  { Borland Delphi 3.0 }
  {$MESSAGE ERROR 'This version  don't support Delphi 3' }
{$ENDIF}

{$IFDEF VER110}         { C++Builder 3.0 }
  {$MESSAGE ERROR 'This version don't support C++Builder 3' }
{$ENDIF}

{$IFDEF VER120}         { Borland Delphi 4.0 }
  {$MESSAGE ERROR 'This version don't support Delphi 4 ' }
{$ENDIF}

{$IFDEF VER125}         { CPP Builder 4.0 }
  {$MESSAGE ERROR 'This version don't support C++Builder 3' }
{$ENDIF}

{$IFDEF VER130}         { Borland Delphi 5.0 or CPP Builder 5.0 }
  {$DEFINE GLH_LIB_DELPHI_5}
{$ENDIF}

{$IFDEF VER140}         { Borland Delphi 6.0 }
  {$DEFINE GLH_LIB_DELPHI_6}
{$ENDIF}


//{$D-}
//{$LOCALSYMBOLS OFF}
//{$REFERENCEINFO OFF}
//{$ASSERTIONS OFF}






unit MenuReg;
//////////////////////////////////////////////////
//          属性编辑器、组件编辑器注册          //
//          设计:甘论洪      glh@163.net        //
//          2002.07.20                          //
//                                              //
//////////////////////////////////////////////////


{$I glh.inc}
interface
uses
  Windows,SysUtils,forms,Classes,db,
  Dialogs,controls,imglist,graphics,ColnEdit,
  {$IFDEF GLH_LIB_dELPHI_6} Variants, DesignEditors,VCLEditors, DesignIntf,{$ENDIF}
  {$IFDEF GLH_LIB_dELPHI_5}  DsgnIntf,{$ENDIF}
  MyMenu;


Type
  //导航菜单组件编辑器
  TglhMenuEditor = class(TComponentEditor)
        public
        //执行选择的项目
        procedure ExecuteVerb(Index: Integer); override;

        //组件编辑器的标题
        function GetVerb(Index: Integer): string; override;

        //组件编辑器的命令数量
        function GetVerbCount: Integer; override;
        end;


  //ImageIndex属性编辑器
  TBaseImageIndexProperty = class(TIntegerProperty
   {$IFDEF GLH_LIB_dELPHI_6} ,ICustomPropertyDrawing, ICustomPropertyListDrawing{$Endif})
        private

        protected
        //取ImageList对象 各IMageIndex属性编辑器需覆盖此方法
        function GetImages: TCustomImageList; virtual;Abstract;


        property Images: TCustomImageList read GetImages;
        public
        //返回属性编辑器风格设置
        function GetAttributes: TPropertyAttributes; override;

        //生成属性编辑器的显示的值列表
        procedure GetValues(Proc: TGetStrProc); override;

        //计算每个可选择单元的宽度
        {$IFDEF GLH_LIB_dELPHI_6}
        procedure ListMeasureWidth(const Value: string; ACanvas: TCanvas;var AWidth: Integer);
        {$ENDIF}
        {$IFDEF GLH_LIB_dELPHI_5}
        procedure ListMeasureWidth(const Value: string; ACanvas: TCanvas;var AWidth: Integer);  override;
        {$ENDIF}



        //计算每个可选择单元的高度
       {$IFDEF GLH_LIB_dELPHI_6}
        procedure ListMeasureHeight(const Value: string; ACanvas: TCanvas;var AHeight: Integer);
        {$ENDIF}
       {$IFDEF GLH_LIB_dELPHI_5}
        procedure ListMeasureHeight(const Value: string; ACanvas: TCanvas;var AHeight: Integer); override;
        {$ENDIF}

        //画弹出列表
       {$IFDEF GLH_LIB_dELPHI_6}
        procedure ListDrawValue(const Value: string; ACanvas: TCanvas;        const ARect: TRect; ASelected: Boolean);
        {$ENDIF}
       {$IFDEF GLH_LIB_dELPHI_5}
        procedure ListDrawValue(const Value: string; ACanvas: TCanvas;        const ARect: TRect; ASelected: Boolean); override;
        {$ENDIF}


        {$IFDEF GLH_LIB_dELPHI_6}
        //画属性值
        procedure PropDrawValue(ACanvas: TCanvas; const ARect: TRect;  ASelected: Boolean);
        //画属性名称
        procedure PropDrawName(ACanvas: TCanvas; const ARect: TRect;  ASelected: Boolean);
        {$EndIf}
        end;
  //TGlhMenu的ImageIndex属性编辑器
  TMenuItemImageIndexProperty=Class(TBaseIMageIndexProperty)
        Protected
        //取ImageList;
        Function GEtImages:TCustomImageList;Override;
        End;

 Procedure Register;

implementation

 //组件编辑器的标题
function TglhMenuEditor.GetVerb(Index: Integer): string;
        begin
        Case Index Of
                0:Result:='Items...';
                1:Result:='About...';

            END;
        end;

//执行选择的项目
procedure TglhMenuEditor.ExecuteVerb(Index: Integer);
        begin
        Case Index of

                0:ShowCollectionEditorClass(Designer, TCollectionEditor, Component,TGlhMenuBar(Component).GlhMenuItems, 'GlhMenuItems');
                1:ShowMessage('设计:甘轮洪'+chr(13)+'EMail   glh@163.net');
             end;

        end;

//组件编辑器的命令数量
function TglhMenuEditor.GetVerbCount: Integer;
        begin
        Result := 2;
        end;



//返回属性编辑器风格设置
function TBaseImageIndexProperty.GetAttributes: TPropertyAttributes;
        begin
        Result := inherited GetAttributes + [paValueList];
        end;

//生成属性编辑器的显示的值列表
procedure TBaseImageIndexProperty.GetValues(Proc: TGetStrProc);
        var
        I: Integer;
        begin
        Proc('-1');
        if Images = nil then Exit;
        for I := 0 to Images.Count - 1 do
                Proc(IntToStr(I));

 
        end;

//计算每个可选择单元的宽度
procedure TBaseImageIndexProperty.ListMeasureWidth(const Value: string; ACanvas: TCanvas;
  var AWidth: Integer);
        begin
        inherited;
        if Images <> nil then
                Inc(AWidth, 1 + Images.Width + 1);
        end;

//计算每个可选择单元的高度
procedure TBaseImageIndexProperty.ListMeasureHeight(const Value: string; ACanvas: TCanvas;
  var AHeight: Integer);
        begin
        inherited;
        if (Images <> nil) and (AHeight < 1 + Images.Height + 1) then
                AHeight := 1 + Images.Height + 1;
        end;

//画弹出列表
procedure TBaseImageIndexProperty.ListDrawValue(const Value: string; ACanvas: TCanvas;
  const ARect: TRect; ASelected: Boolean);
        var
        ATextRect: TRect;
        PrevBrushColor: TColor;
        begin
        ATextRect := ARect;
        if Images <> nil then
                begin
                Inc(ATextRect.Left, 1 + Images.Width + 1);
                with ARect do
                        begin
                        PrevBrushColor := ACanvas.Brush.Color;
                        ACanvas.Brush.Color := clWindow;
                        ACanvas.FillRect(Rect(Left, Top, ATextRect.Left, Bottom));
                        ACanvas.Brush.Color := PrevBrushColor;
                        end;
                Images.Draw(ACanvas, ARect.Left + 1, ARect.Top + 1, StrToInt(Value));
                end;
        with ATextRect, ACanvas do
                ACanvas.TextRect(ATextRect, Left + 1, (Top + Bottom - TextHeight(Value)) div 2, Value);
        end;
{$IFDEF GLH_LIB_dELPHI_6}
  procedure TBaseImageIndexProperty.PropDrawValue(ACanvas: TCanvas; const ARect: TRect;  ASelected: Boolean);
        BEGIN
        DefaultPropertyDrawValue(Self, ACanvas, ARect);
        END;

  procedure TBaseImageIndexProperty.PropDrawName(ACanvas: TCanvas; const ARect: TRect;  ASelected: Boolean);
        BEGIN
        DefaultPropertyDrawName(Self, ACanvas, ARect);
        END;
{$ENDIF}

Function TMenuItemImageIndexProperty.GEtImages:TCustomImageList;
        BEGIN
        Result :=TGlhMenuBar( TglhMenuItems(TGlhMEnuItem(GetComponent(0)).Collection).GetOwner).Images;
        END;

Procedure Register;
        BEGIN
        RegisterComponentEditor(TglhMenuBar,TglhMenuEditor);
        RegisterPropertyEditor(TypeInfo(TIMageIndex),TGlhMenuItem,'NormalImageIndex',TMenuItemImageIndexProperty);
        eND;
end.  

                                

查看回复