main.frm

检定证书的管理打印程序VB6+ace

VERSION 5.00
Begin VB.Form main 
   Caption         =   "Form1"
   ClientHeight    =   6285
   ClientLeft      =   165
   ClientTop       =   855
   ClientWidth     =   8715
   LinkTopic       =   "Form1"
   ScaleHeight     =   6285
   ScaleWidth      =   8715
   StartUpPosition =   3  '窗口缺省
   Begin VB.Menu jbxxwh 
      Caption         =   "基本信息维护"
      Begin VB.Menu wtdwwh 
         Caption         =   "委托单位维护"
      End
      Begin VB.Menu yqmcwh 
         Caption         =   "仪器名称维护"
      End
      Begin VB.Menu yqxhwh 
         Caption         =   "仪器型号维护"
      End
      Begin VB.Menu zzcx 
         Caption         =   "制造厂"
      End
      Begin VB.Menu jdyjwh 
         Caption         =   "检定依据维护"
      End
      Begin VB.Menu jdqj 
         Caption         =   "检定器具维护"
      End
      Begin VB.Menu jdqjxh 
         Caption         =   "检定器具型号"
      End
      Begin VB.Menu bqdd 
         Caption         =   "不确定度或准确度"
      End
      Begin VB.Menu jdzsmc 
         Caption         =   "检定证书号"
      End
      Begin VB.Menu wdwh 
         Caption         =   "温度"
      End
      Begin VB.Menu sdwh 
         Caption         =   "湿度"
      End
      Begin VB.Menu jdjg 
         Caption         =   "检定结果"
      End
      Begin VB.Menu jdjgsj 
         Caption         =   "检定结果数据"
      End
   End
   Begin VB.Menu zssjwh 
      Caption         =   "证书数据维护"
      Begin VB.Menu lrzs 
         Caption         =   "录入证书"
      End
      Begin VB.Menu xgzs 
         Caption         =   "修改证书"
      End
      Begin VB.Menu sczs 
         Caption         =   "删除证书"
      End
   End
   Begin VB.Menu cxdyzs 
      Caption         =   "查询打印证书"
      Begin VB.Menu abh 
         Caption         =   "按证书编号"
      End
      Begin VB.Menu awtdw 
         Caption         =   "按委托单位"
      End
      Begin VB.Menu ayqmc 
         Caption         =   "按仪器名称"
      End
      Begin VB.Menu mhcxm 
         Caption         =   "模糊查询"
      End
   End
   Begin VB.Menu tuc 
      Caption         =   "退出"
   End
End
Attribute VB_Name = "main"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Any, ByVal fuWinIni As Long) As Long
Private Type rect
   left As Long
   top As Long
   right As Long
   botton As Long
End Type
Dim desktoparea As rect
Private Const SPI_GETWORKAREA = 48
Dim screenwidth&, screenheight&, screenleft&, screentop&

Private Sub abh_Click()
caxiun = 1
abhc.Show 1
End Sub

Private Sub awtdw_Click()
caxiun = 2
abhc.Show 1
End Sub

Private Sub axh_Click()

End Sub

Private Sub ayqmc_Click()
caxiun = 3
abhc.Show 1
End Sub

Private Sub bqdd_Click()
flag = 7
jbxx.Show 1
End Sub

Private Sub Form_Load()
On Error GoTo err1
xtm = "林甸县质量技术监督局"
Me.Caption = xtm
Call SystemParametersInfo(SPI_GETWORKAREA, 0, desktoparea, 0)
screenwidth = (desktoparea.right - desktoparea.left) * Screen.TwipsPerPixelX
screenheight = (desktoparea.botton - desktoparea.top) * Screen.TwipsPerPixelY
main.Width = screenwidth
main.Height = screenheight
main.Move 0, 0
conns = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + App.Path + "\bak.mdb"
Set conn = New ADODB.Connection
conn.Open conns
Set grs = New ADODB.Recordset
bm(0) = "证书编号"
bm(1) = "委托单位"
bm(2) = "仪器名称"
bm(3) = "型号规格"
bm(4) = "制造厂"
bm(5) = "出厂编号"
bm(6) = "检定结论"
bm(7) = "室主任"
bm(8) = "检验员"
bm(9) = "检定员"
bm(10) = "检定日期"
bm(11) = "有效期至"
bm(12) = "1.本次检定技术依据"
bm(13) = "温度"
bm(14) = "湿度"
bm(15) = "检定结果"
bmm(0) = "名  称"
bmm(1) = "型号/规格"
bmm(2) = "不确定度"
bmm(3) = "检定证书号"
btt(0) = 20
btt(1) = 20
btt(2) = 20
btt(3) = 20
err1:
  If err.Number = -2147467259 Then
      creatdb App.Path
      CreateTable App.Path
      Resume
  End If
  
End Sub
Public Sub creatdb(dirr As String)
'On Error GoTo errorhander
     Dim cat As New ADOX.Catalog
     cat.Create conns
     Set cat = Nothing
'errorhander:
End Sub

Sub CreateTable(dirr As String)
' On Error GoTo err
 Dim con As New ADODB.Connection
'字典表************************************
    sql1 = "create table  wtdwb(sy integer not null unique,wtdwmc  text(20))"
    sql2 = "create table  yqmcb(sy integer  not null,yqflm  integer , yqmc text(20) not null)"
    sql3 = "create table  xhggb(sy integer not null ,yqxhm integer ,xhmc text(20) not null)"
    sql4 = "create table jdyjb(sy integer not null,yjmc text(30))"
    sql5 = "create table jdqjmcb(sy  integer not null,yqflm integer unique,yqmc text(20))"
    sql6 = "create table jdqjxhb(sy  integer not null ,yqflm integer,yqxh text(20))"
    sql7 = "create table zqdb(sy integer not null ,zqdmc text(20))"
    sql8 = "create table jdjgmcb(sy integer not null,jdjgmc text(20))"
    sql9 = "create table jdjgsjb(sy  integer not null,jdjgsj text(10))"
    sql10 = "create table zzcb(sy  integer not null,zzc text(30))"
    
'*******************************************
    sql11 = "create table jdzsb(zsbh text(9)  not null unique,wtdwmc text(30),yqmc text(30), yqgg text(30),zzc text(30),ccbh text(20),jdjl text(4),szr text(4),jyy text(4),jdy text(4), jdrq text(10),yxqz text(10),jdyq text(40),wd text(10), sd text(10))"
    sql12 = "create table zyjlqjb(zsbh text(9) not null,qjmc text(20) not null,qjxh text(20),zqdmc text(20), jdzsh text(20))"
    sql13 = "create table jdjgb (zsbh text(9) not null,jdjg text(200))"
'***************************************************
    sql14 = "create table dyjwz(dyjm text(20) not null unique," '打印机位置表
    For i = 0 To 80
       sql14 = sql14 + "wz" + Trim(str(i)) & "  Single,"
    Next i
    sql14 = Mid(sql14, 1, Len(sql14) - 1) + ")"
    sql15 = "create table wdb(sy integer not null,flbz integer,wd text(10))" '温度表
    sql16 = "create table sdb(sy integer not null,flbz integer,sd text(10))" '湿度表
    sql17 = "create table qjjdzsb(sy integer not null,flbz integer,jdzs text(20))" '检定器具编号表
    Set con = New ADODB.Connection
    con.Open conns
    con.Execute sql1
    con.Execute sql2
    con.Execute sql3
    con.Execute sql4
    con.Execute sql5
    con.Execute sql6
    con.Execute sql7
    con.Execute sql8
    con.Execute sql9
    con.Execute sql10
    Debug.Print sql11
    con.Execute sql11
    con.Execute sql12
    con.Execute sql13
    con.Execute sql14
    con.Execute sql15
    con.Execute sql16
    con.Execute sql17
    con.Close
    Set con = Nothing
err:
    Set con = Nothing
End Sub

Private Sub jdjg_Click()
flag = 8
jbxx.Show 1

End Sub

Private Sub jdjgsj_Click()
flag = 9
jbxx.Show 1
End Sub

Private Sub jdqj_Click()
flag = 5
jbxx.Show 1
End Sub

Private Sub jdqjxh_Click()
flag = 6
jbxx.Show 1
End Sub

Private Sub jdyjwh_Click()
flag = 4
jbxx.Show 1
End Sub

Private Sub jdzsmc_Click()
flag = 88
jbxx.Show 1
End Sub

Private Sub lrzs_Click()
sjlr.Show 1
End Sub

Private Sub mhcx_Click()

End Sub

Private Sub mhcxm_Click()
mhcx.Show 1
End Sub

Private Sub sczs_Click()
jdzsb.Show 1
End Sub

Private Sub sdwh_Click()
flag = 100
jbxx.Show 1
End Sub

Private Sub tuc_Click()
End
End Sub

Private Sub wdwh_Click()
flag = 99
jbxx.Show 1
End Sub

Private Sub wtdwwh_Click()
flag = 1
jbxx.Show 1
End Sub

Private Sub xgzs_Click()
jdzsb.Show 1
End Sub

Private Sub yqmcwh_Click()
flag = 2
jbxx.Show 1
End Sub

Private Sub yqxhwh_Click()
flag = 3
jbxx.Show 1
End Sub

Private Sub zzcx_Click()
flag = 10
jbxx.Show 1
End Sub