VB6 動態新增控制項物件

【方法一】增加動態物件陣列

新增方法：

Laod ObjectArray(Index)，如 Load Text1(10)。

    《注意事項》
        1.最初物件陣列必須先存在，如 Text1(0)。
        2.引數Index不可以重複。
    優點：
        Load 新增的控制項物件會繼承(Inheritance)原先控制項物件的屬性設定，

        如 Text1(10). MultiLine = True 會自動設定，這個屬性在執行時期無法動態更改。

刪除方法：

Unload ObjectArray(Index) ，如 Unload Text1(10)。

事件觸發：

Private Sub Text1_Change(Index As Integer)
    Select Case Index
    Case 1
        '..... 觸發的控制項
    End Select
End Sub


【方法二】控制項集合(Controls collection)

新增方法：
Set ControlRef=Controls.Add(ProgID，Name [,Container])

    說明：

        1.ProgID是指控制項的類別名稱，它是 Libraryname.controlname 的格式。
        2.Name 是您給控制項的名稱， (這就是控制項Name屬性所傳回名稱) 。

            Name 必需為唯一的(unique)，假如在集合中有其它的控制項具有同樣

            的名稱，就會產生

            Error 727 "There is already a control with the name 'ctrlname'" 。
        3.Container 為選擇性參數，是一個對收納器控制項(如PictureBox 或

            是Frame控制項)的引用，如果沒有指定或為 NULL，預設值

            為Controls 集合物件所屬的收納器。
        4.ControlRef 為物件變數，是一個對該控制項的引用，透過此變數可

            使用控制項的屬性，方法及事件，由底下的程式碼您可以發現要在

            表單右下角，動態新增一個控制項，是非常容易的一件事。

範例：
Private Sub Command1_Click()
    Set textCtrl1 = Controls.Add("vb.textbox", "textCtrl1")
    textCtrl1.Text = "textCtrl1"
    textCtrl1.Visible = True
    Set textCtrl2 = Controls.Add("vb.textbox", "textCtrl2")
    textCtrl2.Top = 500
    textCtrl2.Text = "textCtrl2"
    textCtrl2.Visible = True
End Sub

優點：
無須最初物件陣列 textCtrl(0)，便可以無中生有來動態新增控制項。

刪除方法：
Controls.Remove Control

範例：
Private Sub Command3_Click()
    UnLoadCtrl "textCtrl1"
End Sub

Private Sub UnLoadCtrl(ByVal ctrlName As String)
    Dim Ctrls As Control
    For Each Ctrls In Controls
        If Ctrls.Name = ctrlName Then Controls.Remove Ctrls
    Next
End Sub

    《注意事項》
        Controls.Remove Control 只能刪除Controls.Add 所建立之物件，不然會發生執行階段錯誤 729。

事件觸發：
使用到 WithEvents 變數可以讓您對它的事件作處理。
Option Explicit
'--- textCtrl 先設定 Events
Dim WithEvents textCtrl1 As TextBox
Dim WithEvents textCtrl2 As TextBox

Private Sub textCtrl1_Change()
    Me.Caption = "textCtrl1_Change"
End Sub
Private Sub textCtrl1_GotFocus()
    Me.Caption = "textCtrl1_GotFocus"
End Sub
Private Sub textCtrl2_Change()
    Me.Caption = "textCtrl2_Change"
End Sub
Private Sub textCtrl2_GotFocus()
    Me.Caption = "textCtrl2_GotFocus"
End Sub

《問題》每一次新增控制項就要先設定 WithEvents，使用上非常不方便。

【以下範例可改良上面 WithEvents 的不方便，使用 SubClassing 方法】
Command2_Click 動態新增物件的手法

' 於表單
Option Explicit
'--- textCtrl 設定 Events
Dim WithEvents textCtrl1 As TextBox
Dim WithEvents textCtrl2 As TextBox

Private Sub Command1_Click()
    Set textCtrl1 = Controls.Add("vb.textbox", "textCtrl1")
    textCtrl1.Text = "textCtrl1"
    textCtrl1.Visible = True
    Set textCtrl2 = Controls.Add("vb.textbox", "textCtrl2")
    textCtrl2.Top = 500
    textCtrl2.Text = "textCtrl2"
    textCtrl2.Visible = True
End Sub

'----- 新增10個 TextBox 控制項 ( Controls.Add )
Private Sub Command2_Click()
    Dim txtArray As Object
    Dim Index As Long
    Dim str As String
    '新增10個 TextBox
    Index = 10
    ReDim CtrlhWnd(Index - 1)
    For Index = 0 To Index - 1
        str = "txtArray" & Index
        Set txtArray = Controls.Add("vb.textbox", str)
        With txtArray
            .Top = Index * 300
            .Left = 1300
            .Height = 280
            .Width = 1000
            .Text = str
            .Visible = True
            CtrlhWnd(Index) = .hwnd
        End With
    Next
    '--- txtArray 設定 Events
    MeProc = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Private Sub Command3_Click()
    UnLoadCtrl "textCtrl1"
End Sub
Private Sub UnLoadCtrl(ByVal ctrlName As String)
    Dim Ctrls As Control
    For Each Ctrls In Controls
        If Ctrls.Name = ctrlName Then Controls.Remove Ctrls
    Next
End Sub

Private Sub Form_Unload(Cancel As Integer)
    SetWindowLong Me.hwnd, GWL_WNDPROC, MeProc
End Sub

'---------- ALL Events()
Private Sub textCtrl1_Change()
    Me.Caption = "textCtrl1_Change"
End Sub
Private Sub textCtrl1_GotFocus()
    Me.Caption = "textCtrl1_GotFocus"
End Sub

Private Sub textCtrl2_Change()
    Me.Caption = "textCtrl2_Change"
End Sub
Private Sub textCtrl2_GotFocus()
    Me.Caption = "textCtrl2_GotFocus"
End Sub

Public Sub txtArray_Change(Index As Integer)
    Me.Caption = "txtArray" & Index & "_Change"
End Sub
Public Sub txtArray_GotFocus(Index As Integer)
    Me.Caption = "txtArray" & Index & "_GotFocus"
End Sub


' 於模組
Option Explicit
Public Type LongToByte
    B0 As Byte
    B1 As Byte
    B2 As Byte
    B3 As Byte
End Type
Public bLong As LongToByte
Public Const WM_COMMAND = &H111
Public Const GWL_WNDPROC = (-4)
Public MeProc As Long
Public CtrlhWnd() As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Select Case uMsg
    Case WM_COMMAND
        Dim Index As Integer
        For Index = 0 To UBound(CtrlhWnd)
            If lParam = CtrlhWnd(Index) Then
                CopyMemory bLong, wParam, 4
                Select Case bLong.B3
                Case &H3
                    Form1.txtArray_Change (Index)
                Case &H1
                    Form1.txtArray_GotFocus (Index)
                End Select
            End If
        Next
    End Select
    WindowProc = CallWindowProc(MeProc, hwnd, uMsg, wParam, lParam)
End Function

出處http://tw.myblog.yahoo.com/jw!raiTBxqfGRRgO52kKmk-/article?mid=226&prev=229&next=45&l=f&fid=9