📄 frmnewcase.frm
字号:
VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form frmNewCase
BorderStyle = 3 'Fixed Dialog
Caption = "新文书类型"
ClientHeight = 5700
ClientLeft = 2610
ClientTop = 2040
ClientWidth = 8040
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5700
ScaleWidth = 8040
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin MSFlexGridLib.MSFlexGrid MSFlexGrid
Height = 3585
Left = 60
TabIndex = 14
Top = 30
Width = 7935
_ExtentX = 13996
_ExtentY = 6324
_Version = 393216
FixedCols = 0
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.Frame Frame
Height = 1395
Left = 60
TabIndex = 10
Top = 3600
Width = 7905
Begin VB.CommandButton OKButton
Caption = "确定"
Height = 375
Left = 6180
TabIndex = 4
Top = 300
Width = 1500
End
Begin VB.CommandButton CancelButton
Caption = "取消"
Height = 375
Left = 6180
TabIndex = 5
Top = 780
Width = 1500
End
Begin VB.TextBox txtCaseName
Height = 300
Left = 1290
TabIndex = 0
Text = "Text1"
Top = 210
Width = 4275
End
Begin VB.TextBox txtCode
Height = 300
Left = 1290
MaxLength = 4
TabIndex = 1
Text = "Text2"
Top = 600
Width = 2115
End
Begin VB.TextBox txtPage
Alignment = 1 'Right Justify
Height = 300
Left = 1290
TabIndex = 2
Text = "Text3"
Top = 990
Width = 1275
End
Begin VB.CheckBox chkIsRegister
Caption = "是否登记类型"
Height = 255
Left = 3840
TabIndex = 3
Top = 1020
Width = 1425
End
Begin VB.Label lblCaseName
AutoSize = -1 'True
Caption = "文书名称"
Height = 180
Left = 150
TabIndex = 13
Top = 300
Width = 720
End
Begin VB.Label lblCaseCode
AutoSize = -1 'True
Caption = "文书类型编码"
Height = 180
Left = 150
TabIndex = 12
Top = 660
Width = 1080
End
Begin VB.Label lblCasePages
AutoSize = -1 'True
Caption = "页 数"
Height = 180
Left = 150
TabIndex = 11
Top = 1050
Width = 720
End
End
Begin VB.CommandButton cmdDelete
Caption = " 删除(&D)"
Height = 375
Left = 3690
TabIndex = 8
Top = 5160
Width = 1500
End
Begin VB.CommandButton cmdExit
Caption = " 退出(&X)"
Height = 375
Left = 6240
TabIndex = 9
Top = 5160
Width = 1500
End
Begin VB.CommandButton cmdModify
Caption = " 修改(&M)"
Height = 375
Left = 2190
TabIndex = 7
Top = 5160
Width = 1500
End
Begin VB.CommandButton cmdAdd
Caption = " 添加(&A)"
Height = 375
Left = 690
TabIndex = 6
Top = 5160
Width = 1500
End
End
Attribute VB_Name = "frmNewCase"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private CurrentRow As String
Private Const InitCols As Long = 4 '初始列数
Private Const InitRows As Long = 120 '初始行数
Dim rstCase As ADODB.Recordset
Private Sub CancelButton_Click()
cmdAdd.Enabled = True
cmdModify.Enabled = True
cmdDelete.Enabled = True
'重新加入 txt*
txtCaseName = MSFlexGrid.TextMatrix(CurrentRow, 1)
txtCode = MSFlexGrid.TextMatrix(CurrentRow, 0)
txtPage = MSFlexGrid.TextMatrix(CurrentRow, 2)
chkIsRegister = Val(MSFlexGrid.TextMatrix(CurrentRow, 3))
'使 txt* 不可编辑
txtCode.Enabled = False
txtCaseName.Enabled = False
txtPage.Enabled = False
chkIsRegister.Enabled = False
'使 OK Cancel 按钮不可见
OKButton.Visible = False
CancelButton.Visible = False
End Sub
Private Sub cmdAdd_Click()
Dim strSQL As String
cmdModify.Enabled = False
cmdDelete.Enabled = False
txtCode.Enabled = True
txtCaseName.Enabled = True
txtPage.Enabled = True
chkIsRegister.Enabled = True
txtCode = vbNullString
txtCaseName = vbNullString
txtPage = vbNullString
chkIsRegister = 0
'使 OK Cancel 按钮不可见
OKButton.Tag = "Add"
OKButton.Visible = True
CancelButton.Visible = True
End Sub
Private Sub cmdDelete_Click()
Dim Msg As String
Dim strSQL As String
If txtCode.Text = vbNullString Then
MsgBox "无当前纪录!", vbInformation
Exit Sub
End If
Msg = MsgBox("确定删除当前纪录吗?", vbYesNo + vbInformation)
Select Case Msg
Case vbYes
Case vbNo
Exit Sub
End Select
'删除当前记录
strSQL = "DELETE * FROM Sys_Case WHERE Case_Code='" & MSFlexGrid.TextMatrix(CurrentRow, 0) & "'"
conCaseMain.Execute strSQL
'清除MSFlexGrid_Business中的显示
If MSFlexGrid.Rows >= InitRows Then
MSFlexGrid.RemoveItem CurrentRow
End If
If MSFlexGrid.Rows < InitRows Then
MSFlexGrid.Rows = InitRows
End If
'清除txt*中的的显示
txtCode.Text = vbNullString
txtCaseName.Text = vbNullString
txtPage.Text = vbNullString
chkIsRegister = 0
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdModify_Click()
If txtCode.Text = vbNullString Then
MsgBox "无当前纪录!", vbInformation
Exit Sub
End If
OKButton.Visible = True
CancelButton.Visible = True
cmdAdd.Enabled = False
cmdDelete.Enabled = False
txtCode.Enabled = False
txtCaseName.Enabled = True
txtPage.Enabled = True
chkIsRegister.Enabled = True
'使 OK Cancel 按钮不可见
OKButton.Tag = "Modify"
OKButton.Visible = True
CancelButton.Visible = True
End Sub
Private Sub Form_Load()
Dim cw As Long
Dim i As Integer
Dim strSQL As String
'设置初始行数和列数
MSFlexGrid.Cols = InitCols
MSFlexGrid.Rows = 120
cw = MSFlexGrid.Width
cw = cw - 150
'设置初始列宽
For i = 0 To InitCols - 1
MSFlexGrid.ColWidth(i) = cw / InitCols
Next i
'设置列对齐方式
For i = 0 To InitCols - 1
MSFlexGrid.ColAlignment(i) = flexAlignLeftCenter
Next i
'设置标题
MSFlexGrid.TextMatrix(0, 0) = "文书编码"
MSFlexGrid.TextMatrix(0, 1) = "文书名称"
MSFlexGrid.TextMatrix(0, 2) = "页 数"
MSFlexGrid.TextMatrix(0, 3) = "是否登记类型"
Set rstCase = New ADODB.Recordset
strSQL = "SELECT * FROM sys_Case ORDER BY Case_Code"
rstCase.Open strSQL, conCaseMain, 1, 1 ', adCmdText
With rstCase
If Not .EOF Then .MoveLast
If Not .BOF Then .MoveFirst
'初始化列表框
For i = 0 To rstCase.RecordCount - 1
With MSFlexGrid
.TextMatrix(i + 1, 0) = rstCase.Fields(0)
.TextMatrix(i + 1, 1) = rstCase.Fields(1)
.TextMatrix(i + 1, 2) = rstCase.Fields(2)
.TextMatrix(i + 1, 3) = rstCase.Fields(3)
End With
rstCase.MoveNext
Next i
End With
rstCase.Close
'设置初始值
CurrentRow = 1
txtCaseName.Text = MSFlexGrid.TextMatrix(CurrentRow, 1)
txtCode.Text = MSFlexGrid.TextMatrix(CurrentRow, 0)
txtPage.Text = MSFlexGrid.TextMatrix(CurrentRow, 2)
chkIsRegister.Value = Val(MSFlexGrid.TextMatrix(CurrentRow, 3))
OKButton.Visible = False
CancelButton.Visible = False
txtCaseName.Enabled = False
txtCode.Enabled = False
txtPage.Enabled = False
chkIsRegister.Enabled = False
End Sub
Private Sub MSFlexGrid_Click()
CurrentRow = MSFlexGrid.Row
txtCaseName.Text = MSFlexGrid.TextMatrix(CurrentRow, 1)
txtCode.Text = MSFlexGrid.TextMatrix(CurrentRow, 0)
txtPage.Text = MSFlexGrid.TextMatrix(CurrentRow, 2)
chkIsRegister.Value = Val(MSFlexGrid.TextMatrix(CurrentRow, 3))
End Sub
Private Sub OKButton_Click()
Dim rstCase As ADODB.Recordset
Dim strSQL As String
Dim CurrentRow As Integer
cmdAdd.Enabled = True
cmdModify.Enabled = True
cmdDelete.Enabled = True
'保证新纪录不能有空字段
If txtCaseName = vbNullString Then
MsgBox "文书名称不能为空!", vbInformation
txtCaseName.SetFocus
Exit Sub
End If
If txtCode = vbNullString Then
MsgBox "文书编码不能为空!", vbInformation
txtCode.SetFocus
Exit Sub
End If
If Len(Trim(txtCode)) < CaseCodeLength Then
MsgBox "文书编码必须输满" & CaseCodeLength & "位!", vbInformation
txtCode.SetFocus
Exit Sub
End If
If Val(txtPage) = 0 Then
MsgBox "页数不能为零!", vbInformation
txtPage.SetFocus
Exit Sub
End If
'设置MSFlexGrid_Business的当前行
CurrentRow = MSFlexGrid.Row
'检查该纪录在数据库中是否已存在
If OKButton.Tag = "Add" Then
'打开表:Sys_Case
strSQL = "SELECT * FROM Sys_Case ORDER BY Case_Code"
Set rstCase = New ADODB.Recordset
rstCase.Open strSQL, conCaseMain, 1, 1 ', adCmdText
If Not rstCase.BOF Then rstCase.MoveFirst
rstCase.Find "Case_Code='" & txtCode & "'"
If Not rstCase.EOF Then
MsgBox "该编码在数据库中已存在!", vbInformation
Call CancelButton_Click
Exit Sub
End If
'在数据库里编辑当前记录
rstCase.MoveLast
rstCase.AddNew
rstCase!Case_Code = txtCode
rstCase!Case_Name = txtCaseName
rstCase!Case_Pages = txtPage
rstCase!IsRegister = chkIsRegister
rstCase.Update
'在 MSFlexGrid 里增加显示行
rstCase.Requery
CurrentRow = rstCase.RecordCount + 1
With MSFlexGrid
.TextMatrix(CurrentRow, 0) = rstCase!Case_Code
.TextMatrix(CurrentRow, 1) = rstCase!Case_Name
.TextMatrix(CurrentRow, 2) = rstCase!Case_Pages
.TextMatrix(CurrentRow, 3) = rstCase!IsRegister
End With
End If
If OKButton.Tag = "Modify" Then
'打开表:Sys_Case
strSQL = "SELECT * FROM Sys_Case " & _
"WHERE Case_Code='" & MSFlexGrid.TextMatrix(CurrentRow, 0) & "'"
Set rstCase = New ADODB.Recordset
rstCase.Open strSQL, conCaseMain, 1, 1 ', adCmdText
'在数据库里编辑当前记录
rstCase!Case_Code = txtCode
rstCase!Case_Name = txtCaseName
rstCase!Case_Pages = txtPage
rstCase!IsRegister = chkIsRegister
rstCase.Update
'在 MSFlexGrid 里更新显示行
With MSFlexGrid
.TextMatrix(CurrentRow, 0) = rstCase!Case_Code
.TextMatrix(CurrentRow, 1) = rstCase!Case_Name
.TextMatrix(CurrentRow, 2) = rstCase!Case_Pages
.TextMatrix(CurrentRow, 3) = rstCase!IsRegister
End With
'刷新数据库中所有该类型的文书纪录
ReplaceSameCase MSFlexGrid.TextMatrix(CurrentRow, 0), txtCaseName, txtPage
End If
'使添加的当前记录可见
MSFlexGrid.Row = CurrentRow
MSFlexGrid.TopRow = CurrentRow
'使 txt* 不可编辑
txtCode.Enabled = False
txtCaseName.Enabled = False
txtPage.Enabled = False
chkIsRegister.Enabled = False
'使 OK Cancel 按钮不可见
OKButton.Visible = False
CancelButton.Visible = False
rstCase.Close
End Sub
Private Sub txtPage_KeyPress(KeyAscii As Integer)
If KeyAscii < 48 Or KeyAscii > 57 And KeyAscii <> vbKeyBack Then
KeyAscii = 0
End If
End Sub
Public Sub ReplaceSameCase(Case_Code As String, Case_Name As String, Case_Page As Integer)
'************************************************************
'功能: 更新数据库中的文书信息
'调用: OKButton_Click
'************************************************************
On Error GoTo ErrorHandler
Dim strTemp As String
Dim rstCase As ADODB.Recordset
'更新自定义方式表中的相应文书信息
strTemp = "UPDATE Operation_UserDefined_Rules " & _
"SET Ope_Case_Name='" & Case_Name & "' " & _
"WHERE Ope_Case_Code='" & Case_Code & "'"
conCaseMain.Execute strTemp
'删除图片表中的多余纪录,这里可能不妥!
conCaseMain.Execute "DELETE FROM sys_Image WHERE Img_Page>'" & Case_Page & "' AND Img_Case_Code='" & Case_Code & "'"
'更新图片表中的文书信息
strTemp = "UPDATE sys_Image " & _
"SET Img_Case_Name='" & Case_Name & "'"
conCaseMain.Execute strTemp
MsgBox "更新完成!", vbInformation
Exit Sub
ErrorHandler:
If Err Then
MsgBox Err.Description, vbCritical
Err.Clear
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -