📄 frmquery.frm
字号:
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 + -