浏览器

开发平台：
Visual Basic

frmCmsToolbar.frm：源码内容
							VERSION 5.00
Begin VB.Form frmCmsToolbar 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "选择工具栏按钮"
   ClientHeight    =   4065
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4875
   BeginProperty Font 
      Name            =   "宋体"
      Size            =   9
      Charset         =   134
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "frmCmsToolbar.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4065
   ScaleWidth      =   4875
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  'CenterOwner
   Begin VB.CommandButton cmdSetToDefault 
      Caption         =   "默认值"
      Height          =   330
      Left            =   120
      TabIndex        =   12
      Top             =   3600
      Width           =   900
   End
   Begin VB.CommandButton cmdCancel 
      Cancel          =   -1  'True
      Caption         =   "取消(&C)"
      Height          =   360
      Left            =   3900
      TabIndex        =   5
      Top             =   3600
      Width           =   900
   End
   Begin VB.CommandButton cmdOk 
      Caption         =   "确定(&O)"
      Default         =   -1  'True
      Height          =   360
      Left            =   2880
      TabIndex        =   4
      Top             =   3600
      Width           =   900
   End
   Begin VB.Frame Frame2 
      Caption         =   "小工具栏"
      Height          =   3375
      Left            =   2460
      TabIndex        =   2
      Top             =   60
      Width           =   2355
      Begin VB.CommandButton cmdSep 
         Caption         =   "分隔符"
         Enabled         =   0   'False
         Height          =   330
         Index           =   1
         Left            =   1560
         TabIndex        =   11
         Top             =   2940
         Width           =   660
      End
      Begin VB.CommandButton cmdMoveDown 
         Caption         =   "下移"
         Height          =   330
         Index           =   1
         Left            =   840
         TabIndex        =   10
         Top             =   2940
         Width           =   660
      End
      Begin VB.CommandButton cmdMoveUp 
         Caption         =   "上移"
         Height          =   330
         Index           =   1
         Left            =   120
         TabIndex        =   9
         Top             =   2940
         Width           =   660
      End
      Begin VB.ListBox lstSmallTbr 
         Height          =   2580
         Left            =   120
         Style           =   1  'Checkbox
         TabIndex        =   3
         Top             =   300
         Width           =   2100
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "标准按钮栏"
      Height          =   3375
      Left            =   60
      TabIndex        =   0
      Top             =   60
      Width           =   2355
      Begin VB.CommandButton cmdSep 
         Caption         =   "分隔符"
         Enabled         =   0   'False
         Height          =   330
         Index           =   0
         Left            =   1560
         TabIndex        =   8
         Top             =   2940
         Width           =   660
      End
      Begin VB.CommandButton cmdMoveDown 
         Caption         =   "下移"
         Height          =   330
         Index           =   0
         Left            =   840
         TabIndex        =   7
         Top             =   2940
         Width           =   660
      End
      Begin VB.CommandButton cmdMoveUp 
         Caption         =   "上移"
         Height          =   330
         Index           =   0
         Left            =   120
         TabIndex        =   6
         Top             =   2940
         Width           =   660
      End
      Begin VB.ListBox lstMainTbr 
         Height          =   2580
         Left            =   120
         Style           =   1  'Checkbox
         TabIndex        =   1
         Top             =   300
         Width           =   2100
      End
   End
End
Attribute VB_Name = "frmCmsToolbar"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'自定义Toolbar按钮
Option Explicit
Private mMainTbr As cToolBar
Private mMainTbrPos() As cButtonPosInfo
Private mSmallTbr As cToolBar
Private mSmallTbrPos() As cButtonPosInfo
Public Sub IniMe(nTbrMain As cToolBar, _
        nTbrSmall As cToolBar)
Set mMainTbr = nTbrMain
mMainTbrPos = nTbrMain.p_colBff("desarr")
Call SetListFromTbr(mMainTbr, lstMainTbr, mMainTbrPos)
Set mSmallTbr = nTbrSmall
mSmallTbrPos = nTbrSmall.p_colBff("desarr")
Call SetListFromTbr(mSmallTbr, lstSmallTbr, mSmallTbrPos)
End Sub
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub SetListFromTbr(nTbr As cToolBar, _
        nLst As VB.ListBox, vArr() As cButtonPosInfo)
On Error Resume Next
Dim i&, tcnt&
nLst.Clear
'vArr = nTbr.p_colBff("desarr")
tcnt = nTbr.ButtonCount
For i = 0 To tcnt - 1
    nLst.AddItem vArr(i).Description
    nLst.Selected(i) = vArr(i).vis '  ((nTbr.GetButtonState(nTbr.GetButton(i, False)) And TBSTATE_HIDDEN) = 0)
Next i
nLst.ListIndex = -1
End Sub
Private Sub SetTbrButton(nTbr As cToolBar, _
        nLst As VB.ListBox, nArr() As cButtonPosInfo)
