📄 frmlisttrans.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 frmListTrans
BackColor = &H80000004&
Caption = "通用转帐列表"
ClientHeight = 3750
ClientLeft = 2580
ClientTop = 2595
ClientWidth = 6885
KeyPreview = -1 'True
LinkTopic = "Form1"
LockControls = -1 'True
MDIChild = -1 'True
ScaleHeight = 3750
ScaleWidth = 6885
Tag = "ctPayMethod////101"
WhatsThisButton = -1 'True
WhatsThisHelp = -1 'True
Begin MSRDC.MSRDC datGrid
Height = 345
Left = 2820
Top = 3150
Visible = 0 'False
Width = 1695
_ExtentX = 2990
_ExtentY = 609
_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.CommandButton cmdChangeIndex
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Index = 0
Left = 6540
MaskColor = &H8000000F&
Picture = "frmListTrans.frx":0000
Style = 1 'Graphical
TabIndex = 8
Top = 2355
UseMaskColor = -1 'True
Width = 320
End
Begin VB.CommandButton cmdChangeIndex
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Index = 1
Left = 6540
MaskColor = &H8000000F&
Picture = "frmListTrans.frx":04DE
Style = 1 'Graphical
TabIndex = 9
Top = 2760
UseMaskColor = -1 'True
Width = 320
End
Begin VB.TextBox txtFind
Height = 300
Left = 3195
TabIndex = 3
Top = 75
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 = 75
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 = "frmListTrans.frx":09BC
Height = 2655
Left = 0
TabIndex = 5
Tag = "ctPayMethod////101"
Top = 480
Width = 6495
_ExtentX = 11456
_ExtentY = 4683
_Version = 393216
Rows = 20
Cols = 3
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 = "查找(&F)"
Height = 180
Left = 50
TabIndex = 0
Top = 150
Width = 630
End
End
Attribute VB_Name = "frmListTrans"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'王成
Option Explicit
Private lngOldOperatorID As Long
Private WithEvents mclsMainControl As MainControl '主控对象
Attribute mclsMainControl.VB_VarHelpID = -1
Private WithEvents mclsSubClass As SubClass32.SubClass '钩子对象
Attribute mclsSubClass.VB_VarHelpID = -1
Private WithEvents mclsSubClassform As SubClass32.SubClass
Attribute mclsSubClassform.VB_VarHelpID = -1
Private mclsList As list '列表对象
Attribute mclsList.VB_VarHelpID = -1
Private mclsVoucherMethod As clsVoucherMethod
Private intFindCol As Integer
'////////////////////////////////////////////////
'///// 赋值
'////////////////////////////////////////////////
Private Const intViewID = 125 '转帐：不同的列表窗口，其值不同
Private blnMenuBuilded As Boolean
Private theEditForm As Form
Private mIsShowEdit As Boolean '编辑窗口是否已调出标志
Private theEditRow As Long '弹出编辑窗口时本列表的当前行，编辑窗口的记录移动操作影响此值
Private BeginDate As Date
Private EndDate As Date
Private bDblClick As Boolean
Private blnEdit As Boolean '编辑权限
Private blnChange As Boolean '只能编辑和删除自己制作的单据
Private mclsBaseFun As BaseFunction '通用转帐计算
Private mblnIsSaveListset As Boolean
Private mlngAccountID() As Long
Private mlngCustomerID() As Long
Private mlngDepartmentID() As Long
Private mlngEmployeeID() As Long
Private mlngJobID() As Long
Private mlngClassID1() As Long
Private mlngClassID2() As Long
Private mintDirection() As Long
Private mdblAmount() As Double
Private mdblCurrencyAmount() As Double
Private mdblQuantity() As Double
Private mlngTransID() As Long
Private mlngTypeID() As Long
Private mlngTemplateID() As Long
Private mintNum() As Integer
Private mlngCurrencyID() As Long
Private mstrRemark() As String
Private mcolRateDirect As New Collection
Private mintCount As Integer
Private mstrDebit As String, mstrCredit As String
Private mcolAccount As Collection
'取币种汇率方向
Private Sub GetRateDirect()
Dim dblRate As Double, rstRate As rdoResultset, strSql As String
Set mcolRateDirect = New Collection
strSql = "Select * From Currencys"
Set rstRate = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
With rstRate
Do While Not .EOF
mcolRateDirect.Add .rdoColumns("blnIsIndirect").Value, str(.rdoColumns("lngCurrencyID").Value)
.MoveNext
Loop
End With
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
'获得当前行的lngTransVoucherID
Private Function GetTransID()
With grdList
GetTransID = CLng(.TextMatrix(.Row, 0))
End With
End Function
'返回本张单的各种状态
Private Function GetItemStatus(lngTransVoucherID As Long) As Boolean
Dim strSql As String
Dim recTemp As rdoResultset
strSql = "SELECT TransVoucher.lngOperatorID From TransVoucher WHERE (((TransVoucher.lngTransVoucherID)=" & lngTransVoucherID & "))"
Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
If recTemp.BOF And recTemp.EOF Then Exit Function
If gclsBase.OperatorID = recTemp(0) Then
blnChange = True
Else
blnChange = False
End If
Set recTemp = Nothing
GetItemStatus = True
End Function
Public Function GetList() As rdoResultset
Dim strSql As String
Dim recTemp As rdoResultset
Dim strSelect As String
Dim strFrom As String
Dim strWhere As String
On Error Resume Next
strSelect = mclsList.ListSet.SelectOfSql
strFrom = mclsList.ListSet.FromOfSql
strWhere = mclsList.ListSet.WhereOfSql
If Trim(strSelect) = "" Or Trim(strFrom) = "" Then
Set GetList = Nothing
Exit Function
End If
If Trim(strWhere) <> "" Then
strWhere = " WHERE " & strWhere & ""
Else
strWhere = ""
End If
strSelect = "SELECT TransVoucher.lngTransVoucherID, '' AS 选择 ," & strSelect
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -