⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmquery.frm

📁 地方税务局税控开票系统
💻 FRM
📖 第 1 页 / 共 2 页
字号:
         Caption         =   "开票时间:"
         Height          =   255
         Left            =   180
         TabIndex        =   19
         Top             =   780
         Width           =   945
      End
   End
End
Attribute VB_Name = "frmQuery"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False




Private Sub cboChequeStatus_Change()
    txtQuery(4).Text = cboChequeStatus.Text
End Sub

Private Sub cboChequeStatus_Click()
    txtQuery(4).Text = cboChequeStatus.Text
End Sub

Private Sub cboQuery_Click(Index As Integer)
    If Index = 5 Then
        If cboQuery(5).Text = "等于" Or cboQuery(5).Text = "包含" Then
            txtQuery(9).Enabled = False
            txtQuery(9).BackColor = &H80000004
        Else
            txtQuery(9).Enabled = True
            txtQuery(9).BackColor = &H80000005
        End If
    End If
End Sub

Private Sub cboYesNo_LostFocus()
    txtQuery(2).Text = cboYesNo.Text
End Sub

Private Sub chkQueryRange_Click()
    If chkQueryRange.Value = 1 Then
        gsQueryRange = "b"            '''在本项目中查询
    Else
        gsQueryRange = "a"             '''全部查询
    End If
End Sub

Private Sub cmdExit_Click()
    gsChequeQuery = ""
    Unload Me
End Sub

'检查是有符号(')的录入
Private Function bCheckCharacter() As Boolean
    Dim oText As Object
   
    bCheckCharacter = False
    
   
    For Each oText In txtQuery
        If Len(oText.Text) > 0 Then
            If InStr(oText.Text, "'") > 0 Then
                oText.SetFocus
                Exit Function
            End If
        End If
    Next
    
    
    bCheckCharacter = True
End Function

Private Sub cmdOK_Click()
On Error GoTo Err
    Dim sFieldName  As String
    Dim i As Integer
    Dim sCondition As String
    Dim iNum As Integer
    
    If bCheckCharacter = False Then
        MsgBox "符号(')是本系统的特殊符号,请您选择别的符号代替它!", vbOKOnly + vbInformation, "提示信息"
        Exit Sub
    End If
    
    If optType(0).Value = True Then
    
        If bCheckChequeDate = False Then Exit Sub        '''检查是否是日期
        gsChequeQuery = sGetDateWhere                    '''获取时间条件
        
        For i = 1 To 6
            
            If i = 0 Then sFieldName = "chequedate"
            If i = 1 Then sFieldName = "clientname"
            If i = 2 Then sFieldName = "opencheque"
            If i = 3 Then sFieldName = sGetTable + ".projectname"
            If i = 4 Then sFieldName = "chequestatus"
            If i = 5 Then sFieldName = sGetTable + ".chequecode"
            If i = 6 Then sFieldName = "balanceitem"
            
            If Trim(txtQuery(i).Text) <> "" Then
                sCondition = sGetCondition(cboQuery(i).Text)
                
                If sCondition = "like" Then
                    sCondition = sCondition + " '%" + txtQuery(i).Text + "%'"
                Else
                    If i = 2 And Trim(txtQuery(2).Text) = "全部" Then
                        sCondition = " <>''"
                    Else
                        sCondition = sCondition + " '" + txtQuery(i).Text + "'"
                        If i = 5 And cboQuery(5).Text = "大于等于" And Trim(txtQuery(9).Text) <> "" Then
                            sCondition = sCondition + " and " + sFieldName + " <= '" + Trim(txtQuery(9).Text) + "'"
                        End If
                    End If
                End If
                  
                If gsChequeQuery = "" Then
                    gsChequeQuery = sFieldName + " " + sCondition
                Else
                    gsChequeQuery = gsChequeQuery + " and " + sFieldName + " " + sCondition
                End If
                
                If i = 5 And cboQuery(5).Text = "等于" Then                               '''如果查询的是发票号码,别的条件不起作用
                    gsChequeQuery = sFieldName + " " + sCondition
                End If
            End If
        Next
    Else
        If Trim(cboQuery(i).Text) <> "" Then
            sCondition = sGetCondition(cboQuery(7).Text)
                    
            If sCondition = "like" Then
                sCondition = sCondition + " '%" + txtQuery(8).Text + "%'"
            Else
                sCondition = sCondition + " '" + txtQuery(8).Text + "'"
            End If
            
            gsQueryRange = "i"                                        '''表示为查询项目
            gsChequeQuery = sCondition
        End If
    End If
    
    
    If gsChequeQuery = "" Then
        iNum = MsgBox("您还没有输入查询条件,是否要退出?", vbYesNo + vbInformation, "提示信息")
        If iNum = 7 Then Exit Sub
    Else
        GetDetailWhere                                                                '''获取结算项目的条件
        gsChequeQuery = Mid(gsChequeQuery, 1, Len(gsChequeQuery) - 1)                 '''获取查询条件,把最后的"'"去掉
    End If
    
    If chkQueryTemp.Value = 1 And optType(1).Value = 0 Then                                                   '''查询删除发票
        gsTemp = "_temp"
    Else
        gsTemp = ""
    End If
    
    Unload Me
    Exit Sub
Err:

    MsgBox "获取查询条件失败!", vbOKOnly + vbInformation, "提示信息"
End Sub

'获取结算项目的条件
Private Sub GetDetailWhere()
    Dim sValue As String
    Dim iLen As Integer
    Dim sTable As String
    
    If gsChequeType = "B" Then
        sTable = gsconTabel + "builddetail"
    ElseIf gsChequeType = "E" Then
        sTable = gsconTabel + "estatedetail"
    Else
        sTable = gsconTabel + "commondetail"
    End If
    
    If chkQueryTemp.Value = 1 Then
        sTable = sTable + "_temp"
    End If
    
    iLen = InStr(1, gsChequeQuery, "balanceitem")
    If iLen > 0 Then
        sValue = Mid(gsChequeQuery, iLen)
        
        gsQueryDetail = " and chequecode in (select chequecode from " + sTable + " where " + sValue + ")"
    Else
        gsQueryDetail = ""
    End If
End Sub

'获取表名
Private Function sGetTable() As String
    Dim sTable As String
    
    If gsChequeType = "B" Then
        sTable = gsconTabel + "buildchequeinfo"
    ElseIf gsChequeType = "E" Then
        sTable = gsconTabel + "estatechequeinfo"
    Else
        sTable = gsconTabel + "commonchequeinfo"
    End If
    
    If chkQueryTemp.Value = 1 Then
        sTable = sTable + "_temp"
    End If
    
    sGetTable = sTable
End Function



Private Sub Form_Load()
    Dim i As Integer
    
    gsChequeQuery = ""
    gsQueryRange = "b"
    
    cboQuery(0).Text = "大于等于"
    cboQuery(0).Enabled = False
    For i = 1 To 7
        cboQuery(i).Text = "等于"
    Next
    
    optType(1).Caption = "查询顾客信息"
    Label8.Caption = "顾客名称"
    Frame2.Enabled = False
End Sub

'获取时间条件
Private Function sGetDateWhere() As String
    Dim sWhere As String
    
    If Trim(txtQuery(0).Text) <> "" Then
        sWhere = "chequedate >= '" + Trim(txtQuery(0).Text) + "'"
    End If
    
    If Trim(txtQuery(7).Text) <> "" Then
        sWhere = sWhere + " and chequedate <= '" + Trim(txtQuery(7).Text) + "'"
    End If
    
    sGetDateWhere = sWhere
End Function

'检查是否是日期
Private Function bCheckChequeDate() As Boolean

    bCheckChequeDate = False
    If bCheckDate(Trim(txtQuery(0).Text)) = False Then
        MsgBox "请输入正确的起始日期格式,如2002-07-31!", vbOKOnly + vbInformation, "提示信息"
        txtQuery(0).SetFocus
        Exit Function
    End If
    
    If bCheckDate(Trim(txtQuery(7).Text)) = False Then
        MsgBox "请输入正确的终止日期格式,如2002-07-31!", vbOKOnly + vbInformation, "提示信息"
        txtQuery(7).SetFocus
        Exit Function
    End If
    
    If Trim(txtQuery(7)) <> "" And Trim(txtQuery(0)) = "" Then
        MsgBox "请输入起始日期!", vbOKOnly + vbInformation, "提示信息"
        txtQuery(0).SetFocus
        Exit Function
    End If
    
    bCheckChequeDate = True
End Function


'根据中文条件获取英文条件
Private Function sGetCondition(vsCondition As String) As String
    Dim StrSQL As String
    
    Select Case vsCondition
        Case "等于"
            StrSQL = "="
        Case "大于"
            StrSQL = ">"
        Case "小于"
            StrSQL = "<"
        Case "大于等于"
            StrSQL = ">="
        Case "包含"
            StrSQL = "like"
    End Select
    
    sGetCondition = StrSQL
End Function

'检查开票日期是否是日期形
Private Function bCheckDate(vsDate As String) As Boolean
On Error GoTo Err
    Dim sDate As String
    
    bCheckDate = True
    If vsDate = "" Then Exit Function
    If Len(vsDate) < 4 Then
        bCheckDate = False
        Exit Function
    End If
    sDate = Mid(vsDate, 1, 4)
     If Not IsNumeric(sDate) Then                   '''判断年是否正确
        bCheckDate = False
        Exit Function
'        bCheckDate = True
    End If
    If Len(vsDate) = 4 Then Exit Function
    
    
    If Len(vsDate) > 4 And Len(vsDate) < 7 Then
        bCheckDate = False
        Exit Function
    End If
    
    sDate = Mid(vsDate, 6, 2)                     '''判断月是否正确
    If Not IsNumeric(sDate) Then
        bCheckDate = False
        Exit Function
    End If
    If Mid(vsDate, 5, 1) <> "-" Then
        bCheckDate = False
        Exit Function
    End If
    If Len(vsDate) = 7 Then Exit Function
    
    If Len(vsDate) > 7 And Len(vsDate) < 10 Then
        bCheckDate = False
        Exit Function
    End If
    
    sDate = Mid(vsDate, 9, 2)
    If Not IsNumeric(sDate) Then          '''判断日是否正确
        bCheckDate = False
        Exit Function
    End If
    
    If Mid(vsDate, 8, 1) <> "-" Then
        bCheckDate = False
        Exit Function
    End If
    
    bCheckDate = True
    Exit Function
Err:
End Function

Private Sub optType_Click(Index As Integer)
    If Index = 0 Then
        Frame1.Enabled = True
        Frame2.Enabled = False
        chkQueryRange.Enabled = True
    Else
        Frame1.Enabled = False
        Frame2.Enabled = True
        chkQueryRange.Enabled = False
    End If
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -