unit utslvclmenu;
interface
{**
    @explan(说明) 菜单相关 %%
    @date(20220509) %%
**}
uses utslvclauxiliary,cstructurelib,utslvclgdi,utslvclaction;
type TcustomMenu = class(tcomponent)
    {**
    	@explan(说明) 菜单类 %%
    **}
private
#!begin
    static FSIDC; //command 计数器
    FActionLink:TMenuActionLink;
    Fhandle:hmenu;
    FCaption:string;
    FParent:tmenu;
    FItems;
    FAutoChecked:bool;
    FChecked :bool;
    FEnabled :bool;
    FVisible :bool;
    FCommand :integer; 
    weakref
    FOnclick; 
    fonchanged;
//    FOwnerDraw;
    FOnselect;
    FOnDrawItem; //绘制
    FOnMeasureItem; //测量
    FOninitmenupopup;
    FOnrbuttonup;    
    FOnDesignClick;
    autoref
    FMtype; //样式
    FMenuitemInfo;
    FBitmap;
    FShortCut;
    function modifyshowcaption(item);
    begin
        s := item.caption;
        st := item.ShortCut;
        if st then r := s+"  ("+st+")";
        else r := s;
        return r;
    end     
    function SetBitmap(v); //设置bmp 
    begin
        if v <> FBitmap then SetBitmapsub(v);
    end
    function SetBitmapsub(v); //子项设置bmp
    begin
        FBitmap := v;
        if v is class(tcustombitmap)then
        begin
            if FBitmap.HandleAllocated()then
            begin
                if Parent then
                begin
                    if not(Parent is class(TcustomMainmenu))then
                    begin
                        return parent.setmenuiteminfo(indexof(),MIIM_BITMAP,"hbmpitem",v.Handle);
                    end
                end
            end
        end else
        begin
            if Parent then
            begin
                if not(Parent is class(TcustomMainmenu))then
                begin
                    parent.setmenuiteminfo(indexof(),MIIM_BITMAP,"hbmpitem",-1);
                end
            end
        end
    end
    function ancestor();
    begin
        if parent then return parent.ancestor();
        else return self(true);
    end
    function ancestorof(item);
    begin
        {**
        @explan(说明) 判断item是否为子节点 %%
        @param(item)(TcustomMenu) 判断的节点 %%
        **}
        if item is class(TcustomMenu)then
        begin
            if item=self then return 1;
            for i := 0 to FItems.count-1 do
            begin
                if FItems[i].ancestorof(item)then return 1;
            end
        end
        return 0;
    end
    function inmenutree(item);
    begin
        ac := ancestor();
        if ac.ancestorof(item)then return true;
        return 0;
    end
    function removehmenuitem(item,pi);
    begin
        {**
        @explan(说明) 删除hmenu节点 %%
        **}
        _wapi.RemoveMenu(FHandle,pi,MF_BYPOSITION);
    end
    function addhmenuitem(item,bef);
    begin
        {**
        @explan(说明) 添加到hmenu %%
        **}
        mif := item.Itemstruct;
        mif._setvalue_("wid",item.command);
        ic := modifyshowcaption(item);
        mif._setvalue_("dwtypedata",ic);
        bm := item.Bitmap;
        if(bm is class(tcustombitmap))and bm.HandleAllocated()and(not(self is class(TcustomMainmenu)))then
        begin
            mif._setvalue_("hbmpitem",bm.handle);
            bsk := true;
        end
        if item.HandleAllocated()then
        begin
            mif._setvalue_("hsubmenu",item.handle);
            mif._setvalue_("fmask",MIIM_ID .| MIIM_STRING .| MIIM_STATE .| MIIM_FTYPE .| MIIM_SUBMENU .|(bsk?MIIM_BITMAP:0));
        end else
        begin
            mif._setvalue_("fmask",MIIM_ID .| MIIM_STRING .| MIIM_STATE .| MIIM_FTYPE .|(bsk?MIIM_BITMAP:0));
        end
        IF item.TSeparator then
        begin
            mif._setvalue_("ftype",MFT_SEPARATOR);
        end else
        if item.TOwnerdraw then
        begin
            mif._setvalue_("ftype",MFT_OWNERDRAW);
        end else
        begin
            mif._setvalue_("ftype",MFT_STRING);
        end
        state := 0;
        if item.Checked then
        begin
            state .|= MFS_CHECKED;
        end else
            state .|= MFS_UNCHECKED;
        if item.Enabled then
        begin
            state .|= MFS_ENABLED;
        end else
            state .|= MFS_DISABLED;
        mif._setvalue_("fstate",state);
        _wapi.InsertMenuItemA(FHandle,bef,true,mif._getptr_);
        menuchanged();
    end
    Function SetMenuType(nms,n);
    begin
        if not(n)then
        begin
            ms := MF_STRING;
        end else
        begin
            ms := nms;
        end
        if FMtype <> ms then
        begin
            FMtype := ms;
            if ms=MF_STRING then ft := MFT_STRING;
            if ms=MF_SEPARATOR then ft := MFT_SEPARATOR;
            if ms=MF_OWNERDRAW then ft := MFT_OWNERDRAW;
            if parent then
            begin
                parent.setmenuiteminfo(indexof(),MIIM_FTYPE,"ftype",ft);
            end
        end
    end
    function getitems();
    begin
        return FItems.data();
    end
    function GetItemcount();
    begin
        return FItems.count;
    end
    function GetMenuType(ms);
    begin
        return FMtype=ms;
    end
    function ifchild(item);
    begin
        if item is class(TcustomMenu)then
        begin
            for i := 0 to FItems.count-1 do if FItems[i]=item then return 1;
        end
        return 0;
    end
    function dispatchrbuttonup(e);
    begin
        if e.lparam=FHandle then
        begin
            it := FItems[e.wparam];
            CallMessgeFunction(it.Onrbuttonup,it,e);
            return 1;
        end
        return itemsdispatch(e);
    end
    function dispatchloop(e);
    begin
        if e.wparam=FHandle then
        begin
            CallMessgeFunction(Oninitmenupopup,self(true),e);
            return 1;
        end
        return itemsdispatch(e);
    end
    function dispatchcommand(e);
    begin
        if e.lowparam=FCommand then
        begin
            //if FAutoChecked then checked := not(checked);
            doClick(self(true),e);
            return 1;
        end else
        begin
            return itemsdispatch(e);
        end
        return 0;
    end
    function itemsdispatch(e);
    begin
        for i := 0 to FItems.count-1 do if FItems[i].dispatch(e)then return 1;
    end
    function dispatchselect(e);
    begin
        cmd := e.lowparam;
        if cmd>1000 then
        begin
            if cmd=FCommand then
            begin
                CallMessgeFunction(FOnselect,self(true),e);
                return 1;
            end else
            begin
                return itemsdispatch(e);
            end
        end else
        begin
            if FHandle=e.lparam then
            begin
                it := FItems[cmd];
                if ifobj(it)then CallMessgeFunction(it.Onselect,it,e);
                return 1;
            end else
            return itemsdispatch(e);
        end
    end
    function dispatchbycmdid(e);
    begin
        if e.itemID=FCommand then
        begin
            case e.msg of
                WM_MEASUREITEM:
                begin
                    DoMeasureItem(self(true),e);
                end
                WM_DRAWITEM:
                begin
                    DoDrawItem(self(true),e);
                end
            end;
            return 1;
        end else
        begin
            return itemsdispatch(e);
        end
    end
    function itemsate();
    begin
        state := 0;
        if FEnabled then state .|= MF_ENABLED;
        else state .|= MF_DISABLED;
        if FChecked then state .|= MF_CHECKED;
        else state .|= MF_UNCHECKED;
        return state;
    end
    function doClick(o,e);virtual;
    begin
        if csDesigning in ComponentState then
        begin
            CallMessgeFunction(FOnDesignClick,o,e);
        end
        if Action and Action.Execute() then 
        begin
        
        end else 
            CallMessgeFunction(Onclick,o,e);
    end
    function DoMeasureItem(o,e);virtual;
    begin
        return CallMessgeFunction(OnMeasureItem,o,e);
    end
    function DoDrawItem(o,e);virtual;
    begin
        return CallMessgeFunction(OnDrawItem,o,e);
    end
    function modifyitem(item,uflags);
    begin
        {**
        @explan(说明) 修改菜单子项的状态 %%
        @param(item)(TcustomMenu) 菜单子项 %%
        @param(uflags)(integer) 状态常量 %%
        **}
        if HandleAllocated()then
        begin
            idx := indexof(item);
            vv := vid := array();
            vvdx := 0;
            if((uflags .& MIIM_STRING)=MIIM_STRING)then
            begin
                vid[vvdx]:= "dwtypedata";
                vv[vvdx++]:= modifyshowcaption(item);
            end
            if(uflags .& MF_POPUP)=MF_POPUP then
            begin
                vid[vvdx]:= "hsubmenu";
                vv[vvdx++]:= item.handle;
            end
            setmenuiteminfo(idx,uflags,vid,vv);
            //menuchanged();
            return;
        end
    end
    function GetZorder();
    begin
        r := indexof();
        return r;
    end
    function SetZorder(n);
    begin
        if not(n >= 0)then exit;
        f := Parent;
        if f is class(TcustomMenu)then
        begin
            odn := indexof();
            if odn=n then exit;
            nn := f.GetItemByIndex(n);
            if nn then f.RemoveItem(self(true));
            f.insertitem(self(true),nn);
        end
    end

#!end		
    protected
    function SetAction(Value);virtual;
    begin
        if ifnil(Value)then
        begin
            if FActionLink then
            begin
                FActionLink.SetAction(nil);
            end
            excludestate(FControlStyle,csActionClient);
        end else
        if Value is class(TBasicAction)then
        begin
            includestate(FControlStyle,csActionClient);
            if ifnil(FActionLink)then FActionLink := createobject(GetActionLinkClass(),self);
            FActionLink.Action := Value;
            FActionLink.Onchange := thisfunction(DoActionChange);
            ActionChange(Value,csLoading in Value.ComponentState);
            Value.FreeNotification(Self);
        end
    end
    procedure DoActionChange(Sender:TObject);
    begin
        if Sender=Action then ActionChange(Sender,False);
    end
    function GetAction();virtual;
    begin
        if FActionLink then
        begin
            return FActionLink.Action;
        end
    end
    function GetActionLinkClass();virtual;
    begin
        {**
        @explan(说明) 返回actionlinkclass %%
        @return(TMenuActionLink class)
        **}
        return class(TMenuActionLink);
    end
    procedure ActionChange(Sender:TObject;CheckDefaults:Boolean);virtual;
    begin
        if Sender is class(TCustomAction)then
        begin
            NewAction := Sender;
            if (not CheckDefaults) or (Caption='') or (Caption=Name) then Caption := NewAction.Caption;
            if (not CheckDefaults)  then ShortCut := NewAction.ShortCut;
            if (not CheckDefaults) or Enabled then Enabled := NewAction.Enabled;
            if (not CheckDefaults) or FChecked then Checked := NewAction.Checked;
        end;
    end
    function SetCaption(v);virtual;
    begin
        if not(ifstring(v)and(FCaption <> v))then exit;
        FCaption := v;
        if Parent then
        begin
            vs := modifyshowcaption(self);
            parent.setmenuiteminfo(indexof(),MIIM_STRING,"dwtypedata",vs);
        end
    end
    function SetVisible(v);virtual;
    begin
        return ;
        nv := v?true:false;
        if FVisible=nv then exit;
        FVisible := nv;
        TOwnerDraw := FVisible?false:true;
    end
    function SetChecked(v);virtual;
    begin
        nv := v?true:false;
        if nv <> FChecked then
        begin
            FChecked := nv;
            if parent then parent.setmenuiteminfo(indexof(),MIIM_STATE,"fstate",itemsate());
        end
    end
    function SetEnabled(v);virtual;
    begin
        nv := v?true:false;
        if nv <> FEnabled then
        begin
            FEnabled := nv;
            if parent then
            begin
                parent.setmenuiteminfo(indexof(),MIIM_STATE,"fstate",itemsate());
            end
        end
    end
    function HandleNeeded();
    begin
        {**
        @explan(说明) 获取节点句柄,必须有子节点%%
        @return(pointer) 节点句柄 %%
        **}
        if not HandleAllocated()then CreateHandle();
        return Fhandle;
    end
    //FCompStyle:integer;
    public
    function ExecuteCommand(cmd,d);override;
    begin
        if cmd = 'doshortcut' then 
        begin 
            if csDesigning in ComponentState then return ;
            if FVisible and Enabled and Parent and GetMenuType(0)  then 
            begin
                if d = ShortCut then 
                begin 
                    DoClick(self,new tuieventbase(0,0,0,0));
                    return "havedoshortcut";
                end 
            end 
        end 
    end 
    function Notification(AComponent:TComponent;Operation:TOperation);override;
    begin        
        if Operation=opRecycling then //opRemove
        begin
            if AComponent=Action then Action := nil;
        end
        inherited;
    end
    class function sinit();override;
    begin
        {**
        @explan(说明) 初始化类成员 %%;
        **}
        inherited;
        if not FSIDC then
        begin
            FSIDC := new tidcreater(5000);
        end
    end
    function dispatch(e);override; //分发
    begin
        {**
        @explan(说明) 菜单消息分发 %%
        @param(e)(tuieventbase) 消息对象 %%
        **}
        case e.msg of
            WM_COMMAND:
            begin
                return dispatchcommand(e);
            end
            WM_MENUSELECT:
            begin
                return dispatchselect(e);
            end
            WM_INITMENUPOPUP:
            begin
                return dispatchloop(e);
            end
            WM_MENURBUTTONUP:
            begin
                return dispatchrbuttonup(e);
            end else
            return dispatchbycmdid(e);
        end;
        return 0;
    end
    Function create(AOwner:tcomponent);override;
    begin
        inherited;
        FMtype := MF_STRING;
        FParent := nil;
        FChecked := False;
        FVisible := True;
        FEnabled := True;
        FItems := new TFpList();
        FCaption := "menu";
        FCommand := FSIDC.createid();
        menustr := array(
            ("cbsize","int",0),
            ("fmask","int",0),
            ("ftype","int",0),
            ("fstate","int",0),
            ("wid","int",0),
            ("hsubmenu","intptr",0),
            ("hbmpchecked","intptr",0),
            ("hbmpunchecked","intptr",0),
            ("dwitemdata","intptr",0),
            ("dwtypedata","intptr",0),
            ("cch","int",90),
            ("hbmpitem","intptr",0));
        FMenuitemInfo := new tcstructwithcharptr(menustr,array("dwtypedata":"cch"));
        FMenuitemInfo._setvalue_("cbsize",FMenuitemInfo._size_());
    end
    function HandleAllocated();
    begin
        {**
        @explan(说明)菜单句柄是否已有效%%
        **}
        return ifnumber(FHandle)and FHandle;
    end
    function DestroyHandle();
    begin
        {**
        @explan(说明) 销毁菜单句柄 %%
        **}
        if HandleAllocated()then
        begin
            for i := 0 to FItems.count-1 do
            begin
                it := FItems[i];
                if it is class(TcustomMenu)then it.DestroyHandle();
            end
            _wapi.DestroyMenu(FHandle);
            FHandle := 0;
        end
    end
    function CreateMenu();virtual;
    begin
        {**
        @explan(说明) 构造菜单句柄,通过overrid此函数实现不同类型菜单构造 %%
        @return(pointer) 句柄 %%
        **}
        return _wapi.CreatePopupMenu();
    end
    function CreateHandle();
    begin
        {**
        @explan(说明)更新节点句柄 %%
        **}
        if not HandleAllocated()then
        begin
            IF FItems.count>0 then
            begin
                FHandle := CreateMenu();
            end else
            if self(true) is class(TcustomMainmenu)then //修改 
            begin
                FHandle := CreateMenu();
            end
        end
        for i := 0 to FItems.count-1 do
        begin
            it := FItems[i];
            ch := it.handle;
            addhmenuitem(it,i+1);
        end
    end
    function Recycling();override;
    begin
        {**
        @explan(说明) 菜单资源回收%%
        **}
        //DestroyHandle();
        if parent is class(TcustomMenu)then
        begin
            parent.RemoveItem(self);
        end
        FSIDC.deleteid(FCommand);
        FItems.clean();
        FOnDesignClick := nil;
        FOnclick := nil;
