📄 frmartmd.frm

📁 这是一个有VB开发的学院办公自动化系统
💻 FRM
📖 第 1 页 / 共 2 页
字号:
上一页 12
         Height          =   255
         Left            =   240
         TabIndex        =   10
         Top             =   360
         Width           =   1095
      End
      Begin VB.Label Label2 
         BackStyle       =   0  'Transparent
         Caption         =   "刊物名称"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H0080FFFF&
         Height          =   255
         Left            =   3600
         TabIndex        =   9
         Top             =   1000
         Width           =   1695
      End
      Begin VB.Label Label9 
         BackStyle       =   0  'Transparent
         Caption         =   "级    别"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H0080FFFF&
         Height          =   255
         Left            =   240
         TabIndex        =   8
         Top             =   1650
         Width           =   1095
      End
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "编    号"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H0080FFFF&
      Height          =   255
      Index           =   1
      Left            =   480
      TabIndex        =   15
      Top             =   240
      Width           =   1215
   End
End
Attribute VB_Name = "FrmArtmd"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim mrc As ADODB.Recordset
Dim mcclean As Boolean
'在对话框中显示数据库中信息
Public Sub viewData()
     txtbh.Text = Trim(mrc.Fields(0))
     txtName.Text = Trim(mrc.Fields(1))
     Comzuozhe.Text = Trim(mrc.Fields(2))
     txtzishu.Text = Trim(mrc.Fields(3))
     TxtOwner.Text = Trim(mrc.Fields(4))
     txtjibie.Text = Trim(mrc.Fields(5))
     txtchbshe.Text = Trim(mrc.Fields(6))
     chudata.Text = Trim(mrc.Fields(7))
     yema.Text = Trim(mrc.Fields(8))
End Sub
'定义取消键
Private Sub CmdCancel_Click()
   Call reflashform
End Sub
'定义删除键
Private Sub CmdDelete_Click()
    Dim txtSQL As String
    Dim MsgText As String
    mrc.Close
    txtSQL = "select * from lunwenguanli where lunwen_id = '" & Trim(txtbh.Text) & "'"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    '先按编号查询到人员信息，再删除
    If mrc.BOF Then
          MsgBox "没有此论文信息！", vbOKOnly + vbExclamation, "无法删除"
          Call reflashform
          Exit Sub
    Else
         Call viewData
          '提示是否删除
          str2$ = MsgBox("是否删除当前记录？", vbOKCancel, "删除当前记录")
        If str2$ = vbOK Then
           mrc.Delete
          MsgBox "删除成功！", vbOKOnly + vbExclamation, "警告"
          Call reflashform
        Else
          Call reflashform
        End If
     
    End If
End Sub
'使 “修改人员”按钮具有按’人员编号‘查询功能
Private Sub Cmdedit_Click()
    Dim txtSQL As String
    Dim MsgText As String
    mrc.Close
    txtSQL = "select * from lunwenguanli where lunwen_id = '" & Trim(txtbh.Text) & "'"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    If mrc.BOF Then
          MsgBox "数据库中没有此论文或课题的信息！", vbOKOnly + vbExclamation, "编号错误"
          Call reflashform
          Exit Sub
    Else
        Call viewData
    mcclean = False
   '使移动记录按钮失效
    CmdFirst.Enabled = False
    CmdPrevious.Enabled = False
    Cmdnext.Enabled = False
    CmdLast.Enabled = False
    '是各个文本框有效
          txtbh.Enabled = True
          txtName.Enabled = True
          Comzuozhe.Enabled = True
          txtzishu.Enabled = True
          TxtOwner.Enabled = True
          txtjibie.Enabled = True
          txtchbshe.Enabled = True
          chudata.Enabled = True
          yema.Enabled = True
          Cmdedit.Enabled = False
          CmdDelete.Enabled = False
          CmdCancel.Enabled = True
          cmdtui.Enabled = False
          CmdUpdate.Enabled = True
   End If
End Sub
'最前
Private Sub CmdFirst_Click()
  mrc.MoveFirst
  Call viewData
End Sub
'最后
Private Sub CmdLast_Click()
   mrc.MoveLast
   Call viewData
End Sub
'下一个
Private Sub Cmdnext_Click()
mrc.MoveNext
If mrc.EOF Then
mrc.MoveFirst
End If
 Call viewData
End Sub
'前一个记录
Private Sub CmdPrevious_Click()
    mrc.MovePrevious
    If mrc.BOF Then
    mrc.MoveLast
    End If
    Call viewData
    
End Sub
'退出
Private Sub cmdtui_Click()
Unload Me
End Sub

Private Sub CmdUpdate_Click()
   Dim txtSQL As String
   Dim MsgText As String
   Dim mrcc As ADODB.Recordset
   '判断是否输入编号
     If Not Testtxt(txtbh.Text) Then
        MsgBox "请输入编号！", vbOKOnly + vbExclamation, "警告"
      txtbh.SetFocus
      Exit Sub
     End If
    '判断是否输入题目
    If Not Testtxt(txtName.Text) Then
        MsgBox "请输入名称！", vbOKOnly + vbExclamation, "警告"
      txtName.SetFocus
      Exit Sub
     End If
      '判断是否输入出生日期？
      If Testtxt(chudata.Text) Then
       '判断输入的出生日期是否按照格式
             If Not IsDate(chudata.Text) Then
               MsgBox "出版日期应输入日期格式（yyyy—mm—dd）！", vbOKOnly + vbExclamation, "警告"
               chudata.SetFocus
                 Exit Sub
             Else
                 chudata = Format(chudata, "yyyy-mm-dd")
             End If
      Else
         chudata.Text = "1900-01-01"
         chudata = Format(chudata, "yyyy-mm-dd")
      End If
    '判断修改后的编号是否重复
    txtSQL = "select * from lunwenguanli where lunwen_id = '" & Trim(txtbh.Text) & "'"
    Set mrcc = ExecuteSQL(txtSQL, MsgText)
    If mrcc.EOF = False Then
        If mrcc.Fields(0) <> mrc.Fields(0) Then
        MsgBox "编号重复，请重新输入！", vbOKOnly + vbExclamation, "警告"
        mrcc.Close
        txtbh.SetFocus
        Exit Sub
        End If
    End If
       mrc.Delete
       mrcc.Close
       mrc.AddNew
       mrc.Fields(0) = Trim(txtbh.Text)
       mrc.Fields(1) = Trim(txtName.Text)
       mrc.Fields(2) = Trim(Comzuozhe.Text)
       mrc.Fields(3) = Trim(txtzishu.Text)
       mrc.Fields(4) = Trim(TxtOwner.Text)
       mrc.Fields(5) = Trim(txtjibie.Text)
       mrc.Fields(6) = Trim(txtchbshe.Text)
       mrc.Fields(7) = Trim(chudata.Text)
       mrc.Fields(8) = Trim(yema.Text)
       mrc.Update
          MsgBox "修改成功！", vbOKOnly + vbExclamation, "警告"
          Call reflashform
        
End Sub
'用于刷新窗体
Public Sub reflashform()
   Dim txtSQL As String
   Dim MsgText As String
   txtSQL = "select * from lunwenguanli"
   Set mrc = ExecuteSQL(txtSQL, MsgText)
      If mrc.BOF = True Then
      str2$ = MsgBox("已经没有论文或著作信息！" & Chr(13) & "          添加信息？", vbOKCancel, "警告")
            If str2$ = vbOK Then
            Unload FrmArtmd
            FrmArtadd.Show
            Else
            Unload FrmArtmd
            End If
       Unload Me
       Exit Sub
      Else
       mrc.MoveFirst
       Call viewData
          CmdFirst.Enabled = True
          CmdPrevious.Enabled = True
          Cmdnext.Enabled = True
          CmdLast.Enabled = True
          txtbh.Enabled = True
          txtName.Enabled = False
          txtzishu.Enabled = False
          Comzuozhe.Enabled = False
          TxtOwner.Enabled = False
          txtjibie.Enabled = False
          txtchbshe.Enabled = False
          chudata.Enabled = False
          yema.Enabled = False
          Cmdedit.Enabled = True
          CmdDelete.Enabled = True
          CmdCancel.Enabled = False
          CmdUpdate.Enabled = False
          cmdtui.Enabled = True
          mcclean = True
    End If
End Sub
Private Sub Form_Load()
    Dim txtSQL As String
    Dim MsgText As String
    Dim mrcc As ADODB.Recordset
   '数据库中如果没有信息，则询问添加
    txtSQL = "select personnel_id ,name from personnel_infor"
    Set mrcc = ExecuteSQL(txtSQL, MsgText)
    If Not mrcc.EOF Then
       mrcc.MoveFirst
    Do While Not mrcc.EOF
         Comzuozhe.AddItem Trim(mrcc.Fields(1))
        '移动到下一条记录
        mrcc.MoveNext
    Loop
    End If
    mrcc.Close
    '将现有的论文编号在编号下拉列表中列出来
    txtSQL = "select lunwen_id from lunwenguanli"
    Set mrcc = ExecuteSQL(txtSQL, MsgText)
    If Not mrcc.EOF Then
       mrcc.MoveFirst
    Do While Not mrcc.EOF
         txtbh.AddItem Trim(mrcc.Fields(0))
        '移动到下一条记录
        mrcc.MoveNext
    Loop
    End If
    mrcc.Close
   Call reflashform
End Sub
上一页 12
💿 文件大小 1984 K
👤 上传用户 syxie
📂 所属分类教育系统应用
🏷️ 相关标签

#办公自动化系统
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -