frmfind.frm

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

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 frmfind 
   Caption         =   "统计"
   ClientHeight    =   8145
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   12450
   LinkTopic       =   "Form3"
   ScaleHeight     =   8145
   ScaleWidth      =   12450
   StartUpPosition =   2  '屏幕中心
   Begin StoneXP.XPButton XPButton1 
      Height          =   375
      Left            =   4560
      TabIndex        =   6
      Top             =   360
      Width           =   1095
      _ExtentX        =   1931
      _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
      Caption         =   "统计"
      MouseIcon       =   "frmfind.frx":0000
      MousePointer    =   99
   End
   Begin VB.ComboBox xcombox2 
      Height          =   300
      Left            =   1440
      TabIndex        =   5
      Top             =   600
      Width           =   2655
   End
   Begin StoneXP.XPButton XPButton2 
      Height          =   375
      Left            =   7680
      TabIndex        =   3
      Top             =   360
      Width           =   1095
      _ExtentX        =   1931
      _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
      Caption         =   "返回"
      MouseIcon       =   "frmfind.frx":031A
      MousePointer    =   99
   End
   Begin StoneXP.XPButton print 
      Height          =   375
      Left            =   6120
      TabIndex        =   2
      Top             =   360
      Width           =   1095
      _ExtentX        =   1931
      _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
      Caption         =   "打印"
      MouseIcon       =   "frmfind.frx":0634
      MousePointer    =   99
   End
   Begin VB.ComboBox xcombox1 
      Height          =   300
      Left            =   1440
      TabIndex        =   1
      Top             =   240
      Width           =   2655
   End
   Begin FlexCell.Grid Grid1 
      Height          =   6495
      Left            =   0
      TabIndex        =   7
      Top             =   1080
      Width           =   12135
      _ExtentX        =   21405
      _ExtentY        =   11456
      Appearance      =   0
      Cols            =   10
      Rows            =   30
   End
   Begin VB.Label Label2 
      Caption         =   "种    类："
      Height          =   375
      Left            =   480
      TabIndex        =   4
      Top             =   600
      Width           =   975
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "选择类型："
      Height          =   180
      Left            =   480
      TabIndex        =   0
      Top             =   240
      Width           =   900
   End
End
Attribute VB_Name = "frmfind"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
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
Do While Not rs.EOF
  xcombox1.AddItem rs.Fields(0)
  rs.MoveNext
Loop

Set rs = New Recordset
sqltxt = "select * from zl"
rs.Open sqltxt, cn, adOpenStatic, adLockOptimistic
Do While Not rs.EOF
  xcombox2.AddItem rs.Fields(1)
  rs.MoveNext
Loop

sql = "select lx.类型,zl.种类,zl.特征,zl.处理原则,sgtname.事故头分类名,sgt.事故头分类,sgtname.处理方法,sgtname.处理方法、工具,zl.预防措施,sgtname.处理状态图及工具结构原理图 from lx,zl,sgtname,sgt where lx.类型=zl.类型 and zl.种类=sgtname.种类 and sgtname.事故头分类名= sgt.事故头分类名"
End Sub
Private Sub Form_Resize()
If Me.WindowState <> 1 Then
    Grid1.Left = 0
    Grid1.Width = 12135
    Grid1.Top = 1080
    Grid1.Height = Me.Height - 2000
End If
End Sub


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

Private Sub XPButton1_Click()
If xcombox1.Text = "全部" And xcombox2.Text = "全部" Then
sql = sql & "and lx.类型='" & xcombox1.Text & "'and zl.种类='" & xcombox2.Text & "'"
tj
Else
sql = sql & " and lx.类型='" & xcombox1.Text & "'"
tj
End If
Dim grow As Integer
Dim ssum As Double
grow = Grid1.Rows - 1
For i = 1 To grow
ssum = ssum + Val(Grid1.Cell(i, 6).Text)
Next
Grid1.Rows = Grid1.Rows + 1
Grid1.Cell(Grid1.Rows - 1, 5).Text = "总计数量"
Grid1.Cell(Grid1.Rows - 1, 6).Text = ssum
Grid1.Range(Grid1.Rows - 1, 1, Grid1.Rows - 1, Grid1.Cols - 1).BackColor = RGB(128, 217, 200)
End Sub
Private Sub tj()
'On Error GoTo finish:
Set rs = cnn.Execute(sql)
Grid1.Cols = 10
Grid1.Rows = 1
For i = 1 To Grid1.Cols - 1
Grid1.Cell(0, i).Text = rs.Fields(i - 1).Name
Next
Do While Not rs.EOF
 Grid1.Rows = Grid1.Rows + 1
 Grid1.Cell(Grid1.Rows - 1, 0).Text = Grid1.Rows - 1
 For i = 1 To Grid1.Cols - 1
  If rs.Fields(i - 1) = Null Then
  Grid1.Cell(Grid1.Rows - 1, i).Text = ""
  Else
  Grid1.Cell(Grid1.Rows - 1, i).Text = rs.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
  rs.MoveNext
Loop
Exit Sub
finish:
 MsgBox Err.Description
End Sub

Private Sub XPButton2_Click()
Unload Me
End Sub