//        FOwnerDraw := nil;
        FOnselect := nil;
        FOnDrawItem := nil;
        FOnMeasureItem := nil;
        FOninitmenupopup := nil;
        FOnrbuttonup := nil;
        fonchanged := nil;
        inherited;
    end
    function removefromparent();
    begin
        {**
        @explan(说明) 从父节点中删除自己 %%
        **}
        if Fparent then
        begin
            Fparent.removeitem(self);
            FParent := nil;
        end
        return self;
    end
    function indexof(item);
    begin
        {**
        @explan(说明) 查看对象位置 %%
        @param(item)(TcustomMenu | nil) 如为nil 返回在自己在父节点位置,为菜单返回该菜单,在本菜单的位置 %%
        **}
        if ifnil(item)then
        begin
            if FParent then return FParent.indexof(self(true));
            return-1;
        end
        return FItems.indexof(item);
    end
    function GetItemByIndex(idx);
    begin
        {**
        @explan(说明) 根据序号id 获得菜单%%
        @param(idx)(integer) 序号id %%
        @return(TcustomMenu|nil) 如果存在返回菜单项,如果不错返回nil
        **}
        if ifnumber(idx)>= 0 then
        begin
            return FItems.geti(idx);
        end
        return nil;
    end
    function setmenuiteminfo(idx,mv,vid,vv); //设置信息
    begin
        {**
        @explan(说明)设置菜单信息 %%
        @param(mv)(integer) mask %%
        @param(vid)(string) 下标 %%
        @param(vv)() 值 %%
        **}
        FMenuitemInfo._setvalue_("fmask",mv);
        if ifstring(vid)then
        begin
            FMenuitemInfo._setvalue_(vid,vv);
        end else
        if ifarray(vid)and ifarray(vv)and(length(vid)=length(vv))then
        begin
            for i,v in vid do
            begin
                FMenuitemInfo._setvalue_(v,vv[i]);
            end
        end
        if HandleAllocated()then r:= _wapi.SetMenuItemInfoA(Fhandle,idx,true,FMenuitemInfo._getptr_);
        menuchanged();
        return r;
    end
    function insertitem(item,bef);virtual;
    begin
        {**
        @explan(说明) 添加节点 %%
        @param(item)(TcustomMenu) 待添加的节点 %%
        @param(bef)(TcustomMenu | integer) 基准位置 %%
        **}
        if not(item is class(TcustomMenu))then return-2;
        if not ifchild(item)then
        begin
            if bef is class(TcustomMenu)then
            begin
                beforid := indexof(bef);
            end else
            if ifnumber(bef)then
            begin
                beforid := bef;
            end else
            beforid := FItems.count();
            item.removefromparent();
            flagprant := false;
            if FItems.count=0 then
            begin
                if Fparent then
                begin
                    if Fparent.HandleAllocated()then
                    begin
                        flagprant := true;
                    end
                end
            end
            FItems.insertbefor(item,beforid);
            item.setfparent(self(true));
            if HandleAllocated()then
            begin
                addhmenuitem(item,beforid);
            end
            if flagprant then
            begin
                mks := MIIM_SUBMENU .| MIIM_STRING;
                mksv := array("dwtypedata","hsubmenu");
                vs := modifyshowcaption(self);
                mksvv := array(vs,self.handle);
                if FBitmap is class(tcustombitmap)and FBitmap.HandleAllocated()then
                begin
                    mks .|= MIIM_BITMAP;
                    mksv[2]:= "hbmpitem";
                    mksvv[2]:= FBitmap.Handle;
                end
                Fparent.setmenuiteminfo(indexof(),mks,mksv,mksvv);
            end
        end
        return-1;
    end    
    function setfparent(p);
    begin
        {**
        @ignore(忽略) %%
        @explan(说明) 设置fprent %%
        **}
        FParent := p;
    end        
    function removeItemByIndex(idx);
    begin
        {**
        @explan(说明)根据序号删除子菜单 %%
        @param(idx)(integer) 序号id %%
        **}
        it := GetItemByIndex(idx);
        if it is class(TcustomMenu)then
        begin
            return removeItem(it);
        end
        return nil;
    end
    function RecyclingAllItems();
    begin
        {**
        @explan(说明) 销毁当前节点的 所有子节点,子节点不可以再被使用 %%
        **}
        while FItems.count >= 1 do
        begin
            it := FItems[0];
            it.Recycling();
        end
    end
    function removeitem(item);virtual;
    begin
        {**
        @explan(说明) 删除节点 %%
        @param(item)(TcustomMenu) 将删除的菜单项 %%
        **}
        pi := FItems.indexof(item);
        if pi<0 then return-1;
        if HandleAllocated()then removehmenuitem(item,pi);
        FItems.deli(pi);
        if FItems.count<1 then
        begin
            if Fparent then
            begin
                DestroyHandle(); //销毁菜单
                vs := modifyshowcaption(self);
                Fparent.setmenuiteminfo(indexof(),MIIM_STRING .| MIIM_SUBMENU,array("dwtypedata","hsubmenu"),array(vs,0));
                //Fparent.modifyitem(self(true),FMtype.|MF_POPUP); //修改样式
            end
        end
        item.setfparent(nil);
        menuchanged();
    end
    private
    function setparentforproperty(f);
    begin    
        if f is class(TcustomMenu)then
        begin        
            f.insertitem(self);
        end else
        if parent is class(TcustomMenu)then
        begin
            parent.removeitem(self);
        end
    end    
    public
    function SetChangedPublish(n,v,pp);virtual;
    begin
        {**
        @explan(说明) 设计器相关函数 %%
        **}
        ts := array("tstring","tseparator","townerdraw");
        if(n in ts)then
        begin
            for i,vi in ts do DeleteChangedPublish(vi);
            if v then inherited;
            return;
        end
        inherited;
    end
    function menuchanged();virtual;
    begin
        {**
        @explan(说明) 菜单改变时的回调 %%
        **}
        CallMessgeFunction(fonchanged,self(true),new tuieventbase(0,0,0,0));
    end
    published
    //property Visible read FVisible write SetVisible;
    property Action:taction read GetAction write SetAction;
    {**
    @param(Action)(taction) action对象 %%;
    **}
    property caption:string read FCaption write SetCaption;
    property Enabled:bool read FEnabled write SetEnabled;
    property ItemCount read GetItemcount;
    property Items read getitems;
    property Handle read HandleNeeded;
    property Parent read FParent write setparentforproperty;
    property Command read FCommand;
    property Bitmap:tbitmap read FBitmap write SetBitmap;
    property Onclick:eventhandler read FOnclick write FOnclick;
    property onchanged read fonchanged write fonchanged;
    {**
    @param(caption)(string) 菜单显示文字 %%;
    @param(ItemCount)(integer) 菜单子项个数 %%
    @param(Handle)(pointer) 菜单句柄 %%
    @param(Parent)(TcustomMenu) 父节点 %%
    @param(Command)(integer) 菜单id %%
    @param(onclick)(function[TcustomMenu,tuieventbase]) 菜单点击回调函数 %%
    **}
    //property OwnerDraw read FOwnerDraw write FOwnerDraw;
    property TSeparator:bool index 0x800 read GetMenuType write SetMenuType;
    property Itemstruct read FMenuitemInfo;
    property TString index 0 read GetMenuType write SetMenuType;
    Property TOwnerdraw:bool index 0x100 read GetMenuType write SetMenuType;
    property Checked:bool read FChecked write SetChecked;
    property OnDrawItem read FOnDrawItem write FOnDrawItem;
    property OnMeasureItem read FOnMeasureItem write FOnMeasureItem;
    property OnSelect read FOnselect write FOnselect;
    property Oninitmenupopup read FOninitmenupopup write FOninitmenupopup;
    property Onrbuttonup:eventhandler read FOnrbuttonup write FOnrbuttonup;
    property Zorder read GetZorder write SetZorder;
    property OnDesignClick read FOnDesignClick write FOnDesignClick;
    property ShortCut read getShortCut write SetShortCut;
    {**
    @param(Parent)(TcustomMenu|nil)添加父节点,如果非tmenu,从父节点移除 %%
    @param(OnDrawItem)(function[TcustomMenu,TMDRAWITEM]) 自绘制菜单回调函数 %%
    @param(OnMeasureItem)(function[TcustomMenu,TMMEASUREITEM]) 自绘制菜单高度宽度设置回调函数 %%
    @param(Onrbuttonup)(function[TcustomMenu,tuieventbase]) 菜单右击回调函数 %%
    @param(OnSelect)(function[TcustomMenu,TMMENUSELECT]) 菜单被鼠标选中回调函数 %%
    @param(Oninitmenupopup)(function[TcustomMenu,tuieventbase]) 进入菜单循环菜单回调函数 %%
    **}
    private
    function getShortCut();
    begin
        return  formatshortcut(FShortCut);
    end 

    function SetShortCut(v);
    begin
        if v and ifstring(v) then 
        begin
            nst := parsershortcutstr(v);        
        end else nst := nil;
        if nst <> FShortCut then 
        begin
            FShortCut := nst;
            if Parent then
            begin
                vs := modifyshowcaption(self);
                parent.setmenuiteminfo(indexof(),MIIM_STRING,"dwtypedata",vs);
            end
        end 
    end 
end
type TcustomPopupmenu=class(TcustomMenu)
    {**
    @explan(说明) 弹出菜单 %%
    **}
    function create(AOwner);override;
    begin
        inherited;
    end
end
type TcustomMainmenu=class(TcustomMenu)
    {**
    @explan(说明) 主菜单类 %%
    **}
    private
    FWndHandle;
    function setmenu();
    begin
        if _wapi.IsWindow(FWndHandle)then
        begin
            _wapi.SetMenu(FWndHandle,self.handle);
        end
    end
    function setwndhandle(v);
    begin
        if FWndHandle <> v then
        begin
            if _wapi.IsWindow(FWndHandle)then
            begin
                _wapi.SetMenu(FWndHandle,0);
            end
            FWndHandle := v;
            setmenu();
        end
    end
    function DrawMenuBar();
    begin
        if HandleAllocated()and _wapi.IsWindow(FWndHandle)then
        begin
            _wapi.DrawMenuBar(FWndHandle);
        end
    end
    public
    function insertitem(item,bef);override;
    begin
        inherited;
        DrawMenuBar();
    end
    function removeitem(item);override;
    begin
        inherited;
        DrawMenuBar();
    end
    function menuchanged();override;
    begin
        if _wapi.IsWindow(FWndHandle)then _wapi.DrawMenuBar(FWndHandle);
        inherited;
    end
    function create(AOwner);override;
    begin
        inherited;
    end
    function CreateMenu();override;
    begin
        r := nil;
        r := _wapi.CreateMenu();
        return r;
    end
    published
    property Hwnd:pointer read FWndHandle write setwndhandle;
    {**
    @param(Hwnd)()窗口句柄 %%;
    **}
end
type TMenuActionLink=class(TControlActionLink)
    {**
    @explan(说明) 菜单actionlink %%
    **}
    protected
    procedure AssignClient(AClient);override;
    begin
        {**
        @explan(说明)赋值control %%
        @param(AClient)(tcontrol) %%
        **}
        if AClient is class(TcustomMenu)then FClient := AClient;
    end
    function IsshortcutLinked();override;
    begin
        return FClient and(Action is CLASS(TCustomAction));
    end 
    function IsVisibleLinked():Boolean;override;
    begin
        return false;
    end
    function IsCheckedLinked():Boolean;override;
    begin
        return FClient and(Action is CLASS(TCustomAction));
    end
    public
    procedure SetShortCut(const Value:String);override;
    begin
        if IsshortcutLinked() then
        begin
            return FClient.ShortCut := Value;
        end 
    end 
    function create(AOwner);override;
    begin
        inherited;
    end
    procedure SetChecked(Value:Boolean);override;
    begin
        if IsCheckedLinked()then return FClient.Checked := Value;
    end
end

implementation

initialization


end.