📄 frmlunwenketicl.frm
字号:
TabStop = 0 'False
Top = 0
Width = 8655
_ExtentX = 15266
_ExtentY = 4260
_Version = 393216
Cols = 10
FixedCols = 0
RowHeightMin = 560
WordWrap = -1 'True
FillStyle = 1
SelectionMode = 2
AllowUserResizing= 3
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.Label Label3
BackColor = &H8000000D&
Caption = "论文"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H0080FFFF&
Height = 375
Left = 1680
TabIndex = 13
Top = 2640
Width = 975
End
Begin VB.Label Label2
BackColor = &H8000000D&
Caption = "课题"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H0080FFFF&
Height = 375
Left = 600
TabIndex = 11
Top = 2640
Width = 1215
End
End
Attribute VB_Name = "Frmlunwenketicl"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim myquery(4) As String
Dim tt As Integer
Dim dd(5) As Boolean
Private Sub Cbo_Category_Change(Index As Integer)
''''''''''''''''''''''''''''''''''''课题
For i = 0 To 1
Select Case Cbo_Category(i).Text
Case Is = "编号"
myquery(i) = "keti_id"
Case Is = "名称"
myquery(i) = "mingcheng"
Case Is = "主持人"
myquery(i) = "zhuchiren"
Case Is = "完成情况"
myquery(i) = "jibie"
Case Is = "开始日期"
myquery(i) = " chubandate"
Case Is = "终止日期"
myquery(i) = "fdate"
Case Else
End Select
Next i
'''''''''''''''''''''''''''''''''''论文
For i = 2 To 3
Select Case Cbo_Category(i).Text
Case Is = "编号"
myquery(i) = "lunwen_id"
Case Is = "题目"
myquery(i) = "mingcheng"
Case Is = "作者"
myquery(i) = "zuozhe"
Case Is = "刊物名称"
myquery(i) = "kanwuming"
Case Is = "级别"
myquery(i) = " jibie"
Case Is = "出版社"
myquery(i) = "chubanshe"
Case Is = "出版日期"
myquery(i) = "chubandate"
Case Else
End Select
Next i
End Sub
Private Sub Cbo_Category_Click(Index As Integer)
''''''''''''''''''''''''''''''''''''课题
For i = 0 To 1
Select Case Cbo_Category(i).Text
Case Is = "编号"
myquery(i) = "keti_id"
Case Is = "名称"
myquery(i) = "mingcheng"
Case Is = "主持人"
myquery(i) = "zhuchiren"
Case Is = "完成情况"
myquery(i) = "jibie"
Case Is = "开始日期"
myquery(i) = " chubandate"
Case Is = "终止日期"
myquery(i) = "fdate"
Case Else
End Select
Next i
'''''''''''''''''''''''''''''''''''论文
For i = 2 To 3
Select Case Cbo_Category(i).Text
Case Is = "编号"
myquery(i) = "lunwen_id"
Case Is = "题目"
myquery(i) = "mingcheng"
Case Is = "作者"
myquery(i) = "zuozhe"
Case Is = "刊物名称"
myquery(i) = "kanwuming"
Case Is = "级别"
myquery(i) = " jibie"
Case Is = "出版社"
myquery(i) = "chubanshe"
Case Is = "出版日期"
myquery(i) = "chubandate"
Case Else
End Select
Next i
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdInquire_Click()
'On Error GoTo OOPS
Dim txtSQL As String
Dim MsgText As String
Dim mrc As ADODB.Recordset
If Checklunwen.value Or Checkketi.value Or Checkren.value Then Else MsgBox "无查询方向，请选择论文,课题或相关人员"
If Checkketi.value Then
If (Checklunwen.value Or Checkren.value) Then
MsgBox "请做单一选择"
Exit Sub
End If
txtSQL = "select * from ketiguanli where "
dd(0) = False
dd(1) = False
'判断是否选择第一查询方式
If Check1(0).value Then
If Trim(Text1.Text) = "" Then
sMeg = "查询不能为空！"
MsgBox sMeg, vbOKOnly + vbExclamation, "警告"
Text1.SetFocus
Exit Sub
Else
dd(0) = True
If Cbo_Operator(0).ListIndex = 0 Then
txtSQL = txtSQL & "" & myquery(0) & " " & Cbo_Operator(0) & " '%" & Text1.Text & "%'"
Else
txtSQL = txtSQL & "" & myquery(0) & " " & Cbo_Operator(0) & " '" & Text1.Text & "'"
End If
End If
End If ''''''''''''''''check1(0)完
'判断是否选择第二查询方式
If Check1(1).value Then
If Trim(Text2.Text) = "" Then
sMeg = "查询不能为空！"
MsgBox sMeg, vbOKOnly + vbExclamation, "警告"
Text2.SetFocus
Exit Sub
Else
dd(1) = True
If dd(0) Then
'组合查询语句
If Cbo_Operator(1).ListIndex = 0 Then
txtSQL = txtSQL & " and " & myquery(1) & " " & Cbo_Operator(1).Text & " '%" & Text2.Text & "%'"
Else
txtSQL = txtSQL & " and " & "" & myquery(1) & " " & Cbo_Operator(1).Text & " '" & Text2.Text & "'"
End If
Else '''''''''''''dd(0)
If Cbo_Operator(1).ListIndex = 0 Then
txtSQL = txtSQL & "" & myquery(1) & " " & Cbo_Operator(1).Text & " '%" & Text2.Text & "%'"
Else
txtSQL = txtSQL & " " & "" & myquery(1) & " " & Cbo_Operator(1).Text & " '" & Text2.Text & "'"
End If
End If '''''''''''''''''dd(0)完
End If '''''''''''''''''trim完
End If '''''''''''''''''''''check1(1).value完
'判断是否设置查询方式
If Not (dd(0) Or dd(1)) Then
MsgBox "请设置查询方式！", vbOKOnly + vbExclamation, "警告"
Exit Sub
End If
'查询所有满足条件的内容
txtSQL = txtSQL & " order by keti_id"
'执行查询语句
Set mrc = ExecuteSQL(txtSQL, MsgText)
Label1.Caption = txtSQL
'''''''''''''''''''''''''''''''''''''''''''''''''''''''判断并显示
'将查询内容显示在表格控件中
With myflexgrid
.Rows = 1
.CellAlignment = 4
.TextMatrix(0, 0) = "编号"
.TextMatrix(0, 1) = "名称"
.TextMatrix(0, 2) = "主持人"
.TextMatrix(0, 3) = "资金"
.TextMatrix(0, 4) = "参加人"
.TextMatrix(0, 5) = "完成情况"
.TextMatrix(0, 6) = "项目来源"
.TextMatrix(0, 7) = "开始日期"
.TextMatrix(0, 8) = "结论"
.TextMatrix(0, 9) = "终止日期"
'判断是否移动到数据集对象的最后一条记录
Do While Not mrc.EOF
.Rows = .Rows + 1
.CellAlignment = 4
.TextMatrix(.Rows - 1, 0) = "" & mrc.Fields(0)
.TextMatrix(.Rows - 1, 1) = "" & mrc.Fields(1)
.TextMatrix(.Rows - 1, 2) = "" & mrc.Fields(2)
.TextMatrix(.Rows - 1, 3) = "" & mrc.Fields(3)
.TextMatrix(.Rows - 1, 4) = "" & mrc.Fields(4)
.TextMatrix(.Rows - 1, 5) = "" & mrc.Fields(5)
.TextMatrix(.Rows - 1, 6) = "" & mrc.Fields(6)
.TextMatrix(.Rows - 1, 7) = "" & Format(mrc.Fields(7), "yyyy-mm-dd")
.TextMatrix(.Rows - 1, 8) = "" & mrc.Fields(8)
.TextMatrix(.Rows - 1, 9) = "" & Format(mrc.Fields(9), "yyyy-mm-dd")
'移动到下一条记录
mrc.MoveNext
Loop
End With
If myflexgrid.Rows = 1 Then MsgBox "No Records Found"
'关闭数据集
mrc.Close
Exit Sub
End If ''''''''''''''checkketi完
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''论文开始
If Checklunwen.value Then
If (Checkketi.value Or Checkren.value) Then
MsgBox "请做单一选择"
Exit Sub
End If
txtSQL = "select * from lunwenguanli where "
dd(2) = False
dd(3) = False
'判断是否选择第一查询方式
If Check1(2).value Then
If Trim(Text3.Text) = "" Then
sMeg = "查询不能为空！"
MsgBox sMeg, vbOKOnly + vbExclamation, "警告"
Text3.SetFocus
Exit Sub
Else
dd(2) = True
If Cbo_Operator(2).ListIndex = 0 Then
txtSQL = txtSQL & "" & myquery(2) & " " & Cbo_Operator(2) & " '%" & Text3.Text & "%'"
Else
txtSQL = txtSQL & "" & myquery(2) & " " & Cbo_Operator(2) & " '" & Text3.Text & "'"
End If
End If
End If
'判断是否选择第二查询方式
If Check1(3).value Then
If Trim(Text4.Text) = "" Then
sMeg = "查询不能为空！"
MsgBox sMeg, vbOKOnly + vbExclamation, "警告"
Text4.SetFocus
Exit Sub
Else
dd(3) = True
If dd(2) Then
'组合查询语句
If Cbo_Operator(3).ListIndex = 0 Then
txtSQL = txtSQL & " and " & myquery(3) & " " & Cbo_Operator(3).Text & " '%" & Text4.Text & "%'"
Else
txtSQL = txtSQL & " and " & "" & myquery(3) & " " & Cbo_Operator(3).Text & " '" & Text4.Text & "'"
End If
Else
If Cbo_Operator(1).ListIndex = 0 Then
txtSQL = txtSQL & "" & myquery(3) & " " & Cbo_Operator(3).Text & " '%" & Text4.Text & "%'"
Else
txtSQL = txtSQL & " " & "" & myquery(3) & " " & Cbo_Operator(3).Text & " '" & Text4.Text & "'"
End If
End If ''''''''''''''''''dd(2) 完
End If '''''''''''''''''trim
End If '''''''''''''''''check1(3)
'判断是否设置查询方式
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -