frmlendticket.frm

金算盘软件代码

      Tag             =   "1009"
      Top             =   900
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
End
Attribute VB_Name = "frmLendTicket"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'支票领用、报销
'苏梦
'1999-09-11
Option Explicit
Private m_lngID As Long
Private m_blnFirstIN As Boolean
Private m_blnCheck As Boolean
Private m_blnFromVoucher As Boolean
Private m_lngAccountID As Long
Private m_lngCurrencyID As Long
Private m_lngPaymentMethodID As Long
Private m_strTicketNO As String

Public Function NewCard() As Long
    m_lngID = 0
    m_blnCheck = False
    m_blnFromVoucher = False
    On Error Resume Next
    Me.Show vbModal
    NewCard = m_lngID
End Function

Public Function EditACard(ByVal lngID As Long) As Boolean
    If lngID <= 0 Then
        Exit Function
    End If
    m_lngID = lngID
    m_blnCheck = False
    m_blnFromVoucher = False
    On Error Resume Next
    Me.Show vbModal
End Function

Public Function CheckACard(ByVal lngID As Long) As Boolean
    On Error Resume Next
    If lngID <= 0 Then
        Exit Function
    End If
    m_blnCheck = True
    m_blnFromVoucher = False
    m_lngID = lngID
    Me.Show vbModal
End Function

Public Function NewCardFromVoucher(ByVal lngAccountID As Long, ByVal lngCurrencyID As Long, _
    ByVal lngPaymentMethodID As Long, ByVal strTicketNO As String) As Long
    m_lngID = 0
    m_lngAccountID = lngAccountID
    m_lngCurrencyID = lngCurrencyID
    m_lngPaymentMethodID = lngPaymentMethodID
    m_strTicketNO = strTicketNO
    m_blnCheck = False
    m_blnFromVoucher = True
    On Error Resume Next
    Me.Show vbModal
    NewCardFromVoucher = m_lngID
End Function

Private Sub cmdOK_Click(Index As Integer)
    Select Case Index
    Case 0
        If SaveCard() Then
            Unload Me
        End If
    Case 1
        Unload Me
    Case 2
        If SaveCard() Then
            ClearCard
        End If
        If chkVoid.Visible Then
            chkVoid.Enabled = False
        End If
    Case 3
        If gclsBase.ExecSQL("UPDATE CheckDetail SET blnIsUsed=0,strUseDate=' ',dblCurrAmount=0 WHERE lngActivityDetailID=" & m_lngID) = True Then
            gclsSys.SendMessage 0, msgRCheckUser
            Unload Me
        Else
            IMsgBox "取消报销失败！", "取消报销"
        End If
    End Select
End Sub

Private Sub curInput_Validate(Index As Integer, Cancel As Boolean)
    If C2Dbl(curInput(Index).Text) < 0 Then
        curInput(Index).Text = Mid(curInput(Index).Text, 2)
        If Index = 0 Then
            IMsgBox "预计金额不能小于0！", "错误信息"
        Else
            IMsgBox "报销金额不能小于0！", "错误信息"
        End If
        Cancel = True
        Exit Sub
    End If
    If Abs(C2Dbl(curInput(Index).Text)) >= (10 ^ 12) Then
        curInput(Index).Text = IIf(C2Dbl(curInput(Index).Text) > 0, "", "-") & "999999999999"
    End If
End Sub

Private Sub Form_Activate()
    On Error Resume Next
    If Me.HelpContextID <> 0 Then
        SetHelpID Me.HelpContextID
    End If
    
    If m_blnFirstIN Then
        m_blnFirstIN = False
        If m_blnCheck = False Then
            Me.HelpContextID = 600008
            lstInput(0).SetFocus
        Else
            Me.HelpContextID = 600011
            dtmInput(1).SetFocus
        End If
    End If
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        'SendKeys "{TAB}"
        BKKEY Me.ActiveControl.hwnd, vbKeyTab
    End If
End Sub

Private Sub Form_Load()
    Me.HelpContextID = 600008
    Me.MousePointer = vbHourglass
    Utility.LoadFormResPicture Me
    
    GetList
    If m_blnCheck = False Then
        lblItem(10).Visible = False
        dtmInput(1).Visible = False
        lblItem(11).Visible = False
        curInput(1).Visible = False
        Frame1.Height = Frame1.Height - lblItem(10).top + lblItem(8).top
        Me.Height = Me.Height - lblItem(10).top + lblItem(8).top
        cmdOK(3).Visible = False
        If m_blnFromVoucher = True Then
            ClearCard
            lstInput(0).SeekId m_lngAccountID
            lstInput(1).SeekId m_lngCurrencyID
            lstInput(4).SeekId m_lngPaymentMethodID
            txtInput(0).Text = m_strTicketNO
            lstInput(0).Enabled = False
            lstInput(1).Enabled = False
            lstInput(4).Enabled = False
            txtInput(0).Enabled = False
            Me.Caption = "票据登记"
            cmdOK(2).Visible = False
        End If
        chkVoid.Visible = True
        If m_lngID <> 0 Then
            chkVoid.Enabled = True
        Else
            chkVoid.Enabled = False
        End If
    Else
        Me.Caption = "票据报销"
        lstInput(0).Enabled = False
        lstInput(1).Enabled = False
        lstInput(2).Enabled = False
        lstInput(3).Enabled = False
        lstInput(4).Enabled = False
        lstInput(5).Enabled = False
        dtmInput(0).Enabled = False
        txtInput(0).Enabled = False
        txtInput(1).Enabled = False
        curInput(0).Enabled = False
        cmdOK(2).Visible = False
        cmdOK(3).top = cmdOK(2).top
    End If
    chkVoid.top = Frame1.top + Frame1.Height - chkVoid.Height - 2 * Screen.TwipsPerPixelY
    m_blnFirstIN = True
    If m_lngID = 0 Then
        If m_blnFromVoucher = False Then
            ClearCard
        End If
    Else
        If ShowOldCard = False Then
            Exit Sub
        End If
        cmdOK(2).Visible = False
    End If
    Me.MousePointer = vbDefault
End Sub
Private Sub GetList(Optional ByVal lngIndex As Long = -1)
    If m_blnCheck = True Then
        Exit Sub
    End If
    '科目
    If lngIndex = 0 Or lngIndex = -1 Then
        With lstInput(0)
            .Tag = Message.msgAccount
            .SeekCol = "1,2,3"
            Set .Recordset = Utility.GetListRecordSet(lrtAccount)
            '.SeekCol = "1,2,3"
            .AddRefer "<新增>"
            .AddRefer "<修改>"
            .AddRefer "<删除>"
        End With
    End If
    '币种
    If lngIndex = 1 Or lngIndex = -1 Then
        With lstInput(1)
            .Tag = Message.msgcurrency
            .SeekCol = "1,2,3"
            Set .Recordset = GetCurrencyRec()
            '.SeekCol = "1,2,3"
            .AddRefer "<新增>"
            .AddRefer "<修改>"
            .AddRefer "<删除>"
        End With
    End If
    '部门
    If lngIndex = 2 Or lngIndex = -1 Then
        With lstInput(2)
            .Tag = Message.msgDepartment
            .SeekCol = "1,3"
            Set .Recordset = Utility.GetListRecordSet(lrtDepartment)
            .ColWidth(2) = 0
            '.SeekCol = "1,2,3"
        End With
    End If
    '领用人
    If lngIndex = 3 Or lngIndex = -1 Then
        With lstInput(3)
            .SeekCol = "1,2"
            Set .Recordset = GetPersonRec(True)
            '.SeekCol = "1,2"
        End With
    End If
    '类型
    If lngIndex = 4 Or lngIndex = -1 Then
        With lstInput(4)
            .Tag = Message.msgPaymentMethod
            .SeekCol = "1,2,3"
            Set .Recordset = GetPaymentMethodRec()
            '.SeekCol = "1,2,3"
            .AddRefer "<新增>"
            .AddRefer "<修改>"
            .AddRefer "<删除>"
        End With
    End If
    '签发人
    If lngIndex = 5 Or lngIndex = -1 Then
        With lstInput(5)
            .SeekCol = "1,2"
            Set .Recordset = GetPersonRec(False)
            '.SeekCol = "1,2"
        End With
    End If
End Sub
Private Function GetPersonRec(ByVal blnEmployee As Boolean) As rdoResultset
    Dim strSql As String
    
    If blnEmployee Then
        strSql = "SELECT lngEmployeeID,strEmployeeName FROM Employee WHERE blnIsInActive = 0"
    Else
        strSql = "SELECT lngOperatorID,strOperatorName FROM Operator WHERE blnIsInActive = 0"
    End If
    Set GetPersonRec = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
End Function
Private Function GetCurrencyRec() As rdoResultset
    Dim strSql As String

    strSql = "SELECT lngCurrencyID,strCurrencyCode,strCurrencyName FROM Currencys WHERE blnIsInActive = 0"
    Set GetCurrencyRec = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
End Function
Private Function GetPaymentMethodRec() As rdoResultset
    Dim strSql As String

    strSql = "SELECT lngPaymentMethodID, strPaymentMethodCode, strPaymentMethodName " & _
        " FROM PaymentMethod WHERE blnIsInActive = 0 And blnIsCheck <> 0 "
    Set GetPaymentMethodRec = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
End Function

