frm_计量器具信息.frm

计量器具管理系统

    Cjdjg.Enabled = True
End Sub
Private Sub RsToText(rs As ADODB.Recordset)
'On Error GoTo err
    Tbh = Trim(rs!Bh)
    Tmc = Trim(rs!Mc)
    CZt.Text = Trim(rs!zt)
    Clb.Text = Trim(rs!lb)
    Czb.Text = Trim(rs!zb)
    Cdj.Text = Trim(rs!dj)
    Tggxh = Trim(rs!ggxh)
    Tclfw = Trim(rs!clfw)
    Tfdz = Trim(rs!fdz)
    Tsccj = Trim(rs!sccj)
    Tccbh = Trim(rs!ccbh)
    Csybm.Text = Trim(rs!sybm)
    Tsyz = Trim(rs!syz)
    Tjdzq = Trim(rs!Jdzq)
    Czqdw.Text = Trim(rs!Zqdw)
    Dim rst As New ADODB.Recordset '提取检测信息
    Dim str As String
    If rst.State = 1 Then rst.Close
    rst.CursorLocation = adUseClient
    rst.Open "select max(bcjdrq) as jdrq from jlqjjd where bh='" & Trim(rs!Bh) & "'", Conn
    If IsNull(rst!jdrq) = False Then
        DTPjdrq.Value = rst!jdrq
        rst.Close
        rst.CursorLocation = adUseClient
        rst.Open "select * from jlqjjd where bh='" & Trim(rs!Bh) & "' and bcjdrq=#" & DTPjdrq.Value & "#", Conn
        If rst.EOF = False Then
            Tjddw.Text = rst!Bcjddw
            Cjdjg.Text = rst!bcjdjg
            Tjdjg.Text = IIf(IsNull(rst!jdbz), "", rst!jdbz)
        End If
    Else
        Tjddw = Trim(rs!Jddw)
        Cjdjg.Text = Trim(rs!jdjg)
        Tjdjg.Text = IIf(IsNull(rs!jdbz), "", rs!jdbz)
        DTPjdrq.Value = rs!jdrq
    End If
    DTPqyrq.Value = rs!qyrq
'    DTPbfrq.Value = rs!bfrq
    Exit Sub
ERR:
    MsgBox ERR.Description, vbCritical, "错误提示"
    Exit Sub
End Sub
Private Sub TextToRs(rs As ADODB.Recordset)
'On Error GoTo err
    rs!Bh = Trim(Tbh)
    rs!Mc = Trim(Tmc)
    rs!zt = Trim(CZt.Text)
    rs!lb = Trim(Clb.Text)
    rs!zb = Trim(Czb.Text)
    rs!dj = Trim(Cdj.Text)
    rs!ggxh = Trim(Tggxh)
    rs!clfw = Trim(Tclfw)
    rs!fdz = Trim(Tfdz)
    rs!sccj = Trim(Tsccj)
    rs!ccbh = Trim(Tccbh)
    rs!sybm = Trim(Csybm.Text)
    rs!syz = Trim(Tsyz)
    rs!Jdzq = CInt(Val(Tjdzq))
    rs!Zqdw = Trim(Czqdw.Text)
    Dim rst As New ADODB.Recordset
    If rst.State = 1 Then rst.Close
    rst.Open "select * from jlqjjd where bh='" & Trim(Tbh) & "' and bz='基本信息'", Conn, adOpenDynamic, adLockBatchOptimistic
    If rst.EOF = False Then
        rst!Mc = Trim(Tmc)
        rst!Dwmc = Dwmc
        rst!jlsj = Now
        rst!Bcjddw = Trim(Tjddw.Text)
        '''''
        rst!bcjdjg = Trim(Cjdjg.Text)
        rst!jdbz = Trim(Tjdjg)
        rst!bcjdrq = DTPjdrq.Value
        rst!bz = "基本信息"
        rst.UpdateBatch adAffectAllChapters
    Else
        rst.AddNew
        rst!Bh = Trim(Tbh)
        rst!Mc = Trim(Tmc)
        rst!Dwmc = Dwmc
        rst!jlsj = Now
        rst!zt_h = Trim(CZt.Text)
        rst!Bcjddw = Trim(Tjddw.Text)
        '''''
        rst!bcjdjg = Trim(Cjdjg.Text)
        rst!jdbz = Trim(Tjdjg)
        rst!bcjdrq = DTPjdrq.Value
        rst!bz = "基本信息"
        rst.UpdateBatch adAffectAllChapters
    End If
    rs!Jddw = Trim(Tjddw.Text)
    rs!jdjg = Trim(Tjdjg)
    rs!qyrq = DTPqyrq.Value
'    rs!bfrq = DTPbfrq.Value
    rs!jdrq = DTPjdrq.Value
    rs!Dwmc = Dwmc
    rs!jlsj = Now
    Exit Sub
ERR:
    MsgBox ERR.Description, vbCritical, "错误提示"
    Exit Sub
End Sub

Private Sub Clb_Click()
    If Trim(Clb.Text) <> "" Then
        Dim rstt As New ADODB.Recordset
        If rstt.State = 1 Then rstt.Close
        rstt.CursorLocation = adUseClient
        rstt.Open "select qjzb from qjzl where qjlb='" & Trim(Clb.Text) & "' group by qjzb", Conn
        Czb.Clear
        Do While rstt.EOF = False
            Czb.AddItem Trim(rstt!qjzb)
            rstt.MoveNext
        Loop
    End If
End Sub

Private Sub CmdBc_Click()
    If Add = 0 Then Exit Sub
    If Grid.Visible = True Then Grid.Visible = False
    If Trim(Tmc.Text) = "" Then
        MsgBox "计量器具名称不能为空", vbCritical, "提示"
        Exit Sub
    End If
    If CInt(Val(Tjdzq)) = 0 Then
        MsgBox "检定周期必须填写，并且必须为数字", vbCritical, "提示"
        Exit Sub
    End If
    If Trim(Czqdw.Text) = "" Then
        MsgBox "请选择检定周期的单位", vbCritical, "提示"
        Exit Sub
    End If
    Dim rst As New ADODB.Recordset
    If rst.State = 1 Then rst.Close
    rst.CursorLocation = adUseClient
    rst.Open "select * from jlqjxx where bh='" & Trim(Tbh) & "'", Conn, adOpenDynamic, adLockBatchOptimistic
    If rst.EOF = False Then
        TextToRs rst
        rst.UpdateBatch adAffectAllChapters
    Else
        rst.AddNew
        TextToRs rst
        rst.UpdateBatch adAffectAllChapters
        If Cxx.Value = 1 Then
            Dim i  As Integer
            i = CInt(Tsbs.Text)
            Dim j As Integer
            j = 1
            If i > 1 Then
                For j = 1 To i - 1
                    Tbh = Bh_A()
                    rst.AddNew
                    TextToRs rst
                    rst.UpdateBatch adAffectAllChapters
                Next j
            End If
        End If
    End If
    
    Cxx.Visible = False
    Tsbs.Visible = False
    MsgBox "保存成功！", vbInformation, "提示"
    Sd
    Add = 0
    CmdZj.Enabled = True
    cmdxg.Enabled = True
'    CmdCz.Enabled = True
    cmdsc.Enabled = True
    cmdll.Enabled = True
End Sub

Private Sub CmdLl_Click()
    Grid.Visible = True
    If rs.State = 1 Then rs.Close
    rs.CursorLocation = adUseClient
    rs.Open "select bh as 设备编号 , mc as 设备名称 , lb as 类别 , zb as 种别 , dj as 管理等级, zt as 设备状态, ggxh as 规格型号, clfw as 测量范围, fdz as 分度值, sccj as 生产厂家, ccbh as 出厂编号, sybm as 使用部门, syz as 使用者, qyrq as 启用日期 from jlqjxx", Conn, adOpenStatic, adLockReadOnly
    Set Grid.DataSource = rs
End Sub

Private Sub CmdSc_Click()
    If Add <> 0 Then Exit Sub
    If Trim(Tbh) = "" Then Exit Sub
    If MsgBox("是否确认删除当前设备？", vbYesNo, "提示") = vbYes Then
        Conn.Execute "delete from jlqjxx where bh='" & Trim(Tbh) & "'"
        Conn.Execute "delete from jlqjjd where bh='" & Trim(Tbh) & "'"
        Conn.Execute "delete from jlqjbf where bh='" & Trim(Tbh) & "'"
        Conn.Execute "delete from jlqjwx where bh='" & Trim(Tbh) & "'"
        MsgBox "删除成功！", vbInformation, "提示"
        Qk
    End If
End Sub

Private Sub CmdXg_Click()
    If Grid.Visible = True Then Grid.Visible = False
    If Add <> 0 Then Exit Sub
    If Trim(Tbh) = "" Then
        CmdZj_Click
        Exit Sub
    End If
    Dim rst As New ADODB.Recordset
    If rst.State = 1 Then rst.Close
    rst.CursorLocation = adUseClient
    rst.Open "select * from jlqjxx where bh='" & Trim(Tbh.Text) & "'", Conn
    If rst.EOF = True Then
        MsgBox "在计量器具信息中未找到相关记录，不可修改！", vbCritical, "提示"
        Exit Sub
    End If
    Js
    Add = 2
    CmdZj.Enabled = False
    cmdxg.Enabled = False
'    CmdCz.Enabled = False
    cmdsc.Enabled = False
    cmdll.Enabled = False
End Sub

Private Sub CmdZj_Click()
    If Grid.Visible = True Then Grid.Visible = False
    If Add <> 0 Then Exit Sub
    Js
    Qk
    Cxx.Visible = True
    Tsbs.Visible = True
    Tbh = Bh_A()
    Add = 1
    CmdZj.Enabled = False
    cmdxg.Enabled = False
   ' CmdCz.Enabled = False
    cmdll.Enabled = False
    cmdsc.Enabled = False
End Sub

Private Sub DTPqyrq_Change()
    DTPjdrq.Value = DTPqyrq.Value
End Sub

Private Sub Form_Load()
    Grid.Visible = False
    Me.Left = 30
    Me.Top = 200
    Add = 0
    badd = False
    Cxx.Visible = False
    Tsbs.Visible = False
    Dim rst As New ADODB.Recordset
    If rst.State = 1 Then rst.Close
    rst.CursorLocation = adUseClient
    rst.Open "select * from dwxx", Conn
    If rst.EOF = False Then
        badd = True
        DTPqyrq.Value = Date
        DTPbfrq.Value = Date
        DTPjdrq.Value = Date
        Dwmc = Trim(rst!Dwmc)
'        Jddw = Trim(rst!jydw)
        'Tjddw = Jddw
        Cdj.Clear
        Cdj.AddItem "强制检定"
        Cdj.AddItem "一般管理"
        Cdj.AddItem "特种设备"
        CZt.Clear
        CZt.AddItem "启用"
        CZt.AddItem "禁用"
        Czqdw.Clear
        Czqdw.AddItem "月"
        Czqdw.AddItem "年"
        Czqdw.AddItem "天"
        Cjdjg.Clear
        Cjdjg.AddItem "合格"
        Cjdjg.AddItem "不合格"
        Dim rstt As New ADODB.Recordset
        If rstt.State = 1 Then rstt.Close
        rstt.CursorLocation = adUseClient
        rstt.Open "select qjlb from qjzl group by qjlb", Conn
        Clb.Clear
        Do While rstt.EOF = False
            Clb.AddItem Trim(rstt!qjlb)
            rstt.MoveNext
        Loop
        If rstt.State = 1 Then rstt.Close
        rstt.CursorLocation = adUseClient
        rstt.Open "select jddw from jddw", Conn
        Tjddw.Clear
        Do While rstt.EOF = False
            Tjddw.AddItem Trim(rstt!Jddw)
            rstt.MoveNext
        Loop
        Czb.Clear
        If rstt.State = 1 Then rstt.Close
        rstt.CursorLocation = adUseClient
        rstt.Open "select bmmc from bmxx group by bmmc", Conn
        Csybm.Clear
        Do While rstt.EOF = False
            Csybm.AddItem Trim(rstt!bmmc)
            rstt.MoveNext
        Loop
    Else
        MsgBox "系统尚未设置单位信息，请设置单位信息后在执行此操作！", vbCritical, "器具管理"
        Exit Sub
    End If
End Sub

Function Bh_A() As String ''''''''''''''''''''''''自动生成单据号
'    On Error GoTo err:
    Dim xx As Integer
    Dim rst As New ADODB.Recordset
    If rst.State = 1 Then rst.Close
    rst.CursorLocation = adUseClient
    rst.Open "select max(bh) as bh from jlqjxx", Conn
    If rst.EOF = False Then
        xx = CInt(Trim(IIf(IsNull(rst!Bh), "00000", rst!Bh)))
    Else
        xx = 0
    End If
    Bh_A = Format(xx + 1, "00000")
    Exit Function
ERR:
    MsgBox ERR.Description, vbCritical, "提示"
End Function

Private Sub Grid_DblClick()
On Error GoTo ERR
    If rs.State = 1 Then
        If rs.RecordCount > 0 Then
            If Trim(rs!设备编号) <> "" Then
                Tbh = Trim(rs!设备编号)
                Dim rst As New ADODB.Recordset
                If rst.State = 1 Then rst.Close
                rst.CursorLocation = adUseClient
                rst.Open "select * from jlqjxx where bh='" & Tbh & "'", Conn
                If rst.EOF = False Then
                    RsToText rst
                End If
                Grid.Visible = False
            End If
        End If
    End If
    Exit Sub
ERR:
    Exit Sub
End Sub

Private Sub Grid_HeadClick(ByVal ColIndex As Integer)
    Dim str As String
    Dim st As String
    str = Grid.Columns.Item(ColIndex).Caption
    st = ""
    Select Case str
        Case "设备编号"
           st = "bh"
        Case "设备名称"
            st = "mc"
        Case "类别"
            st = "lb"
        Case "种别"
            st = "zb"
        Case "管理等级"
            st = "dj"
        Case "设备状态"
            st = "zt"
        Case "规格型号"
            st = "ggxh"
        Case "测量范围"
            st = "clfw"
        Case "分度值"
            st = "fdz"
        Case "生产厂家"
            st = "sccj"
        Case "出厂编号"
            st = "ccbh"
        Case "使用部门"
            st = "sybm"
        Case "使用者"
            st = "syz"
        Case "启用日期"
            st = "qyrq"
     End Select
    If st = "" Then Exit Sub
    If rs.State = 1 Then rs.Close
    rs.CursorLocation = adUseClient
    rs.Open "select bh as 设备编号 , mc as 设备名称 , lb as 类别 , zb as 种别 , dj as 管理等级, zt as 设备状态, ggxh as 规格型号, clfw as 测量范围, fdz as 分度值, sccj as 生产厂家, ccbh as 出厂编号, sybm as 使用部门, syz as 使用者, qyrq as 启用日期 from jlqjxx order by " & st, Conn, adOpenStatic, adLockReadOnly
    Set Grid.DataSource = rs

End Sub

Private Sub Text3_KeyPress(KeyAscii As Integer)
    If Add <> 0 Then Exit Sub
    If KeyAscii = 13 Then
        Dim rst As New ADODB.Recordset
        If rst.State = 1 Then rst.Close
        rst.CursorLocation = adUseClient
        rst.Open "select * from jlqjxx where bh='" & Format(Text3, "00000") & "'", Conn
        If rst.EOF = False Then
            RsToText rst
        End If
    End If
End Sub