? ? ? ? ? ?VB6實現動態增加和刪除控件數組中的控件

2021-6-3修改一個BUG

控件的添加：

1From1名稱改為FrmWork

2.添加Picture控件名稱改為PicCharacterContainer

3.添加Picture控件名稱改為PicShow放入PicCharacterContainer中，設置成控件數組

4.添加Text控件名稱改為TxtShow放入PicCharacterContainer中，設置成控件數組

操作：在PicCharacterContainer中鼠標左鍵添加控件，鼠標右鍵去除控件（可以點選指定控件）。

代碼：?

Option Explicit Dim S1GlngMaxCharactor As Long Dim ChoiceRemove As Long '選擇角色移除對象 Private Sub CmdAdd() Dim i As Long, n As Long Dim MaxCharactor As Long MaxCharactor = 100 '最大控件數 For i = 1 To MaxCharactorIf fChkControls(FrmWork, "PicShow", i) = True Then '控件存在n = n + 1End If Next i S1GlngMaxCharactor = n + 1 For i = 1 To MaxCharactorIf fChkControls(FrmWork, "PicShow", i) = False Then '控件不存在AddCharactor i '增加Picture控件AddCharactorNotice i '增加Text控件PublicNewArrangeAdd S1GlngMaxCharactor, "PicShow", FrmWork, FrmWork.PicShow '在缺失位置增加控件PublicNewArrangeAdd S1GlngMaxCharactor, "TxtShow", FrmWork, FrmWork.TxtShow '在缺失位置增加控件AlignBoxes '對齊控件TxtShow(i).Text = i '顯示控件數組編號Exit ForEnd If Next i End Sub Private Sub CmdRemove() Dim n As Long, i As Long If ChoiceRemove <> 0 Then Unload PicShow(ChoiceRemove) Unload TxtShow(ChoiceRemove) ChoiceRemove = 0 ElseIf S1GlngMaxCharactor >= 1 ThenFor i = 1 To 100If fChkControls(FrmWork, "PicShow", i) = True Then '存在 '2020-8-22修改為Truen = i '找到未刪除最大編號End IfNext iIf n = 0 ThenS1GlngMaxCharactor = S1GlngMaxCharactor - 1MsgBox "最初控件不能移除"Exit SubEnd IfUnload PicShow(n)Unload TxtShow(n)S1GlngMaxCharactor = S1GlngMaxCharactor - 1ElseMsgBox "最初控件不能移除"End If End If End Sub Private Sub PicCharacterContainer_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = 1 ThenCmdAdd End If If Button = 2 ThenCmdRemove End If End Sub Rem 判斷控件是否存在 Function fChkControls(frmObject As Form, strControlsName As String, ByVal lngIndex As Long) As Boolean On Error GoTo ErrDim strContrName As StringIf lngIndex >= 0 ThenstrContrName = frmObject.Controls(strControlsName)(lngIndex).NameElsestrContrName = frmObject.Controls(strControlsName).NameEnd IffChkControls = TrueExit Function Err:fChkControls = False End Function Rem 增加控件 Public Sub AddCharactor(ByVal n As Long) Dim RowNum As Long Dim Row As Long, Line As Long Load FrmWork.PicShow(n) Set FrmWork.PicShow(n).Container = FrmWork.PicCharacterContainer RowNum = Int(FrmWork.PicCharacterContainer.Width / FrmWork.PicShow(0).Width) '一排容納多少控件 If n - 1 >= 0 ThenLine = Int(n / RowNum) + 1 '控件所處行號Row = (n + 1) - (Line - 1) * RowNum '控件所處列號FrmWork.PicShow(n).Left = FrmWork.PicShow(0).Left + (Row - 1) * FrmWork.PicShow(n).WidthFrmWork.PicShow(n).Top = FrmWork.PicShow(0).Top + (Line - 1) * (FrmWork.PicShow(n).Height + FrmWork.TxtShow(0).Height)FrmWork.PicShow(n).Visible = True End If End Sub Rem 增加文字控件 Public Sub AddCharactorNotice(ByVal n As Long) Load FrmWork.TxtShow(n) Set FrmWork.TxtShow(n).Container = FrmWork.PicCharacterContainer If n - 1 >= 0 ThenFrmWork.TxtShow(n).Left = FrmWork.PicShow(n).LeftFrmWork.TxtShow(n).Top = FrmWork.PicShow(n).TopFrmWork.TxtShow(n).Visible = True End If End Sub Rem MaxNumber 最大數量 Rem ControlBoxName 控件名稱 Rem From 工作界面 Rem ControlBox 控件:例子From.PicShow Public Sub PublicNewArrangeAdd(ByVal MaxNumber As Long, ByVal ControlBoxName As String, _ ByRef From As Object, ByRef ControlBox As Object) Dim i As Long, l As Long, A As Variant, B As Variant For l = 1 To MaxNumberFor i = 1 To MaxNumberIf fChkControls(From, ControlBoxName, i) = True And fChkControls(From, ControlBoxName, i + l) = True ThenIf ControlBox(i).Left > ControlBox(i + l).Left ThenIf ControlBox(i).Top = ControlBox(i + l).Top Then '2021-6-2增加，作用是同行才交換位置A = ControlBox(i + l).LeftB = ControlBox(i).LeftControlBox(i + l).Left = BControlBox(i).Left = AEnd IfEnd IfEnd IfNext i Next l End Sub Public Sub AlignBoxes() Dim i As Long On Error Resume Next '防止控件沒有出錯 For i = 1 To S1GlngMaxCharactorFrmWork.TxtShow(i).Left = FrmWork.PicShow(i).LeftFrmWork.TxtShow(i).Top = FrmWork.PicShow(i).Top + FrmWork.PicShow(i).Height Next i End Sub Private Sub PicShow_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = 2 ThenChoiceRemove = IndexCmdRemove End If If Button = 1 ThenCmdAdd End If End Sub

總結

以上是生活随笔為你收集整理的VB6实现动态增加和删除控件数组中的控件2021-06-02的全部內容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網站內容還不錯，歡迎將生活随笔推薦給好友。