📄 frmcountfilter.frm
字号:
VERSION 5.00
Begin VB.Form frmAccountFilter
BorderStyle = 3 'Fixed Dialog
Caption = "筛选栏目"
ClientHeight = 3525
ClientLeft = 45
ClientTop = 330
ClientWidth = 7365
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3525
ScaleWidth = 7365
ShowInTaskbar = 0 'False
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton cmdCancel
Cancel = -1 'True
Height = 315
Left = 6090
Style = 1 'Graphical
TabIndex = 10
Tag = "1002"
Top = 600
UseMaskColor = -1 'True
Width = 1155
End
Begin VB.CommandButton cmdOk
Height = 315
Left = 6090
Style = 1 'Graphical
TabIndex = 9
Tag = "1001"
Top = 210
UseMaskColor = -1 'True
Width = 1155
End
Begin VB.Frame Frame1
Height = 3285
Left = 90
TabIndex = 0
Top = 60
Width = 5865
Begin VB.ListBox lstAll
Height = 1860
Left = 180
TabIndex = 2
TabStop = 0 'False
Top = 480
Width = 2370
End
Begin VB.ListBox lstSelected
Height = 1860
Left = 3450
TabIndex = 8
TabStop = 0 'False
Top = 480
Width = 2220
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 = 2700
TabIndex = 3
Top = 735
UseMaskColor = -1 'True
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 = 2700
TabIndex = 4
Top = 1110
UseMaskColor = -1 'True
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 = 2700
TabIndex = 5
Top = 1485
UseMaskColor = -1 'True
Width = 576
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 = 2700
TabIndex = 6
Top = 1860
UseMaskColor = -1 'True
Width = 576
End
Begin VB.Label lblAll
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "可选栏目(&S)"
ForeColor = &H80000008&
Height = 180
Left = 150
TabIndex = 1
Tag = "2406"
Top = 240
Width = 990
End
Begin VB.Label lblSelected
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "已选栏目(&T)"
ForeColor = &H80000008&
Height = 180
Left = 3540
TabIndex = 7
Tag = "2407"
Top = 240
Width = 990
End
End
End
Attribute VB_Name = "frmAccountFilter"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'***********************************
' 作者:王佥
' 功能: 在筛选中,为代码型字段设置多选条件.
' 使用范围: 在筛选窗体和查找窗体内.
' 接口: Public Function AccountFilter( strTable As String, strKeyCode As String) As String
' 其中
' StrTable 是设置多选条件的代码型字段所在表名.
' StrKeyCode 是多选ID字符串, 输入时为已选的多选条件ID串, 返回为设置后的多选ID字符串.
' AccountFilter 返回多选代码字符串
' 日期:1998年6月20日
'***********************************
'***********************************
Option Explicit
Private strTableName As String
Private blnIsEnum As Boolean
Private strCondVersionEnum As String
Private strCondVersion As String
Public strCodeTerm As String
Private strCodeInput As String
Public strOK As String
Public mblnOk As Boolean
Public mTagShow As Boolean
Private mlngViewID As Long '总的视图ID号
Private mlngReceiptTypeID As Long
Private mstrReceiptTypeID As String
Private mEmployeeTag As Long '职员条件标志 -1：所有，1：总帐类
'2：应收类 4：应付类 8：现金银行类 16：采购类 32：销售类 64：库存类 128：委托加工类
''传递变量给类模块TvwFilterSet
Private Sub InitLst()
Dim rs As rdoResultset
Dim strCode As String
Dim blnFind As Boolean
Dim strKey As String
Dim strTemp As String
Dim Index As Long
On Error GoTo EndAllHandle
blnFind = False
lstAll.Clear
lstSelected.Clear
strCode = strCodeInput
Do While Trim(strCode) <> ""
strCode = Trim(strCode)
Index = InStr(strCode, ",")
If Index = 0 Then
strTemp = strCode
If blnIsEnum = False Then
If Not IsNumeric(strTemp) Then Exit Do
End If
Index = Len(strCode)
Else
strTemp = Left(strCode, Index - 1)
End If
lstSelected.AddItem strTemp
strCode = Right(strCode, Len(strCode) - Index)
Loop
AddItemHandle:
Dim strSql As String
Dim strBiaTable As String
If blnIsEnum = False Then
Select Case UCase(strTableName)
Case "EMPLOYEE"
If mEmployeeTag <= 0 Then
strSql = " select strEmployeeCode as a1, strEmployeeName as b1,lngEmployeeID as b2 from Employee order by strEmployeeCode "
Else
strSql = " select strEmployeeCode as a1, strEmployeeName as b1,lngEmployeeID as b2 from Employee where " & Filter.GetEmployeeWhere(mEmployeeTag) & " order by strEmployeeCode "
End If
Case "CLASS1", "CLASS2", "CURRENCYS", "CUSTOM0", "CUSTOM1", "CUSTOM2", "CUSTOM3", "CUSTOM4", "CUSTOM5"
strBiaTable = Left(strTableName, Len(strTableName) - 1)
strSql = "select str" & strBiaTable & "Code as a1, str" & strBiaTable & "Name AS B1,lng" & strBiaTable & "ID as b2 from " & strTableName & " where blnisinactive=0 order by str" & strBiaTable & "Code"
Case "BUSINESSADDRESS", "EMPLOYEETYPE", "AREA", "CUSTOMERADDRESS"
strSql = "select str" & strTableName & "Code as a1, str" & strTableName & "Name AS B1,lng" & strTableName & "ID as b2 from " & strTableName & " order by str" & strTableName & "Code"
Case "FIXEDCARD"
strSql = " select strFixedCardCode AS A1,strFixedName AS B1,lngFixedCardID AS B2 from FixedCard order by strFixedCardCode"
Case "PAYMENTMETHOD"
If mlngViewID = 1195 Then
strSql = " select strPaymentMethodCode AS A1, strPaymentMethodName AS B1,lngPaymentMethodID as b2 from PaymentMethod Where blnIsInActive=0 and blnIsCheck=1 order by strPaymentMethodCode "
Else
strSql = "select str" & strTableName & "Code as a1, str" & strTableName & "Name AS B1,lng" & strTableName & "ID as b2 from " & strTableName & " where blnisinactive=0 order by str" & strTableName & "Code"
End If
Case "VOUCHERTYPE"
If mlngViewID = 316 Then '李鹏的凭证打印
Select Case mlngReceiptTypeID
Case 41
strSql = " select strVoucherTypeCode as a1,strVoucherTypeName AS B1, lngVoucherTypeID as b2 from VoucherType where VoucherType.strVoucherFormat='0' order by strVoucherTypeCode"
Case 54
strSql = " select strVoucherTypeCode as a1,strVoucherTypeName AS B1, lngVoucherTypeID as b2 from VoucherType where VoucherType.strVoucherFormat='1' order by strVoucherTypeCode"
Case 55
strSql = " select strVoucherTypeCode as a1,strVoucherTypeName AS B1, lngVoucherTypeID as b2 from VoucherType where VoucherType.strVoucherFormat='2' order by strVoucherTypeCode"
End Select
Else
strSql = " select strVoucherTypeCode as a1,strVoucherTypeName AS B1, lngVoucherTypeID as b2 from VoucherType order by strVoucherTypeCode"
End If
Case Else
strSql = "select str" & strTableName & "Code as a1, str" & strTableName & "Name AS B1,lng" & strTableName & "ID as b2 from " & strTableName & " where blnisinactive=0 order by str" & strTableName & "Code"
End Select
Set rs = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
If rs.RowCount > 0 Then
rs.MoveFirst
Else
RefreshButton
Exit Sub
End If
If lstSelected.ListCount > 0 Then lstSelected.ListIndex = 0
Index = lstSelected.ListCount
Do While Not rs.EOF
If Index > 0 Then
Dim index2 As Long
Dim Flag As Boolean
Flag = False
index2 = 0
Do While index2 < Index
lstSelected.ListIndex = index2
If rs!b2 = lstSelected.Text Then
lstSelected.RemoveItem lstSelected.ListIndex
lstSelected.AddItem rs!A1 & " " & rs!b1 & Space(50) & "`" & rs!b2, lstSelected.ListCount
Index = Index - 1
Flag = True
Exit Do
Else
index2 = index2 + 1
End If
Loop
If Flag = False Then lstAll.AddItem rs!A1 & " " & rs!b1 & Space(50) & "`" & rs!b2, lstAll.ListCount
Else
lstAll.AddItem rs!A1 & " " & rs!b1 & Space(50) & "`" & rs!b2, lstAll.ListCount
End If
rs.MoveNext
Loop
'删除已经停用的已选项目
For Index = lstSelected.ListCount - 1 To 0 Step -1
If Len(Trim(lstSelected.list(Index))) < 30 Then
' lstSelected.ListIndex = Index
lstSelected.RemoveItem Index
End If
Next
Else
Select Case strTableName
Case "销货清单模板"
strSql = "SELECT Distinct Template.strTemplateName as b2 from Template where bytVersion in " & strCondVersion & " And Template.lngTemplateID in " & _
" (select Template.lngSaleDataBookTemplateID FROM Template WHERE Template.lngReceiptTypeID=20 AND Template.lngSaleDataBookTemplateID>0)"
Case "现金流量"
strSql = "select distinct strCashItemName as b2 from CashItem"
Case "付款方"
strSql = "select distinct strPayCustomerName as b2 from PayCustomer "
Case "应收凭证类型", "应付凭证类型", "核销凭证类型"
strSql = "select distinct strVoucherTypeName as b2 from VoucherType "
Case "凭证模板"
If mlngReceiptTypeID = 0 Then mlngReceiptTypeID = 41
strSql = "select distinct strTemplateName as b2 from Template where lngReceiptTypeID=" & mlngReceiptTypeID & " and bytVersion in" & strCondVersion
Case "模板", "单据模板"
Dim strSqlTemplate As String
Select Case mlngViewID
Case 20
strSqlTemplate = "36,37,38"
Case 21
strSqlTemplate = "34,35"
Case 22
strSqlTemplate = "40"
Case 23
strSqlTemplate = "39"
Case 75
strSqlTemplate = "2"
Case 78
strSqlTemplate = "13"
Case 80
strSqlTemplate = "26"
Case 82
strSqlTemplate = "28"
Case 83
strSqlTemplate = "29"
Case 142
strSqlTemplate = "30,31"
Case 74
strSqlTemplate = "1"
Case 77
strSqlTemplate = "12"
Case 124
strSqlTemplate = "32"
Case 141
strSqlTemplate = "33"
Case 334
strSqlTemplate = "3"
Case 335
strSqlTemplate = "4"
Case 336
strSqlTemplate = "5"
Case 337
strSqlTemplate = "6"
Case 338
strSqlTemplate = "7"
Case 339
strSqlTemplate = "8"
Case 340
strSqlTemplate = "9"
Case 341
strSqlTemplate = "10"
Case 342
strSqlTemplate = "11"
Case 343
strSqlTemplate = "14"
Case 344
strSqlTemplate = "15"
Case 345
strSqlTemplate = "16"
Case 346
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -