📄 frmlook.frm

📁 一个自己做的电力管理系统,主要用于电力电业行业的管理
💻 FRM
📖 第 1 页 / 共 2 页
字号:
上一页 12
      End
      Begin VB.CommandButton cmdDel 
         Caption         =   "删除"
         Height          =   375
         Left            =   240
         TabIndex        =   40
         Top             =   1320
         Width           =   1215
      End
      Begin VB.CommandButton cmdUpdata 
         Caption         =   "更新"
         Height          =   375
         Left            =   240
         TabIndex        =   39
         Top             =   2160
         Width           =   1215
      End
      Begin VB.CommandButton cmdAdd 
         Caption         =   "添加"
         Height          =   375
         Left            =   240
         TabIndex        =   38
         Top             =   480
         Width           =   1215
      End
   End
   Begin VB.Frame Frame3 
      Caption         =   "查询信息："
      BeginProperty Font 
         Name            =   "新宋体"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF00FF&
      Height          =   1455
      Left            =   0
      TabIndex        =   0
      Top             =   4680
      Width           =   6975
      Begin VB.CommandButton cmdExit 
         Caption         =   "退出窗体"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Left            =   4560
         TabIndex        =   44
         Top             =   840
         Width           =   1695
      End
      Begin VB.CommandButton cmdSelect 
         Caption         =   "开始查询"
         Height          =   375
         Left            =   360
         TabIndex        =   43
         Top             =   840
         Width           =   1455
      End
      Begin VB.CommandButton cmdClean 
         Caption         =   "数据清除"
         Height          =   375
         Left            =   2520
         TabIndex        =   1
         Top             =   840
         Width           =   1455
      End
      Begin VB.Label Label16 
         Caption         =   "请输入你要查询的学号："
         BeginProperty Font 
            Name            =   "新宋体"
            Size            =   9
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00C0C000&
         Height          =   375
         Left            =   120
         TabIndex        =   2
         Top             =   360
         Width           =   2655
      End
   End
End
Attribute VB_Name = "frmLook"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public i As Integer           'i 为输出数据项的文本框数组的下标
Public dataTable As String    'datatable为所要的查询表
Public selectkey As String    'selectKey 为所要查询的关键字

Private Sub cmdAdd_Click()                '添加数据
  Me.cmdDel.Enabled = False               '使删除按钮和更新按钮无效
  Me.cmdUpdata.Enabled = False
  Me.cmdSave.Enabled = True
End Sub
                                         '取消按钮
Private Sub cmdCancel_Click()
    Me.cmdAdd.Enabled = True
    Me.cmdDel.Enabled = True
    Me.cmdUpdata.Enabled = True
    Me.cmdSave.Enabled = False
End Sub

Private Sub cmdClean_Click()              '清除数据
   Dim j As Integer
   For j = 0 To i
       Me.txtData(j).Text = ""
       Next j
End Sub

Private Sub cmdDel_Click()                 '删除数据
 On Error GoTo errh
 Dim str As String                              '接受查询语句
 Dim Answer As String
 Dim j As Integer
 If Me.txtData(i).Text = "" Then                             '学号为空时不能删除数据
   MsgBox " 你没有要删除的数据，请查询数据后再删除"
   Exit Sub
End If
 Answer = MsgBox("删除后无法恢复，你可要想好了，确实要删除吗？", vbYesNo, "警告！！")
 If Answer = vbYes Then
    Set rs = New ADODB.Recordset
    MakeConnection                                  '连接数据库
    Set rs.ActiveConnection = CN
    rs.Source = "select * from " & dataTable
    rs.Open                                         '删除信息
    str = "delete * from " & dataTable & " where " & selectkey & "='" & Me.txtData(0).Text & "'"
    CN.Execute str
    delConnection                                    '断开数据库
                   '清空纪录
    For j = 0 To i
        Me.txtData(j) = ""
        Next j
    MsgBox "删除成功！"
    Exit Sub
   Else
    Exit Sub                        '防止没有操作时，出现错误提示框
 End If
errh:
     MsgBox Err.Description
End Sub

Private Sub cmdExit_Click()             '退出窗体
    Unload Me
End Sub

Private Sub cmdSave_Click()             '保存数据
 On Error GoTo errh
 Dim j As Integer
 Dim str As String
 Dim strLb As String
 If Me.txtData(0).Text = "" Then
   strLb = "请输入" & Trim(Left(Me.Label2.Caption, Len(Trim(Me.Label2.Caption)) - 1))
   MsgBox strLb
   Me.txtData(0).SetFocus
   Exit Sub
End If
If Me.txtData(1).Text = "" Then
   strLb = "请输入" & Trim(Left(Me.Label1.Caption, Len(Trim(Me.Label1.Caption)) - 1))
   MsgBox strLb
   Me.txtData(1).SetFocus
   Exit Sub
End If
If Me.txtData(2).Text = "" Then
   strLb = "请输入" & Trim(Left(Me.Label7.Caption, Len(Trim(Me.Label7.Caption)) - 1))
   MsgBox strLb
   Me.txtData(2).SetFocus
   Exit Sub
End If
If Me.txtData(3).Text = "" Then
   strLb = "请输入" & Trim(Left(Me.Label3.Caption, Len(Trim(Me.Label3.Caption)) - 1))
   MsgBox strLb
   Me.txtData(3).SetFocus
   Exit Sub
End If
If Me.txtData(4).Text = "" Then
   strLb = "请输入" & Trim(Left(Me.Label4.Caption, Len(Trim(Me.Label4.Caption)) - 1))
   MsgBox strLb
   Me.txtData(4).SetFocus
   Exit Sub
End If
If Me.txtData(5).Text = "" Then
   strLb = "请输入" & Trim(Left(Me.Label5.Caption, Len(Trim(Me.Label5.Caption)) - 1))
   MsgBox strLb
   Me.txtData(5).SetFocus
   Exit Sub
Else
   Set rs = New ADODB.Recordset
   MakeConnection
   Set rs.ActiveConnection = CN
   rs.Source = "select * from " & dataTable & " where " & selectkey & "='" & Me.txtData(0).Text & "'"
   rs.Open
   If rs.EOF Then
       delConnection
       MakeConnection
       Set rs = New ADODB.Recordset
       rs.LockType = adLockOptimistic
       rs.CursorType = adOpenKeyset
       rs.Open dataTable, CN, , , adCmdTable
       rs.AddNew
       For j = 0 To i - 1
           rs.Fields(j).Value = Me.txtData(j).Text
           Next j
       rs.Update
       delConnection        '断开连接
       MsgBox "保存在成功！", vbOKOnly, "恭喜你！"
       Exit Sub
   Else
      If Me.txtData(0).Text = rs.Fields(0).Value Then
          MsgBox "数据库中已经存在数据，请重新输入"
          Me.txtData(0).SetFocus
          Exit Sub
      End If
   End If
End If

errh:                         '错误信息
     MsgBox Err.Description
End Sub

Private Sub cmdSelect_Click()       '查询信息
On Error GoTo errh
If txtData(i).Text = "" Then
    MsgBox "请在框中输入关键的数据，以便查询"
    txtData(i).SetFocus
    Exit Sub
End If
Dim str As String
Dim j As Integer
Set rs = New ADODB.Recordset
   MakeConnection
Set rs.ActiveConnection = CN
rs.Source = " select * from " & dataTable & " where  " & selectkey & "='" & txtData(i).Text & "'"
rs.Open
If rs.EOF Then
    MsgBox "没有找到你所要求的纪录！请重新输入关键字！"
    delConnection
    txtData(i) = ""
    txtData(i).SetFocus
    Exit Sub
Else
   If txtData(i).Text = rs.Fields(0).Value Then
      For j = 0 To i - 1                             '将数据库的值显示出来
          txtData(j).Text = rs.Fields(j).Value
          Next j
      delConnection
      MsgBox "找到你要查询的数据"
      Exit Sub
    End If
End If
errh:
     MsgBox Err.Description
End Sub

Private Sub cmdUpdata_Click()                       '更新数据库
  Dim str As String
    Me.cmdAdd.Enabled = False
    Me.cmdDel.Enabled = False
    Me.cmdSave.Enabled = True
    If Me.txtData(0).Text = "" Then
        MsgBox "你没有要更新的内容，请查询后再更新！"
        Exit Sub
    End If
    Set rs = New ADODB.Recordset       '更新之前，先删除旧的信息
    MakeConnection
    Set rs.ActiveConnection = CN
    rs.Source = "select * from " & dataTable
    rs.Open
    str = "delete * from " & dataTable & " where " & selectkey & "='" & Me.txtData(0).Text & "'"
    CN.Execute str
    delConnection      '断开连接
                       '写入新数据
    MakeConnection
    Set rs = New ADODB.Recordset
    rs.LockType = adLockOptimistic
    rs.CursorType = adOpenKeyset
    rs.Open dataTable, CN, , , adCmdTable
    rs.AddNew
    For j = 0 To i - 1
        rs.Fields(j).Value = Me.txtData(j).Text
        Next j
    rs.Update
    delConnection        '断开连接
    MsgBox "更新成功！", vbOKOnly, "恭喜你！"
    Exit Sub
    
errh:
         MsgBox Err.Description
End Sub

Private Sub Form_Load()
   i = 16
   dataTable = "成绩表考勤表"
   selectkey = "学号"
   MakeCenter Me                  '窗体位于屏幕中间
End Sub
上一页 12
⌨️ 快捷键说明

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