frmwriteoffbill.frm

金算盘软件代码

    End Select
End Sub

Private Sub CmdCancel_Click()
    my_lngActivityID = 0
    Unload Me
End Sub

Private Sub cmdOK_Click()
    Dim i As Integer
    Dim strSql As String
    Dim recTmp As rdoResultset
    Dim lngTmp() As Long
        
    If mblnStart = False Then
        For i = 0 To 2
            If cmbSelect(i).Visible Then
                If cmbSelect(i).ListIndex < 0 Then
                    ShowMsg Me.hWnd, "请选择" & Left(LblName(i).Caption, 4) & "！", MB_OK + MB_SYSTEMMODAL + MB_ICONEXCLAMATION, Me.Caption
                    If cmbSelect(i).ListCount > 0 Then
                        cmbSelect(i).ListIndex = 0
                    End If
                    cmbSelect(i).SetFocus
                    Erase lngTmp
                    Exit Sub
                End If
            End If
        Next
    End If
    If lstNO.ID = 0 Then
        ShowMsg Me.hWnd, "请选择" & Left(LblName(3).Caption, 4) & "！", MB_OK + MB_SYSTEMMODAL + MB_ICONEXCLAMATION, Me.Caption
        On Error Resume Next
        lstNO.SetFocus
        Erase lngTmp
        Exit Sub
    End If
    If mblnSeek = False Then
        '权限判断
        If cmbSelect(2).Visible Then
            Select Case my_lngReceiptTypeID
            Case 41
            Case 34 To 37
                If cmbSelect(2).ListCount > 0 Then
                    If cmbSelect(2).ListIndex >= 0 Then
                        If Not IsCanDo(EditNO(cmbSelect(2).ItemData(cmbSelect(2).ListIndex))) Then
                            ShowMsg Me.hWnd, "您没有冲销" & cmbSelect(2).Text & "单据的权限！", MB_OK + MB_SYSTEMMODAL + MB_ICONEXCLAMATION, Me.Caption
                            Erase lngTmp
                            Exit Sub
                        End If
                    End If
                End If
            End Select
        End If
        If my_lngReceiptTypeID = 41 Then
            strSql = "SELECT lngPostID FROM Voucher WHERE lngVoucherID=" & lstNO.ID
            Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
            If recTmp.BOF And recTmp.EOF Then
            Else
                If recTmp!lngPostID = 0 Then
                    recTmp.Close
                    Set recTmp = Nothing
                    ShowMsg Me.hWnd, "未记帐凭证不能冲销！", MB_OK + MB_SYSTEMMODAL + MB_ICONEXCLAMATION, Me.Caption
                    Erase lngTmp
                    Exit Sub
                End If
            End If
            recTmp.Close
            Set recTmp = Nothing
        End If
        If blnWriteOff(Me.hWnd, my_lngReceiptTypeID, lstNO.ID, "冲销", lngTmp) Then
            Erase lngTmp
            Exit Sub
        End If
    End If
    my_lngActivityID = lstNO.ID
    blnSucceed = True
    Erase lngTmp
    Unload Me
End Sub

Private Sub Form_Activate()
    If Me.HelpContextID <> 0 Then
        SetHelpID Me.HelpContextID
    End If
    lstNO.SetFocus
End Sub

Private Sub Form_Load()
    Utility.LoadFormResPicture Me
    If mblnSeek Then
        mblnView = IsCanDo(EditNO(my_lngReceiptTypeID, False))
    Else
        mblnView = True
    End If
    Select Case my_lngReceiptTypeID
    Case 42 To 47, 52, 99
        mblnStart = True
    Case Else
        mblnStart = False
    End Select
    
'    Me.Icon = Utility.GetFormResPicture(139, vbResIcon) '窗体图标
'    cmdOK.Picture = Utility.GetFormResPicture(1001, vbResBitmap)     '确定
'    cmdCancel.Picture = Utility.GetFormResPicture(1002, vbResBitmap)     '取消
'    SetHelpID ?????

    Dim strSql As String
    Dim recTmp As rdoResultset
    
    If mblnStart Then
'        cmbSelect(0).Text = ""
'        cmbSelect(1).Text = ""
        cmbSelect(0).Enabled = False
        cmbSelect(1).Enabled = False
    Else
        strSql = "SELECT intYear FROM AccountYear ORDER BY intYear"
        Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        If recTmp.BOF And recTmp.EOF Then
        Else
            Do While Not recTmp.EOF
                cmbSelect(0).AddItem recTmp!intYear
                recTmp.MoveNext
            Loop
        End If
        recTmp.Close
        Set recTmp = Nothing
    End If
    SetForm
EndProc:
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    If Not blnSucceed Then
        my_lngActivityID = 0
    End If
    Utility.UnLoadFormResPicture Me
'    Utility.RemoveFormResPicture 139
'    Utility.RemoveFormResPicture 1001
'    Utility.RemoveFormResPicture 1002
End Sub

Public Sub SetForm()
    Dim bytShowItems As Byte     '显示项目数
    Dim strSql As String
    Dim recTmp As rdoResultset
    Dim lngReceiptTypeID As Long
    Dim lngActivityID As Long
    Dim lngVoucherTypeID As Long
    Dim intYear As Integer
    Dim bytPeriod As Byte
    
    If (my_lngReceiptTypeID = 34 Or my_lngReceiptTypeID = 36) And my_lngActivityID <> 0 Then
        '应收应付特殊处理
        strSql = "SELECT lngReceiptTypeID FROM Activity WHERE lngActivityID=" & my_lngActivityID
        Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
        If recTmp.BOF And recTmp.EOF Then
        Else
            my_lngReceiptTypeID = recTmp!lngReceiptTypeID
        End If
        recTmp.Close
        Set recTmp = Nothing
    End If
    lngReceiptTypeID = my_lngReceiptTypeID
    lngActivityID = my_lngActivityID
    lngVoucherTypeID = my_lngVoucherTypeID
    intYear = my_intYear
    bytPeriod = my_bytPeriod
    
    bytShowItems = 4
    Me.Caption = mstrUse & "单据"
    LblName(2).Caption = "单据类型(&T)"
    Select Case lngReceiptTypeID
'    Case 1, 10, 12, 23, 26, 27, 28, 29, 30, 31, 32, 33
    Case 41
        Me.Caption = mstrUse & "凭证"
        LblName(2).Caption = "凭证类型(&T)"
        LblName(3).Caption = "凭证编号(&C)"
        mstrName = "凭证"
        If my_lngVoucherTypeID = 0 Then
            If my_lngActivityID <> 0 Then
                strSql = "SELECT lngVoucherTypeID FROM Voucher WHERE lngVoucherID=" & my_lngActivityID
                Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
                If recTmp.BOF And recTmp.EOF Then
                Else
                    my_lngVoucherTypeID = recTmp!lngVoucherTypeID
                End If
                recTmp.Close
                Set recTmp = Nothing
            End If
        End If
        strSql = "SELECT strVoucherTypeName,lngVoucherTypeID FROM VoucherType  Order BY strVoucherTypeCode" 'WHERE blnIsInActive=False
        Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        If Not (recTmp.BOF And recTmp.EOF) Then
            Do While Not recTmp.EOF
                cmbSelect(2).AddItem recTmp!strVoucherTypeName
                cmbSelect(2).ItemData(cmbSelect(2).NewIndex) = recTmp!lngVoucherTypeID
                If my_lngVoucherTypeID = recTmp!lngVoucherTypeID Then
                    cmbSelect(2).ListIndex = cmbSelect(2).NewIndex
                End If
                recTmp.MoveNext
            Loop
        End If
        If cmbSelect(2).ListIndex < 0 And cmbSelect(2).ListCount > 0 Then
            cmbSelect(2).ListIndex = 0
        End If
        recTmp.Close
        Set recTmp = Nothing
    Case 34, 35
        mstrName = "应付单"
        my_lngVoucherTypeID = lngReceiptTypeID
        strSql = "SELECT strReceiptTypeName,lngReceiptTypeID FROM ReceiptType WHERE lngReceiptTypeID=34 OR lngReceiptTypeID=35 ORDER BY lngReceiptTypeID"
        Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        cmbSelect(2).AddItem recTmp!strReceiptTypeName
        cmbSelect(2).ItemData(cmbSelect(2).NewIndex) = recTmp!lngReceiptTypeID
        If my_lngReceiptTypeID = recTmp!lngReceiptTypeID Then
            cmbSelect(2).ListIndex = 0
        End If
        recTmp.MoveNext
        cmbSelect(2).AddItem recTmp!strReceiptTypeName
        cmbSelect(2).ItemData(cmbSelect(2).NewIndex) = recTmp!lngReceiptTypeID
        If my_lngReceiptTypeID = recTmp!lngReceiptTypeID Then
            cmbSelect(2).ListIndex = 1
        End If
        recTmp.Close
        Set recTmp = Nothing
    Case 36, 37, 38
        mstrName = "应收单"
        strSql = "SELECT strReceiptTypeName,lngReceiptTypeID FROM ReceiptType WHERE lngReceiptTypeID IN (36,37,38) ORDER BY lngReceiptTypeID"
        Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        Do While Not recTmp.EOF
            cmbSelect(2).AddItem recTmp!strReceiptTypeName
            cmbSelect(2).ItemData(cmbSelect(2).NewIndex) = recTmp!lngReceiptTypeID
            If my_lngReceiptTypeID = recTmp!lngReceiptTypeID Then
                cmbSelect(2).ListIndex = cmbSelect(2).ListCount - 1
            End If
            recTmp.MoveNext
        Loop
'        cmbSelect(2).AddItem recTmp!strReceiptTypeName
'        cmbSelect(2).ItemData(cmbSelect(2).NewIndex) = recTmp!lngReceiptTypeID
'        If my_lngReceiptTypeID = recTmp!lngReceiptTypeID Then
'            cmbSelect(2).ListIndex = 1
'        End If
        recTmp.Close
        Set recTmp = Nothing
    Case 99
        bytShowItems = 3
        mstrName = "通用转帐单据"
        LblName(3).Caption = "转帐名称(&C)"
    Case 39
        bytShowItems = 3
        If my_blnIsSpecial Then
            mstrName = "采购付款单据"
        Else
            mstrName = "其他付款单据"
        End If
    Case 40
        bytShowItems = 3
        If my_blnIsSpecial Then
            mstrName = "销售收款单据"
        Else
            mstrName = "其他收款单据"
        End If
    Case Else
        bytShowItems = 3
        strSql = "SELECT strReceiptTypeName FROM ReceiptType WHERE lngReceiptTypeID=" & lngReceiptTypeID
        Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
        mstrName = recTmp!strReceiptTypeName & "单据"
        #If conVersionType = 16 Then '财务版