📄 ucsearch.ctl
字号:
VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.UserControl ucSearch
BackColor = &H80000005&
ClientHeight = 5190
ClientLeft = 0
ClientTop = 0
ClientWidth = 8460
ScaleHeight = 5190
ScaleWidth = 8460
Begin VB.CommandButton cmdBack
Caption = "返回"
Height = 375
Left = 6300
TabIndex = 13
Top = 4605
Width = 1095
End
Begin VB.Frame fraBody
BackColor = &H80000005&
BeginProperty Font
Name = "楷体_GB2312"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 4380
Left = 135
TabIndex = 0
Top = 105
Width = 7890
Begin VB.CommandButton CmdQuery
Caption = "确定"
Height = 375
Left = 6075
TabIndex = 8
Top = 3630
Width = 1095
End
Begin VB.TextBox txtRemark
Height = 735
Left = 3300
MultiLine = -1 'True
TabIndex = 7
Top = 2100
Width = 3990
End
Begin VB.TextBox txtParkingNO
Height = 375
Left = 3300
TabIndex = 6
Top = 1163
Width = 2595
End
Begin VB.OptionButton OptionQuery
BackColor = &H80000005&
Caption = "按编号查询："
ForeColor = &H00000000&
Height = 300
Index = 0
Left = 1155
TabIndex = 5
Top = 1200
Value = -1 'True
Width = 1800
End
Begin VB.OptionButton OptionQuery
BackColor = &H80000005&
Caption = "按时间查询："
ForeColor = &H00000000&
Height = 300
Index = 1
Left = 1155
TabIndex = 4
Top = 1665
Width = 1935
End
Begin VB.OptionButton OptionQuery
BackColor = &H80000005&
Caption = "按备注（说明）查询："
ForeColor = &H00000000&
Height = 300
Index = 2
Left = 1155
TabIndex = 3
Top = 2085
Width = 2130
End
Begin VB.OptionButton OptionQuery
BackColor = &H80000005&
Caption = "按记录员查询："
ForeColor = &H00000000&
Height = 300
Index = 3
Left = 1155
TabIndex = 2
Top = 3015
Width = 1770
End
Begin VB.TextBox txtRecordID
Height = 375
Left = 3285
TabIndex = 1
Top = 2985
Width = 2640
End
Begin MSComCtl2.DTPicker dtEnterOrExitDate
Height = 330
Left = 3300
TabIndex = 9
Top = 1650
Width = 2595
_ExtentX = 4577
_ExtentY = 582
_Version = 393216
Format = 20774913
CurrentDate = 37987
End
Begin VB.Label lblLogin
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "出入车辆查询"
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 285
Index = 0
Left = 2625
TabIndex = 10
Top = 450
Width = 1800
End
Begin VB.Label lblLogin
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "出入车辆查询"
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00808080&
Height = 285
Index = 1
Left = 2655
TabIndex = 11
Top = 465
Width = 1800
End
End
Begin ParkingCharge.ucSearchResult ucSearchResult1
Height = 3810
Left = 15
TabIndex = 12
Top = 300
Width = 8385
_ExtentX = 14790
_ExtentY = 6720
End
End
Attribute VB_Name = "ucSearch"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Private Sub cmdBack_Click()
fraBody.Visible = True
ucSearchResult1.Visible = False
cmdBack.Visible = False
End Sub
Private Sub CmdQuery_Click()
Dim i As Integer
Dim rsPkInfo As New Recordset
Dim QueryDate1 As Date
Dim QueryDate2 As Date
Dim szSQL As String
Dim szParkingNO As String
Dim szRemark As String
Dim szUsrID As String
If UserNow.Type <> 0 And UserNow.Type <> 2 Then
MsgBox "对不起，您的权限不能查询车辆收费记录！"
Exit Sub
End If
'按编号查询
If OptionQuery(0).Value = True Then
szParkingNO = Replace(txtParkingNO.Text, "'", "''")
'读取停车记录信息
szSQL = "SELECT * FROM ParkingInfo WHERE ParkingNO LIKE "
szSQL = szSQL & "'%" & szParkingNO & "%'"
'打开数据集
rsPkInfo.Open szSQL, DBCnn, adOpenStatic, adLockOptimistic
'按时间查询
ElseIf OptionQuery(1).Value = True Then
QueryDate1 = Format(dtEnterOrExitDate, "yyyy-mm-dd")
QueryDate2 = DateAdd("d", 1, QueryDate1)
'读取停车记录信息
szSQL = "SELECT * FROM ParkingInfo WHERE "
szSQL = szSQL & " (EnterTime>#" & QueryDate1 & "# AND EnterTime<#" & QueryDate2 & "#) "
rsPkInfo.Open szSQL, DBCnn, adOpenStatic, adLockOptimistic
'按备注查询
ElseIf OptionQuery(2).Value = True Then
If txtRemark.Text = "" Then
MsgBox "请输入要查询的备注信息！"
Exit Sub
End If
szRemark = Replace(Trim(txtRemark.Text), "'", "''")
'读取停车记录信息
szSQL = "SELECT * FROM ParkingInfo WHERE Remark LIKE"
szSQL = szSQL & "'%" & szRemark & "%'"
rsPkInfo.Open szSQL, DBCnn, adOpenStatic, adLockOptimistic
'按记录员ID查询
Else
If txtRecordID.Text = "" Then
MsgBox "请输入要查询的记录员ID！"
Exit Sub
ElseIf Len(Trim(txtRecordID.Text)) > 16 Then
MsgBox "记录员ID长度超出范围！"
Exit Sub
End If
szUsrID = Replace(Trim(txtRecordID.Text), "'", "''")
'读取停车记录信息
szSQL = "SELECT * FROM ParkingInfo WHERE "
szSQL = szSQL & "ParkingRecID LIKE '%" & szUsrID & "%'"
szSQL = szSQL & " OR ChargeRecID LIKE '%" & szUsrID & "%'"
rsPkInfo.Open szSQL, DBCnn, adOpenStatic, adLockOptimistic
End If
'显示查询结果
If rsPkInfo.EOF Then
MsgBox "数据库中没有符合要求的记录！"
Exit Sub
End If
Call ucSearchResult1.UpdateList(rsPkInfo)
ucSearchResult1.Visible = True
cmdBack.Visible = True
fraBody.Visible = False
'关闭数据集
rsPkInfo.Close
'记录该操作
AddRec (2)
End Sub
Private Sub UserControl_Initialize()
fraBody.Visible = True
ucSearchResult1.Visible = False
cmdBack.Visible = False
End Sub
'============================================
'功能：响应 用户控件的Resize事件，使fraBody自动居中
'============================================
Private Sub UserControl_Resize()
Dim nLeft, nTop As Integer
'计算新的Left和Top
nLeft = (UserControl.Width - fraBody.Width) / 2
nTop = (UserControl.Height - fraBody.Height) / 2
'只有当新的Left和Top > 0 时才移动fraBody
fraBody.Left = IIf(nLeft > 0, nLeft, fraBody.Left)
'fraBody.Top = IIf(nTop > 0, nTop, fraBody.Top)
With ucSearchResult1
.Left = 0
.Top = 0
.Width = UserControl.Width
.Height = UserControl.Height - cmdBack.Height * 1.5
End With
With cmdBack
.Left = ucSearchResult1.Left + ucSearchResult1.Width - .Width * 1.3
.Top = ucSearchResult1.Top + ucSearchResult1.Height + .Height * 0.1
End With
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -