collate.frm

金算盘软件代码

    Next i
    SaveSetting App.title, "Collate", "ColWidth", strColWidth
End Sub

Private Sub Form_Activate()
    Dim l As Long
    
    If mblnIsShowCard(0) Or mblnIsShowCard(1) Then Exit Sub
    Me.Enabled = False
    MsgForm.PleaseWait
    SetHelpID Me.HelpContextID
    msgCollate.Redraw = True
    mclsMainControl_ChildActive
    gclsSys.CurrFormName = Me.hwnd
    mintGridRow = 1
    RefreshGrid
    If msgCollate.Rows > 1 Then
        If mlngAcntID > 0 And mlngCurID > 0 Then
            For l = 1 To msgCollate.Rows - 1
                If mlngAcntID = msgCollate.TextMatrix(l, 0) And mlngCurID = msgCollate.TextMatrix(l, 1) Then Exit For
            Next l
            If l = msgCollate.Rows Then l = 1
        Else
            l = 1
        End If
        mblnReActive = False
        msgCollate.Row = l
        msgCollate.col = 1
        mlngAcntID = msgCollate.TextMatrix(l, 0)
        mlngCurID = msgCollate.TextMatrix(l, 1)
        mstrDate = msgCollate.TextMatrix(l, 4)
        SetButton
    Else
        mblnRowFail = True
        SetButton False
    End If
    SetColWidth
    Unload MsgForm
    Me.Enabled = True
End Sub

Private Sub Form_Deactivate()
    frmMain.SetEditUnEnabled
End Sub

Private Sub Form_Load()
    Dim edtErrReturn As ErrDealType
    
    On Error GoTo ErrHandle
'    MsgForm.PleaseWait
'    SetHelpID hwnd, 60010
    Set mclsSubClassform = New SubClass32.SubClass
    mclsSubClassform.hwnd = Me.hwnd
    mclsSubClassform.Messages(WM_GETMINMAXINFO) = True
    Set mclsGrid = New Grid
    Set mclsGrid.Grid = msgCollate
    gintDiff = 10
    mblnRowFail = False
    mblnIsShowCard(0) = False
    mblnIsShowCard(1) = False
'    gblnBySum = True
    gintMatchModel = 1
    gblnByDay = True
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
    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
        Select Case True
            Case mblnIsShowCard(0)
                MsgBox "请先退出银行对帐单！", vbExclamation
                Cancel = True
                If frmBankDetail.WindowState = 1 Then frmBankDetail.WindowState = 0
                frmBankDetail.Show
                frmBankDetail.ZOrder 0
            Case mblnIsShowCard(1)
                MsgBox "请先退出企业银行帐！", vbExclamation
                Cancel = True
                If frmBankAccount.WindowState = 1 Then frmBankAccount.WindowState = 0
                frmBankAccount.Show
                frmBankAccount.ZOrder 0
        End Select
    End If
End Sub

Private Sub Form_Resize()
    Dim iHeight As Integer
    
    If (Me.Left + Me.width < 0) Or Me.Left > Screen.width Then Me.Left = 300
    cmdCollate(0).top = Me.Height - 2 * cmdCollate(0).Height - 90
    cmdCollate(0).Left = msgCollate.Left
    cmdCollate(1).top = cmdCollate(0).top
    cmdCollate(1).Left = cmdCollate(0).Left + cmdCollate(0).width + 3
    cmdCollate(2).top = cmdCollate(0).top
    cmdCollate(2).Left = cmdCollate(1).Left + cmdCollate(1).width + 3
    cmdCollate(3).top = cmdCollate(0).top
    cmdCollate(3).Left = cmdCollate(2).Left + cmdCollate(2).width + 3
    cmdCollate(4).top = cmdCollate(0).top
    cmdCollate(4).Left = cmdCollate(3).Left + cmdCollate(3).width + 3
    cmdCollate(5).top = cmdCollate(0).top
    cmdCollate(5).Left = cmdCollate(4).Left + cmdCollate(4).width + 3
    With msgCollate
        .Left = Me.ScaleLeft + 75
        .width = Me.width - .Left - 150
        iHeight = Me.Height - .top - 2 * cmdCollate(0).Height - 150
        .Height = IIf(iHeight < 0, 0, iHeight)
    End With
End Sub

Private Sub mclsMainControl_ListEditMenu(ByVal intIndex As Integer)
    cmdCollate(intIndex).Value = True
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 = 580
        MinMax.ptMinTrackSize.x = 580
        MinMax.ptMinTrackSize.y = 280

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

Private Sub GetBalance(ByVal intRow As Integer)
    Dim dtmStartDate As Date, dtmEndDate As Date
'    Dim intYear As Integer  ', bytPeriod As Byte
    Dim dblBillBalance As Double, dblBankBalance As Double
    Dim dblBankDebit As Double, dblBankCredit As Double
    Dim dblBillDebit As Double, dblBillCredit As Double
    Dim lngAcnID As Long, lngCurID As Long
    Dim bytCurDec As Byte  ',recBankBalance As rdoresultset
    Dim recBankMiss As rdoResultset, reccur As rdoResultset
    Dim recBillMiss As rdoResultset, strSql As String  ', strAcnYearStartDate As String
    Dim strQueryName As String
    
    On Error GoTo ErrHandle
    lngAcnID = CLng(msgCollate.TextMatrix(intRow, 0))
    lngCurID = CLng(msgCollate.TextMatrix(intRow, 1))
    If Trim$(msgCollate.TextMatrix(intRow, 4)) <> "" Then
        dtmStartDate = CDate(msgCollate.TextMatrix(intRow, 4))
    Else
        Exit Sub
    End If
    If Trim$(msgCollate.TextMatrix(intRow, 5)) <> "" Then
        dtmEndDate = CDate(msgCollate.TextMatrix(intRow, 5))
    End If
    If Trim$(msgCollate.TextMatrix(intRow, 7)) <> "" Then
        dblBillBalance = CDbl(msgCollate.TextMatrix(intRow, 7))
    Else
        dblBillBalance = 0
    End If
'    intYear = gclsBase.FYearOfDate(dtmEndDate)
'    bytPeriod = CByte(gclsBase.PeriodOfDate(dtmStartDate))
    
    '取币种小数位数
    strSql = "SELECT * FROM Currencys WHERE lngCurrencyID=" & lngCurID
    Set reccur = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not reccur.EOF Then bytCurDec = reccur!bytCurrencydec
    reccur.Close
    
    '取银行帐帐面余额
    dblBankBalance = BankBalance(lngAcnID, lngCurID, Format(dtmEndDate, "yyyy-mm-dd"))
    '取对帐单未达
    BillMiss lngAcnID, lngCurID, dblBillDebit, dblBillCredit
    '取银行帐未达
    BankMiss lngAcnID, lngCurID, msgCollate.TextMatrix(intRow, 4), msgCollate.TextMatrix(intRow, 5), dblBankDebit, dblBankCredit
    If Not gclsBase.ControlAccount Then
        BankVoucherMiss lngAcnID, lngCurID, msgCollate.TextMatrix(intRow, 4), msgCollate.TextMatrix(intRow, 5), dblBankDebit, dblBankCredit
    End If
    
    If dblBankBalance <> 0 Then
        msgCollate.TextMatrix(intRow, 6) = FormatShow(dblBankBalance, bytCurDec)
    End If
    If dblBankBalance + dblBillCredit - dblBillDebit <> 0 Then
        msgCollate.TextMatrix(intRow, 8) = FormatShow(dblBankBalance + dblBillCredit - dblBillDebit, bytCurDec)
    End If
    If dblBillBalance + dblBankDebit - dblBankCredit <> 0 Then
        msgCollate.TextMatrix(intRow, 9) = FormatShow(dblBillBalance + dblBankDebit - dblBankCredit, bytCurDec)
    End If
    If msgCollate.TextMatrix(intRow, 7) <> "" Then
        msgCollate.TextMatrix(intRow, 7) = FormatShow(msgCollate.TextMatrix(intRow, 7), bytCurDec)
    End If
    Exit Sub
ErrHandle:
    msgCollate.TextMatrix(intRow, 4) = ""
End Sub

Private Sub BankVoucherMiss(ByVal lngAcnID As Long, ByVal lngCurID As Long, ByVal strSD As String, _
    ByVal strED As String, ByRef dblDebit As Double, dblCredit As Double)
    Dim recB As rdoResultset, strSql As String
    
    strSql = "SELECT VoucherDetail.intDirection intDirection,VoucherDetail.dblCurrencyAmount dblAmount " _
          & " FROM Voucher, VoucherDetail Where Voucher.lngVoucherID = VoucherDetail.lngVoucherID " _
          & " AND Voucher.lngVoucherSourceID IN (1,2,3,4,14,16) AND Voucher.blnIsVoid=0 AND " _
          & "VoucherDetail.lngAccountID=" & lngAcnID & " AND VoucherDetail.lngCurrencyID=" _
          & lngCurID & " AND Voucher.strDate>='" & strSD & "' AND Voucher.strDate<='" & strED _
          & "' AND VoucherDetail.blnIsClosed=0"
    Set recB = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
    While Not recB.EOF
        If recB("intDirection") = 1 Then
            dblDebit = dblDebit + recB("dblAmount")
        Else
            dblCredit = dblCredit + recB("dblAmount")
        End If
        recB.MoveNext
    Wend
End Sub


Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    If mblnIsShowCard(0) Then Unload frmBankDetail
    If mblnIsShowCard(1) Then Unload frmBankAccount
    SaveColWidth
    Set mclsGrid = Nothing
    gclsSys.MainControls.Remove Me
    Set mclsMainControl = Nothing
End Sub

'Private Sub MakeListEditMenu()
'    Dim intCnt As Integer
'
'    With frmMain
'        For intCnt = .mnuListEditMenu.Count - 1 To 1 Step -1
'            Unload .mnuListEditMenu(intCnt)
'        Next
'
'        Utility.CloneMenu .mnuEditEdit, .mnuListEditMenu(0)
'        .mnuListEditMenu(0).Caption = "修改(&E)"
'
'        Load .mnuListEditMenu(1)
'        Utility.CloneMenu .mnuEditNew, .mnuListEditMenu(1)
'        .mnuListEditMenu(1).Caption = "新增(&N)"
'        Load .mnuListEditMenu(2)
'        Utility.CloneMenu .mnuEditDel, .mnuListEditMenu(2)
'        .mnuListEditMenu(2).Caption = "删除(&D)"
'    End With
'End Sub
'

Private Sub mclsMainControl_ChildActive()
    Dim vntMessage As Variant
    
    '响应消息
    For Each vntMessage In mclsMainControl.Messages
        If vntMessage = Message.msgClass Then '接收到银行对帐改变消息
            mclsMainControl.Messages.Remove CStr(vntMessage) '清除银行对帐改变消息
        End If
    Next
    mclsMainControl.Messages.Clear
'    gclsSys.CurrFormName = Me.hwnd
End Sub

Private Sub msgCollate_DblClick()
    If cmdCollate(2).Enabled Then cmdCollate(2).Value = True
End Sub

Private Sub RefreshGrid()
    Dim i As Integer, strSql As String
    
    msgCollate.Cols = 0
'    Set Data1.Resultset = gclsBase.BaseDB.rdoQueries("Collate0"). _
        OpenResultset(rdOpenStatic)
    strSql = "SELECT * FROM Collate0 Order by Collate0.""银行科目"""
    Set Data1.Resultset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not Data1.Resultset.EOF Then Data1.Resultset.MoveLast
    For i = 2 To msgCollate.Cols - 1
        msgCollate.FixedAlignment(i) = flexAlignCenterCenter
        If i > 5 Then msgCollate.ColAlignment(i) = flexAlignRightCenter
    Next i
    For i = 1 To msgCollate.Rows - 1
        If Trim$(msgCollate.TextMatrix(i, 4)) <> "" Then GetBalance i
        msgCollate.RowHeight(i) = 300
    Next i
    Data1.Resultset.Close
    msgCollate.FixedCols = 0
    mclsGrid.SetupStyle
End Sub

Private Sub msgCollate_KeyPress(KeyAscii As Integer)
    Select Case KeyAscii
    Case vbKeyUp, vbKeyDown
'        mblnRowFail = False
'        mlngAcntID = msgCollate.TextMatrix(msgCollate.Row, 0)
'        mlngCurID = msgCollate.TextMatrix(msgCollate.Row, 1)
'        mstrDate = msgCollate.TextMatrix(msgCollate.Row, 4)
'        SetButton
    Case vbKeySpace
        If cmdCollate(2).Enabled Then cmdCollate(2).Value = True
    End Select
End Sub

Private Sub msgCollate_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim i As Integer, lHeigh As Long
    
    If msgCollate.Row = 0 Then Exit Sub
    If Button = vbRightButton Then
        MakeListEditMenu
        PopupMenu frmMain.mnuListEdit
    Else
        For i = 0 To msgCollate.Rows - 1
            lHeigh = lHeigh + msgCollate.RowHeight(i)
        Next i
        If y < msgCollate.RowHeight(0) Then
            msgCollate_MouseUp Button, Shift, x, msgCollate.RowHeight(0) * (msgCollate.Rows + 3)
        ElseIf y > lHeigh Then
            mblnRowFail = True
            mstrDate = ""
            SetButton False
        Else
            mblnRowFail = False
            mlngAcntID = msgCollate.TextMatrix(msgCollate.Row, 0)
            mlngCurID = msgCollate.TextMatrix(msgCollate.Row, 1)
            mstrDate = msgCollate.TextMatrix(msgCollate.Row, 4)
            SetButton
        End If
    End If
End Sub

Private Sub SetButton(Optional ByVal blnSel As Boolean = True)
    Dim i As Integer
    
    If Not blnSel Then
        For i = 0 To 5
            cmdCollate(i).Enabled = False
        Next i
    Else
        If mstrDate = "" Then
            cmdCollate(0).Enabled = False
            cmdCollate(1).Enabled = False
            cmdCollate(2).Enabled = False
            cmdCollate(3).Enabled = False
            cmdCollate(4).Enabled = True
            cmdCollate(5).Enabled = False
        Else
            cmdCollate(0).Enabled = True
            cmdCollate(1).Enabled = True
            cmdCollate(2).Enabled = True
            cmdCollate(3).Enabled = True
            cmdCollate(4).Enabled = False
            cmdCollate(5).Enabled = True
        End If
    End If
End Sub

Private Sub MakeListEditMenu()
    Dim intCnt As Integer
    
    With frmMain
        For intCnt = .mnuListEditMenu.Count - 1 To 1 Step -1
            Unload .mnuListEditMenu(intCnt)
        Next
                
        Utility.CloneMenu .mnuEditNew, .mnuListEditMenu(0)
        .mnuListEditMenu(0).Enabled = cmdCollate(0).Enabled
        .mnuListEditMenu(0).Caption = cmdCollate(0).Caption
        
        Load .mnuListEditMenu(1)
        Utility.CloneMenu .mnuEditDel, .mnuListEditMenu(1)
        .mnuListEditMenu(1).Enabled = cmdCollate(1).Enabled
        .mnuListEditMenu(1).Caption = cmdCollate(1).Caption
        
        Load .mnuListEditMenu(2)
        Utility.CloneMenu .mnuEditEdit, .mnuListEditMenu(2)
        .mnuListEditMenu(2).Enabled = cmdCollate(2).Enabled
        .mnuListEditMenu(2).Caption = cmdCollate(2).Caption
        
        Load .mnuListEditMenu(3)
        Utility.CloneMenu .mnuEditFilter, .mnuListEditMenu(3)
        .mnuListEditMenu(3).Enabled = cmdCollate(3).Enabled
        .mnuListEditMenu(3).Caption = cmdCollate(3).Caption
        
        Load .mnuListEditMenu(4)
        Utility.CloneMenu .mnuEditColumn, .mnuListEditMenu(4)
        .mnuListEditMenu(4).Enabled = cmdCollate(4).Enabled
        .mnuListEditMenu(4).Caption = cmdCollate(4).Caption
        
        Load .mnuListEditMenu(5)
        Utility.CloneMenu .mnuEditColumn, .mnuListEditMenu(5)
        .mnuListEditMenu(5).Enabled = cmdCollate(5).Enabled
        .mnuListEditMenu(5).Caption = cmdCollate(5).Caption
    End With
End Sub

Private Sub msgCollate_RowColChange()
    If msgCollate.Row = 0 Then Exit Sub
    If mblnReActive Then Exit Sub
    mblnRowFail = False
    mlngAcntID = msgCollate.TextMatrix(msgCollate.Row, 0)
    mlngCurID = msgCollate.TextMatrix(msgCollate.Row, 1)
    mstrDate = msgCollate.TextMatrix(msgCollate.Row, 4)
    SetButton
End Sub