clslistpsitem.cls

金算盘软件代码

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsListPSItem"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit


Private intFormType As Integer
Private WithEvents mfrmPS As frmAListTemplate   '模版窗体
Attribute mfrmPS.VB_VarHelpID = -1
Private mclsListMethod As clsListMethod         '接口类
Private blnIsVoid    As Boolean                 '是否已作废
Private blnIsInvoice As Boolean                 '开票标志
Private blnChange As Boolean                    '只能编辑和删除自己制作的单据
Private mblnFinish As Boolean
Private mIsShowEdit As Boolean
Private clsListType As String
Public Function SetListType(ByVal strList As String)
    mfrmPS.strListType = strList
    clsListType = strList
End Function
Private Sub cMsgBox(strMsg As String, Optional strTitle As String)
    If Trim(strTitle) = "" Then
        strTitle = "提示信息"
    End If

    ShowMsg mfrmPS.hWnd, strMsg, MB_OK + MB_ICONEXCLAMATION + MB_SYSTEMMODAL, strTitle
End Sub
Private Sub Class_Initialize()
    Set mfrmPS = New frmAListTemplate
    mfrmPS.blnReceptionList = True
    intFormType = GetListType
    mfrmPS.Tabs = 1
    Select Case intFormType
        Case 1
            mfrmPS.mTitle = "销售收款单列表"
            mfrmPS.mHelpID = 60006
            mfrmPS.SpViewID(0) = 1206
            mfrmPS.blnEditByRight(0) = IsCanDo(frmRightsID.frmReceiveListID, gclsBase.OperatorID)
            If IsCanDo(252, gclsBase.OperatorID) Then
                mfrmPS.SpWhere(0) = "Activity.lngActivityTypeID =40 AND ActivityDetail.blnIsReceipt=1 And Activity.blnIsSpecial=1"
            Else
                mfrmPS.SpWhere(0) = "Activity.lngActivityTypeID =40 AND ActivityDetail.blnIsReceipt=1 And Activity.blnIsSpecial=1 " & " And Activity.lngOperatorID=" & gclsBase.OperatorID
            End If
            mfrmPS.SpPrintID(0) = 48
            mfrmPS.SpPrintTitle(0) = "销售收款单列表" & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
            mfrmPS.blnIsHavingReport = True
            mfrmPS.ReportCount = 2
            mfrmPS.ReportName(0) = "销售收款汇总表(&T)"
            mfrmPS.ReportName(1) = "销售收款明细表(&B)"
        Case 2
            mfrmPS.mTitle = "采购付款单列表"
            mfrmPS.mHelpID = 60008
            mfrmPS.SpViewID(0) = 1205
            mfrmPS.blnEditByRight(0) = IsCanDo(frmRightsID.frmPaymentListID, gclsBase.OperatorID)
            If IsCanDo(253, gclsBase.OperatorID) Then
                mfrmPS.SpWhere(0) = " Activity.lngActivityTypeID =39 AND ActivityDetail.blnIsReceipt=1 And Activity.blnIsSpecial=1 "
            Else
                mfrmPS.SpWhere(0) = " Activity.lngActivityTypeID =39 AND ActivityDetail.blnIsReceipt=1 And Activity.blnIsSpecial=1 " & " And Activity.lngOperatorID=" & gclsBase.OperatorID
            End If
            mfrmPS.SpPrintID(0) = 49
            mfrmPS.SpPrintTitle(0) = "采购付款单列表" & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
            mfrmPS.blnIsHavingReport = True
            mfrmPS.ReportCount = 2
            mfrmPS.ReportName(0) = "采购付款汇总表(&T)"
            mfrmPS.ReportName(1) = "采购付款明细表(&B)"
    End Select
    mfrmPS.SpSelect(0) = "Activity.lngActivityID As id,decode(Activity.blnIsVoid,1,'√',' ') As ""作废"""
    mfrmPS.ShowAll(0) = "not Activity.blnIsVoid=1"
    mfrmPS.blnIsReceptionWriteoff = True
    mfrmPS.MenuEnbaleOnPage(0) = 3
    mfrmPS.MenuEnbaleOnPage(1) = 3
    mfrmPS.MenuEnbaleOnPage(2) = 3
    mfrmPS.MenuEnbaleOnPage(3) = 3
    mfrmPS.MenuEnbaleOnPage(4) = 3
    mfrmPS.MenuEnbaleOnPage(5) = 3
    mfrmPS.MenuEnbaleOnPage(6) = 3
    mfrmPS.MenuEnbaleOnPage(7) = 3
End Sub

Public Function Showlist()
    mfrmPS.Show
    mfrmPS.ZOrder 0
    Set mclsListMethod = New clsListMethod
    mclsListMethod.SethWnd mfrmPS.hWnd
End Function

Private Sub mfrmPS_ListChildActive()
    Dim vntMessage As Variant
    For Each vntMessage In mfrmPS.mclsMainControl.Messages
        Select Case intFormType
            Case 1
                If vntMessage = Message.msgReceipt40 Then
                    mfrmPS.ToolRefresh
                    mfrmPS.mclsMainControl.Messages.Remove CStr(vntMessage) '清除消息
                End If
            Case 2
                If vntMessage = Message.msgReceipt39 Then
                    mfrmPS.ToolRefresh
                    mfrmPS.mclsMainControl.Messages.Remove CStr(vntMessage) '清除消息
                End If
        End Select
    Next
    mfrmPS.mclsMainControl.Messages.Clear
End Sub

Private Sub mfrmPS_ListDel()
    Dim lngActivityID As Long
    lngActivityID = mfrmPS.ListID
    If lngActivityID = 0 Then Exit Sub
    If Not GetItemStatus(lngActivityID) Then Exit Sub
    If Not blnChange Then
        cMsgBox "不能删除由他人制作的单据！"
        Exit Sub
    End If
    If Not mclsListMethod.DeleteRow(lngActivityID) Then Exit Sub
    mfrmPS.ToolRefresh
End Sub

Private Sub mfrmPS_ListEdite()
    Dim lngActivityID As Long
    
    lngActivityID = mfrmPS.ListID
    If lngActivityID = 0 Then Exit Sub
    If intFormType = 1 Then
        ShowR_P False, lngActivityID
    Else
        ShowR_P True, lngActivityID
    End If
End Sub

Private Sub mfrmPS_oListInActive()
    Dim lngActivityID As Long

    If mfrmPS.IsInActive Then Exit Sub
    lngActivityID = mfrmPS.ListID
    If lngActivityID = 0 Then Exit Sub
    If Not GetItemStatus(lngActivityID) Then Exit Sub
    If Not blnChange Then
        cMsgBox "不能作废由他人制作的单据！"
        Exit Sub
    End If
    If Not mclsListMethod.ChangeVoid(lngActivityID) Then Exit Sub
    mfrmPS.ToolRefresh
End Sub

Private Sub mfrmPS_ListInActive(blnLevel As Boolean, blnSuceess As Boolean)
    Dim lngActivityID As Long
    blnLevel = True
    blnSuceess = False
    If mfrmPS.IsInActive Then Exit Sub
    lngActivityID = mfrmPS.ListID
    If lngActivityID = 0 Then Exit Sub
    If Not GetItemStatus(lngActivityID) Then Exit Sub
    If Not blnChange Then
        cMsgBox "不能作废由他人制作的单据！"
        Exit Sub
    End If
    If Not mclsListMethod.ChangeVoid(lngActivityID) Then Exit Sub
    mfrmPS.ToolRefresh
    blnSuceess = True
End Sub

Private Sub mfrmPS_ListNew()
    If intFormType = 1 Then
        ShowR_P False
    Else
        ShowR_P True
    End If
End Sub

Private Sub mfrmPS_ListPrintReceipt()
    frmPrintReceipt.ShowfrmPrintReceipt 55 + intFormType
End Sub

Private Sub mfrmPS_ListReorpt(ByVal Index As Integer)
    Select Case Index
        Case 0
            Select Case intFormType
                Case 1
                    If gclsBase.ControlAccount Then
                       Report.ShowSumReport 1306, 572
                    Else
                       Report.ShowSumReport 1702, 1017
                    End If
                Case 2
                    If gclsBase.ControlAccount Then
                       Report.ShowSumReport 1307, 1149
                    Else
                       Report.ShowSumReport 1704, 1019
                    End If
            End Select
    Case 1
        Select Case intFormType
            Case 1
                If gclsBase.ControlAccount Then
                   Report.ShowStandardReport 1412, 634
                Else
                   Report.ShowStandardReport 1701, 1015
                End If
            Case 2
                If gclsBase.ControlAccount Then
                   Report.ShowStandardReport 1411, 635
                Else
                   Report.ShowStandardReport 1703, 1018
                End If
        End Select
     End Select
End Sub

Private Sub mfrmPS_ListShowAll()
    With mfrmPS
        If .chkShowall = 0 Then
            .ShowAll(0) = "not Activity.blnIsVoid=1"
        Else
            .ShowAll(0) = ""
        End If
        .ToolRefresh
    End With
End Sub

Private Sub mfrmPS_ListUserMenu(ByVal Index As Integer)
    If mfrmPS.blnIsReceptionWriteoff Then
        If Index = 4 Then
            Dim lngTypeID As Long
            lngTypeID = frmWriteOffBill.WriteOffBill(Choose(intFormType, 40, 39), mfrmPS.ListID, mfrmPS.hWnd, , , , True)
            If lngTypeID > 0 Then ShowBill1 Choose(intFormType, 40, 39), lngTypeID, True
        End If
    End If
End Sub

Private Function GetItemStatus(lngActivityID As Long) As Boolean
    Dim recTemp As rdoResultset
    Dim strSql As String
    strSql = "SELECT Activity.lngVoucherID, Activity.lngOperatorID From Activity" _
            & " WHERE (Activity.lngActivityID)=" & lngActivityID
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
    If recTemp.BOF And recTemp.EOF Then Exit Function
    If gclsBase.OperatorID = recTemp(1) Then
        blnChange = True
    Else
        blnChange = False
    End If
    GetItemStatus = True
End Function

'告诉列表：编辑窗口已关闭
Public Sub IAmCLosed()
    mIsShowEdit = False
End Sub