📄 collate.frm
字号:
VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Object = "{F6125AB1-8AB1-11CE-A77F-08002B2F4E98}#2.0#0"; "MSRDC20.OCX"
Begin VB.Form frmCollate
Caption = "银行科目余额表"
ClientHeight = 3345
ClientLeft = 60
ClientTop = 2295
ClientWidth = 8370
HelpContextID = 60010
LinkTopic = "Form1"
LockControls = -1 'True
MDIChild = -1 'True
ScaleHeight = 3345
ScaleWidth = 8370
WindowState = 2 'Maximized
Begin MSRDC.MSRDC Data1
Height = 330
Left = 2760
Top = 1920
Visible = 0 'False
Width = 1200
_ExtentX = 2117
_ExtentY = 582
_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 cmdCollate
Caption = "取消启用(&U)"
Height = 350
Index = 5
Left = 6780
TabIndex = 6
Top = 2880
Width = 1315
End
Begin VB.CommandButton cmdCollate
Caption = "启用(&T)"
Height = 350
Index = 4
Left = 5460
TabIndex = 5
Top = 2880
Width = 1315
End
Begin VB.CommandButton cmdCollate
Caption = "余额调节表(&A)"
Height = 350
Index = 3
Left = 4140
TabIndex = 4
Top = 2880
Width = 1315
End
Begin VB.CommandButton cmdCollate
Caption = "银行对帐(&C)"
Height = 350
Index = 2
Left = 2820
TabIndex = 3
Top = 2880
Width = 1315
End
Begin VB.CommandButton cmdCollate
Caption = "银行帐(&B)"
Height = 350
Index = 1
Left = 1500
TabIndex = 2
Top = 2880
Width = 1315
End
Begin VB.CommandButton cmdCollate
Caption = "对帐单(&D)"
Height = 350
Index = 0
Left = 180
TabIndex = 1
Top = 2880
Width = 1315
End
Begin MSFlexGridLib.MSFlexGrid msgCollate
Bindings = "Collate.frx":0000
Height = 2415
Left = 120
TabIndex = 0
Top = 120
Width = 7575
_ExtentX = 13361
_ExtentY = 4260
_Version = 393216
Cols = 10
FixedCols = 0
BackColorBkg = 16777215
Redraw = -1 'True
GridLines = 0
SelectionMode = 1
AllowUserResizing= 1
FormatString = "|| 银行科目 | 币种 | 启用日期 | 截止日期 |>银行帐帐面余额|>对帐单帐面余额|>调整后银行帐余额|>调整后对帐单余额 "
End
End
Attribute VB_Name = "frmCollate"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'''''''''''''''''''''''''''''''''''
'
'银行对帐主界面窗体
'
'作者:苏涛
'
'日期:1998.6.24
'
'接口：引出：AccountID,CurrencyID
'
''''''''''''''''''''''''''''''''''
Option Explicit
Option Compare Text
Private mblnIsShowCard(1) As Boolean
Private mblnRowFail As Boolean
Private mclsGrid As Grid
Private mintGridRow As Integer
Private mlngAcntID As Long
Private mlngCurID As Long
Private mstrDate As String
Private mblnReActive As Boolean
Private WithEvents mclsMainControl As MainControl '主控对象
Attribute mclsMainControl.VB_VarHelpID = -1
Private WithEvents mclsSubClassform As SubClass32.SubClass
Attribute mclsSubClassform.VB_VarHelpID = -1
Public Property Let ReActive(ByVal NewValue As Boolean)
mblnReActive = NewValue
End Property
Public Property Let IsShowCard(ByVal Index As Integer, ByVal blnIsShow As Boolean)
mblnIsShowCard(Index) = blnIsShow
End Property
Public Property Get IsShowCard(ByVal Index As Integer) As Boolean
IsShowCard(Index) = mblnIsShowCard(Index)
End Property
Public Property Get AccountID() As Long
AccountID = mlngAcntID
End Property
Public Property Let AccountID(ByVal NewValue As Long)
mlngAcntID = NewValue
End Property
Public Property Let CurrencyID(ByVal NewValue As Long)
mlngCurID = NewValue
End Property
Public Property Get CurrencyID() As Long
CurrencyID = mlngCurID
End Property
Private Sub AdjustDate(ByVal strNewDate As String)
Dim recBankInitAdd As rdoResultset, strSql As String, strQueryName As String
If mlngAcntID = 0 Then Exit Sub
On Error GoTo ErrHandle
gclsBase.BaseWorkSpace.BeginTrans
If Trim$(strNewDate) = "" Then
msgCollate.TextMatrix(msgCollate.Row, 5) = ""
msgCollate.TextMatrix(msgCollate.Row, 6) = ""
msgCollate.TextMatrix(msgCollate.Row, 7) = ""
msgCollate.TextMatrix(msgCollate.Row, 8) = ""
msgCollate.TextMatrix(msgCollate.Row, 9) = ""
strSql = "DELETE FROM BankInfo WHERE lngAccountID=" & mlngAcntID _
& " And lngCurrencyID = " & mlngCurID
If Not gclsBase.ExecSQL(strSql) Then GoTo ErrHandle
' strSql = "DELETE FROM BankInit WHERE lngAccountID=" & mlngAcntID _
& " And lngCurrencyID = " & mlngCurID
' If Not gclsBase.ExecSQL(strSql) Then GoTo ErrHandle
' strSql = "DELETE FROM BankDetail WHERE lngAccountID=" & mlngAcntID _
& " And lngCurrencyID = " & mlngCurID
' If Not gclsBase.ExecSQL(strSql) Then GoTo ErrHandle
ElseIf strNewDate > mstrDate Then
' If gclsBase.ControlAccount Then
' strQueryName = "BankInitAddQuery"
' Else
' strQueryName = "BankInitAddQueryf"
' End If
' gclsBase.BaseDB.QueryDefs(strQueryName).rdoParameters("lngAcnID") = mlngAcntID
' gclsBase.BaseDB.QueryDefs(strQueryName).rdoParameters("lngCurID") = mlngCurID
' gclsBase.BaseDB.QueryDefs(strQueryName).rdoParameters("strStartDate") = mstrDate & " "
' gclsBase.BaseDB.QueryDefs(strQueryName).rdoParameters("strEndDate") = strNewDate
' Set recBankInitAdd = gclsBase.BaseDB.QueryDefs(strQueryName). _
' openresultset(rdopenstatic)
' With recBankInitAdd
' Do Until .EOF
' strSql = "INSERT INTO BankInit(lngAccountID,lngCurrencyID," _
' & "lngReceiptTypeID,strReceiptNO,lngReceiptNO,strDate,strRemark,intDirection," _
' & "dblAmount,lngPaymentMethodID,strCheckNumber,lngOperatorID," _
' & "blnIsMatch) VALUES(" & !lngAccountID & "," & !lngCurrencyID _
' & "," & !lngReceiptTypeID & ",'" & !strReceiptNo & "'," & !lngReceiptNo & ",'" _
' & !strDate & "','" & !strRemark & "'," & !intDirection & "," _
' & !dblAmount & "," & !lngPaymentMethodID & ",'" & !strCheckNumber _
' & "'," & !lngOperatorID & "," & !blnIsMatch & ")"
' If Not gclsBase.ExecSQL(strSql) Then GoTo ErrHandle
' .MoveNext
' Loop
' End With
' If mstrDate <> "" Then
strSql = "UPDATE BankInfo SET strStartDate='" & strNewDate & "'" _
& " WHERE lngAccountID=" & mlngAcntID & " AND lngCurrencyID=" & mlngCurID
' Else
' Dim recBaseDetail As rdoresultset, dblEndBalance As Double, strEndDate As String
'
' strSql = "SELECT * FROM BankDetail WHERE lngAccountID=" & mlngAcntID _
' & " AND lngCurrencyID=" & mlngCurID & " ORDER BY strDate,lngBankDetailID"
' Set recBaseDetail = gclsBase.BaseDB.openresultset(strSql, rdopenstatic)
' If Not recBaseDetail.EOF Then
' recBaseDetail.MoveLast
' strEndDate = recBaseDetail!strDate
' dblEndBalance = recBaseDetail!dblBalance
' End If
' recBaseDetail.Close
' strSql = "INSERT INTO BankInfo(lngAccountID,lngCurrencyID,strStartDate," _
' & "strEndDate,dblEndBalance) VALUES(" & mlngAcntID & "," & mlngCurID _
' & ",'" & strNewDate & "','" & strEndDate & " '," & dblEndBalance & ")"
If Not gclsBase.ExecSQL(strSql) Then GoTo ErrHandle
strSql = "DELETE FROM BankInit WHERE lngAccountID=" & mlngAcntID _
& " AND lngCurrencyID=" & mlngCurID & " AND strDate>='" _
& strNewDate & "'"
If Not gclsBase.ExecSQL(strSql) Then GoTo ErrHandle
' End If
ElseIf strNewDate < mstrDate Then
strSql = "DELETE FROM BankInit WHERE lngAccountID=" & mlngAcntID _
& " AND lngCurrencyID=" & mlngCurID & " AND strDate>='" _
& strNewDate & "'"
If Not gclsBase.ExecSQL(strSql) Then GoTo ErrHandle
strSql = "UPDATE BankInfo SET strStartDate='" & strNewDate & "'" _
& " WHERE lngAccountID=" & mlngAcntID & " AND lngCurrencyID=" & mlngCurID
If Not gclsBase.ExecSQL(strSql) Then GoTo ErrHandle
End If
gclsBase.BaseWorkSpace.CommitTrans
Exit Sub
ErrHandle:
gclsBase.BaseWorkSpace.RollBacktrans
End Sub
Private Sub StartCollate(ByVal iRow As Integer)
Dim bytCurDec As Byte, lngAcnID As Long, lngCurID As Long
Dim recX As rdoResultset, strSql As String
lngAcnID = msgCollate.TextMatrix(iRow, 0)
lngCurID = msgCollate.TextMatrix(iRow, 1)
strSql = "SELECT * FROM Currencys WHERE lngCurrencyID=" & lngCurID
Set recX = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
If Not recX.EOF Then
bytCurDec = recX!bytCurrencydec
End If
recX.Close
strSql = "SELECT strStartDate,DECODE(SIGN(TO_DATE(BankInfo.strEndDate,'YYYY-MM-DD')" _
& "-TO_DATE(BankInfo.strStartDate,'YYYY-MM-DD')),1,BankInfo.strStartDate," _
& "BankInfo.strEndDate) AS strEndDate, " _
& "DECODE(dblEndBalance,0,'',dblEndBalance) AS strBillBalance FROM BankInfo WHERE " _
& "BankInfo.lngCurrencyID=" & lngCurID & " AND BankInfo.lngAccountID=" & lngAcnID
Set recX = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
With msgCollate
If Not recX.EOF Then
.TextMatrix(iRow, 4) = recX!strStartDate
.TextMatrix(iRow, 5) = recX!strEndDate
If IsNull(recX!strBillBalance) Or recX!strBillBalance = 0 Then
.TextMatrix(iRow, 7) = ""
Else
.TextMatrix(iRow, 7) = FormatShow(CStr(recX!strBillBalance), bytCurDec)
End If
Else
.TextMatrix(iRow, 4) = mstrDate
.TextMatrix(iRow, 5) = mstrDate
End If
End With
recX.Close
GetBalance iRow
End Sub
Private Sub cmdCollate_Click(Index As Integer)
Dim iRow As Integer, strNewDate As String, strEndDate As String
Static blnNLoad As Boolean
Select Case Index
Case 0
If Not blnNLoad Then
blnNLoad = True
frmBankDetail.ShowCard
blnNLoad = False
End If
Case 1
If Not blnNLoad Then
blnNLoad = True
frmBankAccount.ShowCard
blnNLoad = False
End If
Case 2
If Not blnNLoad Then
blnNLoad = True
gstrEndDate = msgCollate.TextMatrix(msgCollate.Row, 5)
strEndDate = gstrEndDate
iRow = msgCollate.Row
frmBank.Show vbModal
Form_Activate
blnNLoad = False
End If
' If gstrEndDate <> strEndDate Then
' GetBalance iRow
' End If
Case 3
frmBalance.Show vbModal
Case 4
If mstrDate = "" Then
frmStartDate.StartDate = Format(gclsBase.BaseDate, "yyyy-mm-dd")
Else
frmStartDate.StartDate = mstrDate
End If
frmStartDate.AccountID = mlngAcntID
frmStartDate.CurrencyID = mlngCurID
frmStartDate.Show vbModal
If Not frmStartDate.Cancel Then
strNewDate = frmStartDate.StartDate
If mstrDate <> strNewDate Then
AdjustDate strNewDate
mstrDate = strNewDate
End If
StartCollate msgCollate.Row
SetButton
End If
Case 5
If ShowMsg(hwnd, "您确实要取消启用吗?", vbQuestion + vbYesNo + vbDefaultButton2, Caption) = vbYes Then
msgCollate.TextMatrix(msgCollate.Row, 4) = ""
AdjustDate ""
mstrDate = ""
SetButton
End If
End Select
End Sub
Private Sub SetColWidth()
Dim i As Integer, strColWidth As String
strColWidth = GetSetting(App.title, "Collate", "ColWidth")
msgCollate.ColWidth(0) = 0
msgCollate.ColWidth(1) = 0
If strColWidth <> "" Then
While strColWidth <> ""
For i = 2 To msgCollate.Cols - 1
msgCollate.ColWidth(i) = StringOut(strColWidth, ",")
Next i
Wend
Else
msgCollate.ColWidth(2) = 1500
msgCollate.ColWidth(3) = 1500
msgCollate.ColWidth(4) = 1175
msgCollate.ColWidth(5) = 1175
msgCollate.ColWidth(6) = 1600
msgCollate.ColWidth(7) = 1600
msgCollate.ColWidth(8) = 1600
msgCollate.ColWidth(9) = 1600
End If
End Sub
Private Sub SaveColWidth()
Dim i As Integer, strColWidth As String
strColWidth = msgCollate.ColWidth(2)
For i = 3 To msgCollate.Cols - 1
strColWidth = strColWidth & "," & msgCollate.ColWidth(i)
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -