⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 test.frm

📁 这是一个把各种控件都结合在一个的一个程序。我向大家在这里面应该能找到自己想要得
💻 FRM
📖 第 1 页 / 共 4 页
字号:
      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 + -