📄 frmvis.frm
字号:
VERSION 5.00
Begin VB.Form FrmVis
BorderStyle = 3 'Fixed Dialog
Caption = "设置显示的字段"
ClientHeight = 3840
ClientLeft = 45
ClientTop = 330
ClientWidth = 6045
Icon = "FrmVis.frx":0000
LinkTopic = "Form2"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3840
ScaleWidth = 6045
ShowInTaskbar = 0 'False
StartUpPosition = 3 '窗口缺省
Begin VB.VScrollBar VS1
Height = 495
Left = 120
Max = 1
Min = -1
TabIndex = 10
Top = 1200
Width = 495
End
Begin VB.ListBox ListView1
Height = 2040
Left = 3960
TabIndex = 9
Top = 600
Width = 1935
End
Begin VB.ListBox ListView2
Height = 2040
Left = 600
TabIndex = 8
Top = 600
Width = 1935
End
Begin VB.CommandButton Command2
Caption = "取消"
Height = 375
Index = 1
Left = 4320
TabIndex = 5
Top = 3360
Width = 1335
End
Begin VB.CommandButton Command2
Caption = "确定"
Height = 375
Index = 0
Left = 2640
TabIndex = 4
Top = 3360
Width = 1335
End
Begin VB.CommandButton Command1
Caption = ">>"
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 3
Left = 2760
TabIndex = 3
Top = 2400
Width = 975
End
Begin VB.CommandButton Command1
Caption = ">"
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 2
Left = 2760
TabIndex = 2
Top = 1800
Width = 975
End
Begin VB.CommandButton Command1
Caption = "<<"
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 1
Left = 2760
TabIndex = 1
Top = 1200
Width = 975
End
Begin VB.CommandButton Command1
Caption = "<"
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 0
Left = 2760
TabIndex = 0
Top = 600
Width = 975
End
Begin VB.Label Label1
Caption = "未用的字段："
Height = 252
Index = 1
Left = 4200
TabIndex = 7
Top = 240
Width = 1452
End
Begin VB.Label Label1
Caption = "显示的字段："
Height = 252
Index = 0
Left = 840
TabIndex = 6
Top = 240
Width = 1452
End
End
Attribute VB_Name = "FrmVis"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click(Index As Integer)
Dim i
Select Case Index
Case 0
If ListView1.ListCount = 0 Then
Exit Sub
End If
If ListView1.ListIndex < 0 Then
ListView1.ListIndex = 0
End If
i = ListView1.ListIndex
ListView2.AddItem ListView1.List(ListView1.ListIndex)
ListView2.ItemData(ListView2.ListCount - 1) = ListView1.ItemData(ListView1.ListIndex)
ListView1.RemoveItem ListView1.ListIndex
If i < ListView1.ListCount Then
ListView1.ListIndex = i
Else
If ListView1.ListCount > 1 Then
ListView1.ListIndex = ListView1.ListCount - 1
End If
End If
ListView1.Refresh
Case 2
If ListView2.ListCount = 0 Then
Exit Sub
End If
If ListView2.ListIndex < 0 Then
ListView2.ListIndex = 0
End If
i = ListView2.ListIndex
ListView1.AddItem ListView2.List(ListView2.ListIndex)
ListView1.ItemData(ListView1.ListCount - 1) = ListView2.ItemData(ListView2.ListIndex)
ListView2.RemoveItem ListView2.ListIndex
If i < ListView2.ListCount Then
ListView2.ListIndex = i
Else
If ListView2.ListCount > 1 Then
ListView2.ListIndex = ListView2.ListCount - 1
End If
End If
ListView2.Refresh
Case 1
For i = ListView1.ListCount - 1 To 0 Step -1
ListView2.AddItem ListView1.List(i)
ListView2.ItemData(ListView2.ListCount - 1) = ListView1.ItemData(i)
ListView1.RemoveItem i
Next
Case 3
For i = ListView2.ListCount - 1 To 0 Step -1
ListView1.AddItem ListView2.List(i)
ListView1.ItemData(ListView1.ListCount - 1) = ListView2.ItemData(i)
ListView2.RemoveItem i
Next
End Select
End Sub
Private Sub Command2_Click(Index As Integer)
If Index = 0 Then
Dim i, j, k, jj
If ListView2.ListCount = 0 Then
MsgBox "无显示的项目！", vbInformation + vbOKOnly, "提示"
Exit Sub
End If
k = A_lookview.MaxCols
ReDim Temp(k, 11)
With A_lookview
For j = 0 To ListView2.ListCount - 1
For i = 0 To 11
Temp(j, i) = .SqlA(ListView2.ItemData(j), i)
Next
If Not Temp(j, 5) Then
Temp(j, 5) = True
Temp(j, 3) = 1000
End If
Next
jj = j
For j = 0 To ListView1.ListCount - 1
For i = 0 To 11
Temp(jj, i) = .SqlA(ListView1.ItemData(j), i)
Next
If Temp(jj, 5) Then
Temp(jj, 5) = False
End If
jj = jj + 1
Next
End With
For i = 0 To k
For j = 0 To 11
A_lookview.SqlLet i, j, Temp(i, j)
Next
Next
A_lookview.PaintIt
End If
Unload Me
End Sub
Private Sub Form_Load()
On Error Resume Next
Dim num, i, num1, str
With A_lookview.GetDBGrid
num = .Columns.Count - 1
For i = 0 To num
str = .Columns(i).Caption
If .Columns(i).Visible Then
ListView2.AddItem str
ListView2.ItemData(ListView2.ListCount - 1) = i
Else
ListView1.AddItem str
ListView1.ItemData(ListView1.ListCount - 1) = i
End If
Next
End With
End Sub
Private Sub ListView1_DblClick()
If ListView1.ListIndex > -1 Then
ListView2.AddItem ListView1.List(ListView1.ListIndex)
ListView2.ItemData(ListView2.ListCount - 1) = ListView1.ItemData(ListView1.ListIndex)
ListView1.RemoveItem ListView1.ListIndex
End If
End Sub
Private Sub ListView2_DblClick()
If ListView2.ListCount = 0 Then
Exit Sub
End If
If ListView2.ListIndex > -1 Then
ListView1.AddItem ListView2.List(ListView2.ListIndex)
ListView1.ItemData(ListView1.ListCount - 1) = ListView2.ItemData(ListView2.ListIndex)
ListView2.RemoveItem ListView2.ListIndex
End If
End Sub
Private Sub VS1_Change()
Dim tmp1, tmp2
If ListView2.ListCount <= 1 Or ListView2.ListIndex = -1 Then
VS1.Value = 0
Exit Sub
End If
With ListView2
If VS1.Value = -1 Then
If .ListIndex > 0 Then
tmp1 = .List(.ListIndex - 1)
tmp2 = .ItemData(.ListIndex - 1)
.List(.ListIndex - 1) = .List(.ListIndex)
.ItemData(.ListIndex - 1) = .ItemData(.ListIndex)
.List(.ListIndex) = tmp1
.ItemData(.ListIndex) = tmp2
.ListIndex = .ListIndex - 1
End If
ElseIf VS1.Value = 1 Then
If .ListIndex < .ListCount - 1 Then
tmp1 = .List(.ListIndex + 1)
tmp2 = .ItemData(.ListIndex + 1)
.List(.ListIndex + 1) = .List(.ListIndex)
.ItemData(.ListIndex + 1) = .ItemData(.ListIndex)
.List(.ListIndex) = tmp1
.ItemData(.ListIndex) = tmp2
.ListIndex = .ListIndex + 1
End If
End If
VS1.Value = 0
.Refresh
End With
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -