|
This is for all people, who want a SystemCommand but no ribbon, only simple menus and commandbars:
In Designer i have created a mainmenu, which becomes automatically Id=1 !
All additional Commandbars are designed in Designer as i need.
Private Sub Form_Load()
Dim xRibbonBar As RibbonBar Dim xSystemPopup As CommandBarPopup Dim xMainMenue As CommandBar
Dim xRibbonLeft As Long Dim xRibbonRight As Long Dim xRibbonTop As Long Dim xRibbonBottom As Long
With cmdBars .Options.UseSharedImageList = False .LoadDesignerBars
Set xMainMenue = GetCommandBar(cmdBars, 1) ' Find Mainmenu xMainMenue.BarID = 1001 ' Change ID to prevent conflicts
Set xRibbonBar = .AddRibbonBar("System") ' becomes now Id=1 xRibbonBar.EnableDocking xtpFlagStretched xRibbonBar.Title = App.ProductName xRibbonBar.RemoveAllTabs xRibbonBar.Customizable = True CopyControls xMainMenue.Controls, xRibbonBar.Controls xMainMenue.Delete ' never needed any more
Set xSystemPopup = xRibbonBar.AddSystemButton xSystemPopup.IconId = ID_SYSTEM_MENUE ' your Icon here xSystemPopup.CommandBar = Nothing ' only a simple button xRibbonBar.AllowMinimize = False xRibbonBar.AllowQuickAccessCustomization = True
xRibbonBar.EnableFrameTheme
' now adjust Commandbars to appear under the ribbon and not above the windowscaption !!!
' the IDR_'s are coming from my designerbars
xRibbonBar.GetWindowRect xRibbonLeft, xRibbonTop, xRibbonRight, xRibbonBottom .DockToolBar GetCommandBar(cmdBars, IDR_DATE), 0, xRibbonBottom, xtpBarTop .DockToolBar GetCommandBar(cmdBars, IDR_KENNZAHL), 0, xRibbonBottom, xtpBarTop CmdDockRightOf GetCommandBar(cmdBars, IDR_EXPORT), GetCommandBar(cmdBars, IDR_KENNZAHL), False CmdDockRightOf GetCommandBar(cmdBars, IDR_LUPE), GetCommandBar(cmdBars, IDR_EXPORT), False CmdDockRightOf GetCommandBar(cmdBars, IDR_CHARTS), GetCommandBar(cmdBars, IDR_LUPE), False CmdDockRightOf GetCommandBar(cmdBars, IDR_BEARBEITEN), GetCommandBar(cmdBars, IDR_CHARTS), False CmdDockRightOf GetCommandBar(cmdBars, IDR_INFO), GetCommandBar(cmdBars, IDR_BEARBEITEN), False
End With End Sub
Public Function GetCommandBar(pCmdBar As XtremeCommandBars.CommandBars, pId As Long) As XtremeCommandBars.CommandBar Dim xI As Integer For xI = 1 To pCmdBar.Count If pCmdBar.Item(xI).BarID = pId Then Set GetCommandBar = pCmdBar.Item(xI) Exit For End If Next End Function
' This code is from CJ themselves
Private Sub CmdDockRightOf(BarToDock As CommandBar, BarOnLeft As CommandBar, VerticalBar As Boolean) Dim Left As Long Dim Top As Long Dim Right As Long Dim Bottom As Long Dim LeftBar As CommandBar Set LeftBar = BarOnLeft cmdBars.RecalcLayout BarOnLeft.GetWindowRect Left, Top, Right, Bottom LeftBar.GetWindowRect Left, Top, Right, Bottom If (VerticalBar = False) Then cmdBars.DockToolBar BarToDock, Right, (Bottom + Top) / 2, LeftBar.Position Else cmdBars.DockToolBar BarToDock, (Left + Right) / 2, Bottom, LeftBar.Position End If End Sub
' Copy a Tree of controls
Private Sub CopyControls(FromControls As CommandBarControls, ToControls As CommandBarControls) Dim xControlBar As CommandBarControl Dim xAddControl As CommandBarControl Dim xControlPopup As CommandBarPopup Dim xFromPopup As CommandBarPopup Static xRecure As Integer xRecure = xRecure + 1 For Each xControlBar In FromControls Set xAddControl = ToControls.Add(xControlBar.Type, xControlBar.Id, xControlBar.Caption) xAddControl.BeginGroup = xControlBar.BeginGroup If xControlBar.Type = xtpControlButtonPopup Then Set xControlPopup = xAddControl If xRecure = 1 Then xAddControl.Style = xtpButtonCaption Else xAddControl.Style = xtpButtonIconAndCaption End If Set xFromPopup = xControlBar CopyControls xFromPopup.CommandBar.Controls, xControlPopup.CommandBar.Controls End If Next xRecure = xRecure - 1 End Sub
Have a look and enjoy ;)
I think, it's look very nice.
Use this code for free.
|