?? frmbankdetail.frm
字號:
& " WHERE lngAccountID=" & lngAcnID & " AND lngCurrencyID=" & lngCurID
End If
If Not gclsBase.ExecSQL(strSql) Then GoTo ErrHandle
End If
AddBankDetail = 1
gclsBase.BaseWorkSpace.CommitTrans
Exit Function
ErrHandle:
gclsBase.BaseWorkSpace.RollBacktrans
End Function
Public Sub ShowCard()
If Me.WindowState = 1 Then Me.WindowState = 0
InitGrid
Show
Refresh
ZOrder 0
End Sub
Private Function AdaptBalance(ByVal lngAcnID As Long, ByVal lngCurID As Long, ByVal strDate As String, ByRef dblBalance As Double) As Boolean
Dim recBankDetail As rdoResultset, strSql As String
AdaptBalance = False
strSql = "SELECT * FROM BankDetail WHERE lngAccountID=" & lngAcnID _
& " AND lngCurrencyID=" & lngCurID & " AND intDirection<>9 " _
& " AND strDate>='" & strDate & "' ORDER BY strDate,lngBankDetailID"
Set recBankDetail = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
With recBankDetail
Do Until .EOF
dblBalance = dblBalance - !intDirection * !dblAmount
strSql = "UPDATE BankDetail Set dblBalance=" & dblBalance & " WHERE lngBankDetailID=" & !lngBankDetailID
gclsBase.ExecSQL strSql
.MoveNext
Loop
.Close
End With
AdaptBalance = True
End Function
Private Sub AdjustBalance(ByVal lngSRow As Long, Optional blnReStart As Boolean = False)
Dim i As Long, j As Long ', blnBegin As Boolean
If msgBill.Rows = 2 Then Exit Sub
' GetColNO
If blnReStart Then
For j = 1 To msgBill.Rows - 1
If msgBill.TextMatrix(j, 2) = "9" Then
lngSRow = j
Exit For
End If
Next
Else
j = lngSRow
End If
With msgBill
For i = lngSRow + 1 To .Rows - 1
' If .TextMatrix(i, 2) = "9" Then
' blnBegin = True
' j = i
' End If
If .RowHeight(i) <> 0 Then 'And blnBegin Then
CalDebitAndCredit i
.TextMatrix(i, mintBalCol) = FormatShow(TxtToDouble(.TextMatrix(j, _
mintBalCol)) + mdblCredit - mdblDebit, mbytDec)
.TextMatrix(i, 1) = "-1"
j = i
' Else
' .TextMatrix(i, mintBalCol) = ""
End If
Next i
End With
End Sub
''檢查編輯的對帳單是否合法
'Private Sub BillIsValid(Optional intMode As Integer = -1)
' Dim blnShow As Boolean, strMess As String
'
' If Not mblnIsInit Then mblnValueOK = False
' If mintPRow = msgBill.Row And intMode <> vbFormControlMenu Then
' mblnValueOK = True
' Exit Sub
' End If
' blnShow = (mintPCol = msgBill.col)
' CalDebitAndCredit mintRow
'' If mblnIsAdd Then
''' If dteInput.Text = "" Or mdblDebit + mdblCredit = 0 Then
'' If mdblDebit + mdblCredit = 0 Then
'' msgBill.Rows = msgBill.Rows - 1
'' mintRow = msgBill.Row
'' dteInput.Move -50000
'' mblnIsAdd = False
'' Exit Function
'' End If
'' End If
' If mdblDebit <> 0 And mdblCredit <> 0 Then
' strMess = "不能同時有借方和貸方!"
' ElseIf mdblDebit + mdblCredit = 0 And mintRow <> 1 Then
' strMess = "必須要有借方或貸方!"
' End If
' If strMess <> "" Then
' Dim l As Long
' If blnShow Then l = ShowMsg(hwnd, strMess, vbExclamation, Caption)
' msgBill.col = mintDebitCol
' msgBill.Row = mintRow
' EditGrid vbKeyEnd
' Exit Sub
' End If
' mblnValueOK = True
'End Sub
'
Private Sub CalDebitAndCredit(ByVal iRow As Integer)
' GetColNO
mdblDebit = 0
mdblCredit = 0
With msgBill
mdblDebit = TxtToDouble(.TextMatrix(iRow, mintDebitCol))
mdblCredit = TxtToDouble(.TextMatrix(iRow, mintCreditCol))
mintDire = IIf(mdblDebit = 0, -1, 1)
End With
End Sub
Private Sub cboBill_Click(index As Integer)
Dim i As Integer, lngAcnID As Long, lngCurID As Long
lngAcnID = mlngAcnID
lngCurID = mlngCurID
' GetColNO
dteInput.Move -50000
If index = 0 Then
lstInput.Move -50000
If mlngAcnID = cboBill(0).ItemData(cboBill(0).ListIndex) Then Exit Sub
mlngAcnID = cboBill(0).ItemData(cboBill(0).ListIndex)
mlngCurID = 0
' InitCurrencyList
Else
lstInput.Move -50000
If mlngCurID = cboBill(1).ItemData(cboBill(1).ListIndex) Then Exit Sub
mlngCurID = cboBill(1).ItemData(cboBill(1).ListIndex)
With mrecBankAccount
.Requery
Do Until !lngCurrencyID = mlngCurID
.MoveNext
Loop
mstrStartDate = !strStartDate
End With
End If
If mblnIsChanged Then
MsgForm.PleaseWait
msgBill.TextMatrix(msgBill.Row, mintDateCol) = dteInput.Text
' BillIsValid
' If Not mblnValueOK Then
' cboBill(0).Text = mstrAcnName
' cboBill(1).Text = mstrCurName
' Exit Sub
' End If
If Not SaveData(lngAcnID, lngCurID) Then
ShowMsg hwnd, "保存數據失敗,本次對帳單期初編輯無效!", vbExclamation, Caption
Unload MsgForm
Exit Sub
End If
End If
mstrAcnName = cboBill(0).Text
mstrCurName = cboBill(1).Text
InitCurrencyList
With frmCollate.msgCollate
For i = 1 To .Rows - 1
If .TextMatrix(i, 0) = mlngAcnID And .TextMatrix(i, 1) = mlngCurID Then
gstrEndDate = .TextMatrix(i, 5)
End If
Next i
End With
InitGrid
Form_Resize
Unload MsgForm
End Sub
Private Function CellAllowEdit() As Boolean
' GetColNO
With msgBill
' If (.Row = 1 And (.col = mintRemarkCol Or .col = mintBillNOCol Or .col = mintBalCol)) _
Or (.Row > 1 And (.col <> 1 And .col <> mintBalCol And IIf(.col = mintDebitCol, _
.TextMatrix(.Row, mintCreditCol) <= "1", IIf(.col = mintCreditCol, .TextMatrix(.Row, mintDebitCol) _
<= "1", True)))) Then
If (.TextMatrix(.Row, 2) = "9" And .col = mintBalCol) Or (.TextMatrix(.Row, 2) <> "9" _
And (.col <> mintCheckCol And .col <> mintBalCol And .col <> mintDateCol)) Then
CellAllowEdit = True
Else
CellAllowEdit = False
End If
End With
End Function
'Private Sub chkAll_Click()
' Dim i As Integer
'
' GetColNO
' With msgBill
' If chkAll.Value Then
' For i = 1 To .Rows - 1
' If .TextMatrix(i, 1) <> "-5" And .RowHeight(i) = 0 Then _
' .RowHeight(i) = .RowHeight(0)
Private Sub cboBill_KeyUp(index As Integer, KeyCode As Integer, Shift As Integer)
If index < 2 Then Exit Sub
Select Case KeyCode
Case vbKeyReturn ', vbKeyRight
If msgBill.col < msgBill.Cols - 1 Then
msgBill.col = msgBill.col + 1
If msgBill.col <> mintDateCol Then msgBill.SetFocus
End If
Case vbKeyLeft
' If msgbill.col > 2 Then msgbill.col = msgbill.col - 1
End Select
End Sub
Private Sub cboBill_LostFocus(index As Integer)
If index = 2 Then lstInput.Move -50000
End Sub
' Next i
' .ColWidth(mintCheckCol) = 450
' Else
' For i = 1 To .Rows - 1
' If .TextMatrix(i, mintCheckCol) = "√" Then .RowHeight(i) = 0
' Next i
' .ColWidth(mintCheckCol) = 0
' End If
' End With
' dteInput.Move -50000
' Form_Resize
'End Sub
'
Private Sub cmdBill_Click(index As Integer)
dteInput.Move -50000
lstInput.Move -50000
If txtCal.Visible Then txtCal.Visible = False
If index = 0 Then
MakeListEditMenu
SetMenu
PopupMenu frmMain.mnuListEdit, , cmdBill(0).Left, cmdBill(0).top + cmdBill(0).Height
Else
MakeListReportMenu
PopupMenu frmMain.mnuListReport, , cmdBill(1).Left, cmdBill(1).top + cmdBill(1).Height
End If
End Sub
Private Sub EditGrid(ByVal KeyCode As Integer)
On Error Resume Next
' GetColNO
With msgBill
If .RowHeight(.Row) = 0 Or .col = 0 Then Exit Sub
If .col = mintDebitCol Or .col = mintCreditCol Or .col = mintBalCol Then
txtCal.Move .Left + .CellLeft, .top + .CellTop, .CellWidth, .CellHeight
mintDCBCol = .col
mdblAmount = TxtToDouble(.TextMatrix(.Row, .col))
If Chr(KeyCode) >= "0" And Chr(KeyCode) <= "9" Or Chr(KeyCode) = "-" Then
txtCal.Text = Chr(KeyCode)
Else
txtCal.Text = .Text '& Chr(KeyCode)
End If
txtCal.Visible = True
txtCal.SetFocus
txtCal.SelStart = Len(txtCal.Text)
Else
txtInput.Move .Left + .CellLeft, .top + .CellTop, .CellWidth, .CellHeight
If KeyCode = 8 Then
txtInput.Text = Mid(.Text, 1, Len(.Text) - 1)
Else
txtInput.Text = .Text & Chr(KeyCode)
End If
If .col = mintRemarkCol Then
txtInput.MaxLength = 30
Else
txtInput.MaxLength = 20
mstrBillNO = .Text
End If
txtInput.Visible = True
txtInput.SetFocus
txtInput.SelStart = Len(txtInput.Text)
End If
mintPCol = .col
mintPRow = .Row
mblnIsChanged = True
' .TextMatrix(.Row, 1) = -1 '修改
' .TextMatrix(.Row, 1) = ""
End With
End Sub
Private Sub dteInput_Change()
On Error GoTo ErrHandle
' GetColNO
If Not mblnIsInit Then mblnIsChanged = True
If Not mblnIsInit Then mblnIsChanged = True
If Trim(dteInput.Text) <> "" Then
If Year(dteInput.Value) < 1000 Then dteInput.Text = mstrDate
msgBill.TextMatrix(msgBill.Row, mintDateCol) = Format(CDate(dteInput.Text), "yyyy-mm-dd")
msgBill.TextMatrix(mintRow, 4) = dteInput.Text & Mid(msgBill.TextMatrix(mintRow, 4), 11)
If Not mblnIsInit Then msgBill.TextMatrix(mintRow, 1) = "-1"
End If
Exit Sub
ErrHandle:
' dteInput.Text = mstrDate
End Sub
Private Sub dteInput_Error(bCancel As Integer)
mblnDateOK = False
dteInput.Text = mstrDate
End Sub
Private Sub dteInput_GotFocus()
mstrDate = dteInput.Text
End Sub
Private Sub dteInput_KeyUp(KeyCode As Integer, Shift As Integer, bCancel As Long)
Dim i As Integer
Static blnIsLeft As Boolean
' GetColNO
Select Case KeyCode
Case vbKeyReturn
If mintDateCol < msgBill.Cols - 1 Then
msgBill.col = mintDateCol + 1
msgBill.SetFocus
End If
Case vbKeyUp
For i = msgBill.Row - 1 To 1 Step -1
If msgBill.RowHeight(i) > 0 Then Exit For
Next i
If msgBill.CellTop < msgBill.top + msgBill.RowHeight(0) Then msgBill.SetFocus
If i > 0 Then msgBill.Row = i
msgBill_Click
Case vbKeyDown
For i = msgBill.Row + 1 To msgBill.Rows - 1
If msgBill.RowHeight(i) > 0 Then Exit For
Next i
If i < msgBill.Rows Then
' msgBill.SetFocus
msgBill.Row = i
msgBill_Click
End If
Case vbKeySpace
dteInput.DropDownPanel
Case vbKeyLeft
If dteInput.SelStart = 0 Then
If Not blnIsLeft Then
blnIsLeft = True
Else
msgBill.SetFocus
BKKEY msgBill.hwnd, vbKeyLeft
blnIsLeft = False
End If
End If
Case vbKeyRight
If dteInput.SelStart = Len(dteInput.Text) Then
msgBill.SetFocus
BKKEY msgBill.hwnd, vbKeyRight
End If
End Select
End Sub
Private Sub dteInput_LostFocus()
Dim iLeft As Integer, i As Integer
On Error Resume Next
' GetColNO
iLeft = 0
For i = 1 To mintDateCol - 1
iLeft = iLeft + msgBill.ColWidth(i)
Next i
' If mblnIsScroll Then
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -