📄 frmlistset.frm
字号:
VERSION 5.00
Begin VB.Form frmListSet
BorderStyle = 3 'Fixed Dialog
Caption = "栏目设置"
ClientHeight = 3165
ClientLeft = 45
ClientTop = 330
ClientWidth = 6570
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3165
ScaleWidth = 6570
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin VB.Frame Frame1
Height = 2925
Left = 150
TabIndex = 2
Top = 60
Width = 4965
Begin VB.TextBox txtName
Height = 285
Left = 2760
TabIndex = 14
Top = 2520
Width = 1635
End
Begin VB.ComboBox cmbOrder
Height = 300
ItemData = "frmListSet.frx":0000
Left = 2760
List = "frmListSet.frx":000D
Style = 2 'Dropdown List
TabIndex = 16
Top = 3120
Visible = 0 'False
Width = 1635
End
Begin VB.CommandButton cmdSerial
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 336
Index = 0
Left = 4530
Picture = "frmListSet.frx":002D
Style = 1 'Graphical
TabIndex = 11
Top = 990
UseMaskColor = -1 'True
Width = 240
End
Begin VB.CommandButton cmdSerial
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 336
Index = 1
Left = 4530
Picture = "frmListSet.frx":050B
Style = 1 'Graphical
TabIndex = 12
Top = 1650
UseMaskColor = -1 'True
Width = 240
End
Begin VB.CommandButton cmdLeftAll
Caption = "<<"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 336
Left = 1980
MaskColor = &H00000000&
TabIndex = 8
Top = 1920
Width = 576
End
Begin VB.CommandButton cmdLeftOne
Caption = "<"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 336
Left = 1980
MaskColor = &H00000000&
TabIndex = 7
Top = 1545
Width = 576
End
Begin VB.CommandButton cmdRightAll
Caption = ">>"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 336
Left = 1980
MaskColor = &H00000000&
TabIndex = 6
Top = 1170
Width = 576
End
Begin VB.CommandButton cmdRightOne
Caption = ">"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 336
Left = 1980
MaskColor = &H00000000&
TabIndex = 5
Top = 795
Width = 576
End
Begin VB.ListBox lstSelected
Height = 1680
Left = 2760
TabIndex = 4
Top = 570
Width = 1620
End
Begin VB.ListBox lstAll
Height = 1680
Left = 180
TabIndex = 3
Top = 570
Width = 1620
End
Begin VB.Label LblName
AutoSize = -1 'True
Caption = "显示名称(&N)"
Height = 180
Left = 1750
TabIndex = 13
Top = 2550
Width = 990
End
Begin VB.Label lblOrder
AutoSize = -1 'True
Caption = "排序方式(&O)"
Height = 180
Left = 1740
TabIndex = 15
Top = 3180
Visible = 0 'False
Width = 990
End
Begin VB.Label lblSelected
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "已选栏目"
ForeColor = &H80000008&
Height = 180
Left = 2850
TabIndex = 10
Tag = "2407"
Top = 300
Width = 720
End
Begin VB.Label lblAll
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "可选栏目"
ForeColor = &H80000008&
Height = 180
Left = 210
TabIndex = 9
Tag = "2406"
Top = 300
Width = 720
End
End
Begin VB.CommandButton cmdOk
Default = -1 'True
Height = 350
Left = 5280
Picture = "frmListSet.frx":09E9
Style = 1 'Graphical
TabIndex = 0
Top = 150
UseMaskColor = -1 'True
Width = 1215
End
Begin VB.CommandButton cmdCancel
Cancel = -1 'True
Height = 350
Left = 5280
Picture = "frmListSet.frx":12AB
Style = 1 'Graphical
TabIndex = 1
Top = 540
UseMaskColor = -1 'True
Width = 1215
End
End
Attribute VB_Name = "frmListSet"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' 列表设置
' 作者：魏 然
' 日期：1998.05.20
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Private WithEvents mclsMainControl As MainControl
Attribute mclsMainControl.VB_VarHelpID = -1
Private mblnIsNew As Boolean '该用户是否第一次使用该列表
Private mblnOk As Boolean '是否按OK键
Private mintNowList As Integer '当前设置排序的行
Private mblnNameChange As Boolean '栏目名称是否改变
Private mintLastIndex As Integer '上次选中的已选栏目的 ListIndex
Private mblnNotRespond As Boolean '是否响应 lstSelected 和 cmbOrder 的 Click 事件
Private mclsListSet As ListSet
Private mblnLoad As Boolean
'设置排序列
Private Sub cmbOrder_Click()
Dim intCount As Integer
Dim strNew As String
If mblnNotRespond Then
Exit Sub
End If
mintNowList = lstSelected.ListIndex
strNew = ChangeTag(lstSelected.Text, cmbOrder.ListIndex, 4, Space(100), "~")
lstSelected.list(lstSelected.ListIndex) = strNew
If cmbOrder.ListIndex > 0 Then
For intCount = 0 To lstSelected.ListCount - 1
If mintNowList <> intCount Then
strNew = ChangeTag(lstSelected.list(intCount), 0, 4, Space(100), "~")
lstSelected.list(intCount) = strNew
End If
Next intCount
End If
End Sub
Private Sub CmdCancel_Click()
mblnOk = False
Unload Me
End Sub
Private Sub cmdOK_Click()
Dim intCount As Integer
mblnOk = True
If txtName.Enabled Then
If Not EditName Then
Exit Sub
End If
End If
With lstSelected
mclsListSet.Columns = .ListCount
For intCount = 0 To .ListCount - 1
mclsListSet.ColumnDesc(intCount + 1) = GetNoXString(.list(intCount), 1, Space(100))
mclsListSet.ColumnFieldName(intCount + 1) = GetNoXString(GetNoXString(.list(intCount), 2, Space(100)), 1, "~")
mclsListSet.ColumnWidth(intCount + 1) = GetNoXString(GetNoXString(.list(intCount), 2, Space(100)), 2, "~")
mclsListSet.ColumnOrderType(intCount + 1) = GetNoXString(GetNoXString(.list(intCount), 2, Space(100)), 3, "~")
mclsListSet.ColumnIsFix(intCount + 1) = GetNoXString(GetNoXString(.list(intCount), 2, Space(100)), 4, "~")
mclsListSet.ColumnIsFind(intCount + 1) = GetNoXString(GetNoXString(.list(intCount), 2, Space(100)), 5, "~")
mclsListSet.ColumnFieldID(intCount + 1) = GetNoXString(GetNoXString(.list(intCount), 2, Space(100)), 6, "~")
mclsListSet.ColumnFieldType(intCount + 1) = GetNoXString(GetNoXString(.list(intCount), 2, Space(100)), 7, "~")
mclsListSet.ColumnFieldSize(intCount + 1) = GetNoXString(GetNoXString(.list(intCount), 2, Space(100)), 8, "~")
mclsListSet.ColumnIsMust(intCount + 1) = GetNoXString(GetNoXString(.list(intCount), 2, Space(100)), 9, "~")
mclsListSet.ColumnFormat(intCount + 1) = Val(GetNoXString(GetNoXString(.list(intCount), 2, Space(100)), 10, "~"))
mclsListSet.ColumnNotZero(intCount + 1) = GetNoXString(GetNoXString(.list(intCount), 2, Space(100)), 11, "~")
mclsListSet.ColumnGroup(intCount + 1) = GetNoXString(GetNoXString(.list(intCount), 2, Space(100)), 12, "~")
Next intCount
End With
mclsListSet.SaveList
Unload Me
End Sub
Private Sub cmdLeftAll_Click()
Dim i As Integer
Dim Count As Integer
Dim DelCol As Integer
With lstSelected
DelCol = mclsListSet.FixColumns
Count = .ListCount - DelCol
For i = 0 To Count - 1
If GetNoXString(GetNoXString(.list(DelCol), 2, Space(100)), 9, "~") Then
DelCol = DelCol + 1
Else
lstAll.AddItem .list(DelCol)
.RemoveItem DelCol
End If
Next
On Error Resume Next
.ListIndex = 0
lstAll.ListIndex = lstAll.ListCount - 1
End With
RefreshButton
RefreshUpDown
End Sub
Private Sub cmdLeftOne_Click()
Dim index As Integer
Dim blnValid As Boolean
Dim strText As String
With lstSelected
index = .ListIndex
strText = GetNoXString(.Text, 1, Space(100))
If GetNoXString(GetNoXString(.Text, 2, Space(100)), 9, "~") Then
MsgBox "“" & strText & "”是必选栏目！", vbOKOnly, Me.Caption
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -