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相关推荐

js动态增加，删除td，tr，table，div
js实现的动态添加,删除table内容: 截图如下: 1. 2. 源代码: main.css body {background-image: url(../images/qiantai/bg.png) ...
java 动态添加定时器_quartz实现任务动态增加和删除
场景这几天做项目的时候遇到了个状态自动切换的场景.该场景具体情况如下: 用户可以创建多个活动活动有开始时间和结束时间活动有个状态:未上线.未开始(上线但未到开始时间).进行中(上线且处于开始时间 ...
批处理--删除当前目录及子目录中的空文件夹或文件
批处理–删除当前目录及子目录中的空文件夹第一种方式 @echo off echo. echo 正在删除当前目录及子目录中所有的空文件夹,请稍后...... echo ---------------- ...
php两个数组去掉相同的,php如何删除两个数组中相同的数据
php如何删除两个数组中相同的数据发布时间:2021-03-12 10:27:42 来源:亿速云阅读:77 作者:小新这篇文章给大家分享的是有关php如何删除两个数组中相同的数据的内容.小编觉得 ...
PHP常用数组函数（含按键值删除二维数组中的元素）
// 1.array_search():在数组中搜索键值"red",并返回它的键名 $a=array("a"=>"red"," ...
使用C#删除一个字符串数组中的空字符串
C#中要如何才能删除一个字符串数组中的空字符串呢?随着微软对C#不断发展和更新,C#中对于数组操作的方式也变得越来越多样化.以往要实现过滤数组中的空字符串,都是需要实行循环的方式来排除和过滤.C#3. ...
php删除二维数组元素_php怎样删除二维数组中的元素
php怎样删除二维数组中的元素发布时间:2020-11-03 10:22:40 来源:亿速云阅读:68 作者:小新这篇文章主要介绍了php怎样删除二维数组中的元素,具有一定借鉴价值,需要的朋友可 ...
//假设有一个能装入总体积为T的背包和n件体积分别为w1,w2....wn.的物品，能否从n件物品中挑选若干件恰好装满背包，即使w1+w2+....+wn=T,要求找出所有满足上述条件的解。例如：当T
//背包问题 //假设有一个能装入总体积为T的背包和n件体积分别为w1,w2....wn.的物品,能否从n件物品中挑选若干件恰好装满背包,即使w1+w2+....+wn=T,要求找出所有满足上述条件的 ...
solr-cloud 集群动态增加、删除节点
本次讲述动态增加节点基于上一章集群搭建的基础上来讲:https://blog.csdn.net/u013490585/article/details/86494476 上一章的例子中用了3台zk,4台 ...

VB6实现动态增加和删除控件数组中的控件2021-06-02

VB6实现动态增加和删除控件数组中的控件

VB6实现动态增加和删除控件数组中的控件2021-06-02相关推荐

最新文章

热门文章