frmbankdetail.frm

金算盘软件代码

'        mblnIsScroll = False
'        Exit Sub
'    End If
    If dteInput.Text = "" And msgBill.Row <> 1 And dteInput.Left > 0 Then
        ShowMsg hwnd, "单据日期不能为空!", vbExclamation, Caption
'        dteInput.Text = msgBill.TextMatrix(mintRow, mintDateCol)
'        dteInput.Move msgBill.Left + iLeft, msgBill.top + msgBill.CellTop, msgBill.ColWidth(mintDateCol)
        dteInput.SetFocus
        dteInput.Text = mstrDate
        mblnDateOK = False
        Exit Sub
    Else
        mblnDateOK = True
    End If
'    msgBill.TextMatrix(mintRow, 4) = dteInput.Text & Mid(msgBill.TextMatrix(mintRow, 4), 11)
    If mstrDate <> dteInput.Text Then
        msgBill.TextMatrix(msgBill.Row, mintCheckCol) = ""  '金额改变取消对帐标志
    '    msgBill.TextMatrix(mintRow, 4) = dteInput.Text & Mid(msgBill.TextMatrix(mintRow, 4), 11)
        If Not mblnIsAdd Then ReSort
    End If
    If Me.ActiveControl.Name <> "dteInput" Then
        dteInput.Move -50000
    End If
End Sub

Private Sub InitHeadName()
    Dim i As Integer
    
    With mclsGrid.ListSet
    For i = 1 To mclsGrid.ListSet.Columns
        If InStr(.ColumnFieldName(i), "对帐") > 0 Then
            mstrCheckCol = .ColumnDesc(i)
        ElseIf InStr(.ColumnFieldName(i), "日期") > 0 Then
            mstrDateCol = .ColumnDesc(i)
        ElseIf InStr(.ColumnFieldName(i), "摘要") > 0 Then
            mstrRemarkCol = .ColumnDesc(i)
        ElseIf InStr(.ColumnFieldName(i), "票据号") > 0 Then
            mstrBillNOCol = .ColumnDesc(i)
        ElseIf InStr(.ColumnFieldName(i), "借方") > 0 Then
            mstrDebitCol = .ColumnDesc(i)
        ElseIf InStr(.ColumnFieldName(i), "贷方") > 0 Then
            mstrCreditCol = .ColumnDesc(i)
        ElseIf InStr(.ColumnFieldName(i), "余额") > 0 Then
            mstrBalCol = .ColumnDesc(i)
        ElseIf InStr(.ColumnFieldName(i), "付款方式") > 0 Then
            mstrPayMethodCol = .ColumnDesc(i)
        End If
    Next i
    End With
    
End Sub

Private Sub Form_Activate()
    SetHelpID Me.HelpContextID
    gclsSys.CurrFormName = Me.hwnd
    UpdateMenuStatus
End Sub

Private Sub Form_Deactivate()
    frmMain.SetEditUnEnabled
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyEscape Then
        If dteInput.Left > 0 Then
            mclsMainControl_ListEditMenu 1
            KeyCode = 0
        ElseIf txtInput.Visible Then
            txtInput.Text = ""
            KeyCode = 0
            msgBill.SetFocus
        ElseIf txtCal.Visible Then
            txtCal.Text = ""
            KeyCode = 0
            msgBill.SetFocus
        Else
            Unload Me
        End If
    End If
    If Shift = 2 Then
        MakeListEditMenu
        SetMenu
        Select Case UCase(Chr(KeyCode))
        Case "N"
            If frmMain.mnuListEditMenu(0).Enabled Then
                mclsMainControl_ListEditMenu 0
            End If
        Case "D"
            If frmMain.mnuListEditMenu(1).Enabled Then
                mclsMainControl_ListEditMenu 1
            End If
        Case "H"
            If frmMain.mnuListEditMenu(3).Enabled Then
                mclsMainControl_ListEditMenu 3
            End If
        Case "S"
            If frmMain.mnuListEditMenu(4).Enabled Then
                mclsMainControl_ListEditMenu 4
            End If
        Case "P"
            If frmMain.mnuListEditMenu(6).Enabled Then
                mclsMainControl_ListEditMenu 6
            End If
        End Select
    End If
End Sub

Private Sub Form_Load()
    Dim edtErrReturn As ErrDealType
    
    On Error GoTo ErrHandle
    MsgForm.PleaseWait
'    SetHelpID hwnd, 60011
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
    Set mclsSubClassform = New SubClass32.SubClass
    mclsSubClassform.hwnd = Me.hwnd
    mclsSubClassform.Messages(WM_GETMINMAXINFO) = True
    frmCollate.IsShowCard(0) = True
    Set mclsGrid = New Grid
    mclsGrid.ListSet.ViewId = mintViewId
    Set mclsGrid.Grid = msgBill
    mblnDateOK = True
'    mblnValueOK = True
    mblnIsInit = True
    mblnIsHide = False
    mblnRowValid = False
    mlngNO = 90000
    InitHeadName
    mlngAcnID = frmCollate.AccountID
    mlngCurID = frmCollate.CurrencyID
    mblnIsChanged = False
    mblnIsAdd = False
    msgBill.top = 411
    InitAccountList
    InitCurrencyList
    setlistbox lstInput, 33
'    InitGrid
    mintDCBCol = mintDebitCol
    mblnIsInit = False
    Unload MsgForm
    dteInput.ParenthWnd = msgBill.hwnd
    txtInput.ParenthWnd = msgBill.hwnd
    Exit Sub
ErrHandle:
    edtErrReturn = Errors.ErrorsDeal
    
    If edtErrReturn = edtResume Then
         Resume
    Else
         On Error Resume Next
         Unload MsgForm
         Unload Me
    End If
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
'    If UnloadMode <> vbFormControlMenu Then Exit Sub
'    GetColNO
    If mblnIsChanged Then
        If ShowMsg(hwnd, "要保存本次对帐单编辑的结果吗?", _
            vbQuestion + vbYesNo, Caption) = vbYes Then
'            msgBill.TextMatrix(msgBill.Row, mintDateCol) = dteInput.Text
            MsgForm.PleaseWait
            If dteInput.Left > 0 Then dteInput_LostFocus
            If Not mblnDateOK Then
                Cancel = True
                Exit Sub
            End If
'            BillIsValid vbFormControlMenu
'            If Not mblnValueOK Then
'                Cancel = True
'                Exit Sub
'            End If
            If Not SaveData Then
                ShowMsg hwnd, "保存数据失败,本次对帐单期初编辑无效!", _
                    vbExclamation, Caption
                Unload MsgForm
                Exit Sub
            End If
            Unload MsgForm
        End If
    End If
End Sub

Private Sub Form_Resize()
    Dim i As Integer
    
    If Me.WindowState = vbMinimized Then Exit Sub
    dteInput.Left = -50000
    txtInput.Visible = False
    cmdBill(0).Left = Me.ScaleLeft + 50
    cmdBill(0).top = Me.ScaleHeight - 75 - cmdBill(0).Height
    cmdBill(1).top = cmdBill(0).top
    cmdBill(1).Left = cmdBill(0).Left + cmdBill(0).width
'    chkAll.top = cmdBill(0).top
    With msgBill
    .Left = cmdBill(0).Left
    .top = cboBill(0).top + cboBill(0).Height + 75
    .width = Me.ScaleWidth - 100
'    .ColWidth(1) = 0
    .ColWidth(5) = 450
    .Height = cmdBill(0).top - 575
'    For i = 0 To .Cols - 1
'        If .ColWidth(i) = 0 Then iZeroCol = iZeroCol + 1
'    Next i
'    For i = 3 To .Cols - 1
'        .ColWidth(i) = (.Width - .ColWidth(1)) / (.Cols - 2)
'    Next i
'    .ColWidth(4) = intWidth / 4
'    .ColWidth(5) = intWidth / 4
'    .ColWidth(6) = intWidth / 4
'    .ColWidth(7) = intWidth / 4
    cboBill(1).Left = .Left + .width - cboBill(1).width
    lblBill(1).Left = cboBill(1).Left - lblBill(1).width - 60
