frmtaskfinancecharge.frm

金算盘软件代码

    lngEmployeeID As Long, lngClassID1 As Long, lngClassID2 As Long, dblResult As Double)
    
    Dim lngURow As Long
    Dim lngCnt As Long
    Dim blnFind As Boolean
    
    blnFind = False
    lngURow = UBound(marrcustomer)
    For lngCnt = 0 To lngURow
        If marrcustomer(lngCnt).lngCustomerID = lngCustomerID And _
            marrcustomer(lngCnt).lngCurrencyID = lngCurrencyID And _
            marrcustomer(lngCnt).lngDepartmentID = lngDepartmentID And _
            marrcustomer(lngCnt).lngEmployeeID = lngEmployeeID And _
            marrcustomer(lngCnt).lngClassID1 = lngClassID1 And _
            marrcustomer(lngCnt).lngClassID2 = lngClassID2 Then
            blnFind = True
            Exit For
        ElseIf marrcustomer(lngCnt).lngCustomerID = 0 Or _
            marrcustomer(lngCnt).lngCurrencyID = 0 Then
            marrcustomer(lngCnt).lngCustomerID = lngCustomerID
            marrcustomer(lngCnt).lngCurrencyID = lngCurrencyID
            marrcustomer(lngCnt).dblAmount = 0
            blnFind = True
            Exit For
        End If
    Next lngCnt
    
    If Not blnFind Then
        lngCnt = lngURow + 1
        ReDim Preserve marrcustomer(lngCnt)
        marrcustomer(lngCnt).lngCustomerID = lngCustomerID
        marrcustomer(lngCnt).lngCurrencyID = lngCurrencyID
        marrcustomer(lngCnt).lngDepartmentID = lngDepartmentID
        marrcustomer(lngCnt).lngEmployeeID = lngEmployeeID
        marrcustomer(lngCnt).lngClassID1 = lngClassID1
        marrcustomer(lngCnt).lngClassID2 = lngClassID2
    End If
    marrcustomer(lngCnt).dblAmount = marrcustomer(lngCnt).dblAmount + dblResult
End Sub

Private Sub SubArray(lngRow As Long, lngCustomerID As Long, lngCurrencyID As Long)
    Dim lngURow As Long
    Dim lngCnt As Long
    
    lngURow = UBound(marrcustomer)
    For lngCnt = 0 To lngURow
        If marrcustomer(lngCnt).lngCustomerID = lngCustomerID And _
            marrcustomer(lngCnt).lngCurrencyID = lngCurrencyID Then
            marrcustomer(lngCnt).lngCustomerID = 0
            marrcustomer(lngCnt).lngCurrencyID = 0
            marrcustomer(lngCnt).dblAmount = 0
        End If
    Next lngCnt
End Sub

Private Sub cldTaskDate_KeyDown(KeyCode As Integer, Shift As Integer, bCancel As Long)
    On Error Resume Next
    If KeyCode = vbKeyReturn Then
        KeyCode = 0
        SendKeys "{Tab}", True
    End If
End Sub

Private Sub Form_Deactivate()
    frmMain.SetEditUnEnabled
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 27 Then
        Unload Me
    End If
End Sub

Private Sub Form_Load()
    mlngActivityID = 0
    mblnExit = False
    mdtmDate = gclsBase.BaseDate
    ReDim marrcustomer(0)
    cldTaskDate.Text = Format(gclsBase.BaseDate, "yyyy-mm-dd")

    Set mclsSubClassform = New SubClass32.SubClass
    mclsSubClassform.hwnd = Me.hwnd
    mclsSubClassform.Messages(WM_GETMINMAXINFO) = True

    Set mclsMainControl = gclsSys.MainControls.Add(Me)
    Me.HelpContextID = 60115

    Set mclsList = New Grid
    Set mclsList.Grid = msgTask
'    RefreshGrid
'
'    RefreshTemplate
End Sub

Public Sub ShowMe()
    Load Me
'    Set mclsList = New Grid
'    Set mclsList.Grid = msgTask
    RefreshGrid

    RefreshTemplate
    Me.Show
    Me.ZOrder 0
End Sub
Private Sub Form_Activate()
    gclsSys.CurrFormName = Me.hwnd
    SetHelpID HelpContextID
    frmMain.SetEditUnEnabled
    mclsMainControl_ChildActive
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Dim lngRow As Long
    
    If Not mblnExit And Cancel <= 1 Then
        For lngRow = 1 To msgTask.Rows - 1
            If msgTask.TextMatrix(lngRow, mintColCheck) = "√" Then
                Exit For
            End If
        Next lngRow
        If lngRow < msgTask.Rows Then
            If ShowMsg(hwnd, "未生成计息单，是否退出？", vbQuestion + vbYesNo, Caption) <> vbYes Then
                Cancel = 1
            End If
        End If
    End If
End Sub

Private Sub Form_Resize()
    On Error Resume Next

    If WindowState <> vbMinimized Then
        If (Left + width < 0 Or Left > Screen.width) And WindowState <> vbMaximized Then
            Left = (Screen.width - width) / 2
        End If
        If width < mlngFormMinWidth * Screen.TwipsPerPixelX Then
            width = mlngFormMinWidth * Screen.TwipsPerPixelX
        End If

        cmdOK(0).Left = ScaleWidth - cmdOK(0).width - mlngLeft
        cmdOK(1).Left = cmdOK(0).Left
        cmdOK(2).Left = cmdOK(0).Left
        cmdOK(3).Left = cmdOK(0).Left
        cmdOK(4).Left = cmdOK(0).Left
        cmdOK(5).Left = cmdOK(0).Left
        cmdOK(6).Left = cmdOK(0).Left
        chkProBill.Left = cmdOK(0).Left

        msgTask.top = mlngTop
        msgTask.Left = mlngLeft
        msgTask.Height = ScaleHeight - mlngTop - mlngBottomHeight
        msgTask.width = ScaleWidth - 3 * mlngLeft - cmdOK(0).width

        ltxtTemplate.Left = msgTask.Left + msgTask.width - ltxtTemplate.width
        Label1(1).Left = ltxtTemplate.Left - Label1(1).width - 30
        mclsList.RefreshGridData
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    gclsSys.MainControls.Remove Me
    Unload frmSetTaskPara
    Set mclsList = Nothing
    Set mclsSubClassform = Nothing
    Set mclsMainControl = Nothing
End Sub

Private Sub mclsList_AfterColChange(lngSourCol As Long, lngDestCol As Long)
    FindColPosition
End Sub

Private Sub mclsList_AfterRefresh(lngRow As Long)
    Dim intDec As Integer
    Dim dblAmount As Double
    
    With msgTask
        intDec = C2lng(.TextMatrix(lngRow, mintColCurrencyDec))
        dblAmount = C2Dbl(.TextMatrix(lngRow, mintColAmount))
        If mintColAmount > 0 Then
            If intDec > 0 Then
                .TextMatrix(lngRow, mintColAmount) = strFormat(dblAmount, intDec)
            End If
        Else
            .TextMatrix(lngRow, mintColAmount) = ""
        End If
        dblAmount = C2Dbl(.TextMatrix(lngRow, mintColInterest))
        If mintColInterest > 0 Then
            If intDec > 0 Then
                .TextMatrix(lngRow, mintColInterest) = strFormat(dblAmount, intDec)
            End If
        Else
            .TextMatrix(lngRow, mintColInterest) = ""
        End If
    End With
End Sub


Private Sub mclsMainControl_ChildActive()
    Dim vntMessage As Variant
    
    On Error Resume Next
    '响应消息
    For Each vntMessage In mclsMainControl.Messages
        Select Case vntMessage
        Case Message.msgTemplate
            RefreshTemplate
        Case msgReceipt38
            mclsMainControl.Messages.Remove CStr(vntMessage)
            RefreshGrid
        End Select
    Next
    
    gclsSys.CurrFormName = hwnd
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 = mlngFormMinWidth
        MinMax.ptMinTrackSize.y = mlngFormMinHeight

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

Private Sub msgTask_KeyPress(KeyAscii As Integer)
    If KeyAscii <> 32 Then Exit Sub
    
    Dim lngRow As Long
    Dim lngCustomerID As Long
    With msgTask
        lngRow = .Row
        If lngRow >= .FixedRows And lngRow < .Rows Then
            If .TextMatrix(lngRow, mintColCheck) = "" Then
                Me.MousePointer = vbHourglass
                MsgForm.PleaseWait "正在计算利息，请稍后..."
                If IsDate(.TextMatrix(lngRow, mintColDate)) Then
                    If .TextMatrix(lngRow, mintColDate) < cldTaskDate.Text Then
                        .TextMatrix(lngRow, mintColCheck) = "√"
                        ComputeInterest lngRow
                        lngCustomerID = GetValue(lngRow, mintColCustomerID)
                        For lngRow = 1 To .Rows - 1
                            If .TextMatrix(lngRow, mintColCheck) = "" Then
                                If lngCustomerID = GetValue(lngRow, mintColCustomerID) Then
                                    .TextMatrix(lngRow, mintColCheck) = "√"
                                    ComputeInterest lngRow
                                End If
                            End If
                        Next lngRow
                    End If
                Else
                    .TextMatrix(lngRow, mintColCheck) = "√"
                    ComputeInterest lngRow
                    lngCustomerID = GetValue(lngRow, mintColCustomerID)
                    For lngRow = 1 To .Rows - 1
                        If .TextMatrix(lngRow, mintColCheck) = "" Then
                            If lngCustomerID = GetValue(lngRow, mintColCustomerID) Then
                                .TextMatrix(lngRow, mintColCheck) = "√"
                                ComputeInterest lngRow
                            End If
                        End If
                    Next lngRow
                End If
                Unload MsgForm
                Me.MousePointer = vbDefault
            Else
                .TextMatrix(lngRow, mintColCheck) = ""
                .TextMatrix(lngRow, mintColInterest) = ""
                lngCustomerID = GetValue(lngRow, mintColCustomerID)
                SubArray lngRow, lngCustomerID, GetValue(lngRow, mintColCurrencyID)
                For lngRow = 1 To .Rows - 1
                    If .TextMatrix(lngRow, mintColCheck) = "√" Then
                        If lngCustomerID = GetValue(lngRow, mintColCustomerID) Then
                            .TextMatrix(lngRow, mintColCheck) = ""
                            .TextMatrix(lngRow, mintColInterest) = ""
                            SubArray lngRow, lngCustomerID, GetValue(lngRow, mintColCurrencyID)
                        End If
                    End If
                Next lngRow
            End If
        End If
    End With
End Sub
Private Sub msgTask_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    With msgTask
        If .MouseCol = mintColCheck And .MouseRow > 0 And .MouseRow <= .Rows - 1 Then
            .MousePointer = vbCustom
        Else
            .MousePointer = vbDefault
        End If
    End With
End Sub

'选择执行行
Private Sub msgTask_Click()
    Dim lngRow As Long
    Dim lngCustomerID As Long
    With msgTask
        lngRow = .MouseRow
        If lngRow >= .FixedRows And lngRow < .Rows And .MouseCol = mintColCheck Then
            If .TextMatrix(lngRow, mintColCheck) = "" Then
                Me.MousePointer = vbHourglass
                MsgForm.PleaseWait "正在计算利息，请稍后..."
                If IsDate(.TextMatrix(lngRow, mintColDate)) Then
                    If .TextMatrix(lngRow, mintColDate) < cldTaskDate.Text Then
                        .TextMatrix(lngRow, mintColCheck) = "√"
                        ComputeInterest lngRow
                        lngCustomerID = GetValue(lngRow, mintColCustomerID)
                        For lngRow = 1 To .Rows - 1
                            If .TextMatrix(lngRow, mintColCheck) = "" Then
                                If lngCustomerID = GetValue(lngRow, mintColCustomerID) Then
                                    .TextMatrix(lngRow, mintColCheck) = "√"
                                    ComputeInterest lngRow
                                End If
                            End If
                        Next lngRow
                    End If
                Else
                    .TextMatrix(lngRow, mintColCheck) = "√"
                    ComputeInterest lngRow
                    lngCustomerID = GetValue(lngRow, mintColCustomerID)
                    For lngRow = 1 To .Rows - 1
                        If .TextMatrix(lngRow, mintColCheck) = "" Then
                            If lngCustomerID = GetValue(lngRow, mintColCustomerID) Then
                                .TextMatrix(lngRow, mintColCheck) = "√"
                                ComputeInterest lngRow
                            End If
                        End If
                    Next lngRow
                End If
                Unload MsgForm
                Me.MousePointer = vbDefault
            Else
                .TextMatrix(lngRow, mintColCheck) = ""
                .TextMatrix(lngRow, mintColInterest) = ""
                lngCustomerID = GetValue(lngRow, mintColCustomerID)
                SubArray lngRow, lngCustomerID, GetValue(lngRow, mintColCurrencyID)
                For lngRow = 1 To .Rows - 1
                    If .TextMatrix(lngRow, mintColCheck) = "√" Then
                        If lngCustomerID = GetValue(lngRow, mintColCustomerID) Then
                            .TextMatrix(lngRow, mintColCheck) = ""
                            .TextMatrix(lngRow, mintColInterest) = ""
                            SubArray lngRow, lngCustomerID, GetValue(lngRow, mintColCurrencyID)
                        End If
                    End If
                Next lngRow
            End If
        End If
    End With
End Sub