frmvouchermultilist.frm

金算盘软件代码

    cMsgBox "多张凭证复核成功，本次共复核" & iCount & "张凭证！", "多张复核"
    gclsSys.SendMessage Me.hwnd, Message.msgReceipt41
    Sub_Check = True
    Exit Function
CheckErr:
'    Unload MsgForm
    gclsBase.BaseWorkSpace.RollBacktrans
    Screen.MousePointer = vbDefault
    cMsgBox "多张凭证复核失败！", "多张复核"
    Unload Me
End Function

Private Function Sub_UnCheck() As Boolean
    Dim lngRow As Long
    Dim lngVoucherID As Long
    Dim iCount As Integer

    If ShowMsg(Me.hwnd, "您确实要取消复核所选的凭证吗？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "多张复核取消") <> IDYES Then Exit Function
    
    With grdList
        If Not (.Rows > 0) Then
            Exit Function
        End If
        
On Error GoTo UnCheckErr
        ProgressBar1.Visible = True
        Screen.MousePointer = vbHourglass
        ProgressBar1.Value = 5
        mblnIsFocus = False
        gclsBase.BaseWorkSpace.BeginTrans
        
        lngVoucherID = 0
        iCount = 0
        ProgressBar1.Value = 10
        For lngRow = 1 To .Rows - 1
            If Trim(.TextArray(pos(lngRow, 1))) = "√" Then
                If lngVoucherID <> CLng(.TextArray(pos(lngRow, 0))) Then
                    lngVoucherID = CLng(.TextArray(pos(lngRow, 0)))
                    iCount = iCount + 1
                    '取消复核
'                    MsgForm.PleaseWait "已取消复核凭证" & iCount & "张"
                    If Not mclsVoucher.UnCheckVoucher(lngVoucherID, True, , True) Then GoTo UnCheckErr
                End If
            End If
            Select Case lngRow
                   Case Is > (1 / 2) * (.Rows)
                        ProgressBar1.Value = 80
                   Case Is > (1 / 3) * (.Rows)
                        ProgressBar1.Value = 70
                   Case Is > (1 / 4) * (.Rows)
                        ProgressBar1.Value = 60
                   Case Is > (1 / 5) * (.Rows)
                        ProgressBar1.Value = 50
                   Case Is > (1 / 6) * (.Rows)
                        ProgressBar1.Value = 40
                   Case Is > (1 / 7) * (.Rows)
                        ProgressBar1.Value = 30
                   Case Is > (1 / 8) * (.Rows)
                        ProgressBar1.Value = 20
            End Select
        Next lngRow
    End With
    ProgressBar1.Value = 90
'    Unload MsgForm
    gclsBase.BaseWorkSpace.CommitTrans
    ProgressBar1.Value = 100
    ProgressBar1.Visible = False
    Screen.MousePointer = vbDefault
    cMsgBox "多张凭证复核取消成功，本次共取消复核" & iCount & "张凭证！", "多张复核取消"
    gclsSys.SendMessage Me.hwnd, Message.msgReceipt41
    Sub_UnCheck = True
    Exit Function
UnCheckErr:
'    Unload MsgForm
    gclsBase.BaseWorkSpace.RollBacktrans
    Screen.MousePointer = vbDefault
    cMsgBox "多张凭证复核取消失败！", "多张复核取消"
    Unload Me
End Function

Private Function Sub_Post() As Boolean
    Dim lngRow As Long
    Dim lngVoucherID As Long
    Dim iCount As Integer
    
    If ShowMsg(Me.hwnd, "您确实要记帐所选的凭证吗？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "多张记帐") <> IDYES Then Exit Function
    With grdList
        If Not (.Rows > 0) Then
            Exit Function
        End If

On Error GoTo PostErr
        ProgressBar1.Visible = True
        Screen.MousePointer = vbHourglass
        ProgressBar1.Value = 5
        mblnIsFocus = False
        Debug.Print "PostTime:", time
        gclsBase.BaseWorkSpace.BeginTrans
        
        lngVoucherID = 0
        iCount = 0
        ProgressBar1.Value = 10
        For lngRow = 1 To .Rows - 1
            Select Case lngRow
                   Case Is > (1 / 2) * (.Rows)
                        ProgressBar1.Value = 80
                   Case Is > (1 / 3) * (.Rows)
                        ProgressBar1.Value = 70
                   Case Is > (1 / 4) * (.Rows)
                        ProgressBar1.Value = 60
                   Case Is > (1 / 5) * (.Rows)
                        ProgressBar1.Value = 50
                   Case Is > (1 / 6) * (.Rows)
                        ProgressBar1.Value = 40
                   Case Is > (1 / 7) * (.Rows)
                        ProgressBar1.Value = 30
                   Case Is > (1 / 8) * (.Rows)
                        ProgressBar1.Value = 20
            End Select
            If Trim(.TextArray(pos(lngRow, 1))) = "√" Then
                If lngVoucherID <> CLng(.TextArray(pos(lngRow, 0))) Then
                    lngVoucherID = CLng(.TextArray(pos(lngRow, 0)))
                    iCount = iCount + 1
                    '记帐
'                    MsgForm.PleaseWait "已记帐凭证" & iCount & "张"
                    If Not mclsVoucher.PostVoucher(lngVoucherID, True, , True) Then GoTo PostErr
                End If
            End If
            
        Next lngRow
    End With
    ProgressBar1.Value = 90
'    Unload MsgForm
    gclsBase.BaseWorkSpace.CommitTrans
    ProgressBar1.Value = 100
    ProgressBar1.Visible = False
    Screen.MousePointer = vbDefault
    cMsgBox "多张凭证记帐成功，本次共记帐" & iCount & "张凭证！", "多张记帐"
    Debug.Print "PostEndtime:", time
    gclsSys.SendMessage Me.hwnd, Message.msgReceipt41
    Sub_Post = True
    Exit Function
PostErr:
'    Unload MsgForm
    gclsBase.BaseWorkSpace.RollBacktrans
    Screen.MousePointer = vbDefault
    cMsgBox "多张凭证记帐失败！", "多张记帐"
    Unload Me
End Function

Private Function Sub_UnPost() As Boolean
    Dim lngRow As Long
    Dim lngVoucherID As Long
    Dim iCount As Integer
    
    If ShowMsg(Me.hwnd, "您确实要取消记帐所选的凭证吗？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "多张记帐取消") <> IDYES Then Exit Function
    
    With grdList
        If Not (.Rows > 0) Then
            Exit Function
        End If

On Error GoTo UnPostErr
        ProgressBar1.Visible = True
        Screen.MousePointer = vbHourglass
        ProgressBar1.Value = 5
        mblnIsFocus = False
        gclsBase.BaseWorkSpace.BeginTrans
        
        lngVoucherID = 0
        iCount = 0
        ProgressBar1.Value = 10
        For lngRow = 1 To .Rows - 1
            Select Case lngRow
                   Case Is > (1 / 2) * (.Rows)
                        ProgressBar1.Value = 90
                   Case Is > (1 / 3) * (.Rows)
                        ProgressBar1.Value = 80
                   Case Is > (1 / 4) * (.Rows)
                        ProgressBar1.Value = 70
                   Case Is > (1 / 5) * (.Rows)
                        ProgressBar1.Value = 60
                   Case Is > (1 / 6) * (.Rows)
                        ProgressBar1.Value = 50
                   Case Is > (1 / 7) * (.Rows)
                        ProgressBar1.Value = 40
                   Case Is > (1 / 8) * (.Rows)
                        ProgressBar1.Value = 30
                   Case Is > (1 / 9) * (.Rows)
                        ProgressBar1.Value = 20
            End Select
            If Trim(.TextArray(pos(lngRow, 1))) = "√" Then
                If lngVoucherID <> CLng(.TextArray(pos(lngRow, 0))) Then
                    lngVoucherID = CLng(.TextArray(pos(lngRow, 0)))
                    iCount = iCount + 1
                    '取消记帐
'                    MsgForm.PleaseWait "已取消记帐凭证" & iCount & "张"
                    If Not mclsVoucher.UnPostVoucher(lngVoucherID, True, , True) Then GoTo UnPostErr
                End If
            End If
        Next lngRow
    End With
    ProgressBar1.Value = 95
'    Unload MsgForm
    gclsBase.BaseWorkSpace.CommitTrans
    ProgressBar1.Value = 100
    ProgressBar1.Visible = False
    Screen.MousePointer = vbDefault
    cMsgBox "多张凭证记帐取消成功，本次共取消记帐" & iCount & "张凭证！", "多张记帐取消"
    gclsSys.SendMessage Me.hwnd, Message.msgReceipt41
    Sub_UnPost = True
    Exit Function
UnPostErr:
'    Unload MsgForm
    gclsBase.BaseWorkSpace.RollBacktrans
    Screen.MousePointer = vbDefault
    cMsgBox "多张凭证记帐取消失败！", "多张记帐取消"
    Unload Me
End Function

Private Sub Sub_Cancel()
    Unload Me
End Sub

'全部选择
Private Sub Sub_SelectAll()
    Dim lngRow As Long
    Dim lngVoucherID As Long
    
    With grdList
        lngVoucherID = 0
        For lngRow = 1 To .Rows - 1
            If lngVoucherID <> CLng(.TextArray(pos(lngRow, 0))) And .RowHeight(lngRow) <> 0 Then
                .TextArray(pos(lngRow, 1)) = "√"
                lngVoucherID = CLng(.TextArray(pos(lngRow, 0)))
            End If
        Next
    End With
End Sub

'条件选择
Private Sub Sub_Select()
    '1）调用过滤窗口
    Dim blnFlage As Boolean
    '执行过滤
    If mclsList.ListSet.ListID < 1 Then
       mclsList.ListSet.SaveList
       DefaultCurrentDate mclsList.ListSet.ListID, 9975
    End If
    Filter.ShowFilter mclsList.ListSet.ListID, 1, , , , , blnFlage, , "条件选择"
    If Not blnFlage Then Exit Sub
    mclsList.ListSet.ViewId = intViewID
    conSet
    Filter.DelSelectedCond mclsList.ListSet.ListID, 1
End Sub


'全部取消
Private Sub Sub_CancelAll()
    Dim lngRow As Long
    With grdList
        For lngRow = 1 To .Rows - 1
            .TextArray(pos(lngRow, 1)) = ""
        Next
    End With
End Sub

'打印
Private Sub Sub_Print()
    
    Dim myPrintclass As PrintClass
    
    HookPaint True
    Set myPrintclass = New PrintClass
    myPrintclass.PrintList gclsBase.BaseDB, mclsList.FlexGrid, 67, Me.Caption & Chr(1) & Trim(gclsBase.BaseName) & Chr(1) & gclsBase.OperatorName
    Set myPrintclass = Nothing
    mclsList.DoForm = False
End Sub



Private Sub mclsSubClass_WndProc(Msg As Long, wParam As Long, lParam As Long, Result As Long)
    mclsList.HookProc Msg, wParam, lParam, mclsSubClass
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 = 250
        
        CopyMemory ByVal lParam, MinMax, Len(MinMax)
        Result = 0
    End If
End Sub



'//////////////////////////////////////////////////////////////
'///////        窗体 Form 控件
'//////////////////////////////////////////////////////////////

Private Sub Form_Load()
'    Dim intYear As Integer, bytPeriod As Integer, IntYearcol As Integer, intPeriodcol As Integer
'    Dim strPeriodList() As String
'    Dim blnPeriodCanPost As Boolean
'    ReDim strPeriodList(0)
'    Dim i As Long, j As Long
    
    On Error GoTo ErrHandle
    mblnIsFocus = True
    '获得当前操作员的权限
    ReDim arrRights_Make(0)
    ReDim arrRights_Check(0)
    ReDim arrRights_Post(0)
    GetGroupOperator gclsBase.OperatorID, arrRights_Make(), arrRights_Check(), arrRights_Post()
    
    Utility.LoadFormResPicture Me
    
    '需求：Grid的栏目设置情况应和frmVoucherList中的Grid的栏目设置情况一致