📄 frmzdktwo.frm
字号:
VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form frmZDKTwo
Caption = "数据字典"
ClientHeight = 5400
ClientLeft = 60
ClientTop = 345
ClientWidth = 4020
FillColor = &H80000004&
ForeColor = &H80000004&
Icon = "frmZDKTwo.frx":0000
LinkTopic = "Form2"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5400
ScaleWidth = 4020
StartUpPosition = 2 'CenterScreen
Begin VB.TextBox txt
Alignment = 1 'Right Justify
BorderStyle = 0 'None
ForeColor = &H00C00000&
Height = 270
Left = 1020
TabIndex = 2
Top = 930
Width = 975
End
Begin MSFlexGridLib.MSFlexGrid MS
Height = 4605
Left = 90
TabIndex = 0
Top = 690
Width = 3855
_ExtentX = 6800
_ExtentY = 8123
_Version = 327680
FixedCols = 0
ForeColor = 16711680
ForeColorFixed = 12582912
GridColor = 16711680
ScrollTrack = -1 'True
AllowUserResizing= 1
Appearance = 0
End
Begin VB.Frame Frame1
Height = 615
Left = 90
TabIndex = 1
Top = 30
Width = 3855
Begin VB.Label Label1
Caption = "院(系)课程字典"
BeginProperty Font
Name = "隶书"
Size = 15.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C00000&
Height = 375
Left = 690
TabIndex = 3
Top = 180
Width = 2535
End
End
End
Attribute VB_Name = "frmZDKTwo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'状态参数
Dim bEdit, BADDNEW As Boolean
Dim bDblClick As Boolean
'初始值
Dim recCount As Integer
'检测参数
Dim bDateNull As Boolean
'全局的记录集
Dim REC As Recordset
Dim DBDAX As Database
Dim LBL As String
'添加处理
Private Sub cmdAddnew_Click()
MS.Rows = MS.Rows + 1
MS.col = MS.FixedCols
MS.Row = MS.Rows - MS.FixedRows
BADDNEW = True
End Sub
Private Sub cmdDelete_Click()
If MS.Row <= recCount Then
If MsgBox("您确信要删除" & vbCrLf & "fjasdk" & "记录", vbQuestion + vbOKCancel, "询问") = vbOK Then
txt.Visible = False
REC.AbsolutePosition = MS.Row - 1
REC.Delete
MS.RemoveItem MS.Row
End If
Else
MsgBox "当前记录尚未保存" & vbCrLf & "因此无法删除"
End If
If REC.RecordCount > 0 Then
REC.MoveLast
recCount = REC.RecordCount
End If
End Sub
Private Sub cmdExit_Click()
If txt.Visible = True Then EditKeyCode MS, txt, 13, 0
If recCount < (MS.Rows - MS.FixedRows) Then
If MsgBox("您是否保存当前数据?", vbQuestion + vbOKCancel, "询问") = vbOK Then
cmdSave_Click
End If
End If
Unload Me
End Sub
Private Sub cmdSave_Click()
Dim I As Integer
Dim J As Integer
For I = 1 To MS.Rows - MS.FixedRows - recCount
REC.AddNew
MS.Row = recCount + I
For J = 0 To REC.Fields.Count - 1
MS.col = J
If CheckedItem Then
If Not bDateNull Then
REC.Fields(J).Value = MS
End If
Else
REC.CancelUpdate
REC.MoveLast
recCount = REC.RecordCount
Exit Sub
End If
Next J
REC.Update
Next I
REC.MoveLast
recCount = REC.RecordCount
End Sub
Private Sub Form_Load()
'TO DO
'Dim lbl As String
Set DBDAX = OpenDatabase(App.Path + "\DATABASE\MARK.MDB", , False)
Select Case ZDKID2
Case 1
Set REC = DBDAX.OpenRecordset("zdkzhuany", dbOpenDynaset)
LBL = "专业信息"
Case 2
Set REC = DBDAX.OpenRecordset("ZDKZHUANY", dbOpenDynaset)
'LBL = "学籍变动"
End Select
'end do
If REC.RecordCount <> 0 Then
REC.MoveLast
recCount = REC.RecordCount
REC.MoveFirst
InputData MS, REC
End If
txt.Visible = False
'调整网格的宽度
MS.col = 1
MS.Row = 0
MS.ColWidth(0) = 1000
MS.ColWidth(1) = 2580
'显示标题
MS.Row = 0
MS.col = 0
'lblChoice = lbl
'Select Case ZDKID2
'Case 1
MS = "课程代码"
MS.col = 1
MS = "课程名称"
'Case 2
' MS = "变动代码"
' MS.col = 1
' MS = "变动类别"
'End Select
MS.col = MS.FixedCols
MS.Row = MS.FixedRows
End Sub
'MSFlexGrid控件到Edit控件的数据转换及Edit控件的移动
Private Sub MSFlexGridEdit(MSFlexGrid As Control, _
Edt As Control, KeyAscii As Integer)
Select Case KeyAscii
Case 13, 37, 38, 39, 40
Edt = MSFlexGrid
Edt.SelStart = 0
Case 27
Edt.Visible = False
Exit Sub
End Select
Edt.Move MS.Left + MS.CellLeft, MS.Top + MS.CellTop, MS.CellWidth, MS.CellHeight
Edt.Visible = True
Edt.SetFocus
End Sub
'Edit控件的方向消息去响应MSFlexGrid的移动
Private Sub EditKeyCode(MSFlexGrid As Control, Edt As Control, KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case 27 'ESC键
MSFlexGrid.SetFocus
Edt.Visible = False
Case 13
MSFlexGrid.SetFocus
MSFlexGrid = Edt
If MS.Row <= recCount Then
Edit MSFlexGrid, Edt, REC
End If
Case 37 '向左
MSFlexGrid.SetFocus
MSFlexGrid = Edt
If MS.Row <= recCount Then
Edit MSFlexGrid, Edt, REC
End If
If MSFlexGrid.col > MSFlexGrid.FixedCols Then
MSFlexGrid.col = MSFlexGrid.col - 1
End If
Case 38 '向上
MSFlexGrid.SetFocus
MSFlexGrid = Edt
If MS.Row <= recCount Then
Edit MSFlexGrid, Edt, REC
End If
If MSFlexGrid.Row > MSFlexGrid.FixedRows Then
MSFlexGrid.Row = MSFlexGrid.Row - 1
End If
Case 39 '向右
MSFlexGrid.SetFocus
MSFlexGrid = Edt
If MS.Row <= recCount Then
Edit MSFlexGrid, Edt, REC
End If
If MSFlexGrid.col < MSFlexGrid.Cols - MSFlexGrid.FixedCols - 1 Then
MSFlexGrid.col = MSFlexGrid.col + 1
End If
Case 40 '向下
MSFlexGrid.SetFocus
MSFlexGrid = Edt
If MS.Row <= recCount Then
Edit MSFlexGrid, Edt, REC
End If
If MSFlexGrid.Row < MSFlexGrid.Rows - 1 Then
MSFlexGrid.Row = MSFlexGrid.Row + 1
End If
End Select
End Sub
Private Sub MS_Click()
Select Case MS.col
Case 0
MS.col = 1
ZDKShow2 = MS
Case 1
ZDKShow2 = MS
End Select
TEMPZDK = Trim(ZDKShow2)
cmdExit_Click
End Sub
Private Sub MS_DblClick()
MSFlexGridEdit MS, txt, 13
End Sub
Private Sub MS_KeyPress(KeyAscii As Integer)
MSFlexGridEdit MS, txt, KeyAscii
End Sub
Private Sub MS_LeaveCell()
If txt.Visible = True Then
MS = txt
If MS.Row <= recCount Then
Edit MS, txt, REC
End If
txt.Visible = False
End If
End Sub
Private Sub txt_KeyDown(KeyCode As Integer, Shift As Integer)
EditKeyCode MS, txt, KeyCode, Shift
MSFlexGridEdit MS, txt, KeyCode
End Sub
'数据导入
Private Sub InputData(MSFlexGrid As Control, recForMS As Recordset)
Dim I As Integer
Dim J As Integer
MSFlexGrid.Rows = recForMS.RecordCount + 1
MSFlexGrid.Cols = recForMS.Fields.Count
MSFlexGrid.Row = 0
For J = 0 To recForMS.Fields.Count - 1
MSFlexGrid.col = J
MSFlexGrid.Text = recForMS.Fields(J).Name
Next J
J = 0
While Not recForMS.EOF
J = J + 1
MSFlexGrid.Row = J
For I = 0 To recForMS.Fields.Count - 1
MSFlexGrid.col = I
If Not IsNull(recForMS.Fields(I)) Then
MSFlexGrid.Text = recForMS.Fields(I)
End If
Next I
recForMS.MoveNext
Wend
End Sub
'校验MS当前格的数据正确性
Private Function CheckedItem() As Boolean
CheckedItem = True
Select Case MS.col
Case 0, 1
If Len(MS) = 0 Then
MsgBox "此数据不可为空!" & vbCrLf & "当前数据无法被保存", vbExclamation + vbOKOnly, "警告"
CheckedItem = False
End If
End Select
End Function
'编辑函数
Private Sub Edit(MSFlexGrid As Control, Edt As Control, recForMS As Recordset)
If CheckedItem Then
If Not bDateNull Then
recForMS.AbsolutePosition = MSFlexGrid.Row - 1
recForMS.Edit
recForMS.Fields(MSFlexGrid.col) = MSFlexGrid
recForMS.Update
End If
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -