⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmzdktwo.frm

📁 网上教务管理系统 包括(教师
💻 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 + -