📄 账户管理列表.frm
字号:
VERSION 5.00
Begin VB.Form frmAccSort
BorderStyle = 3 'Fixed Dialog
Caption = "账户列表"
ClientHeight = 3345
ClientLeft = 45
ClientTop = 330
ClientWidth = 6120
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3345
ScaleWidth = 6120
ShowInTaskbar = 0 'False
Begin VB.CommandButton cmdOK
Caption = "确认(&O)"
Height = 330
Left = 1858
TabIndex = 11
Top = 2970
Width = 1050
End
Begin VB.CommandButton cmdSelect
Caption = "全部弃选"
Height = 330
Index = 3
Left = 4983
TabIndex = 10
Top = 2115
Width = 1050
End
Begin VB.CommandButton cmdSelect
Caption = "弃选"
Height = 330
Index = 2
Left = 4983
TabIndex = 9
Top = 1545
Width = 1050
End
Begin VB.CommandButton cmdSelect
Caption = "选择"
Height = 330
Index = 1
Left = 4983
TabIndex = 8
Top = 975
Width = 1050
End
Begin VB.CommandButton cmdSelect
Caption = "选择全部"
Height = 330
Index = 0
Left = 4983
TabIndex = 7
Top = 405
Width = 1050
End
Begin VB.CommandButton cmdArrow
Caption = "↓"
Height = 420
Index = 1
Left = 4443
TabIndex = 6
Top = 1620
Width = 330
End
Begin VB.CommandButton cmdArrow
Caption = "↑"
Height = 420
Index = 0
Left = 4443
TabIndex = 5
Top = 900
Width = 330
End
Begin VB.CommandButton cmdCancel
Caption = "放弃(&C)"
Height = 330
Left = 3208
TabIndex = 4
Top = 2970
Width = 1050
End
Begin VB.ComboBox cmbOrder
Height = 315
Index = 2
Left = 51
Style = 2 'Dropdown List
TabIndex = 3
Top = 1470
Width = 1575
End
Begin VB.ComboBox cmbOrder
Height = 315
Index = 1
Left = 51
Style = 2 'Dropdown List
TabIndex = 2
Top = 975
Width = 1575
End
Begin VB.ComboBox cmbOrder
Height = 315
Index = 0
Left = 51
Style = 2 'Dropdown List
TabIndex = 1
Top = 480
Width = 1575
End
Begin VB.ListBox lstItem
Height = 2580
ItemData = "账户管理列表.frx":0000
Left = 1858
List = "账户管理列表.frx":0002
Style = 1 'Checkbox
TabIndex = 0
Top = 45
Width = 2400
End
Begin VB.Label lblOrder
AutoSize = -1 'True
Caption = "排序"
Height = 180
Left = 53
TabIndex = 12
Top = 120
Width = 360
End
Begin VB.Line Line1
BorderColor = &H00808080&
BorderStyle = 6 'Inside Solid
Index = 1
X1 = 10
X2 = 6125
Y1 = 2865
Y2 = 2865
End
Begin VB.Line Line1
BorderColor = &H00FFFFFF&
BorderWidth = 2
Index = 0
X1 = 15
X2 = 6100
Y1 = 2880
Y2 = 2880
End
End
Attribute VB_Name = "frmAccSort"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cmdArrow_Click(index As Integer)
Dim l As String
Dim i As Integer
Dim b As Boolean
Select Case index
Case 0
If lstItem.ListIndex > 0 Then
l = lstItem.List(lstItem.ListIndex)
b = lstItem.Selected(lstItem.ListIndex)
i = lstItem.ListIndex
lstItem.RemoveItem lstItem.ListIndex
lstItem.AddItem l, i - 1
lstItem.Selected(i - 1) = b
End If
Case 1
If lstItem.ListIndex < lstItem.ListCount - 1 Then
l = lstItem.List(lstItem.ListIndex)
b = lstItem.Selected(lstItem.ListIndex)
i = lstItem.ListIndex
lstItem.RemoveItem lstItem.ListIndex
lstItem.AddItem l, i + 1
lstItem.Selected(i + 1) = b
lstItem.ListIndex = i + 1
End If
End Select
End Sub
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdOk_Click()
Dim objEO As U8FDEso.EntityObject
Dim objAccDefBI As New U8FDBso.clsAccDefBI
Dim objDataMgr As New U8FDMgr.DataManager
Set objEO = objAccDefBI.Init(g_sDataSourceName)
Dim i As Integer, index As Integer
For i = 0 To lstItem.ListCount - 1
If lstItem.Selected(i) = True Then
If LCase(mID(lstItem.List(i), InStrRev(lstItem.List(i), "&") + 1)) = "yt_cad_code" Then
If objEO("yt_flag").QryFldSqc = 0 Then
objEO("yt_cad_code").QryFldSqc = 0
Else
index = index + 1
objEO(mID(lstItem.List(i), InStrRev(lstItem.List(i), "&") + 1)).QryFldSqc = index
End If
ElseIf LCase(mID(lstItem.List(i), InStrRev(lstItem.List(i), "&") + 1)) = "deficit_mny" Or LCase(mID(lstItem.List(i), InStrRev(lstItem.List(i), "&") + 1)) = "deficitrestrict_flag" Then
If objEO("deficit_flag").QryFldSqc = 0 Then
objEO("deficit_mny").QryFldSqc = 0
objEO("deficitrestrict_flag").QryFldSqc = 0
Else
index = index + 1
objEO(mID(lstItem.List(i), InStrRev(lstItem.List(i), "&") + 1)).QryFldSqc = index
End If
Else
index = index + 1
objEO(mID(lstItem.List(i), InStrRev(lstItem.List(i), "&") + 1)).QryFldSqc = index
End If
Else
If LCase(mID(lstItem.List(i), InStrRev(lstItem.List(i), "&") + 1)) = "yt_flag" Then
objEO(mID(lstItem.List(i), InStrRev(lstItem.List(i), "&") + 1)).QryFldSqc = 0
objEO("yt_cad_code").QryFldSqc = 0
End If
If LCase(mID(lstItem.List(i), InStrRev(lstItem.List(i), "&") + 1)) = "deficit_flag" Then
objEO(mID(lstItem.List(i), InStrRev(lstItem.List(i), "&") + 1)).QryFldSqc = 0
objEO("deficit_mny").QryFldSqc = 0
objEO("deficitrestrict_flag").QryFldSqc = 0
End If
If LCase(mID(lstItem.List(i), InStrRev(lstItem.List(i), "&") + 1)) = "accdef_code" Or LCase(mID(lstItem.List(i), InStrRev(lstItem.List(i), "&") + 1)) = "accdef_name" Then
MsgBox "账户号和账号名称必须选择!", vbInformation, App.ProductName
Exit Sub
End If
objEO(mID(lstItem.List(i), InStrRev(lstItem.List(i), "&") + 1)).QryFldSqc = 0
End If
objEO(mID(lstItem.List(i), InStrRev(lstItem.List(i), "&") + 1)).ReferenceType = 0
Next
If index < 2 Then
MsgBox "至少选择两个项目!"
Exit Sub
End If
For i = 0 To 2
objEO(mID(cmbOrder(i).Text, InStrRev(cmbOrder(i).Text, "&") + 1)).ReferenceType = i + 1
Next
If cmbOrder(0).ListIndex = cmbOrder(1).ListIndex Or cmbOrder(0).ListIndex = cmbOrder(2).ListIndex Or cmbOrder(1).ListIndex = cmbOrder(2).ListIndex Then
MsgBox "排序项目不能重复!"
Exit Sub
End If
objEO("destroy_flag").QryFldSqc = 0
If Not objDataMgr.SaveEOMetaData(g_sDataSourceName, objEO, , False) Then
MsgBox 保存不成功!
End If
Set objDataMgr = Nothing
frmAccMgr.CreateSQL frmAccMgr.IsGroup
frmAccMgr.RefreshUI 2
Unload Me
End Sub
Private Sub cmdSelect_Click(index As Integer)
Dim i As Integer
Select Case index
Case 0
Dim lIndex As Integer
lIndex = lstItem.ListIndex
For i = 0 To lstItem.ListCount - 1
lstItem.Selected(i) = True
Next
lstItem.ListIndex = lIndex
Case 1
If lstItem.ListCount > 0 Then
If lstItem.ListIndex = -1 Then
lstItem.Selected(0) = True
End If
lstItem.Selected(lstItem.ListIndex) = True
End If
Case 2
If lstItem.ListCount > 0 Then
If lstItem.ListIndex = -1 Then
lstItem.Selected(0) = False
End If
lstItem.Selected(lstItem.ListIndex) = False
End If
Case 3
For i = 0 To lstItem.ListCount - 1
lstItem.Selected(i) = False
Next
End Select
End Sub
Private Sub Form_Load()
Dim i As Integer
Dim QryFldSqcSelect() As String
Dim QryFldSqcUnSel() As String
Dim QryFldOrderBy(3) As String
Dim index As Integer
ReDim Preserve QryFldSqcSelect(frmAccMgr.EO.Fields.Count)
ReDim Preserve QryFldSqcUnSel(frmAccMgr.EO.Fields.Count)
For i = 1 To frmAccMgr.EO.Fields.Count
If frmAccMgr.EO.Fields(i).IsUsed And frmAccMgr.EO.Fields(i).EditProp <> U8FDEso.esoNotVisible And frmAccMgr.EO.Fields(i).DataType <> esoLabel And frmAccMgr.EO.Fields(i).Name <> "ration_mny" And frmAccMgr.EO.Fields(i).Name <> "destroy_flag" Then
If frmAccMgr.EO.Fields(i).QryFldSqc > 0 Then
QryFldSqcSelect(frmAccMgr.EO.Fields(i).QryFldSqc) = frmAccMgr.EO.Fields(i).Name
Else
index = index + 1
QryFldSqcUnSel(index) = frmAccMgr.EO.Fields(i).Name
End If
If frmAccMgr.EO.Fields(i).ReferenceType > 0 Then
QryFldOrderBy(frmAccMgr.EO.Fields(i).ReferenceType) = frmAccMgr.EO.Fields(i).Caption & String(100, " ") & "&" & frmAccMgr.EO.Fields(i).Name
End If
End If
Next
For i = 1 To UBound(QryFldSqcSelect)
If Not IsNull(QryFldSqcSelect(i)) And QryFldSqcSelect(i) <> "" Then
lstItem.AddItem frmAccMgr.EO(QryFldSqcSelect(i)).Caption & String(100, " ") & "&" & frmAccMgr.EO(QryFldSqcSelect(i)).Name
lstItem.Selected(lstItem.ListCount - 1) = True
cmbOrder(0).AddItem frmAccMgr.EO(QryFldSqcSelect(i)).Caption & String(100, " ") & "&" & frmAccMgr.EO(QryFldSqcSelect(i)).Name
cmbOrder(1).AddItem frmAccMgr.EO(QryFldSqcSelect(i)).Caption & String(100, " ") & "&" & frmAccMgr.EO(QryFldSqcSelect(i)).Name
cmbOrder(2).AddItem frmAccMgr.EO(QryFldSqcSelect(i)).Caption & String(100, " ") & "&" & frmAccMgr.EO(QryFldSqcSelect(i)).Name
End If
Next
For i = 1 To UBound(QryFldSqcUnSel)
If Not IsNull(QryFldSqcUnSel(i)) And QryFldSqcUnSel(i) <> "" Then
lstItem.AddItem frmAccMgr.EO(QryFldSqcUnSel(i)).Caption & String(100, " ") & "&" & frmAccMgr.EO(QryFldSqcUnSel(i)).Name
cmbOrder(0).AddItem frmAccMgr.EO(QryFldSqcUnSel(i)).Caption & String(100, " ") & "&" & frmAccMgr.EO(QryFldSqcUnSel(i)).Name
cmbOrder(1).AddItem frmAccMgr.EO(QryFldSqcUnSel(i)).Caption & String(100, " ") & "&" & frmAccMgr.EO(QryFldSqcUnSel(i)).Name
cmbOrder(2).AddItem frmAccMgr.EO(QryFldSqcUnSel(i)).Caption & String(100, " ") & "&" & frmAccMgr.EO(QryFldSqcUnSel(i)).Name
End If
Next
If QryFldOrderBy(1) = "" Then
cmbOrder(0).ListIndex = 0
Else
cmbOrder(0).Text = QryFldOrderBy(1)
End If
If QryFldOrderBy(2) = "" Then
cmbOrder(1).ListIndex = 0
Else
cmbOrder(1).Text = QryFldOrderBy(2)
End If
If QryFldOrderBy(3) = "" Then
cmbOrder(2).ListIndex = 0
Else
cmbOrder(2).Text = QryFldOrderBy(3)
End If
CenterForm Me
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -