界面库

toolbar 支持 mainmenu

designer/tslvcldesigner.tsf

@@ -2532,7 +2532,6 @@ type TDOpenFileADlg = class(TDRootComponent)
     end 
     function classification();override;
     begin
-        return inherited;
         return "对话框";
     end 
     function bitmapinfo();override;

funcext/tvclib/tslvcl.tsf

@@ -2456,7 +2456,7 @@ type TToolBar = class( TcustomToolBar)
     function publishs();override;
     begin
         return array("name","align","caption","enabled","font","left","top","width","height",
-            "visible","imagelist");
+            "visible","imagelist","mainmenu");
         if Align <> alNone then
         begin
             return array("name","align","caption","enabled","font",

funcext/tvclib/utslvclcoolbar.tsf

@@ -177,15 +177,7 @@ type tcustomcoolbar=class(tcustomcontrol)
             if abs(dh)>4 then 
             begin
                 Align := alNone;
-                {if WSSizebox then
+                if WSSizebox or WsDlgModalFrame or Border then bw := 2;
-                begin
-                    bw := 16;
-                end else
-                if WsDlgModalFrame then
-                begin
-                    bw := 6;
-                end else}
-                if Border then bw := 2;
                 Height := bw+nh;
                 Align := alTop;
                 return ;

funcext/tvclib/utslvclmenu.tsf

@@ -23,6 +23,7 @@ private
     FVisible :bool;
     FCommand :integer; 
     FOnclick; 
+    fonchanged;
     FOwnerDraw;
     FOnselect;
     FOnDrawItem; //绘制
@@ -328,7 +329,7 @@ private
                 vv[vvdx++]:= item.handle;
             end
             setmenuiteminfo(idx,uflags,vid,vv);
-            menuchanged();
+            //menuchanged();
             return;
         end
     end
@@ -415,6 +416,7 @@ private
     end
     function SetVisible(v);virtual;
     begin
+        return ;
         nv := v?true:false;
         if FVisible=nv then exit;
         FVisible := nv;
@@ -614,6 +616,7 @@ private
         FOnMeasureItem := nil;
         FOninitmenupopup := nil;
         FOnrbuttonup := nil;
+        fonchanged := nil;
         inherited;
     end
     function removefromparent();
@@ -674,7 +677,9 @@ private
                 FMenuitemInfo._setvalue_(v,vv[i]);
             end
         end
-        if HandleAllocated()then return _wapi.SetMenuItemInfoA(Fhandle,idx,true,FMenuitemInfo._getptr_);
+        if HandleAllocated()then r:= _wapi.SetMenuItemInfoA(Fhandle,idx,true,FMenuitemInfo._getptr_);
+        menuchanged();
+        return r;
     end
     function insertitem(item,bef);virtual;
     begin
@@ -816,6 +821,7 @@ private
         {**
         @explan(说明) 菜单改变时的回调 %%
         **}
+        CallMessgeFunction(fonchanged,self(true),new tuieventbase(0,0,0,0));
     end
     published
     //property Visible read FVisible write SetVisible;
@@ -832,6 +838,7 @@ private
     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) 菜单子项个数 %%
@@ -940,6 +947,7 @@ type TcustomMainmenu=class(TcustomMenu)
     function menuchanged();override;
     begin
         if _wapi.IsWindow(FWndHandle)then _wapi.DrawMenuBar(FWndHandle);
+        inherited;
     end
     function create(AOwner);override;
     begin

funcext/tvclib/utslvclstdctl.tsf

@@ -4081,6 +4081,52 @@ type TcustomComboBox=class(TCustomComboBoxbase)
         return FListBox.SetData(d);
     end
 end
+type tcustommenubutton = class()//菜单按钮
+    function create(mu,tb);
+    begin
+        fmenu := mu;
+        fParent := tb;
+    end 
+    function DoOnClick(o,e); //点击
+    begin
+        if fParent and  (fmenu is class(TcustomMenu)) then 
+        begin
+            if fmenu.ItemCount>0 then  //弹出菜单处理
+            begin 
+                fParent.PopupMenu := fmenu;
+                rec := GetRect();
+                xy := fParent.clienttoscreen(rec[0],rec[3]);
+                uf := TPM_LEFTALIGN .| TPM_TOPALIGN .| TPM_RIGHTBUTTON;
+                fParent._wapi.TrackPopupMenu(fmenu.Handle,uf,xy[0],xy[1],0,fParent.Handle,nil);
+                return ;
+            end  //图片点击处理
+            CallMessgeFunction(fmenu.OnClick,fmenu,e);
+        end 
+    end
+    function GetRect();
+    begin
+        return fParent.GetItemRect(self);
+    end 
+    property menu read fmenu;
+    property Enabled read GetEnabled;
+    property visible read getvisible;
+    property caption read getcaption;
+    private
+    function GetEnabled();
+    begin
+        return fmenu.Enabled;
+    end 
+    function getcaption();
+    begin
+        return fmenu.Caption;
+    end 
+    function getvisible(); //可见
+    begin
+        return true;
+    end 
+    fmenu;
+    fParent;
+end 
 type TcustomToolButton=class(tcomponent)
     {**
     @explan(说明) 工具栏项 %%
@@ -4092,14 +4138,12 @@ type TcustomToolButton=class(tcomponent)
         FImageId :=-1; //imageid
         FEnabled := true; //有效 可以点击
         FVisible := true; //可见 
-        FStylesep := false;
     end
     function ExecuteCommand(cmd,d);override;
     begin        
-        
         if cmd="doshortcut" then //shortcut 
         begin
-            if FStylesep then return ;
+            if fstyle=2 then return ;
             if csDesigning in ComponentState then return;
             if Enabled and Visible then
             begin
@@ -4113,7 +4157,7 @@ type TcustomToolButton=class(tcomponent)
     end
     function DoOnClick(o,e);virtual;
     begin
-        if FStylesep then return ;
+        if fStyle=2 then return ;
         if Parent then 
         begin
             if FPopupMenu is class({TcustomPopupmenu}TcustomMenu) then 
@@ -4171,7 +4215,8 @@ type TcustomToolButton=class(tcomponent)
     property Action:taction read GetAction write SetAction;
     property ShortCut read getShortCut write SetShortCut;
     property PopupMenu:tpopupmenu read FPopupMenu write FPopupMenu;
-    property stylesep:bool read FStylesep write setstylesep;
+    property stylesep:bool read getStylesep write setstylesep;
+    property style read fstyle write setstyle;
     {**
     @param(OnClick)(function[o:TToolButton;e:tuieventbase]) 点击消息 %%
     @param(Caption)(string) 标题 %%
@@ -4180,20 +4225,29 @@ type TcustomToolButton=class(tcomponent)
     @param(Visible)(bool) 是否可见 %%
     **}
     private
-    FStylesep;
     FShortCut;
-    function setstylesep(v);
+    fStyle;
+    function setstyle(v);
     begin
-        nv := v?true:false;
+        if not(v in array(0,1,2)) then return ;
-        if nv<>FStylesep then 
+        if fStyle<>v then 
         begin
-            FStylesep := nv;
+            fStyle := v;
             if FToolbar then
             begin
                 FToolbar.ExecuteCommand("btnchanged",0);
             end 
         end     
     end 
+    function getStylesep();
+    begin
+        return fstyle=2;
+    end 
+    function setstylesep(v);
+    begin
+        nv := v?true:false;
+        setstyle(v?2:0);
+    end 
     function getShortCut();
     begin
         return formatshortcut(FShortCut);
@@ -4242,6 +4296,10 @@ type TcustomToolButton=class(tcomponent)
         if ifstring(s)and s <> FCaption then
         begin
             FCaption := s;
+            if fStyle=1 and FToolbar then 
+            begin
+                FToolbar.ExecuteCommand("btnchanged",0);
+            end 
         end
     end
     function SetEnabled(v);
@@ -4350,7 +4408,7 @@ type TcustomToolBar=class(TCustomControl)
     function Create(AOwner);override;
     begin
         inherited;
-        height := 34;
+        height := 28;
         Width := 300;
         Align := alTop;
         FButtons := new tnumindexarray();
@@ -4372,7 +4430,7 @@ type TcustomToolBar=class(TCustomControl)
             EndShowWnd();
             if FMouseDownIdx >= 0 then
             begin
-                if not(FButtons[FMouseDownIdx].Enabled)then
+                if not(getbtnitem(FMouseDownIdx).Enabled)then
                 begin
                     FMouseDownIdx :=-1;
                     return;
@@ -4400,7 +4458,7 @@ type TcustomToolBar=class(TCustomControl)
             begin
                 if FMouseDownIdx=idx then
                 begin
-                    bi := FButtons[idx];
+                    bi := getbtnitem(idx);
                     bi.DoOnClick(bi,e);
                 end;
             end
@@ -4418,9 +4476,10 @@ type TcustomToolBar=class(TCustomControl)
         idx := PosInBtn(e.pos);
         if idx<0 then return;
         FShowtimeIndexA := idx;
+        if fmainmenu then return ;
         FTimer.Start();
     end
-    function CNALIGN(o,e):CN_ALIGN;override;
+    function DoCNALIGN(o,e);override;
     begin
         case Align of
             alTop,alBottom:
@@ -4569,11 +4628,15 @@ type TcustomToolBar=class(TCustomControl)
         @param(btn)(TToolButton) 工具栏项%%
         @return(array) 区域 %%
         **}
-        idx := IndexOfBtn(btn);
+        for i,v in FButtons.data do 
-        if idx >= 0 then
         begin
-            return FBtnRects[idx];
+            if v=btn then return FBtnRects[i];
         end 
+        for i,v in fmenubtns.data do 
+        begin
+            if v=btn then return fmenubtnrects[i];
+        end 
+        return array(0,0,0,0);
     end
     function IncPaintLock(); //锁定刷新
     begin
@@ -4593,14 +4656,21 @@ type TcustomToolBar=class(TCustomControl)
     function Paint();override;
     begin
         c := canvas;
-        for i := 0 to FButtons.length()-1 do
+        c.font := font;
+        for i := 0 to getbtncount()-1 do
         begin
-            bi := FButtons[i];
+            bi := getbtnitem(i);
             if not(bi.Visible)then continue;
-            ci := FBtnRects[i];
+            ci := getbtnrect(i);
             if not ifarray(ci)then return;
             if FMouseDownIdx=i then
             begin
+                if fmainmenu then 
+                begin
+                    c.brush.Color := 0xe0e0e0;
+                    c.FillRect(ci);
+                end 
+                else 
                     c.draw("framecontrol",array(ci[0:1],ci[2:3]),DFC_BUTTON,DFCS_BUTTONCHECK);
             end else
             begin
@@ -4612,7 +4682,11 @@ type TcustomToolBar=class(TCustomControl)
                     c.brush.Color := 0x8c8c8c;////0xc0c0cc;
                     c.FillRect(ci);
                 end                     
-                    
+            end 
+            if fmainmenu then 
+            begin 
+                c.drawtext(bi.Caption,ci,DT_VCENTER.|DT_CENTER .|DT_SINGLELINE);
+                continue;
             end 
             igslist := ImageList;
             if igslist is class(TCustomImageList)then
@@ -4651,15 +4725,12 @@ type TcustomToolBar=class(TCustomControl)
         @return(intger) 计算的高度 %%
         **}
         bw := 0;
-        if WSSizebox then
+        //16 6 2 简化边框处理
+        if WSSizebox or WsDlgModalFrame or Border then bw := 2;
+        if fmainmenu then 
         begin
-            bw := 16;
+            return font.Height+bw+4;
-        end else
+        end 
-        if WsDlgModalFrame then
-        begin
-            bw := 6;
-        end else
-        if Border then bw := 2;
         imglst := ImageList; //图标
         imgw := 36;
         imgh := 36;
@@ -4695,15 +4766,11 @@ type TcustomToolBar=class(TCustomControl)
         @return(intger) 宽度 %%
         **}
         bw := 0;
-        if WSSizebox then
+        if WSSizebox or WsDlgModalFrame or Border then  bw := 2;
+        if fmainmenu then 
         begin            
-            bw := 16;
+            return 40;
-        end else
+        end 
-        if WsDlgModalFrame then
-        begin
-            bw := 6;
-        end else
-        if Border then bw := 2;
         imglst := ImageList; //图标
         imgw := 36;
         imgh := 36;
@@ -4737,11 +4804,19 @@ type TcustomToolBar=class(TCustomControl)
         @param(btn)(TToolButton) 按钮  %%
         @return(integer) >=0表示正确序号 %%
         **}
-        for i := 0 to FButtons.Length()-1 do
+        for i := 0 to FButtons.length()-1 do 
         begin
-            if btn=FButtons[i]then return i;
+            if btn = FButtons[i] then return i;
         end 
-        return-1;
+        return -1;
+    end
+    function Notification(a,op);override;
+    begin
+        if a=fmainmenu and op=opRemove then 
+        begin
+            setmainmenu(nil);
+        end     
+        inherited;
     end 
     function Recycling();override;
     begin
@@ -4758,12 +4833,16 @@ type TcustomToolBar=class(TCustomControl)
         FTimer := nil;
         FCurrentPos := nil;
         FMouseDownIdx :=-1;
