formmain.frm

奖学金查询系统

         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   12582912
      BevelWidth      =   0
      Layout          =   3
      MouseOverColor  =   16777215
      ScaleWidth      =   73
      ScaleMode       =   0
      ScaleHeight     =   57
      BackStyle       =   0
      Object.ToolTipText     =   "添加销售记录"
   End
   Begin VB.Image Image1 
      Height          =   255
      Left            =   11040
      MouseIcon       =   "Formmain.frx":511F7
      MousePointer    =   99  'Custom
      Top             =   8640
      Width           =   495
   End
   Begin VB.Label Label2 
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "当前操作员"
      ForeColor       =   &H00000000&
      Height          =   255
      Left            =   120
      TabIndex        =   1
      Top             =   1680
      Width           =   1455
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "admin"
      ForeColor       =   &H000000FF&
      Height          =   255
      Left            =   120
      TabIndex        =   0
      Top             =   1920
      Width           =   1455
   End
End
Attribute VB_Name = "Formmain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim addmx As Boolean
Dim yxsave As Boolean
Dim yxedit As Boolean
Dim yxdel As Boolean
Private Declare Function GetKeyState Lib "user32" _
   (ByVal nVirtKey As Long) As Integer

Private Sub asPopup1_Click(Cancel As Boolean)
Call XPButton8_Click
End Sub

Private Sub asPopup2_Click(Cancel As Boolean)
cx.Show 1
End Sub

Private Sub asPopup5_Click(Cancel As Boolean)
yxsave = False '不可保存，可删除，可修改
yxedit = True
yxdel = True
addmx = False '添加明细不可用
Grid1.Rows = 1
Grid1.Column(1).Locked = True
Grid1.Column(2).Locked = True
yxsql = "select * from 奖学金记录 order by 获得奖学金时间 desc"
yxkusee '执行过程,执行数据的查询与显示
End Sub

Private Sub asPopup9_Click(Cancel As Boolean)
End
End Sub

Private Sub Form_Load()
On Error GoTo finish:
Grid1.SetRegisterInformation "CNwinndy", "W]vyY-nonvk-u\nty-Zbl_e-`hms^" '进行注册
Me.Picture = LoadPicture(App.Path & "\images\bgmain.jpg")
yxsql = "select * from 奖学金记录"
yxnumber = 5 '设定表中有多少个字段，在这里使用变量是防止以后程序修改后只需要修改
              '这个关键字就可以了
Grid1.Cols = yxnumber + 1
Grid1.Column(1).Width = 90 '合理的设定表格中每列的宽度
Grid1.Column(2).Width = 98
Grid1.Column(3).Width = 110
Grid1.Column(4).Width = 90
Grid1.Column(5).Width = 60
Grid1.Column(2).CellType = cellCalendar
Grid1.DisplayFocusRect = False '改变输入模式为平面
Label1 = yxadmin '当前操作员的名字
'*****************通过用户获取权限，来分配用户哪些程序可以使用
Set yx3 = cnn.Execute("select * from 用户 where 用户名='" & yxadmin & "'")
If yx3.Fields(2) = "0" Then
 asPopup5.Enabled = False '不可查看
End If
If yx3.Fields(3) = "0" Then
 XPButton1.Enabled = False '不可新增
 XPButton2.Enabled = False '不可增加明细
 XPButton3.Enabled = False '不可保存
End If
If yx3.Fields(4) = "0" Then
 XPButton4.Enabled = False '不可修改
End If
If yx3.Fields(5) = "0" Then
 XPButton5.Enabled = False '不可删除
End If
If yx3.Fields(6) = "0" Then
 XPButton6.Enabled = False '不可查询
 asPopup1.Enabled = False '不可查询
End If
If yx3.Fields(7) = "0" Then
 asPopup2.Enabled = False '不可使用用户管理
End If
'*****************
Set yx1 = cnn.Execute(yxsql) '执行某一SQL语句，并将结果返回到记录集yx1
For i = 1 To Grid1.Cols - 1
Grid1.Cell(0, i).Text = yx1.Fields(i - 1).Name
Next
Grid1.BackColorFixed = RGB(242, 244, 189)
'****************************grid2表格控件的配置
Grid2.AllowUserResizing = False
Grid2.DisplayFocusRect = False '改变输入模式为平面
Grid2.Column(0).Width = 0
Grid2.Column(2).Width = 100
Grid2.Column(4).Width = 108
Grid2.Column(5).Width = 200
Grid2.Column(1).CellType = cellComboBox
Grid2.Column(2).CellType = cellComboBox
Grid2.Column(3).CellType = cellComboBox
Grid2.Cell(0, 1).Text = "查询模式" '将表格内添入固定内容
Grid2.Cell(0, 2).Text = "查询段"
Grid2.Cell(0, 3).Text = "条件"
Grid2.Cell(0, 4).Text = "关键字"
Grid2.Cell(0, 5).Text = "附加条件"
Grid2.ComboBox(1).AddItem "精确查询" '这里是类似combo框的操作，也是把内容添入combo控件的记录集
Grid2.ComboBox(1).AddItem "模糊查询"
Set yx2 = cnn.Execute("select * from 奖学金记录")
For i = 1 To Grid1.Cols - 1
Grid2.ComboBox(2).AddItem yx2.Fields(i - 1).Name
Next
'************************************
Exit Sub
finish:
MsgBox Err.Description
End Sub

Private Sub yxkusee() '这里是通过引入的SQL语句来执行数据的显示
Set yx1 = cnn.Execute(yxsql)
Do While Not yx1.EOF '当yx1记录集未到结尾时执行
Grid1.Rows = Grid1.Rows + 1
Grid1.Cell(Grid1.Rows - 1, 0).Text = yx1.Fields(5)
 For j = 1 To Grid1.Cols - 1 '设定读取列
 If Not yx1.Fields(j - 1) Is Nothing Then '空值的处理
  Grid1.Cell(Grid1.Rows - 1, j).Text = yx1.Fields(j - 1)
 Else
 Grid1.Cell(Grid1.Rows - 1, j).Text = ""
 End If
 Next
 yx1.MoveNext
Loop
End Sub
Private Sub Grid1_RowColChange(ByVal Row As Long, ByVal Col As Long)
hang = Row
 If Grid1.Rows <> 1 Then '以下几句代码主要实现鼠标点击行时行背景自动变色
  Grid1.Range(1, 1, Grid1.Rows - 1, Grid1.Cols - 1).BackColor = vbWhite
  Grid1.Range(Row, 1, Row, Grid1.Cols - 1).BackColor = RGB(90, 158, 214)
 End If
End Sub

Private Sub Grid1_Validate(Cancel As Boolean)
'以下的程序来源于本控件不支持TAB键切换到下一单元格,所以以下的代码就可以实现
    Dim nActiveRow As Long, nActiveCol As Long
    Const VK_TAB = 9

    If GetKeyState(VK_TAB) < 0 Then
        nActiveRow = Grid1.ActiveCell.Row
        nActiveCol = Grid1.ActiveCell.Col
        If nActiveCol < Grid1.Cols - 1 Then
            Grid1.Range(nActiveRow, nActiveCol + 1, _
                        nActiveRow, nActiveCol + 1).Selected
        End If
        Cancel = True
    End If
End Sub

Private Sub Grid2_RowColChange(ByVal Row As Long, ByVal Col As Long)
If Grid2.Cell(1, 1).Text <> "" Then
If Grid2.Cell(1, 1).Text = "精确查询" Then
Grid2.ComboBox(3).Clear '以下清除表格中combo集中的内容,并加入以下内容
Grid2.ComboBox(3).AddItem "="
Grid2.ComboBox(3).AddItem ">"
Grid2.ComboBox(3).AddItem "<"
Grid2.ComboBox(3).AddItem ">="
Grid2.ComboBox(3).AddItem "<="
Grid2.ComboBox(3).AddItem "<>"
Grid2.ComboBox(2).Clear '先清空记录集
Set yx2 = cnn.Execute("select * from 奖学金记录")
For i = 1 To Grid1.Cols - 1
Grid2.ComboBox(2).AddItem yx2.Fields(i - 1).Name
Next
Else
Grid2.ComboBox(3).Clear
Grid2.ComboBox(3).AddItem "like"
Grid2.ComboBox(2).Clear
Set yx2 = cnn.Execute("select * from 奖学金记录")
For i = 1 To Grid1.Cols - 1
 Select Case i '这里使用case语句是因为模糊查询中数值型是不支持的
   Case 1, 3, 5
   Grid2.ComboBox(2).AddItem yx2.Fields(i - 1).Name
 End Select
Next
End If
End If
End Sub

Private Sub Image1_Click()
End
End Sub

Private Sub Label9_Click()

End Sub

Private Sub XPButton1_Click()
yxsave = True
yxedit = False
yxdel = False
addmx = True '指示当前可以添加明细，即grid的行数
Grid1.Rows = 1 '使用等于1可以将表格中的残余数据清空
Grid1.Rows = 2
Grid1.Column(1).Locked = False
Grid1.Column(2).Locked = False
Grid1.Cell(Grid1.Rows - 1, 0).Text = Grid1.Rows - 1
End Sub
Private Sub XPButton2_Click()
If addmx = True Then
Grid1.Rows = Grid1.Rows + 1
Grid1.Cell(Grid1.Rows - 1, 0).Text = Grid1.Rows - 1
End If
End Sub

