frmacess.frm

采用最新的XP类模块

VERSION 5.00
Object = "{DAAC6951-59A4-4C08-9D6E-FE3919B64861}#1.0#0"; "FlexCell.ocx"
Object = "{CFA7AFF4-3242-4269-9172-7389D695AE01}#1.0#0"; "StoneXP.ocx"
Begin VB.Form frmacess 
   Caption         =   "数据库维护"
   ClientHeight    =   8595
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   9675
   LinkTopic       =   "Form1"
   ScaleHeight     =   8595
   ScaleWidth      =   9675
   StartUpPosition =   2  '屏幕中心
   Begin StoneXP.XPButton XPButton10 
      Height          =   375
      Left            =   7320
      TabIndex        =   3
      Top             =   120
      Width           =   1335
      _ExtentX        =   2355
      _ExtentY        =   661
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ButtonStyle     =   3
      Caption         =   "事故头分类表"
      MouseIcon       =   "frmacess.frx":0000
      MousePointer    =   99
   End
   Begin StoneXP.XPButton XPButton9 
      Height          =   375
      Left            =   5040
      TabIndex        =   2
      Top             =   120
      Width           =   1455
      _ExtentX        =   2566
      _ExtentY        =   661
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ButtonStyle     =   3
      Caption         =   "事故头分类名表"
      MouseIcon       =   "frmacess.frx":031A
      MousePointer    =   99
   End
   Begin StoneXP.XPButton XPButton8 
      Height          =   375
      Left            =   2880
      TabIndex        =   1
      Top             =   120
      Width           =   1335
      _ExtentX        =   2355
      _ExtentY        =   661
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ButtonStyle     =   3
      Caption         =   "种类表"
      MouseIcon       =   "frmacess.frx":0634
      MousePointer    =   99
   End
   Begin StoneXP.XPButton XPButton7 
      Height          =   375
      Left            =   600
      TabIndex        =   0
      Top             =   120
      Width           =   1335
      _ExtentX        =   2355
      _ExtentY        =   661
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ButtonStyle     =   3
      Caption         =   "类型表"
      MouseIcon       =   "frmacess.frx":094E
      MousePointer    =   99
   End
   Begin StoneXP.XPButton XPButton6 
      Height          =   375
      Left            =   6600
      TabIndex        =   9
      Top             =   8040
      Width           =   975
      _ExtentX        =   1720
      _ExtentY        =   661
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ButtonStyle     =   1
      Caption         =   "打印"
      MouseIcon       =   "frmacess.frx":0C68
      MousePointer    =   99
   End
   Begin StoneXP.XPButton XPButton4 
      Height          =   375
      Left            =   3720
      TabIndex        =   7
      Top             =   8040
      Width           =   975
      _ExtentX        =   1720
      _ExtentY        =   661
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ButtonStyle     =   1
      Caption         =   "修 改"
      MousePointer    =   99
   End
   Begin FlexCell.Grid Grid1 
      Height          =   7335
      Left            =   120
      TabIndex        =   4
      Top             =   600
      Width           =   9135
      _ExtentX        =   16113
      _ExtentY        =   12938
      Appearance      =   0
      Cols            =   7
      Rows            =   30
      ScrollBars      =   2
   End
   Begin StoneXP.XPButton XPButton1 
      Height          =   375
      Left            =   840
      TabIndex        =   5
      Top             =   8040
      Width           =   975
      _ExtentX        =   1720
      _ExtentY        =   661
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ButtonStyle     =   1
      Caption         =   "增 加"
      MousePointer    =   99
   End
   Begin StoneXP.XPButton XPButton2 
      Height          =   375
      Left            =   2280
      TabIndex        =   6
      Top             =   8040
      Width           =   975
      _ExtentX        =   1720
      _ExtentY        =   661
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ButtonStyle     =   1
      Caption         =   "保 存"
      MousePointer    =   99
   End
   Begin StoneXP.XPButton XPButton5 
      Height          =   375
      Left            =   8040
      TabIndex        =   10
      Top             =   8040
      Width           =   975
      _ExtentX        =   1720
      _ExtentY        =   661
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ButtonStyle     =   1
      Caption         =   "退 出"
      MousePointer    =   99
   End
   Begin StoneXP.XPButton XPButton3 
      Height          =   375
      Left            =   5160
      TabIndex        =   8
      Top             =   8040
      Width           =   975
      _ExtentX        =   1720
      _ExtentY        =   661
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ButtonStyle     =   1
      Caption         =   "删 除"
      MousePointer    =   99
   End
End
Attribute VB_Name = "frmacess"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim cn As ADODB.Connection
Dim cg2 As ADODB.Recordset
Dim grow As Integer
Dim cgtable As String

Private Sub Form_Load()
With Grid1 '这里是grid的一些参数，包含背景色与单元格的列的宽度等等
    .AllowUserResizing = True
    .DisplayFocusRect = False
    '.ExtencgastCol = True
    .Appearance = Flat
    .FixedRowColStyle = Flat
    .ScrollBarStyle = Flat
    
    .DefaultFont.Name = "admin"
    .DefaultFont.Size = 8
    .BackColorFixed = RGB(128, 217, 193)  'RGB(90, 158, 214)
    .BackColorFixedSel = RGB(128, 217, 193)  'RGB(110, 180, 230)
    .BackColorBkg = RGB(128, 217, 193)  'RGB(90, 158, 214)
    .BackColorScrollBar = RGB(128, 217, 193)
    .BackColor1 = RGB(231, 235, 247)
    .BackColor2 = RGB(239, 243, 255)
    .GridColor = RGB(148, 190, 231)
End With
Me.BackColor = RGB(128, 217, 193)
End Sub

Private Sub Form_Resize()
If Me.WindowState <> 1 Then
    Grid1.Left = 0
    Grid1.Width = 9135
    Grid1.Top = 600
    Grid1.Height = 7335
End If
End Sub

Private Sub XPButton1_Click()
cgsave = True
Set cg2 = cnn.Execute(sql)
Grid1.Rows = 1 '清除所有记录
Grid1.Rows = 21 '默认为2行
For i = 0 To 1   '显示数据的字段名
'Grid1.Cell(0, i + 1).Text = cg2.Fields(i).Name  '读取表中的各字段名
Next
Grid1.Column(1).Locked = False
Grid1.Cell(1, 1).SetFocus
XPButton2.Default = True
End Sub

Private Sub XPButton2_Click()
If cgsave = False Then
MsgBox "不支持保存操作！", vbInformation, "当前不支持"
Exit Sub
End If
Call Grid1_RowColChange(hang, 1)
If m <> 0 And n <> 0 Then
Grid1.Range(m, 1, m, 2).BackColor = gcolor1
Grid1.Range(n, 1, n, 2).BackColor = gcolor2
End If
For i = 1 To Grid1.Rows - 1 '从第一行到最后一行检测有些必要数据用户是否填完整了
 For j = i + 1 To Grid1.Rows - 1
  If Grid1.Cell(i, 1).Text <> "" Then
   If Grid1.Cell(i, 2).Text = "" Then
   MsgBox "第" & i & "行的数据请填完整!", vbInformation, "错误提示"
   Grid1.Cell(i, 2).SetFocus
   Exit Sub
   End If
  If Grid1.Cell(i, 1).Text = Grid1.Cell(j, 1).Text And Grid1.Cell(i, 2).Text = Grid1.Cell(j, 2).Text Then
  MsgBox "第" & i & "行与" & j & "行的数据出现重复，请修改!", vbInformation, "重复错误"
  m = i
  n = j
  gcolor1 = Grid1.Cell(m, 1).BackColor '这里主要是检测出有同名的数据，就将相同的两行变色显示，方便用户看出
  gcolor2 = Grid1.Cell(n, 1).BackColor
  Grid1.Range(i, 1, i, 2).BackColor = RGB(90, 158, 214)
  Grid1.Range(j, 1, j, 2).BackColor = RGB(90, 158, 214)
  Exit Sub
  End If
  End If
 Next
Next
For i = 1 To Grid1.Rows - 1 '这里是每一行分别组织一个插入语句，并把数据写入数据库
If Grid1.Cell(i, 1).Text <> "" Then
 sql = "insert into  table  values('"
    For j = 1 To Grid1.Cols - 2
     sql = sql & Grid1.Cell(i, j).Text & "','"
    Next
    sql = sql & Grid1.Cell(i, Grid1.Cols - 1).Text & "')"
Set cg2 = cnn.Execute(sql)
End If
Next
MsgBox "资料已保存！", vbInformation, "完成"
Call callmain
End Sub

Private Sub XPButton3_Click()
If cgdel = False Then '如果当前在添加记录，那么修改和删除都就应是不可用的
MsgBox "当前删除操作不被允许!", vbInformation, "非使用对象"
Exit Sub
End If
If hang = 0 Then
Exit Sub
End If
'If Grid1.Cell(hang, 1).Text = "" Then
'Exit Sub
'End If
'这里组织了SQL中的删除语句进行记录的删除
'Set cg1 = cnn.Execute("delete from table where " & cg2.Fields(0).Name & "='" & Grid1.Cell(hang, 1).Text & "' and " & cg2.Fields(1).Name & "='" & Grid1.Cell(hang, 2).Text & "' and " & cg1.Fields(2).Name & "='" & Grid1.Cell(hang, 3).Text & "'")
MsgBox "目标己删除,请刷新数据!", vbInformation, "删除成功"
Call callmain
End Sub

Private Sub XPButton4_Click()
'On Error GoTo finish:
Dim delok As String
 delok = MsgBox("确认修改刚才修改的所有数据吗？？", vbQuestion + vbOKCancel, "提示")
If delok = vbOK Then
hang = 1
 Do While hang <= Grid1.Rows - 1
 If Grid1.Cell(hang, 1).Text = "" Then
 MsgBox "己完成修改操作!", , "提示"
 Exit Sub
 End If
 '利用SQL的update语句进行修改操作
  sql = "update table set "
            For j = 2 To Grid1.Cols - 2
            sql = sql & cg1.Fields(j - 1).Name & "='" & Grid1.Cell(hang, j).Text & "',"
            Next
  sql = sql & cg2.Fields(7).Name & "='" & Grid1.Cell(hang, 8).Text & "' where " & cg2.Fields(0).Name & "='" & Grid1.Cell(hang, 1).Text & "'"
  Set cg2 = cnn.Execute(sql) '用cg2更新数据集,这样可实现批量更新
  hang = hang + 1
 Loop
 MsgBox "己完成修改操作!", , "提示"
 End If
Exit Sub
finish:
MsgBox Err.Description
End Sub

Private Sub XPButton5_Click()
Unload Me
End Sub

Private Sub XPButton6_Click()
sql = "select * from table "
Unload Me
Classprint.rsDK1 sql
ClassReport.Show
Set ClassReport.DataSource = Classprint.rs1
End Sub

Private Sub XPButton7_Click()
Grid1.Cell(0, 0).SetFocus '防止数据被覆盖
sql = "select * from lx order by 类型 desc"
Grid1.Cols = 2
grow = Grid1.Rows - 1
Grid1.Rows = Grid1.Rows + 1
cgtable = "lx" '当前指向表名为权限
Call callmain
End Sub

Private Sub XPButton8_Click()
sql = "select * from zl order by 种类 desc"
Grid1.Cols = 6
grow = Grid1.Rows - 1
Grid1.Rows = Grid1.Rows + 1
cgtable = "zl" '当前指向表名为权限
Call callmain
End Sub

Private Sub XPButton9_Click()
sql = "select * from sgtname order by 事故头分类名 desc "
Grid1.Cols = 6
grow = Grid1.Rows - 1
Grid1.Rows = Grid1.Rows + 1
Grid1.Column(4).Width = 140
Grid1.Column(5).Width = 200
cgtable = "sgtname" '当前指向表名为权限
Call callmain
End Sub

Private Sub XPButton10_Click()
sql = "select * from sgt order by 事故头分类 desc"
Grid1.Cols = 6
grow = Grid1.Rows - 1
Grid1.Rows = Grid1.Rows + 1
Grid1.Column(3).Width = 150
Grid1.Column(4).Width = 160
Grid1.Column(5).Width = 200
cgtable = "sgt" '当前指向表名为权限
Call callmain
End Sub
Private Sub Grid1_RowColChange(ByVal Row As Long, ByVal Col As Long)
hang = Row '这里是追踪当前鼠标所操作的行位置
End Sub
Private Sub callmain()
'On Error GoTo finish:
Set cg2 = cnn.Execute("select * from " & cgtable)
Grid1.Rows = 1
For i = 1 To Grid1.Cols - 1
Grid1.Cell(0, i).Text = cg2.Fields(i - 1).Name
Next
Do While Not cg2.EOF
 Grid1.Rows = Grid1.Rows + 1
 Grid1.Cell(Grid1.Rows - 1, 0).Text = Grid1.Rows - 1
 For i = 1 To Grid1.Cols - 1
  If cg2.Fields(i - 1) = Null Then
  Grid1.Cell(Grid1.Rows - 1, i).Text = ""
  Else
  Grid1.Cell(Grid1.Rows - 1, i).Text = cg2.Fields(i - 1) & ""
   If Mid(Grid1.Cell(Grid1.Rows - 1, i).Text, 1, 1) = "." Then
   Grid1.Cell(Grid1.Rows - 1, i).Text = "0" & Grid1.Cell(Grid1.Rows - 1, i).Text
   End If
  End If
  Next
  cg2.MoveNext
Loop
Exit Sub
finish:
 MsgBox Err.Description
End Sub