📄 test.frm
字号:
TabIndex = 54
Top = 3840
Width = 1080
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function GetTickCount Lib "kernel32" () As Long
Dim i As Integer, j As Integer
Private Sub BB_ScrollDown(ByVal nIndex As Integer)
Me.Caption = nIndex
End Sub
Private Sub BB_ScrollUp(ByVal nIndex As Integer)
Me.Caption = nIndex
End Sub
Private Sub Box1_Resize(Index As Integer, Left As Long, Top As Long, Width As Long, Height As Long)
TV.Move Left, Top, Width, Height
LV.Move Left, Top, Width, Height
End Sub
Private Sub CC_Click()
LB.BorderStyle = CC.ListIndex
TB.BorderStyle = CC.ListIndex
Box1(0).BorderStyle = CC.ListIndex
Box1(1).BorderStyle = CC.ListIndex
End Sub
Private Sub Check1_Click()
On Error Resume Next
LB.TBTabs.Item(LB.SelItem.Parent.Index).View = Check1.Value
LB.CreateToolBox
TB.TBTabs.Item(TB.SelItem.Parent.Index).View = Check1.Value
TB.CreateToolBox
End Sub
Private Sub Check2_Click()
On Error Resume Next
LB.TBTabs.Item(LB.SelItem.Parent.Index).ShowText = Check2.Value
LB.CreateToolBox
TB.TBTabs.Item(TB.SelItem.Parent.Index).ShowText = Check2.Value
TB.CreateToolBox
End Sub
Private Sub Check3_Click()
LB.Enabled = Check3.Value
TB.Enabled = Check3.Value
End Sub
Private Sub Check4_Click()
LB.ItemMoveable = Check4.Value
TB.ItemMoveable = Check4.Value
End Sub
Private Sub Check5_Click()
LB.TabMoveable = Check5.Value
TB.TabMoveable = Check5.Value
End Sub
Private Sub Check6_Click()
LB.MoveItem2Tab = Check6.Value
TB.MoveItem2Tab = Check6.Value
End Sub
Private Sub Check7_Click()
LB.ShowToolTip = Check7.Value
TB.ShowToolTip = Check7.Value
End Sub
Private Sub Check8_Click()
LB.Appearance = Check8.Value
End Sub
Private Sub Check9_Click()
LB.tabPlacement = Check9.Value
End Sub
Private Sub Command1_Click()
cdg.ShowColor
LB.BackColor = cdg.Color
cdg.ShowColor
TB.BackColor = cdg.Color
End Sub
Private Sub Command10_Click()
Static a As Integer
LB.TBTabs.AddTab Text4.Text, , "tbtab " & a, , "TabToolTip" & a
a = a + 1
LB.CreateToolBox
TB.TBTabs.AddTab Text4.Text, , "tbtab " & a, , "TabToolTip" & a
a = a + 1
TB.CreateToolBox
End Sub
Private Sub Command11_Click()
On Error Resume Next
Static a As Integer
If a = 12 Then a = 0
LB.TBTabs.Item(LB.SelItem.Parent.Index).TBItems.AddItem , , "Item" & a, I2.ListImages(a + 1).Picture, "ItemToolTip " & a, lstStyle.ListIndex
TB.TBTabs.Item(TB.SelItem.Parent.Index).TBItems.AddItem , , "Item" & a, I2.ListImages(a + 1).Picture, "ItemToolTip " & a, lstStyle.ListIndex
a = a + 1
LB.CreateToolBox
TB.CreateToolBox
End Sub
Private Sub Command12_Click()
LB.TBTabs.RemoveTab Text5.Text
TB.TBTabs.RemoveTab Text5.Text
LB.CreateToolBox
TB.CreateToolBox
Me.Caption = LB.TBTabs.Count & TB.TBTabs.Count
End Sub
Private Sub Command13_Click()
Set LB.Background = Nothing
Set TB.Background = Nothing
End Sub
Private Sub Command14_Click()
On Error Resume Next
LB.TBTabs.Item(LB.SelItem.Parent.Index).TBItems.RemoveItem Text4.Text
LB.CreateToolBox
TB.TBTabs.Item(TB.SelItem.Parent.Index).TBItems.RemoveItem Text4.Text
TB.CreateToolBox
End Sub
Private Sub Command15_Click()
Text9.Text = ""
For j = 0 To LB.TBTabs.Item(0).TBItems.Count - 1
Text9.Text = Text9.Text & LB.TBTabs.Item(0).TBItems(j).Value & " " & j & vbCrLf
Next j
End Sub
Private Sub Command16_Click()
Dim a As ActiveXToolBox.tbitem
Set a = LB.TBTabs.Item(Text1.Text).TBItems(Text2.Text)
Me.Caption = a.Parent.Text & "|" & a.Parent.Index & "|" & a.Text & "|" & a.Index & "|" & a.Value
Set a = Nothing
End Sub
Private Sub Command17_Click()
LB.TBTabs.Clear
TB.TBTabs.Clear
LB.CreateToolBox
TB.CreateToolBox
End Sub
Private Sub Command18_Click()
On Error Resume Next
LB.TBTabs.Item(LB.SelItem.Parent.Index).TBItems.Clear
LB.CreateToolBox
TB.TBTabs.Item(TB.SelItem.Parent.Index).TBItems.Clear
TB.CreateToolBox
End Sub
Private Sub Command19_Click()
LB.TBTabs.MoveTab Text4.Text, Text5.Text
TB.TBTabs.MoveTab Text4.Text, Text5.Text
LB.CreateToolBox
TB.CreateToolBox
End Sub
Private Sub Command2_Click()
cdg.ShowColor
LB.BackColor = cdg.Color
cdg.ShowColor
TB.BackColor = cdg.Color
End Sub
Private Sub Command20_Click()
LB.TBTabs.SwapTab Text4.Text, Text5.Text
TB.TBTabs.SwapTab Text4.Text, Text5.Text
LB.CreateToolBox
TB.CreateToolBox
End Sub
Private Sub Command21_Click()
On Error Resume Next
LB.TBTabs.Item(LB.SelItem.Parent.Index).TBItems.MoveItem Text4.Text, Text5.Text
LB.CreateToolBox
TB.TBTabs.Item(TB.SelItem.Parent.Index).TBItems.MoveItem Text4.Text, Text5.Text
TB.CreateToolBox
End Sub
Private Sub Command22_Click()
On Error Resume Next
LB.TBTabs.Item(LB.SelItem.Parent.Index).TBItems.SwapItem Text4.Text, Text5.Text
LB.CreateToolBox
TB.TBTabs.Item(TB.SelItem.Parent.Index).TBItems.SwapItem Text4.Text, Text5.Text
TB.CreateToolBox
End Sub
Private Sub Command23_Click()
LB.TBTabs.Item2Tab Text4.Text, Text5.Text, Text6.Text
TB.TBTabs.Item2Tab Text4.Text, Text5.Text, Text6.Text
LB.CreateToolBox
TB.CreateToolBox
End Sub
Private Sub Command25_Click()
Me.Caption = LB.LoadFromFile
End Sub
Private Sub cmdSave_Click()
Me.Caption = LB.SaveToFile
End Sub
Private Sub Command3_Click()
Set LB.Background = P.Picture
Set TB.Background = P.Picture
End Sub
Private Sub Command4_Click()
LB.Height = LB.Height + 2
TB.Height = TB.Height + 2
End Sub
Private Sub Command5_Click()
LB.Height = LB.Height - 2
TB.Height = TB.Height - 2
End Sub
Private Sub Command6_Click()
LB.TBTabs.AddTabFull Text4.Text, TBC.TBTabs.Item(0)
LB.CreateToolBox
TB.TBTabs.AddTabFull Text4.Text, TBC.TBTabs.Item(1)
TB.CreateToolBox
End Sub
Private Sub Command7_Click()
'On Error Resume Next
LB.TBTabs.Item(LB.SelItem.Parent.Index).TBItems.AddItemFull , TBC.TBTabs.Item(0).TBItems(5)
LB.CreateToolBox
TB.TBTabs.Item(TB.SelItem.Parent.Index).TBItems.AddItemFull , TBC.TBTabs.Item(0).TBItems(9)
TB.CreateToolBox
End Sub
Private Sub Command8_Click()
LB.Width = LB.Width + 2
TB.Width = TB.Width + 2
End Sub
Private Sub Command9_Click()
LB.Width = LB.Width - 2
TB.Width = TB.Width - 2
End Sub
Private Sub Form_Load()
Me.Show
Dim T As Long
T = GetTickCount
On Error Resume Next
For i = 0 To 9
CC.AddItem i
Next i
TBC.TBTabs.AddTab , "A", "工具", , "General", tbIcon, False, tbRight
TBC.TBTabs.AddTab , "B", "控件", , "Common Controls", tbIcon, False
TBC.TBTabs.AddTab , "C", "Miscellaneous", , "Miscellaneous", tbIcon, False
TBC.TBTabs.AddTab , "G", "文字", , "文字", tbIcon
For i = 1 To 12
TBC.TBTabs.Item("A").TBItems.AddItem , , i, I2.ListImages(i).Picture, -i, tbCheck
Next i
For i = 1 To 12
TBC.TBTabs.Item("B").TBItems.AddItem , , i, I2.ListImages(i).Picture, -i
Next i
TBC.CreateToolBox
Dim hi As Long, a As Integer
TV.Nodes.Add , , "K", "Zhu", 7
For i = 0 To 5
LV.ListItems.Add , , i & i & i & i, i + 1
TV.Nodes.Add "K", tvwChild, "K" & i, i & i, i + 1
For j = 0 To 2
TV.Nodes.Add "K" & i, tvwChild, , "Ch" & i & j, j + 1
Next j
Next i
Me.Show
Me.Caption = GetTickCount - T
Set TB.TBTabs(0).TBItems(22) = TBC.TBTabs(0).TBItems(1)
TB.CreateToolBox
End Sub
Private Sub LB_ItemClick(ByVal Item As ActiveXToolBox.tbitem)
Text1.Text = "LB ItemText " & Item.Text & " TabText " & Item.Parent.Text
Text2.Text = "LB ItemIndex " & Item.Index & " TabIndex " & Item.Parent.Index
Text3.Text = "LB ItemToolTip " & Item.ToolTip & " TabToolTip " & Item.Parent.ToolTip & " ItemValue " & Item.Value
Text8.Text = "LB ItemKey " & Item.Key & " TabKey " & Item.Parent.Key & " ItemCount " & LB.TBTabs.Item(Item.Parent.Index).TBItems.Count
Set PTest.Picture = Item.Picture
Set P2.Picture = Item.Parent.Picture
'MsgBox 1
'LB.TBTabs.Item(Item.Index).TBItems(Item.ItemIndex).ItemValue = Not (LB.TBTabs.Item(Item.Index).TBItems(Item.ItemIndex).ItemValue)
Me.Caption = LB.SelItem.Parent.Index
End Sub
Private Sub LV_ItemClick(ByVal Item As MSComctlLib.ListItem)
Me.Caption = Item.Text
End Sub
Private Sub tB_ItemClick(ByVal Item As ActiveXToolBox.tbitem)
Text1.Text = "TB ItemText " & Item.Text & " TabText " & Item.Parent.Text
Text2.Text = "TB ItemIndex " & Item.Index & " TabIndex " & Item.Parent.Index
Text3.Text = "TB ItemToolTip " & Item.ToolTip & " TabToolTip " & Item.Parent.ToolTip & " ItemValue " & Item.Value
Text8.Text = "TB ItemKey " & Item.Key & " TabKey " & Item.Parent.Key & " ItemCount " & TB.TBTabs.Item(Item.Parent.Index).TBItems.Count & " TabCount " & TB.TBTabs.Count
Set PTest.Picture = Item.Picture
Set P2.Picture = Item.Parent.Picture
Me.Caption = TB.SelItem.Parent.Index
End Sub
Private Sub LB_ItemDblClick(ByVal Item As ActiveXToolBox.tbitem)
Set P2.Picture = Item.Picture
End Sub
Private Sub LB_MouseOver(ByVal Item As ActiveXToolBox.tbitem)
Me.Caption = Val(Me.Caption) + 1
Text4.Text = Item.Index
End Sub
Private Sub LB_TabClick(ByVal AxTab As ActiveXToolBox.tbtab)
Set PTest.Picture = AxTab.Picture
Text1.Text = AxTab.Text & AxTab.Index
Text2.Text = AxTab.Left & " " & AxTab.Top & " " & AxTab.Width & " " & AxTab.Height
End Sub
Private Sub Option1_Click(Index As Integer)
LB.TabStyle = Index
TB.TabStyle = Index
End Sub
Private Sub Option2_Click(Index As Integer)
LB.ItemStyle = Index
TB.ItemStyle = Index
End Sub
Private Sub Option3_Click(Index As Integer)
On Error Resume Next
LB.TBTabs.Item(LB.SelItem.Parent.Index).TextAlignment = Index
LB.CreateToolBox
TB.TBTabs.Item(TB.SelItem.Parent.Index).TextAlignment = Index
TB.CreateToolBox
End Sub
Private Sub Option4_Click(Index As Integer)
TB.Alignment = Index
End Sub
Private Sub P_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
P.Picture = LoadPicture(Data.Files.Item(1))
End Sub
Private Sub P2_Click()
Set P2.Picture = Nothing
End Sub
Private Sub P2_DblClick()
Set P2.Picture = LB.SelItem.Picture
End Sub
Private Sub TB_TabClick(ByVal AxTab As ActiveXToolBox.tbtab)
Text1.Text = AxTab.Text
Text2.Text = AxTab.Left & " " & AxTab.Top & " " & AxTab.Width & " " & AxTab.Height
End Sub
Private Sub TBC_TabClick(ByVal AxTab As ActiveXToolBox.tbtab)
Dim i As Integer
For i = 2 To 3
If AxTab.Index = i Then
Box1(i - 2).Move AxTab.Left, AxTab.Height + AxTab.Top, AxTab.ItemsWidth, AxTab.ItemsHeight
Box1(i - 2).Visible = True
Else
Box1(i - 2).Visible = False
End If
Next i
End Sub
Private Sub Text6_Change()
On Error Resume Next
LB.TBTabs.Item(Text4.Text).Text = Text6.Text
LB.CreateToolBox
TB.TBTabs.Item(Text4.Text).Text = Text6.Text
TB.CreateToolBox
End Sub
Private Sub Text7_Change()
On Error Resume Next
LB.TBTabs.Item(Text4.Text).TBItems(Text5.Text).Text = Text7.Text
LB.CreateToolBox
TB.TBTabs.Item(Text4.Text).TBItems(Text5.Text).Text = Text7.Text
TB.CreateToolBox
End Sub
Private Sub ToolBox1_ItemClick(ByVal Item As ActiveXToolBox.tbitem)
Me.Caption = Item.Index & " " & Item.Parent.Index
End Sub
Private Sub ToolBox1_TabClick(ByVal AxTab As ActiveXToolBox.tbtab)
Me.Caption = AxTab.Text & " " & AxTab.Index
End Sub
Private Sub TV_NodeClick(ByVal Node As MSComctlLib.Node)
LV.ListItems.Clear
Dim i As Integer, N As Node
For i = 1 To TV.Nodes.Count
Set N = TV.Nodes(i).Parent
If Not (N Is Nothing) Then
If N.Key = Node.Key Then
LV.ListItems.Add , , TV.Nodes(i).Text, TV.Nodes(i).Image
End If
End If
Next i
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -