frmbankaccount.frm

金算盘软件代码

    txtCal.Visible = False
    GetColNO
'    End If
End Sub

Private Sub FilePrint()
    Dim myPrintclass As PrintClass
    Set myPrintclass = New PrintClass
    myPrintclass.PrintList gclsBase.BaseDB, msgBook, 69, Caption & Chr(1) _
        & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName & Chr(1) & "科目:" _
        & cboBook(0).Text & String(35, " ") & "币种:" & Trim(cboBook(1).Text)
End Sub

Private Function SpaceNum() As String
    Dim i As Integer, lWidth As Long, strX As String
    
    For i = 0 To msgBook.Cols - 1
        lWidth = lWidth + msgBook.ColWidth(i)
    Next i
    lWidth = lWidth - TextWidth("科目:" & cboBook(0).Text & "币种:" & cboBook(1).Text)
    While TextWidth(strX) < lWidth * 7 / 10
        strX = strX & " "
    Wend
    SpaceNum = strX
End Function

Private Sub mclsMainControl_ChildActive()
     Dim vntMessage As Variant
     gclsSys.CurrFormName = Me.hwnd
    '响应消息
    For Each vntMessage In mclsMainControl.Messages
        If vntMessage = msgVoucherType Then InitReceiptList True
'        ToolRefresh sstCustom.Tab
        mclsMainControl.Messages.Remove CStr(vntMessage) '清除部门雇员改变消息
    Next
    mclsMainControl.Messages.Clear
End Sub

Private Sub mclsMainControl_EditColumn()
    setColumn
End Sub

Private Sub mclsMainControl_EditDel()
    On Error GoTo ErrHandle
    SetMenu
    If frmMain.mnuListEditMenu(1).Enabled Then
        DeleteBook
    End If
ErrHandle:
End Sub

Private Sub mclsMainControl_EditFilter()
    BookFilter
End Sub

Private Sub mclsMainControl_EditNew()
    AddBook
End Sub

Private Sub mclsMainControl_FilePrint()
    FilePrint
End Sub

Private Sub mclsMainControl_ListEditMenu(ByVal intIndex As Integer)
    Dim i As Integer, blnOK As Boolean
'    GetColNO
    
    Select Case intIndex
    Case 0
'        If msgBook.RowHeight(mintPRow) <> 0 Then
'            i = mintPRow
'        Else
'            For i = msgBook.Rows - 1 To 1 Step -1
'                If msgBook.RowHeight(i) <> 0 Then Exit For
'            Next i
'        End If
'        If msgBook.RowHeight(i) <> 0 And i <> 0 Then
'            If msgBook.TextMatrix(i, mintDateCol) = "" Then
'                msgBook.Row = i
'                msgBook.col = mintDateCol
'                Exit Sub
'            End If
'            CalDebitAndCredit i
'            If mdblDebit + mdblCredit = 0 Then
'                msgBook.Row = i
'                msgBook.col = mintDebitCol
'                Exit Sub
'            End If
'                ShowMsg hwnd, "必须要有借方或贷方!", vbExclamation, Caption
'                msgBook.Row = mintPRow
'                msgBook.col = mintDebitCol
'                EditGrid vbKeyEnd
'                Exit Sub
'            End If
'            If mdblDebit <> 0 And mdblCredit <> 0 Then
'                ShowMsg hwnd, "不能同时有借方和贷方!", vbExclamation, Caption
'                txtInput.Visible = True
'                txtInput.SetFocus
'                Exit Sub
'            End If
'        End If
        AddBook
    Case 1
        DeleteBook
    Case 3
        BookFilter
    Case 4
        setColumn
    Case 6
        FilePrint
    End Select
End Sub

Private Sub mclsMainControl_ListReportMenu(ByVal intIndex As Integer)
    If intIndex = 0 Then
        If mblnIsChanged Then
            If ShowMsg(hwnd, "您要保存银行帐的数据吗?", vbQuestion + vbYesNo, Caption) = vbYes Then
                MsgForm.PleaseWait
                mblnIsHide = True
                SaveData
                InitGrid
                mblnIsHide = False
                Unload MsgForm
            End If
            mblnIsChanged = False
        End If
        If gclsBase.ControlAccount Then
            ShowBankDaily msgDay, mlngAcnID
        Else
            Report.ShowAcntBook 1743, 1109
        End If
    End If
End Sub

Private Sub mclsMainControl_ToolRefresh()
    Dim blnOK As Boolean
    
    mblnIsHide = True
    If mblnIsChanged Then
        blnOK = (ShowMsg(hwnd, "要保存本次银行帐编辑的结果吗?", vbQuestion + vbYesNo, Caption) = vbYes)
    End If
    MsgForm.PleaseWait
    If blnOK Then SaveData
    InitGrid
    Unload MsgForm
    mblnIsHide = False
End Sub

Private Sub mclsSubClassForm_WndProc(Msg As Long, wParam As Long, lParam As Long, Result As Long)
    Dim MinMax As MINMAXINFO

    If Msg = WM_GETMINMAXINFO Then
        CopyMemory MinMax, ByVal lParam, Len(MinMax)

        MinMax.ptMinTrackSize.x = 350
        MinMax.ptMinTrackSize.y = 260

        CopyMemory ByVal lParam, MinMax, Len(MinMax)
        Result = 0
    End If
End Sub

Private Sub msgBook_Click()
    If msgBook.TextMatrix(msgBook.Row, 2) = "-9" Then
        mblnRowValid = False
        Exit Sub
    End If
'    GetColNO
    mintRow = msgBook.Row
    If msgBook.col = mintDateCol Or msgBook.col = mintTypeCol Or _
        msgBook.col = mintPayMethodCol Or msgBook.col = mintVoucherTypeCol Then
        Paste
    End If
    UpdateMenuStatus
End Sub

Private Sub msgBook_DblClick()
    Dim recAct As rdoResultset, strSql As String
    If msgBook.Row = 0 Or mblnTitle Then Exit Sub  ' Not mblnRowValid Then Exit Sub
    If msgBook.TextMatrix(msgBook.Row, 2) = "-9" Then Exit Sub
'    GetColNO
    If msgBook.TextMatrix(msgBook.Row, mintDateCol) >= mstrStartDate Then '调凭证
        If gclsBase.ControlAccount Then
            strSql = "SELECT ActivityDetail.*,Activity.lngActivityTypeID FROM ActivityDetail,Activity " _
                & "WHERE ActivityDetail.lngActivityID=Activity.lngActivityID And " _
                & "lngActivityDetailID=" & msgBook.TextMatrix(msgBook.Row, 0)
            Set recAct = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
            If Not recAct.EOF Then
                ShowBill1 recAct!lngActivityTypeID, recAct!lngActivityID
            End If
        Else
            If Trim(msgBook.TextMatrix(msgBook.Row, mintVoucherTypeCol)) = "" Then
'                If mintTypeCol > 0 Then
                    strSql = "SELECT ActivityDetail.*,Activity.lngActivityTypeID FROM ActivityDetail,Activity " _
                        & "WHERE ActivityDetail.lngActivityID=Activity.lngActivityID And " _
                        & "lngActivityDetailID=" & msgBook.TextMatrix(msgBook.Row, 0)
                    Set recAct = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                    If Not recAct.EOF Then
                        ShowBill1 recAct!lngActivityTypeID, recAct!lngActivityID
                    End If
'                End If
            Else
                strSql = "SELECT VoucherDetail.* FROM VoucherDetail " _
                    & "WHERE lngVoucherDetailID=" & msgBook.TextMatrix(msgBook.Row, 0)
                Set recAct = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                If Not recAct.EOF Then
                    ShowBill1 50, recAct!lngVoucherID
                End If
            End If
        End If
        recAct.Close
'        InitGrid
    Else
        If msgBook.col <> mintCheckCol And msgBook.col <> mintDateCol And CellAllowEdit Then EditGrid 0
    End If
End Sub

Private Sub msgBook_EnterCell()
    
'    GetColNO
    If mblnIsInit Then Exit Sub
    If msgBook.Row = 0 Then Exit Sub
'    If Not Me.ActiveControl Is Nothing Then
'        If Me.ActiveControl.Name = "dteInput" Then Exit Sub
'    End If
        
    If Not mblnDateOK Then Exit Sub
    If msgBook.TextMatrix(msgBook.Row, 2) = "-9" Then Exit Sub
    UpdateMenuStatus
    If dteInput.Left > 0 And Trim(dteInput.Text) = "" Then Exit Sub
    If mintRow = 0 Or msgBook.Row = 0 Or msgBook.RowHeight(msgBook.Row) = 0 Or mblnIsSort Then Exit Sub
    If mblnIsAdd And msgBook.Row = mintRow Then
        If msgBook.col <> mintTypeCol And lstInput(0).Left > 0 Then
            lstInput(0).Left = -50000
            Exit Sub
        End If
    End If
    If msgBook.Row <> mintRow Then mblnIsAdd = False
'    BankIsValid
'    If mintRow = msgBook.Row Then Exit Sub
'    If mintRow <> msgBook.Row Then Exit Sub
    mintCol = msgBook.col
'    mintPRow = msgBook.Row
    mintRow = msgBook.Row
'    mintPCol = msgBook.col
'    If Not mblnIsAdd Then
'        msgBook.TextMatrix(mintRow, mintDateCol) = dteInput.Text
'        msgBook.TextMatrix(mintRow, mintTypeCol) = cboBook(2).Text
'    ElseIf mintRow <> msgBook.Row Then
''    If mintRow <> msgBook.Row Then
'        mblnIsAdd = False
'    End If
'    mintRow = msgBook.Row
'    If mintRow <> msgBook.Row Then
'        mblnIsAdd = False
'        dteInput.Text = msgBook.TextMatrix(msgBook.Row, mintDateCol)
'        If msgBook.TextMatrix(mintRow, mintTypeCol) = "" Then
'            cboBook(2).Text = String(4, " ")
'        Else
'            cboBook(2).Text = msgBook.TextMatrix(mintRow, mintTypeCol)
'        End If
'        mintRow = msgBook.Row
'        ReSort
'    End If
'    dteInput.Text = msgBook.TextMatrix(mintRow, mintDateCol)
    If msgBook.col = mintDateCol Or msgBook.col = mintTypeCol Or _
        msgBook.col = mintPayMethodCol Or msgBook.col = mintVoucherTypeCol Then
        Paste
    Else
        If dteInput.Text = "" Then Exit Sub
        dteInput.Move -50000
        lstInput(0).Move -50000
        lstInput(1).Move -50000
        lstInput(2).Move -50000
    End If
'    If msgBook.Row = msgBook.Rows - 1 Then
'        If msgBook.TextMatrix(msgBook.Row, mintDateCol) <> "" _
'            And (TxtToDouble(msgBook.TextMatrix(msgBook.Row, mintCreditCol)) + _
'            TxtToDouble(msgBook.TextMatrix(msgBook.Row, mintDebitCol))) > 0 Then
'            msgBook.Rows = msgBook.Rows + 1
'        End If
'    Else
'        If TwoEmptyRow Then msgBook.Rows = msgBook.Rows - 1
'    End If
End Sub

Private Sub SetMenu()
'    If txtInput.Visible Or dteInput.Left > 0 Or lstInput(0).Left > 0 Then
'        frmMain.mnuListEditMenu(0).Enabled = False
'        frmMain.mnuListEditMenu(1).Enabled = False
'        frmMain.mnuListEditMenu(3).Enabled = False
'        frmMain.mnuListEditMenu(4).Enabled = False
'    Else
        frmMain.mnuListEditMenu(0).Enabled = True
        frmMain.mnuListEditMenu(1).Enabled = True
        frmMain.mnuListEditMenu(3).Enabled = True
        frmMain.mnuListEditMenu(4).Enabled = True
'    End If
    frmMain.mnuListEditMenu(1).Enabled = mblnRowValid
End Sub

Private Sub msgBook_KeyPress(KeyAscii As Integer)
'    GetColNO
    If KeyAscii = vbKeyEscape Then Exit Sub
    With msgBook
        If CellAllowEdit Then
            If (.col = mintDebitCol Or .col = mintCreditCol) And .Text = "0" Then .Text = ""
            EditGrid KeyAscii
        End If
    End With
End Sub

Private Sub msgBook_KeyUp(KeyCode As Integer, Shift As Integer)
    Dim i As Integer, iMax As Integer, iNext As Integer

'    GetColNO
    With msgBook
    iNext = 0
    For i = .Row + 1 To .Rows - 1
        If .RowHeight(i) > 0 Then
            If iNext = 0 Then iNext = i
            iMax = i
        End If
    Next i
    If iMax = 0 Then iMax = .Row
    If KeyCode = vbKeyReturn Then
        If .col < .Cols - 1 Then
'            .col = .col + 1
            BKKEY msgBook.hwnd, vbKeyRight
        ElseIf .Row = iMax Then
            mclsMainControl_ListEditMenu 0
        Else
            .Row = iNext
            .col = mintDateCol
        End If
    End If
    End With
End Sub

Private Sub msgBook_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim i As Integer, lHeigh As Long
        
    With msgBook
    For i = 0 To .Rows - 1
        lHeigh = .RowHeight(i) + lHeigh
    Next i
    mblnTitle = (y <= .RowHeight(0))
    If y < lHeigh And y > .RowHeight(0) Then
        mblnRowValid = .RowHeight(.Row) > 0
'        mblnRowValid = (.TextMatrix(.Row, mintDateCol) < mstrStartDate And .RowHeight(.Row) > 0)
    Else
        mblnRowValid = False
    End If
    End With
    If Button = vbLeftButton Then Exit Sub
'    GetColNO
    MakeListEditMenu
    mblnRowValid = (msgBook.TextMatrix(msgBook.Row, mintDateCol) < mstrStartDate And msgBook.TextMatrix(msgBook.Row, 2) <> "-9")
    SetMenu
    UpdateMenuStatus
    PopupMenu frmMain.mnuListEdit
End Sub

'保存银行帐期初数据
Private Fu