'    chkAll.Left = .Left + .Width - chkAll.Width + 40
    End With
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    frmCollate.IsShowCard(0) = False
    Set mclsGrid = Nothing
    gclsSys.MainControls.Remove Me
    Set mclsMainControl = Nothing
    frmCollate.AccountID = mlngAcnID
    frmCollate.CurrencyID = mlngCurID
    frmCollate.ReActive = True
End Sub

Private Sub InitAccountList()
    Dim lngAcnID As Long, strSql As String
    
    cboBill(0).Clear
    strSql = "SELECT * FROM BANKACCOUNTVIEW ORDER BY lngAccountID,lngCurrencyID"
    Set mrecBankAccount = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    With mrecBankAccount
        If Not .EOF Then
            lngAcnID = !lngAccountID
            cboBill(0).AddItem Trim$(!strAccountCode) & String(4, " ") _
                & Trim$(!strAccountName)
            If mlngAcnID = !lngAccountID Then mstrAcnName = Trim$(!strAccountCode) _
                & String(4, " ") & Trim$(!strAccountName)
            cboBill(0).ItemData(cboBill(0).NewIndex) = !lngAccountID
            .MoveNext
        End If
        Do Until .EOF
            If lngAcnID <> !lngAccountID Then
                cboBill(0).AddItem Trim$(!strAccountCode) & String(4, " ") _
                    & Trim$(!strAccountName)
                If mlngAcnID = !lngAccountID Then mstrAcnName = Trim$(!strAccountCode) _
                    & String(4, " ") & Trim$(!strAccountName)
                cboBill(0).ItemData(cboBill(0).NewIndex) = !lngAccountID
                lngAcnID = !lngAccountID
            End If
            .MoveNext
        Loop
    End With
    cboBill(0).Text = mstrAcnName
End Sub

Private Sub InitCurrencyList()
    
    cboBill(1).Clear
    With mrecBankAccount
    .Requery
    Do Until !lngAccountID = mlngAcnID
        .MoveNext
    Loop
    Do Until .EOF
        If mlngCurID = 0 Then mlngCurID = !lngCurrencyID
        If !lngAccountID <> mlngAcnID Then Exit Do
        cboBill(1).AddItem Trim$(!strCurrencyCode) & String(2, " ") _
            & Trim$(!strCurrencyName)
        cboBill(1).ItemData(cboBill(1).NewIndex) = !lngCurrencyID
        If mlngCurID = !lngCurrencyID Then
            mstrCurName = Trim$(!strCurrencyCode) & String(2, " ") _
                & Trim$(!strCurrencyName)
            mstrStartDate = !strStartDate
            mbytDec = !bytCurrencydec
        End If
        .MoveNext
    Loop
    End With
    cboBill(1).Text = mstrCurName
End Sub

Private Sub InitGrid(Optional ByVal strSql As String = "")
    Dim i As Integer, strSql0 As String
    
    msgBill.Cols = 0
    With mclsGrid.ListSet