On Error Resume Next
Dim i&, tUb&
tUb = UBound(nArr)
For i = 0 To tUb
    nArr(i).Pos = i
    nTbr.MoveButton nTbr.GetButton(nArr(i).id, True), i
    nArr(i).vis = nLst.Selected(i)
    nTbr.ShowButton nArr(i).id, nArr(i).vis
Next i
nTbr.p_colBff.Remove "desarr"
nTbr.p_colBff.Add nArr, "desarr"
'tcnt = nLst.ListCount
'For i = 0 To tcnt - 1
'    nTbr.ShowButton nTbr.GetButton(i, False), nLst.Selected(i)
'    If nLst.Selected(i) Then
'        nArr(i) = 1
'    Else
'        nArr(i) = 0
'    End If
'Next i
'On Error Resume Next
'Dim i&
'For i = 1 To nLst.ListCount
'    nTbr.Buttons(i).Visible = nLst.Selected(i - 1)
'    If nLst.Selected(i - 1) Then
'        nArr(i - 1) = 1
'    Else
'        nArr(i - 1) = 0
'    End If
'Next i
End Sub
'---------------------------------------------------------------------------------------
' Procedure : MoveDown
' DateTime  : 2005-8-9 22:23
' Author    : Lingll
' Purpose   : 移动list item
'---------------------------------------------------------------------------------------
Private Sub MoveDown(vLst As ListBox, vArr() As cButtonPosInfo)
On Error Resume Next
Dim tObj As cButtonPosInfo
Dim tIndex&, i&
tIndex = vLst.ListIndex
If tIndex >= 0 And tIndex < vLst.ListCount - 1 Then
    SwapObj vArr(tIndex), vArr(tIndex + 1)
    SwapListItem vLst, tIndex, tIndex + 1
End If
End Sub
'---------------------------------------------------------------------------------------
' Procedure : MoveUp
' DateTime  : 2005-8-9 22:28
' Author    : Lingll
' Purpose   :
'---------------------------------------------------------------------------------------
Private Sub MoveUp(vLst As ListBox, vArr() As cButtonPosInfo)
On Error Resume Next
Dim tObj As cButtonPosInfo
Dim tIndex&, i&
tIndex = vLst.ListIndex
If tIndex > 0 And tIndex < vLst.ListCount Then
    SwapObj vArr(tIndex), vArr(tIndex - 1)
    SwapListItem vLst, tIndex, tIndex - 1
End If
End Sub
Private Sub cmdMoveDown_Click(index As Integer)
Select Case index
    Case 0
        Call MoveDown(lstMainTbr, mMainTbrPos)
    Case 1
        Call MoveDown(lstSmallTbr, mSmallTbrPos)
End Select
End Sub
Private Sub cmdMoveUp_Click(index As Integer)
Select Case index
    Case 0
        Call MoveUp(lstMainTbr, mMainTbrPos)
    Case 1
        Call MoveUp(lstSmallTbr, mSmallTbrPos)
End Select
End Sub
Private Sub cmdOk_Click()
Call SetTbrButton(mMainTbr, lstMainTbr, mMainTbrPos)
Call SetTbrButton(mSmallTbr, lstSmallTbr, mSmallTbrPos)
gMainForm.ResizeTbr
Unload Me
End Sub
'---------------------------------------------------------------------------------------
' Procedure : SwapObj
' DateTime  : 2005-8-9 22:28
' Author    : Lingll
' Purpose   :
'---------------------------------------------------------------------------------------
Private Sub SwapObj(obj1 As Object, obj2 As Object)
Dim tObj As Object
Set tObj = obj1
Set obj1 = obj2
Set obj2 = tObj
Set tObj = Nothing
End Sub
'---------------------------------------------------------------------------------------
' Procedure : SwapListItem
' DateTime  : 2005-8-9 22:46
' Author    : Lingll
' Purpose   :
'---------------------------------------------------------------------------------------
Private Sub SwapListItem(vLst As ListBox, i1&, i2&)
On Error Resume Next
Dim tStr$, tSel As Boolean
tStr = vLst.List(i1)
tSel = vLst.Selected(i1)
vLst.List(i1) = vLst.List(i2)
vLst.Selected(i1) = vLst.Selected(i2)
vLst.List(i2) = tStr
vLst.Selected(i2) = tSel
End Sub
Private Sub cmdSetToDefault_Click()
Dim tObj As New cButtonPosInfo
tObj.SetToDefault mMainTbrPos
tObj.SetToDefault mSmallTbrPos
Call SetListFromTbr(mMainTbr, lstMainTbr, mMainTbrPos)
Call SetListFromTbr(mSmallTbr, lstSmallTbr, mSmallTbrPos)
End Sub

						