程序运行时生成任意多个控件

解决方案 »

  1.   


    这种方法需要事先在窗体上放置一个控件,并设置它的index属性为0。即该控件作为控件数组中的第一控件Option ExplicitPrivate Sub Command1_Click()
        On Error Resume Next
        Dim i As Integer
        For i = 1 To Text1
            '加载控件
            Load Check1(i)
            Check1(i).Visible = True
            '设置控件的位置
            Check1(i).Left = Check1(i - 1).Left + 1500
            Check1(i).Top = Check1(i - 1).Top
            DoEvents
            If Check1(i).Left >= 6000 Then
                Check1(i).Top = Check1(i - 1).Top + 700
                Check1(i).Left = Check1(0).Left
            End If
        Next
    End SubPrivate Sub Command2_Click()
        On Error Resume Next
        Dim i As Integer
        Dim j As Integer
        j = Val(Text1.Text)
        '删除控件
        For i = Check1.Count - j To Check1.Count - 1
            Unload Check1(i)
        Next
    End Sub欢迎光临电脑爱好者论坛 bbs.cfanclub.net
      

  2.   

    这是一个动态生成Text文本框的例子:Const TH32CS_SNAPHEAPLIST = &H1
    Const TH32CS_SNAPPROCESS = &H2
    Const TH32CS_SNAPTHREAD = &H4
    Const TH32CS_SNAPMODULE = &H8
    Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE)
    Const TH32CS_INHERIT = &H80000000
    Const MAX_PATH As Integer = 260
    Private Type PROCESSENTRY32
        dwSize As Long
        cntUsage As Long
        th32ProcessID As Long
        th32DefaultHeapID As Long
        th32ModuleID As Long
        cntThreads As Long
        th32ParentProcessID As Long
        pcPriClassBase As Long
        dwFlags As Long
        szExeFile As String * MAX_PATH
    End Type
    Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
    Private Declare Function Process32First Lib "kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
    Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
    Private Declare Sub ExitProcess Lib "kernel32" (ByVal uExitCode As Long)
    Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As LongPrivate Sub Command1_Click()
        Dim List1 As ListBox
        Set List1 = Controls.Add("vb.listbox", "list1", Me)
        List1.Visible = True
        Me.Move 1500, 1500, 5000, 6000
        List1.Move 500, 1000, 4000, 4000
    End Sub