'        strSql0 = "SELECT BankDetailInitQuery.lngBankDetailID,BankDetailInitQuery.blnIsMatch," _
            & "BankDetailInitQuery.intDirection,BankDetailInitQuery.lngPaymentMethodID," _
            & "BankDetailInitQuery.日期 || (BankDetailInitQuery.lngBankDetailID+1000000)," _
            & "DECODE(BankDetailInitQuery.blnIsMatch,1,'√','') ""对帐""," _
            & .SelectOfSql & .FromOfSql
        strSql0 = "SELECT BankDetailInitQuery.lngBankDetailID,BankDetailInitQuery.blnIsMatch," _
            & "BankDetailInitQuery.intDirection,BankDetailInitQuery.lngPaymentMethodID," _
            & "BankDetailInitQuery.日期 || (BankDetailInitQuery.lngBankDetailID+1000000)," _
            & .SelectOfSql & .FromOfSql
        strSql0 = strSql0 & " WHERE lngAccountID=" & mlngAcnID & " AND lngCurrencyID=" & mlngCurID
        If Trim(.WhereOfSql) <> "" Then
            strSql0 = strSql0 & " AND " & Trim(.WhereOfSql)
        End If
        If Trim$(strSql) <> "" Then strSql0 = strSql0 & " AND " & strSql
    End With
    If InStr(1, strSql0, "WHERE") > 0 Then
        strSql0 = strSql0 & " OR Rtrim(BankDetailInitQuery.日期)=''"
    End If
    strSql0 = Replace(strSql0, "BYTDEC", mbytDec)
        
'    gclsBase.BaseDB.QueryDefs("BankDetailInitQuery").rdoParameters("lngAcnID") = mlngAcnID
'    gclsBase.BaseDB.QueryDefs("BankDetailInitQuery").rdoParameters("lngCurID") = mlngCurID
'    Set Data1.Resultset = gclsBase.BaseDB.QueryDefs("BankDetailInitQuery"). _
        openresultset(rdopenstatic)
    Set DATA1.Resultset = gclsBase.BaseDB.OpenResultset(strSql0, rdOpenStatic)
    If Not DATA1.Resultset.EOF Then
        DATA1.Resultset.MoveLast
    End If
    For i = 0 To msgBill.Cols - 1
        msgBill.FixedAlignment(i) = flexAlignCenterCenter
'        msgBill.ColWidth(i) = 1 / (msgBill.Cols - 2)
    Next
    mclsGrid.ColOfs = 5
    mclsGrid.ListSetToGrid
    mclsGrid.SetupStyle
    GetColNO
'    msgBill.RowHeight(0) = 300
'    For i = 1 To msgBill.Rows - 1
'        msgBill.RowHeight(i) = 300
'        If TxtToDouble(msgBill.TextMatrix(i, mintDebitCol)) = 0 Then
'            msgBill.TextMatrix(i, mintDebitCol) = ""
'        Else
'            msgBill.TextMatrix(i, mintDebitCol) = FormatShow(msgBill.TextMatrix(i, mintDebitCol), mbytDec)
'        End If
'        If TxtToDouble(msgBill.TextMatrix(i, mintCreditCol)) = 0 Then
'            msgBill.TextMatrix(i, mintCreditCol) = ""
'        Else
'            msgBill.TextMatrix(i, mintCreditCol) = FormatShow(msgBill.TextMatrix(i, mintCreditCol), mbytDec)
'        End If
'        If TxtToDouble(msgBill.TextMatrix(i, mintBalCol)) = 0 Then
'            msgBill.TextMatrix(i, mintBalCol) = ""
'        Else
'            msgBill.TextMatrix(i, mintBalCol) = FormatShow(msgBill.TextMatrix(i, mintBalCol), mbytDec)
'        End If
'    Next i
    mintRow = 1
    mintCol = mintDateCol
    mintPRow = 1
    msgBill.FixedCols = 6
    msgBill.ColWidth(1) = 0
    msgBill.ColWidth(2) = 0
    msgBill.ColWidth(3) = 0
    msgBill.ColWidth(4) = 0
    DATA1.Resultset.Close
    ReSort
    msgBill.Row = 1
    msgBill.col = mintBalCol
End Sub

Private Sub lstInput_AddNew()
    Dim lngID As Long
    
    lngID = frmPaymentMethodCard.AddCard(, vbModal)
    If lngID <> 0 Then
        msgBill.TextMatrix(mintRow, 3) = lngID
        msgBill.TextMatrix(msgBill.Row, mintCheckCol) = ""
    End If
    setlistbox lstInput, 33, lngID
    msgBill.TextMatrix(mintRow, 1) = "-1"
    mblnIsChanged = True