Private Sub XPButton3_Click()
If yxsave = False Then
MsgBox "当先为非保存状态！", , "错误"
Exit Sub
End If
For i = 1 To Grid1.Rows - 1 '有些字段属于必填字段,在这里就要对其进行检查,确定后来的语句组织正确
 For j = 1 To Grid1.Cols - 2
  If Grid1.Cell(i, j).Text = "" Then
  MsgBox "第" & i & "行的[ " & Grid1.Cell(0, j).Text & " ]字段不允许为空!"
  Grid1.Cell(i, j).SetFocus
  Exit Sub
  End If
  Next
Next
For i = 1 To Grid1.Rows - 1
'**********************以下是保存销售记录
 yxsql = "insert into 奖学金记录(姓名,获得奖学金时间,发放奖学金学校,奖学金金额,奖学金具体内容) values('" & Grid1.Cell(i, 1).Text & "','" & Grid1.Cell(i, 2).Text & "','" & Grid1.Cell(i, 3).Text & "'," & Grid1.Cell(i, 4).Text & ",'" & Grid1.Cell(i, 5).Text & "')"
 '以上就是通过SQL的插入语句方式进行组织插入语句,而通过循环的方式执行可以实现批量添加数据
Set yx1 = cnn.Execute(yxsql)
Next
MsgBox "登记操作已完成！", vbInformation, "操作完成"
Call asPopup5_Click(True)
End Sub

Private Sub XPButton4_Click()
If hang = 0 Or yxedit = False Then
Exit Sub
End If
     yxsql = "update 奖学金记录 set 姓名='" & Grid1.Cell(hang, 1).Text & "',获得奖学金时间='" & Grid1.Cell(hang, 2).Text & "',发放奖学金学校='" & Grid1.Cell(hang, 3).Text & "',奖学金金额=" & Grid1.Cell(hang, 4).Text & ",奖学金具体内容='" & Grid1.Cell(hang, 5).Text & "' where 自动编号=" & Grid1.Cell(hang, 0).Text
     Set yx1 = cnn.Execute(yxsql)
MsgBox "修改操作完成,此行已改变！"
End Sub

Private Sub XPButton5_Click() '删除操作
If hang = 0 Or yxdel = False Then
Exit Sub
End If
yxsql = "delete from 奖学金记录 where 自动编号=" & Grid1.Cell(hang, 0).Text
Set yx1 = cnn.Execute(yxsql)
MsgBox "删除完成,此行已改变,建议刷新数据！"
End Sub

Private Sub XPButton6_Click()
On Error GoTo finish '防错代码，防止用户组织语句的错误或其它不可预见的错误发生
If Grid2.Cell(1, 1).Text <> "" And Grid2.Cell(1, 2).Text <> "" And Grid2.Cell(1, 3).Text <> "" And Grid2.Cell(1, 4).Text <> "" Then
    If Grid2.Cell(1, 1).Text = "精确查询" Then
      Select Case Grid2.Cell(1, 2).Text '处理数值型的查询组织语句
      Case "获得奖学金时间"
      yxsql = "select * from 奖学金记录"
      Grid1.Rows = 1
      yxkusee1
      XPFrame1.Visible = False
      Exit Sub
      Case Else
      yxsql = "select * from 奖学金记录 where " & Grid2.Cell(1, 2).Text & Grid2.Cell(1, 3).Text & "'" & Grid2.Cell(1, 4).Text & "'"
     End Select
    Else
    yxsql = "select * from 奖学金记录 where " & Grid2.Cell(1, 2).Text & " like '%" & Grid2.Cell(1, 4).Text & "%'"
    End If
    If Grid2.Cell(1, 5).Text <> "" Then
    yxsql = yxsql & " " & Grid2.Cell(1, 5).Text
    End If
  Grid1.Rows = 1
  yxkusee
  XPFrame1.Visible = False
Else
MsgBox "查询时关键组成部分不可以出现空格！"
End If
Exit Sub
finish:
  MsgBox Err.Description
End Sub

Private Sub XPButton7_Click()
XPFrame1.Visible = False
End Sub

Private Sub XPButton8_Click()
yxsave = False
yxedit = True
yxdel = True
XPFrame1.Visible = True
End Sub
Private Sub yxkusee1() '这里是通过引入的SQL语句来执行数据的显示
'因为access数据库针对日期的SQL语句查询支持非常差,因此要准确的执行日期查询只能通过ADO的逐个配对
Set yx1 = cnn.Execute(yxsql)
Do While Not yx1.EOF '当yx1记录集未到结尾时执行
If yx1.Fields(1) = Grid2.Cell(1, 4).Text Then
Grid1.Rows = Grid1.Rows + 1
Grid1.Cell(Grid1.Rows - 1, 0).Text = yx1.Fields(5)
 For j = 1 To Grid1.Cols - 1 '设定读取列
 If Not yx1.Fields(j - 1) Is Nothing Then '空值的处理
  Grid1.Cell(Grid1.Rows - 1, j).Text = yx1.Fields(j - 1)
 Else
 Grid1.Cell(Grid1.Rows - 1, j).Text = ""
 End If
 Next
 End If
 yx1.MoveNext
Loop
End Sub