Private Sub ClearCard()
    '清空内容
    dtmInput(0).Text = Format(gclsBase.BaseDate, "YYYY-MM-DD")
    lstInput(1).SeekId gclsBase.NaturalCurId
    curInput(0).Digits = gclsBase.NaturalCurDec
    curInput(1).Digits = gclsBase.NaturalCurDec
    curInput(0).MaxLength = curInput(0).Digits + 13
    curInput(1).MaxLength = curInput(1).Digits + 13
    lstInput(2).Text = ""
    lstInput(3).Text = ""
    lstInput(5).SeekId gclsBase.OperatorID
    txtInput(0).Text = ""
    txtInput(1).Text = ""
    curInput(0).Text = ""
    curInput(1).Text = ""
    chkVoid.Value = 0
    m_lngID = 0
    On Error Resume Next
    lstInput(0).SetFocus
End Sub
Private Function ShowOldCard() As Boolean
    Dim strSql As String
    Dim recTmp As rdoResultset
    
    If m_blnCheck = False Then
        strSql = "SELECT CheckDetail.*,Currencys.bytCurrencyDec FROM CheckDetail,Currencys " & _
            " WHERE CheckDetail.lngCurrencyID=Currencys.lngCurrencyID " & _
            " AND ROWNUM<=1 AND lngActivityDetailID=" & m_lngID
        Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
        With recTmp
            If .BOF And .EOF Then
                ClearCard
            Else
                curInput(0).Digits = !bytCurrencydec
                curInput(0).MaxLength = curInput(0).Digits + 13
                lstInput(0).SeekId !lngAccountID
                lstInput(1).SeekId !lngCurrencyID
                lstInput(2).Text = Trim(!strOutDepartment)
                lstInput(4).SeekId !lngPaymentMethodID
                txtInput(0).Text = Trim(!strCheckNo)
                dtmInput(0).Text = Trim(!strOutdate)
                lstInput(3).Text = Trim(!strOutMan)
                txtInput(1).Text = Trim(!strRemark)
                If !bytCurrencydec <= 0 Then
                    curInput(0).Text = Format(!dblCurrBugetAmount, "0")
                Else
                    curInput(0).Text = Format(!dblCurrBugetAmount, "0." & String(!bytCurrencydec, "0"))
                End If
                lstInput(5).Text = !strSigner
                If !blnIsUsed <> 0 Then
                    Frame1.Enabled = False
                    chkVoid.Enabled = False
                End If
'                !strUseDate
'                !dblCurrAmount
                chkVoid.Value = !blnIsInActive
            End If
        End With
    Else
        strSql = "SELECT CheckDetail.* , Account.strAccountCode||' '||Account.strAccountName AS strAccount," & _
            " Currencys.strCurrencyCode||' '||Currencys.strCurrencyName AS strCurrency,Currencys.bytCurrencyDec," & _
            " PaymentMethod.strPaymentMethodCode||' '||PaymentMethod.strPaymentMethodName AS strPaymentMethod " & _
            " FROM CheckDetail,Account,Currencys,PaymentMethod " & _
            " WHERE CheckDetail.lngAccountID = Account.lngAccountID " & _
            " AND CheckDetail.lngCurrencyID = Currencys.lngCurrencyID " & _
            " AND CheckDetail.lngPaymentMethodID = PaymentMethod.lngPaymentMethodID " & _
            " AND CheckDetail.lngActivityDetailID=" & m_lngID
        Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
        With recTmp
            If .BOF And .EOF Then
                .Close
                Set recTmp = Nothing
                Unload Me
                Exit Function
            Else
                If !blnIsInActive <> 0 Then
                    .Close
                    Set recTmp = Nothing
                    Unload Me
                    Exit Function
                End If
                curInput(0).Digits = !bytCurrencydec
                curInput(0).MaxLength = curInput(0).Digits + 13
                curInput(1).Digits = !bytCurrencydec
                curInput(1).MaxLength = curInput(1).Digits + 13
                'lstInput(0).SeekId !lngAccountID
                'lstInput(1).SeekId !lngCurrencyID
                'lstInput(4).SeekId !lngPaymentMethodID
                lstInput(0).Text = !strAccount
                lstInput(1).Text = !strCurrency
                lstInput(4).Text = !strPaymentMethod
                
                lstInput(2).Text = !strOutDepartment
                txtInput(0).Text = !strCheckNo
                dtmInput(0).Text = !strOutdate
                lstInput(3).Text = !strOutMan
                txtInput(1).Text = !strRemark
                If !bytCurrencydec <= 0 Then
                    curInput(0).Text = Format(!dblCurrBugetAmount, "0")
                    curInput(1).Text = Format(!dblCurrAmount, "0")
                Else
                    curInput(0).Text = Format(!dblCurrBugetAmount, "0." & String(!bytCurrencydec, "0"))
                    curInput(1).Text = Format(!dblCurrAmount, "0." & String(!bytCurrencydec, "0"))
                End If
                lstInput(5).Text = !strSigner
                If !blnIsUsed = 0 Then
                    dtmInput(1).Text = Format(gclsBase.BaseDate, "YYYY-MM-DD")
                    cmdOK(3).Enabled = False
                Else
                    dtmInput(1).Text = !strUseDate
                    cmdOK(3).Enabled = True
                End If