frmview.frm

来自「采用最新的XP类模块」· FRM 代码 · 共 336 行

VERSION 5.00
Object = "{DAAC6951-59A4-4C08-9D6E-FE3919B64861}#1.0#0"; "FlexCell.ocx"
Begin VB.Form frmview 
   Caption         =   "浏览"
   ClientHeight    =   8955
   ClientLeft      =   1230
   ClientTop       =   1500
   ClientWidth     =   9510
   Icon            =   "frmview.frx":0000
   LinkTopic       =   "Form2"
   ScaleHeight     =   8955
   ScaleWidth      =   9510
   StartUpPosition =   2  '屏幕中心
   Begin FlexCell.Grid Grid1 
      Height          =   6255
      Left            =   120
      TabIndex        =   15
      Top             =   2280
      Width           =   7935
      _ExtentX        =   13996
      _ExtentY        =   11033
      Cols            =   11
      Rows            =   30
   End
   Begin VB.CommandButton Command1 
      Caption         =   "统计"
      Height          =   375
      Left            =   8400
      TabIndex        =   14
      Top             =   1560
      Width           =   975
   End
   Begin VB.CheckBox Check1 
      Caption         =   "模糊查询"
      Height          =   375
      Left            =   8400
      TabIndex        =   13
      Top             =   360
      Width           =   1335
   End
   Begin VB.CommandButton cmdexit 
      Caption         =   "退出"
      Height          =   375
      Left            =   8400
      TabIndex        =   7
      Top             =   7440
      Width           =   975
   End
   Begin VB.CommandButton cmdprint 
      Caption         =   "打印"
      Height          =   375
      Left            =   8400
      TabIndex        =   6
      Top             =   6600
      Width           =   975
   End
   Begin VB.CommandButton cmdSeek 
      Caption         =   "查询"
      Height          =   375
      Left            =   8400
      TabIndex        =   5
      Top             =   960
      Width           =   975
   End
   Begin VB.Frame fraSeek 
      Caption         =   "查询"
      Height          =   2295
      Left            =   120
      TabIndex        =   0
      Top             =   0
      Width           =   7935
      Begin VB.ListBox List4 
         Height          =   1860
         Left            =   5880
         MultiSelect     =   2  'Extended
         TabIndex        =   4
         Top             =   240
         Width           =   1935
      End
      Begin VB.ListBox List3 
         Height          =   1860
         Left            =   3720
         MultiSelect     =   2  'Extended
         TabIndex        =   3
         Top             =   240
         Width           =   1815
      End
      Begin VB.ListBox List2 
         Height          =   1860
         Left            =   2040
         TabIndex        =   2
         Top             =   240
         Width           =   1335
      End
      Begin VB.ListBox List1 
         Height          =   1860
         ItemData        =   "frmview.frx":29C12
         Left            =   480
         List            =   "frmview.frx":29C19
         TabIndex        =   1
         Top             =   240
         Width           =   1095
      End
      Begin VB.Label Label3 
         Caption         =   "事故头分类："
         Height          =   615
         Left            =   5520
         TabIndex        =   12
         Top             =   240
         Width           =   375
      End
      Begin VB.Label lblClass 
         AutoSize        =   -1  'True
         Height          =   180
         Left            =   240
         TabIndex        =   11
         Top             =   840
         Width           =   90
      End
      Begin VB.Label lblDep 
         AutoSize        =   -1  'True
         Caption         =   "类型："
         Height          =   180
         Left            =   0
         TabIndex        =   10
         Top             =   240
         Width           =   540
      End
      Begin VB.Label Label1 
         Caption         =   "种类："
         Height          =   375
         Left            =   1560
         TabIndex        =   9
         Top             =   240
         Width           =   735
      End
      Begin VB.Label Label2 
         Caption         =   "事故头分类名："
         Height          =   735
         Left            =   3360
         TabIndex        =   8
         Top             =   240
         Width           =   495
      End
   End
End
Attribute VB_Name = "frmview"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim sql As String
Dim mohu As String
Dim fnumber As Integer
Dim tkbase As String
Dim cg2 As ADODB.Recordset
Private Sub cmdexit_Click()
Unload Me
End Sub

Private Sub cmdprint_Click()
sql = "select lx.类型,zl.种类,zl.特征,zl.处理原则,sgtname.事故头分类名,sgt.事故头分类,sgtname.处理方法,sgtname.处理方法、工具,zl.预防措施,sgtname.处理状态图及工具结构原理图 from lx,zl,sgtname,sgt where 类型='" & List1.Text & "'"
Unload Me
Classprint.rsDK1 sql
ClassReport.Show
Set ClassReport.DataSource = Classprint.rs1
End Sub

Private Sub cmdSeek_Click()
If Check1.Value = 1 Then
mohu = " like "
Else: mohu = " = "
End If
If List1.Text <> "" Then
   sql = "lx.类型" & mohu & "'" & peifu(mohu) & Trim(List1.Text) & peifu(mohu) & "'"
ElseIf List2.Text <> "" Then
    If sql <> "" Then
    sql = sql & "and 种类" & mohu & "'" & peifu(mohu) & Trim(List2.Text) & peifu(mohu) & "'"
    Else
    sql = " 种类" & mohu & "'" & peifu(mohu) & Trim(List2.Text) & peifu(mohu) & "'"
    End If
ElseIf List3.Text <> "" Then
    If sql <> "" Then
    sql = sql & "and 事故头分类名" & mohu & "'" & peifu(mohu) & Trim(List3.Text) & peifu(mohu) & "'"
    Else
    sql = " 事故头分类名" & mohu & "'" & peifu(mohu) & Trim(List3.Text) & peifu(mohu) & "'"
    End If
ElseIf List4.Text <> "" Then
    If sql <> "" Then
    sql = sql & "and 事故头分类" & mohu & "'" & peifu(mohu) & Trim(List4.Text) & peifu(mohu) & "'"
    Else
    sql = " 事故头分类" & mohu & "'" & peifu(mohu) & Trim(List4.Text) & peifu(mohu) & "'"
    End If
End If
sql = "select distinct lx.类型,zl.种类,zl.特征,zl.处理原则,sgtname.事故头分类名,sgt.事故头分类,sgtname.处理方法,sgtname.处理方法、工具,zl.预防措施,sgtname.处理状态图及工具结构原理图 from lx,zl,sgtname,sgt where " & sql
'sql = "select * from lx where  " & sql

seeku

End Sub
Private Function peifu(ss As String) As String
If ss = " = " Then
peifu = ""
ElseIf ss = " like " Then
peifu = "%"
End If
End Function

Private Sub Command1_Click()
frmfind.Show vbModal
End Sub

Private Sub Form_Load()
dbname = App.Path + "\drilling.mdb"
conn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source='" & dbname & "'"
Set cn = New ADODB.Connection
   cn.Open conn
Set rs = New Recordset
sqltxt = "select * from lx"
rs.Open sqltxt, cn, adOpenStatic, adLockOptimistic
List1.Clear
Do While Not rs.EOF
  List1.AddItem rs.Fields("类型")
  rs.MoveNext
Loop
With Grid1
    .AllowUserResizing = True
    .DisplayFocusRect = False
    .ExtendLastCol = True
    .Appearance = Flat
    .FixedRowColStyle = Flat
    .ScrollBarStyle = Flat
    .DefaultFont.Name = "admin"
    .DefaultFont.Size = 8
    .BackColorFixed = RGB(84, 201, 134)
    .BackColorFixedSel = RGB(167, 111, 177)
    .BackColorBkg = RGB(198, 229, 211)
    .BackColorScrollBar = RGB(167, 111, 177)
    .BackColor1 = RGB(231, 235, 247)
    .BackColor2 = RGB(198, 229, 211)
    .GridColor = RGB(148, 190, 231)
    .Column(0).Width = 20
End With
End Sub
Private Sub List1_Click()
dbname = App.Path + "\drilling.mdb"
conn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source='" & dbname & "'"
Dim ncn1 As ADODB.Connection
Dim nrs1 As ADODB.Recordset

Set ncn1 = New ADODB.Connection
    ncn1.Open conn
Set nrs1 = New Recordset
If Trim(List1.Text) <> "" Then

  nSQLtxt1 = "select * from zl where 类型 ='" & Trim(List1.Text) & "'"
  nrs1.Open nSQLtxt1, ncn1, adOpenStatic, adLockOptimistic
  List2.Clear
  List3.Clear
  List4.Clear
Do While Not nrs1.EOF
  List2.AddItem nrs1.Fields("种类")
  nrs1.MoveNext
Loop
End If
End Sub
Private Sub List2_Click()
dbname = App.Path + "\drilling.mdb"
conn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source='" & dbname & "'"
Dim ncn2 As ADODB.Connection
Dim nrs2 As ADODB.Recordset

Set ncn2 = New ADODB.Connection
   ncn2.Open conn
Set nrs2 = New Recordset

If Trim(List2.Text) <> "" Then

  nSQLtxt2 = "select * from sgtname where 种类 ='" & Trim(List2.Text) & "'"
  nrs2.Open nSQLtxt2, ncn2, adOpenStatic, adLockOptimistic
  List3.Clear
  List4.Clear
Do While Not nrs2.EOF
  List3.AddItem nrs2.Fields("事故头分类名")
  nrs2.MoveNext
Loop
End If
End Sub
Private Sub List3_Click()
dbname = App.Path + "\drilling.mdb"
conn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source='" & dbname & "'"
Dim ncn3 As ADODB.Connection
Dim nrs3 As ADODB.Recordset

Set ncn3 = New ADODB.Connection
   ncn3.Open conn
Set nrs3 = New Recordset
If Trim(List3.Text) <> "" Then
  nSQLtxt3 = "select * from sgt where 事故头分类名 ='" & Trim(List3.Text) & "'"
  nrs3.Open nSQLtxt3, ncn3, adOpenStatic, adLockOptimistic
  List4.Clear
Do While Not nrs3.EOF
  List4.AddItem nrs3.Fields("事故头分类")
  nrs3.MoveNext
Loop
End If
End Sub
Private Sub seeku()
'On Error GoTo finish:
Set cg2 = cnn.Execute(sql)
Grid1.Cols = 11
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 - 2
  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