+        fmainmenu := nil;
+        fmenubtns := nil;
     end
     function ExecuteCommand(cmd,pm);override;
     begin
         case cmd  of 
             "btnchanged":
             begin
+                if fmainmenu then return ;
+                if not HandleAllocated() then return ;
                 CalcButtonsRect();
                 InvalidateRect(nil,false);
                 return 0;
@@ -4771,6 +4850,7 @@ type TcustomToolBar=class(TCustomControl)
         end ;
         return inherited;
     end 
+    property MainMenu:tmainmenu read fmainmenu write setmainmenu;
     protected
     procedure SetAlign(Value:TAlign);override;
     begin
@@ -4784,6 +4864,7 @@ type TcustomToolBar=class(TCustomControl)
     function ImageChanged();override;
     begin
         if IsUpDating()then return;
+        if fmainmenu then return ;
         if Parent then
         begin
             Parent.DoControlAlign();
@@ -4791,7 +4872,39 @@ type TcustomToolBar=class(TCustomControl)
             InvalidateRect(nil,false);
         end
     end
+    function FontChanged(o);override;
+    begin
+        inherited;
+        if fmainmenu then doControlALign();        
+    end 
     private
+    function mainmenuchanged();
+    begin
+        fmenubtns := new tnumindexarray();
+        for i:= 0 to  fmainmenu.ItemCount-1 do 
+        begin
+            fmenubtns.push(new tcustommenubutton( fmainmenu.GetItemByIndex(i),self(true)));
+        end    
+        CalcButtonsRect();
+    end 
+    function setmainmenu(v);
+    begin
+        if v<>fmainmenu then 
+        begin
+            if v is class(TcustomMainmenu) then 
+            begin
+                fmainmenu := v; 
+                fmainmenu.onchanged := thisfunction(mainmenuchanged);
+                mainmenuchanged();
+                doControlALign();
+            end else 
+            begin
+                fmainmenu := nil; 
+                fmenubtns := new tnumindexarray();
+            end 
+            InvalidateRect(nil,false);                
+        end 
+    end 
     function EndShowWnd();
     begin
         FShowTimeIndexA :=-1;
@@ -4806,6 +4919,29 @@ type TcustomToolBar=class(TCustomControl)
             FWillModifyToolbar := true;
             return;
         end
+        if fmainmenu then 
+        begin
+            rc := ClientRect;
+            y := rc[1];
+            x := rc[0]+1;
+            fmenubtnrects := array();
+            for i:= 0 to fmenubtns.length()-1 do
+            begin
+                mu := getbtnitem(i);
+                if mu.Visible then 
+                begin 
+                    s := mu.Caption;
+                    wh := GetTextWidthAndHeightWidthFont(s,self.font,0);// wh
+                    fmenubtnrects[i]:= array(x,y,x+wh[0]+5,rc[3]);
+                    x:=x+wh[0]+8;
+                    if x>rc[2] then break; //只有一行
+                end else 
+                begin
+                    fmenubtnrects[i] := array(0,0,0,0);
+                end 
+            end 
+            return ;
+        end 
         imglst := ImageList; //图标
         imgw := 28;
         imgh := 28;
@@ -4904,25 +5040,45 @@ type TcustomToolBar=class(TCustomControl)
     end
     function PosInBtn(p);
     begin
-        for i := 0 to FButtons.length()-1 do
+        for i := 0 to getbtncount()-1 do
         begin
-            ri := FBtnRects[i];
+            ri := getbtnrect(i);
             if ri and pointinrect(p,ri)then
             begin
                 return i;
             end
         end
-        return-1;
+        return -1;
+    end
+    function getbtnitem(idx);
+    begin
+        if fmainmenu then return fmenubtns[idx];
+        return FButtons[idx];
+    end 
+    function getbtncount();
+    begin
+        if fmainmenu then return fmenubtns.length();
+        return FButtons.length();
+    end 
+    function getbtnrect(idx);
+    begin
+        if fmainmenu then return fmenubtnrects[idx];  
+        return FBtnRects[idx];  
     end 
     FShowLoked;
     FBtnRects;
     FButtons;
+    
+    fmenubtns;
+    fmenubtnrects;
+    
     FTipWnd;
     FShowtimeIndexA;
     FTimer;
     FCurrentPos;
     FMouseDownIdx;
     FWillModifyToolbar;
+    fmainmenu;
 end
 type TcustomStatusBar=class(TCustomControl)
     {**