frmpz_search.frm

一个用VB写的财务软件源码

    KeyAscii = NegativeDoubleEnabled(txtMoney2, KeyAscii)
End Sub

Private Sub txtPerson_LostFocus()
If Not SqlStringValid(txtPerson.text) Then
    MsgBox e_MSG_SQLVALID, vbInformation
    Call FullSelTextbox(txtPerson)
End If
End Sub

Private Sub txtPzbhFrom_GotFocus()
    txtPzbhFrom.SelStart = 0
    txtPzbhFrom.SelLength = Len(txtPzbhFrom.text)
End Sub

Private Sub txtPzbhFrom_KeyPress(KeyAscii As Integer)
    KeyAscii = IntegerEnabled(KeyAscii)
End Sub

Private Sub txtPzbhFrom_LostFocus()
    If txtPzbhFrom.text <> "" Then
        txtPzbhFrom.text = Format(txtPzbhFrom.text, "0000")
    End If
End Sub

Private Sub txtPzbhTo_GotFocus()
    txtPzbhTo.SelStart = 0
    txtPzbhTo.SelLength = Len(txtPzbhTo.text)
End Sub

Private Sub txtPzbhTo_KeyPress(KeyAscii As Integer)
    KeyAscii = IntegerEnabled(KeyAscii)
End Sub

Private Sub txtPzbhTo_LostFocus()
    If txtPzbhTo.text <> "" Then
        txtPzbhTo.text = Format(txtPzbhTo.text, "0000")
    End If
End Sub





Private Sub cmdCBD_Click()
    With frmUSU_HelpPerson
        .Show 1, Me
        If .Ok Then
            txtCBD.text = .usName
            txtCBD.ToolTipText = .usCode
        End If
    End With
End Sub

Private Sub cmdCountMode_Click()
    With frmUSU_HelpJsfs
        .Show 1, Me
        If .Ok Then
            txtCountMode.ToolTipText = .usCode
            txtCountMode.text = .usName
        End If
    End With
End Sub

Private Sub cmdCustomer_Click()
    With frmUSU_HelpCustomer
        .Show 1, Me
        If .Ok Then
            txtCustomer.text = .usName
            txtCustomer.ToolTipText = .usCode
        End If
    End With
End Sub

Private Sub cmdDepartment_Click()
    With frmUSU_HelpDepartment
        .Show 1, Me
        If .Ok Then
            txtDepartment.text = .usName
            txtDepartment.ToolTipText = .usCode
        End If
    End With
End Sub

Private Sub cmdItem_Click()
    With frmUSU_HelpItem
        .Show 1, Me
        If .Ok Then
            txtItem.text = .usName
            txtItem.ToolTipText = .usCode
        End If
    End With
End Sub

Private Sub cmdMore_Click()
    If cmdMore.Caption = "辅助条件>>" Then
        Me.Height = 7185
        cmdMore.Caption = "辅助条件<<"
        Me.Top = (Screen.Height - Me.Height) \ 2
    Else
        Me.Height = 4050
        cmdMore.Caption = "辅助条件>>"
        Me.Top = (Screen.Height - Me.Height) \ 2
    End If
End Sub

Private Sub cmdOccurDate_Click()
    With mvwOccurDate
        If .Visible Then
            .Visible = False
        Else
            .Top = cmdOccurDate.Top - .Height
            .Left = cmdOccurDate.Left + cmdOccurDate.Width
            .Visible = True
            .SetFocus
        End If
    End With
End Sub

Private Sub cmdPerson_Click()
    With frmUSU_HelpPerson
        .Show 1, Me
        If .Ok Then
            txtPerson.text = .usName
            txtPerson.ToolTipText = .usCode
        End If
    End With
End Sub

Private Sub cmdSubject_Click()
    With frmUSU_KmHelp
    '==============================8.15======================
        .ubSelAll = True
    '=====================================================
        .Show 1, Me
        If .Valid Then
            txtSubject.Tag = .SubjectName
            txtSubject.text = .SubjectCode
        End If
    End With
End Sub

Private Sub cmdSummary_Click()
    With frmIN_Summary
        .ubSelectStatus = True
        .Show 1, Me
        If .Ok Then
            txtSummary.text = .usName
        End If
    End With
End Sub

Private Sub cmdVendor_Click()
    With frmUSU_HelpVendor
        .Show 1, Me
        If .Ok Then
            txtVendor.text = .usName
            txtVendor.ToolTipText = .usCode
        End If
    End With
End Sub

Private Sub txtSummary_Validate(Cancel As Boolean)
    With txtSummary
        If .text <> "" Then
            If Not SqlStringValid(.text) Then
                MsgBox e_MSG_SQLVALID, vbInformation
                Cancel = 1
            End If
        End If
    End With
End Sub

Private Sub txtCustomer_Change()
    txtCustomer.Tag = "1"
End Sub

Private Sub txtCustomer_Validate(Cancel As Boolean)
    If Not CheckValid(txtCustomer, "tZW_Customer" & glo.sOperateYear, "cCusCode", "cCusName", "此客户不存在！") Then
        Cancel = 1
    End If
End Sub

Private Sub txtCBD_Change()
    txtCBD.Tag = "1"
End Sub

Private Sub txtCBD_Validate(Cancel As Boolean)
    If Not CheckValid(txtCBD, "" + GetPersTableName + "", "ZGBH", "ZGXM", "此职工(业务员)不存在！") Then
        Cancel = 1
    End If
End Sub

Private Sub txtCountMode_Change()
    txtCountMode.Tag = "1"
End Sub

Private Sub txtCountMode_Validate(Cancel As Boolean)
    If Not CheckValid(txtCountMode, "tZW_Jsfs" & glo.sOperateYear, "cCode", "cName", "此结算方式不存在！") Then
        Cancel = 1
    End If
End Sub

Private Sub txtDepartment_Change()
    txtDepartment.Tag = "1"
End Sub

Private Sub txtDepartment_Validate(Cancel As Boolean)
    If Not CheckValid(txtDepartment, "tUSU_Department" & glo.sOperateYear, "cDepCode", "cDepName", "此部门不存在！") Then
        Cancel = 1
    End If
End Sub

Private Sub txtItem_Change()
    txtItem.Tag = "1"
End Sub

Private Sub txtItem_Validate(Cancel As Boolean)
    If Not CheckValid(txtItem, "tZW_Item" & glo.sOperateYear, "cCode", "cName", "此项目不存在！") Then
        Cancel = 1
    End If
End Sub

Private Sub txtPerson_Change()
    txtPerson.Tag = "1"
End Sub

Private Sub txtPerson_Validate(Cancel As Boolean)
    If Not CheckValid(txtPerson, "" + GetPersTableName + "", "ZGBH", "ZGXM", "此人员不存在！") Then
        Cancel = 1
    End If
End Sub

Private Sub txtSubject_Change()
    txtSubject.Tag = "1"
End Sub

Private Sub txtSubject_Validate(Cancel As Boolean)
    If Not CheckValid(txtSubject, "tZW_km" & glo.sOperateYear, _
            "kmdm", "kmmc", "此科目不存在！") Then
        Cancel = 1
    End If
End Sub

Private Sub txtVendor_Change()
    txtVendor.Tag = "1"
End Sub

Private Sub txtVendor_LostFocus()
If Not SqlStringValid(txtVendor.text) Then
    MsgBox e_MSG_SQLVALID, vbInformation
    Call FullSelTextbox(txtVendor)
End If
End Sub

Private Sub txtVendor_Validate(Cancel As Boolean)
    If Not CheckValid(txtVendor, "tZW_Vendor" & glo.sOperateYear, "cVenCode", "cVenName", "此供应商不存在！") Then
        Cancel = 1
    End If
End Sub

Private Function CheckValid(TB As TextBox, ByVal sTable As String, _
        ByVal s1 As String, ByVal s2 As String, ByVal sMsg As String, _
        Optional ByVal s3 As String, Optional sQuery As String = "x") As Boolean
    Dim sCode As String, sName As String
    
    With TB
        If Trim(.text) = "" Then
            CheckValid = True
            .Tag = ""
        ElseIf .Tag = "1" Then
            If Not SqlStringValid(.text) Then
                MsgBox e_MSG_SQLVALID, vbInformation
                Call FullSelTextbox(TB)
                CheckValid = False
            ElseIf IsRecordExist(.text, sTable, s1, s2, sCode, sName) Then
                .ToolTipText = sCode
                .text = sName
                .Tag = ""
                CheckValid = True
                '==================================8.16====yao  kmdm模糊查询 =======================
'                If sQuery = "" Then
'                     sQuery = "RTRIM(" & s3 & ") ='" & Trim(sCode) & "'"
'                End If
                If sQuery = "" Then
                    If s3 = "kmdm" Then
                        sQuery = "RTRIM(A." & s3 & ")  like '" & Trim(sCode) & "%'"
                    Else
                        sQuery = "RTRIM(A." & s3 & ") ='" & Trim(sCode) & "'"
                    End If
                End If
                '============================================================================
            Else
                MsgBox sMsg, vbInformation
                Call FullSelTextbox(TB)
                CheckValid = False
            End If
        Else
            If sQuery = "" Then
                If s3 = "kmdm" Then
                   sQuery = "A." & s3 & " like  '" & Trim(.ToolTipText) & "%'"
                Else
                   sQuery = "RTRIM(A." & s3 & ")='" & Trim(.ToolTipText) & "'"
                End If
            End If
            CheckValid = True
        End If
    End With
        
End Function

Private Function CheckValid2(TB As TextBox, ByVal sTable As String, _
        ByVal s1 As String, ByVal s2 As String, ByVal sMsg As String, _
        Optional ByVal s3 As String, Optional ByVal s4 As String, _
        Optional sQuery As String = "x") As Boolean
    Dim sCode As String, sName As String
    
    With TB
        If .text = "" Then
            CheckValid2 = True
            .Tag = ""
        ElseIf .Tag = "1" Then
            If Not SqlStringValid(.text) Then
                MsgBox e_MSG_SQLVALID, vbInformation
                Call FullSelTextbox(TB)
                CheckValid2 = False
            ElseIf IsRecordExist(.text, sTable, s1, s2, sCode, sName) Then
                .ToolTipText = sCode
                .text = sName
                .Tag = ""
                CheckValid2 = True
                If sQuery = "" Then
                    sQuery = "(RTRIM(A." & s3 & ")='" & Trim(sCode) & _
                        "' OR  RTRIM(A." & s4 & ")='" & Trim(sCode) & "')"
                End If
            Else
                MsgBox sMsg, vbInformation
                Call FullSelTextbox(TB)
                CheckValid2 = False
            End If
        ElseIf sQuery = "" Then
            sQuery = "(RTRIM(A." & s3 & ")='" & Trim(.ToolTipText) & _
                "' OR RTRIM(A." & s4 & ")='" & Trim(.ToolTipText) & "')"
            CheckValid2 = True
        End If
    End With
        
End Function

'判断输入的代码、名称、助记码是否符合于数据库中的某条记录
'适用于企事业单位、医院的判断
' sField1cl: 指字段1，"cl" 意为既是匹配条件(condition)又是查询的字段列表(list)
Private Function IsRecordExist(ByVal sText As String, ByVal sTable As String, _
        ByVal sField1cl As String, ByVal sField2cl As String, _
        ByRef sValue1 As String, ByRef sValue2 As String, _
        Optional vField3c As Variant, _
        Optional vField3l As Variant, _
        Optional vValue3 As Variant) As Boolean
    Dim rSt As ADODB.Recordset
    Dim sSQL As String
    
    Set rSt = New ADODB.Recordset
    With rSt
        .CursorLocation = adUseClient
        sSQL = "SELECT " & sField1cl & "," & sField2cl
        If Not IsMissing(vField3l) Then
            sSQL = sSQL & "," & vField3l
        End If
        sSQL = sSQL & " FROM " & sTable & " WHERE " & _
            sField1cl & "='" & sText & "' OR " & sField2cl & "='" & sText & "'"
        If Not IsMissing(vField3c) Then
            sSQL = sSQL & " OR " & vField3c & "='" & sText & "'"
        End If
        .Open sSQL, glo.cnnMain, adOpenStatic, adLockReadOnly
        If .EOF Then
            IsRecordExist = False
        Else
            sValue1 = .Fields(sField1cl).value
            sValue2 = .Fields(sField2cl).value
            If (Not IsMissing(vField3l)) And (Not IsMissing(vValue3)) Then
                vValue3 = .Fields(vField3l).value
            End If
            IsRecordExist = True
        End If
        .Close
    End With
    
End Function