📄 frmvoucherlist.frm
字号:
VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Object = "{0D452EE1-E08F-101A-852E-02608C4D0BB4}#2.0#0"; "FM20.DLL"
Object = "{F6125AB1-8AB1-11CE-A77F-08002B2F4E98}#2.0#0"; "MSRDC20.OCX"
Begin VB.Form frmVoucherList
BackColor = &H80000004&
Caption = "凭证列表"
ClientHeight = 3708
ClientLeft = 2580
ClientTop = 2592
ClientWidth = 6888
ClipControls = 0 'False
FillColor = &H80000007&
KeyPreview = -1 'True
LinkTopic = "Form1"
LockControls = -1 'True
MDIChild = -1 'True
ScaleHeight = 3708
ScaleWidth = 6888
Tag = "ctPayMethod////101"
Begin MSRDC.MSRDC datGrid
Height = 324
Left = 5232
Top = 3216
Visible = 0 'False
Width = 1236
_ExtentX = 2180
_ExtentY = 572
_Version = 393216
Options = 0
CursorDriver = 0
BOFAction = 0
EOFAction = 0
RecordsetType = 1
LockType = 3
QueryType = 0
Prompt = 3
Appearance = 1
QueryTimeout = 30
RowsetSize = 100
LoginTimeout = 15
KeysetSize = 0
MaxRows = 0
ErrorThreshold = -1
BatchSize = 15
BackColor = -2147483643
ForeColor = -2147483640
Enabled = -1 'True
ReadOnly = 0 'False
Appearance = -1 'True
DataSourceName = ""
RecordSource = ""
UserName = ""
Password = ""
Connect = ""
LogMessages = ""
Caption = "MSRDC1"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.CheckBox chkShowAll
Caption = "全部显示"
Height = 350
Left = 4080
TabIndex = 8
Top = 3180
Width = 1095
End
Begin VB.TextBox txtFind
Height = 300
Left = 3135
TabIndex = 3
Top = 90
Width = 3015
End
Begin VB.CommandButton cmdAgain
BeginProperty Font
Name = "Arial"
Size = 9
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Left = 6240
Style = 1 'Graphical
TabIndex = 4
Tag = "1017"
ToolTipText = "再找"
Top = 90
UseMaskColor = -1 'True
Width = 300
End
Begin VB.ComboBox cboFindKind
Height = 300
Left = 720
Style = 2 'Dropdown List
TabIndex = 1
Top = 90
Width = 1515
End
Begin MSFlexGridLib.MSFlexGrid grdList
Bindings = "frmVoucherList.frx":0000
Height = 2655
Left = 0
TabIndex = 5
Tag = "ctPayMethod////101"
Top = 480
Width = 6495
_ExtentX = 11451
_ExtentY = 4678
_Version = 393216
Rows = 20
Cols = 4
FixedCols = 0
BackColor = 16777215
BackColorFixed = -2147483644
BackColorSel = -2147483646
BackColorBkg = 16777215
Redraw = -1 'True
AllowBigSelection= 0 'False
FocusRect = 0
SelectionMode = 1
AllowUserResizing= 1
End
Begin MSForms.CommandButton cmdReport
Height = 345
Left = 1260
TabIndex = 7
Tag = "1018"
Top = 3240
WhatsThisHelpID = 5010
Width = 1215
Caption = "报表"
PicturePosition = 196613
Size = "2143;609"
TakeFocusOnClick= 0 'False
FontName = "宋体"
FontHeight = 180
FontCharSet = 134
FontPitchAndFamily= 34
ParagraphAlign = 3
End
Begin MSForms.CommandButton cmdEdit
Height = 350
Left = 50
TabIndex = 6
Tag = "1018"
Top = 3240
WhatsThisHelpID = 5010
Width = 1215
Caption = "编辑"
PicturePosition = 196613
Size = "2143;609"
FontName = "宋体"
FontHeight = 180
FontCharSet = 134
FontPitchAndFamily= 34
ParagraphAlign = 3
End
Begin VB.Label lblFind
AutoSize = -1 'True
Caption = "内容(&C)"
Height = 180
Left = 2460
TabIndex = 2
Top = 150
Width = 630
End
Begin VB.Label lblFindKind
AutoSize = -1 'True
Caption = "查找(&B)"
Height = 180
Left = 50
TabIndex = 0
Top = 150
Width = 630
End
End
Attribute VB_Name = "frmVoucherList"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'王成
Option Explicit
Private strSql As String
Private lngOldOperatorID As Long '当系统重新登录时，应重新取得权限
Private mIsShowEdit As Boolean '编辑窗口是否已调出标志
Private mblnFormNoRezise As Boolean '不需要响应form_Rezise事件
Private WithEvents mclsMainControl As MainControl '主控对象
Attribute mclsMainControl.VB_VarHelpID = -1
Private WithEvents mclsSubClassform As SubClass32.SubClass
Attribute mclsSubClassform.VB_VarHelpID = -1
Private WithEvents mclsSubClass As SubClass32.SubClass '钩子对象
Attribute mclsSubClass.VB_VarHelpID = -1
Private mclsList As list '列表对象
Attribute mclsList.VB_VarHelpID = -1
Private mblnFindTextFocus As Boolean
Private strVoucher As String '凭证名称
Private mclsVoucher As clsVoucherMethod
'////////////////////////////////////////////////
'///// 赋值
'////////////////////////////////////////////////
Private Const intViewID = 19 '凭证列表：不同的列表窗口，其值不同
Private intFindCol As Integer '用于cmdAgain
Private blnMenuBuilded As Boolean
Private strOldMenuCaption As String
Private theEditForm As Form
Private theEditRow As Long '弹出编辑窗口时本列表的当前行，编辑窗口的记录移动操作影响此值
Private bDblClick As Boolean
Private blnEdit As Boolean '编辑权限
Private blnChange As Boolean '只能编辑和删除自己制作的单据
'Private mblnPrint As Boolean 'Whether or not save lngViewID in list
Private blnFilter As Boolean '使列表过滤后，定位到第一行
Private mblnIsFilter As Boolean '是否筛选
Private Sub Form_KeyPress(KeyAscii As Integer)
On Error Resume Next
If KeyAscii = vbKeyEscape Then
Unload Me
ElseIf KeyAscii = vbKeyReturn Then
BKKEY Me.ActiveControl.hwnd, vbKeyTab
End If
End Sub
Private Sub cMsgBox(strMsg As String, Optional strTitle As String)
If Trim(strTitle) = "" Then
strTitle = "提示信息"
End If
ShowMsg Me.hwnd, strMsg, MB_OK + MB_ICONEXCLAMATION + MB_SYSTEMMODAL, strTitle
End Sub
Private Sub GotoRow(lngRow As Long)
With grdList
.Row = lngRow
.ColSel = .Cols - 1
End With
End Sub
'返回行为row，列为col的cell在TextArray中的位置
Private Function pos(Row As Long, col As Long) As Long
pos = col + grdList.Cols * Row
End Function
'获得当前行的lngVoucherID
Private Function GetlngVoucherID()
Dim i As Integer
Dim bFound As Boolean
With grdList
If .Row > 0 Then
GetlngVoucherID = CLng(.TextMatrix(.Row, 0))
Else
GetlngVoucherID = -1
Exit Function
End If
strVoucher = ""
'获得本张凭证的凭证号
For i = 1 To .Cols - 1
If "凭证号" = Trim(.TextArray(i)) Then
intFindCol = i
bFound = True
Exit For
End If
Next i
If Not bFound Then Exit Function
'从本行开始往上找
i = .Row
Do While i >= 1
If CLng(.TextMatrix(i, 0)) = GetlngVoucherID Then
i = i - 1
Else
Exit Do
End If
Loop
strVoucher = .TextMatrix(i + 1, intFindCol)
strVoucher = "“" + strVoucher + "”"
End With
End Function
Public Function GetList() As rdoResultset
Dim BeginDate As Date
Dim EndDate As Date
Dim recTemp As rdoResultset
Dim strSelect As String
Dim strFrom As String
Dim strWhere As String
Dim strFromOfMe As String
mclsList.DoForm = True
On Error Resume Next
mclsList.ListSet.ViewId = intViewID
strSelect = mclsList.ListSet.GetSelect
strFrom = mclsList.ListSet.FromOfSql
strWhere = mclsList.ListSet.WhereOfSql
If Trim(strSelect) = "" Or Trim(strFrom) = "" Then
Set GetList = Nothing
Exit Function
End If
If mclsList.ListSet.ListID < 1 Then '新建帐套时，条件为本期
BeginDate = gclsBase.PeriodBegin
EndDate = gclsBase.PeriodEnd
If Trim(strWhere) <> "" Then
strWhere = " and (To_Date(Voucher.strDate,'rrrr-mm-dd')>= To_Date('" & _
Format(BeginDate, "yyyy-mm-dd") & "','rrrr-mm-dd') And To_Date(Voucher.strDate,'rrrr-mm-dd')<=To_Date('" & Format(EndDate, "yyyy-mm-dd") & "','rrrr-mm-dd'))" _
& " and voucher.lngvoucherID in (select voucher.lngVoucherID " & strFrom & " where " & strWhere & ")" _
& " ORDER BY Voucher.intYear,Voucher.bytPeriod,VoucherType.strVoucherTypeCode || ' ' || To_Char(Voucher.intVoucherNO,'9999'),Voucher.lngVoucherID,VoucherDetail.lngRowID" ' lngVoucherDetailID"
Else
strWhere = " and (To_Date(Voucher.strDate,'rrrr-mm-dd')>= To_Date('" & Format(BeginDate, "yyyy-mm-dd") & _
"','rrrr-mm-dd') And To_Date(Voucher.strDate,'rrrr-mm-dd')<=To_Date('" & Format(EndDate, "yyyy-mm-dd") & _
"','rrrr-mm-dd')) ORDER BY Voucher.intYear,Voucher.bytPeriod,VoucherType.strVoucherTypeCode || ' ' || To_Char(Voucher.intVoucherNO,'9999'),Voucher.lngVoucherID,VoucherDetail.lngRowID" 'lngVoucherDetailID"
End If
Else
If Trim(strWhere) <> "" Then
strWhere = " And voucher.lngvoucherID in (select voucher.lngVoucherID " & strFrom & " where " & strWhere & ")" & _
" ORDER BY Voucher.intYear,Voucher.bytPeriod,VoucherType.strVoucherTypeCode || ' ' || To_Char(Voucher.intVoucherNO,'9999'),Voucher.lngVoucherID,VoucherDetail.lngRowID" ' lngVoucherDetailID" '" ORDER BY cdate(voucher.strdate), Voucher.lngVoucherID , VoucherDetail.lngRowID" ' lngVoucherDetailID"
Else
strWhere = " ORDER BY Voucher.intYear,Voucher.bytPeriod,VoucherType.strVoucherTypeCode || ' ' || To_Char(Voucher.intVoucherNO,'9999'),Voucher.lngVoucherID,VoucherDetail.lngRowID" ' lngVoucherDetailID"
End If
End If
strSelect = "Select Voucher.lngVoucherID As id,decode(Voucher.blnIsVoid,1,'√','') As ""作废""," & strSelect
' strFromOfMe = " From ((((((((((((Voucher INNER JOIN VoucherType ON Voucher.lngVoucherTypeID = VoucherType.lngVoucherTypeID) INNER JOIN Template ON Voucher.lngTemplateID = Template.lngTemplateID)" & _
' " INNER JOIN Operator ON Voucher.lngOperatorID = Operator.lngOperatorID)" & _
' " INNER JOIN VoucherDetail ON Voucher.lngVoucherID = VoucherDetail.lngVoucherID)" & _
' " INNER JOIN Account ON VoucherDetail.lngAccountID = Account.lngAccountID)" & _
' " INNER JOIN Currencys ON VoucherDetail.lngCurrencyID = Currencys.lngCurrencyID)" & _
' " LEFT JOIN Class1 ON VoucherDetail.lngClassID1 = Class1.lngClassID)" & _
' " LEFT JOIN Class2 ON VoucherDetail.lngClassID2 = Class2.lngClassID)" & _
' " LEFT JOIN Customer ON VoucherDetail.lngCustomerID = Customer.lngCustomerID)" & _
' " LEFT JOIN Department ON VoucherDetail.lngDepartmentID = Department.lngDepartmentID)" & _
' " LEFT JOIN Employee ON VoucherDetail.lngEmployeeID = Employee.lngEmployeeID)" & _
' " LEFT JOIN Operator AS Operator_1 ON Voucher.lngCheckerID = Operator_1.lngOperatorID)" & _
' " LEFT JOIN Operator AS Operator_2 ON Voucher.lngPostID = Operator_2.lngOperatorID "
' strFromOfMe = " From ((((((((((((Voucher INNER JOIN VoucherType ON Voucher.lngVoucherTypeID = VoucherType.lngVoucherTypeID) INNER JOIN Template ON Voucher.lngTemplateID = Template.lngTemplateID)" & _
' " INNER JOIN Operator ON Voucher.lngOperatorID = Operator.lngOperatorID)" & _
' " LEFT JOIN Operator AS Operator_1 ON Voucher.lngCheckerID = Operator_1.lngOperatorID)" & _
' " LEFT JOIN Operator AS Operator_2 ON Voucher.lngPostID = Operator_2.lngOperatorID) " & _
' " INNER JOIN VoucherDetail ON Voucher.lngVoucherID = VoucherDetail.lngVoucherID)" & _
' " INNER JOIN Account ON VoucherDetail.lngAccountID = Account.lngAccountID)" & _
' " INNER JOIN Currencys ON VoucherDetail.lngCurrencyID = Currencys.lngCurrencyID)" & _
' " LEFT JOIN Class1 ON VoucherDetail.lngClassID1 = Class1.lngClassID)" & _
' " LEFT JOIN Class2 ON VoucherDetail.lngClassID2 = Class2.lngClassID)" & _
' " LEFT JOIN Customer ON VoucherDetail.lngCustomerID = Customer.lngCustomerID)" & _
' " LEFT JOIN Department ON VoucherDetail.lngDepartmentID = Department.lngDepartmentID)" & _
' " LEFT JOIN Employee ON VoucherDetail.lngEmployeeID = Employee.lngEmployeeID"
' strFromOfMe = " FROM (((((Voucher INNER JOIN VoucherType ON Voucher.lngVoucherTypeID = VoucherType.lngVoucherTypeID) INNER JOIN Template ON Voucher.lngTemplateID = Template.lngTemplateID)" & _
' " INNER JOIN Operator ON Voucher.lngOperatorID = Operator.lngOperatorID)" & _
' " LEFT JOIN Operator AS Operator_1 ON Voucher.lngCheckerID = Operator_1.lngOperatorID)" & _
' " LEFT JOIN Operator AS Operator_2 ON Voucher.lngPostID = Operator_2.lngOperatorID) " & _
' " INNER JOIN (((((((VoucherDetail INNER JOIN Account ON VoucherDetail.lngAccountID = Account.lngAccountID)" & _
' " INNER JOIN Currencys ON VoucherDetail.lngCurrencyID = Currencys.lngCurrencyID) " & _
' " LEFT JOIN Class1 ON VoucherDetail.lngClassID1 = Class1.lngClassID) " & _
' " LEFT JOIN Class2 ON VoucherDetail.lngClassID2 = Class2.lngClassID)" & _
' " LEFT JOIN Customer ON VoucherDetail.lngCustomerID = Customer.lngCustomerID) " & _
' " LEFT JOIN Department ON VoucherDetail.lngDepartmentID = Department.lngDepartmentID) " & _
' " LEFT JOIN Employee ON VoucherDetail.lngEmployeeID = Employee.lngEmployeeID)" & _
' " ON Voucher.lngVoucherID = VoucherDetail.lngVoucherID"
strFromOfMe = " FROM Voucher,VoucherType,Template,Operator,Operator Operator_1," & _
" Operator Operator_2,VoucherDetail,Account,Currencys,Class1,Class2,Customer,Department,Employee " & _
" Where ((((( Voucher.lngVoucherTypeID = VoucherType.lngVoucherTypeID) and Voucher.lngTemplateID = Template.lngTemplateID)" & _
" and Voucher.lngOperatorID = Operator.lngOperatorID)" & _
" and Voucher.lngCheckerID = Operator_1.lngOperatorID(+))" & _
" and Voucher.lngPostID = Operator_2.lngOperatorID(+)) " & _
" and ((((((( VoucherDetail.lngAccountID = Account.lngAccountID)" & _
" and VoucherDetail.lngCurrencyID = Currencys.lngCurrencyID) " & _
" and VoucherDetail.lngClassID1 = Class1.lngClassID(+)) " & _
" and VoucherDetail.lngClassID2 = Class2.lngClassID(+))" & _
" and VoucherDetail.lngCustomerID = Customer.lngCustomerID(+)) " & _
" and VoucherDetail.lngDepartmentID = Department.lngDepartmentID(+)) " & _
" and VoucherDetail.lngEmployeeID = Employee.lngEmployeeID(+))" & _
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -