📄 frmdbmanage.frm
字号:
VERSION 5.00
Object = "{8E27C92E-1264-101C-8A2F-040224009C02}#7.0#0"; "MSCAL.OCX"
Begin VB.Form frmDBManage
Caption = "数据库管理窗口"
ClientHeight = 3588
ClientLeft = 48
ClientTop = 336
ClientWidth = 7188
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
Moveable = 0 'False
ScaleHeight = 3588
ScaleWidth = 7188
Begin VB.CommandButton cmdNo
Caption = "否&N"
Height = 300
Left = 3720
MouseIcon = "frmDBManage.frx":0000
TabIndex = 11
Top = 2520
Width = 732
End
Begin VB.CommandButton cmdYes
Caption = "是&Y"
Height = 300
Left = 2640
MouseIcon = "frmDBManage.frx":0152
TabIndex = 10
Top = 2520
Width = 732
End
Begin VB.TextBox txtEnd
Height = 372
Left = 2160
Locked = -1 'True
TabIndex = 2
Text = " "
Top = 1320
Width = 1572
End
Begin VB.TextBox txtStart
Height = 372
Left = 2160
Locked = -1 'True
TabIndex = 1
Text = " "
Top = 840
Width = 1572
End
Begin MSACAL.Calendar Calendar1
Height = 1812
Left = 3840
TabIndex = 8
Top = 120
Width = 3252
_Version = 524288
_ExtentX = 5736
_ExtentY = 3196
_StockProps = 1
BackColor = -2147483633
Year = 2000
Month = 10
Day = 13
DayLength = 0
MonthLength = 0
DayFontColor = 0
FirstDay = 1
GridCellEffect = 1
GridFontColor = 10485760
GridLinesColor = -2147483632
ShowDateSelectors= -1 'True
ShowDays = -1 'True
ShowHorizontalGrid= -1 'True
ShowTitle = -1 'True
ShowVerticalGrid= -1 'True
TitleFontColor = 10485760
ValueIsNull = 0 'False
BeginProperty DayFont {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 7.8
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BeginProperty GridFont {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 7.8
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BeginProperty TitleFont {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "System"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.CommandButton Command5
Cancel = -1 'True
Caption = "退出&B"
BeginProperty Font
Name = "隶书"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 492
Left = 5400
MouseIcon = "frmDBManage.frx":02A4
MousePointer = 99 'Custom
Picture = "frmDBManage.frx":03F6
Style = 1 'Graphical
TabIndex = 4
ToolTipText = "退出本窗口"
Top = 2400
Width = 612
End
Begin VB.ComboBox cbo1
Height = 276
Left = 2160
Style = 2 'Dropdown List
TabIndex = 0
Top = 360
Width = 1572
End
Begin VB.CommandButton cmdDelete
Caption = "删除&D"
Height = 300
Left = 3120
MouseIcon = "frmDBManage.frx":05B8
TabIndex = 3
Top = 3000
Width = 732
End
Begin VB.Label Label4
Caption = "在本窗口中可以删除数据库记录以提高程序运行速度。"
BeginProperty Font
Name = "楷体_GB2312"
Size = 10.8
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 936
Left = 360
TabIndex = 12
Top = 2520
Width = 1716
End
Begin VB.Image Image1
BorderStyle = 1 'Fixed Single
Height = 3540
Left = 36
Top = 0
Width = 7150
End
Begin VB.Label lblAreYouSure
Caption = "确实要删除吗？"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 252
Left = 2760
TabIndex = 9
Top = 2040
Width = 1692
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "请选择截止日期:"
BeginProperty Font
Name = "宋体"
Size = 10.8
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 216
Left = 240
TabIndex = 7
Top = 1440
Width = 1620
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "请选择起始日期:"
BeginProperty Font
Name = "宋体"
Size = 10.8
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 216
Left = 240
TabIndex = 6
Top = 960
Width = 1620
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "请选择数据库名称:"
BeginProperty Font
Name = "宋体"
Size = 10.8
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 216
Left = 240
TabIndex = 5
Top = 360
Width = 1836
End
End
Attribute VB_Name = "frmDBManage"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private DateStartOrEnd As String
Public gstrDBName As String
Private mDateStart, mDateEnd As Date
Public gblnHaveRightDelete As Boolean
Private Sub Calendar1_Click()
On Error Resume Next
With Calendar1
Select Case DateStartOrEnd
Case "start"
mDateStart = .Value
txtStart.Text = CStr(mDateStart)
Case "end"
mDateEnd = .Value
txtEnd.Text = CStr(mDateEnd)
End Select
End With
End Sub
Private Sub cmdDelete_Click()
On Error Resume Next
If gstrDBName = Empty Then
Call Inform(103)
Exit Sub
Else
With frmPassword
.EventChar = "delete record"
.Show vbModal
End With
If Not (gblnHaveRightDelete) Then Exit Sub
If mDateStart > mDateEnd Then
Call Inform(100)
Exit Sub
End If
Dim i As Integer
For i = 1 To 3
If gGongZuoZhuangTai(i) Then
Call Inform(101)
Exit Sub
Else
lblAreYouSure.Visible = True
cmdYes.Visible = True
cmdNo.Visible = True
cmdNo.SetFocus
End If
Next
gblnHaveRightDelete = False
End If
End Sub
Private Sub cmdNo_Click()
lblAreYouSure.Visible = False
cmdYes.Visible = False
cmdNo.Visible = False
End Sub
Private Sub cmdYes_Click()
On Error Resume Next
lblAreYouSure.Visible = False
cmdYes.Visible = False
cmdNo.Visible = False
Select Case gstrDBName
Case "bjjl"
If mDateStart = Empty Then
Baojingdb.Execute "delete from [" & gstrDBName & "] where date<=#" & mDateEnd & "#"
Else
Baojingdb.Execute "delete from [" & gstrDBName & "] where date>=#" & mDateStart & "# and date<=#" & mDateEnd & "#"
End If
Case Else
If mDateStart = Empty Then
Lsdb.Execute "delete from [" & gstrDBName & "] where riqi<=#" & mDateEnd & "#"
Else
Lsdb.Execute "delete from [" & gstrDBName & "] where riqi>=#" & mDateStart & "# and riqi<=#" & mDateEnd & "#"
End If
End Select
Dim i As Integer
For i = 1 To 3
Detaillsrs(i).Update
Continousrs(i).Update
Batchlsrs(i).Update
Next
Bjrs.Update
BlackBoxRec.Update
Call WriteBlackBox
Call Inform(102)
End Sub
Private Sub Command5_Click()
Unload Me
End Sub
Private Sub cbo1_Click()
Select Case cbo1.ListIndex
Case 0
gstrDBName = "continous1"
Case 1
gstrDBName = "continous2"
Case 2
gstrDBName = "continous3"
Case 3
gstrDBName = "detaills1"
Case 4
gstrDBName = "detaills2"
Case 5
gstrDBName = "detaills3"
Case 6
gstrDBName = "batchls1"
Case 7
gstrDBName = "batchls2"
Case 8
gstrDBName = "batchls3"
Case 9
gstrDBName = "bjjl"
Case 10
gstrDBName = "blackbox"
End Select
End Sub
Private Sub Form_Load()
Width = Screen.Width - dataviewfrm.Width - dataviewfrm.Left
Left = dataviewfrm.Width + dataviewfrm.Left
Top = Screen.Height - 4600
Height = 3940
With cbo1
.List(0) = "1#釜连续记录"
.List(1) = "2#釜连续记录"
.List(2) = "3#釜连续记录"
.List(3) = "1#釜批次记录"
.List(4) = "2#釜批次记录"
.List(5) = "3#釜批次记录"
.List(6) = "1#釜操作记录"
.List(7) = "2#釜操作记录"
.List(8) = "3#釜操作记录"
.List(9) = "系统报警记录"
.List(10) = "系统黑匣子"
.Text = .List(0)
gstrDBName = "continous1"
End With
Calendar1.Value = Date
lblAreYouSure.Visible = False
cmdYes.Visible = False
cmdNo.Visible = False
cmdDelete.Enabled = False
gblnHaveRightDelete = False
End Sub
Private Sub txtEnd_Change()
cmdDelete.Enabled = True
End Sub
Private Sub txtEnd_GotFocus()
DateStartOrEnd = "end"
End Sub
Private Sub txtStart_GotFocus()
DateStartOrEnd = "start"
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -