frmbmxx.frm

计量器具管理系统

         AutoSize        =   -1  'True
         BackColor       =   &H80000005&
         Caption         =   "部门编号"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   9.75
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H80000008&
         Height          =   195
         Left            =   540
         TabIndex        =   3
         Top             =   840
         Width           =   780
      End
      Begin VB.Label Label1 
         Appearance      =   0  'Flat
         AutoSize        =   -1  'True
         BackColor       =   &H80000005&
         Caption         =   "单位名称"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   9.75
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H80000008&
         Height          =   195
         Left            =   525
         TabIndex        =   2
         Top             =   300
         Width           =   780
      End
      Begin VB.Shape Shape2 
         BorderColor     =   &H00FF8080&
         Height          =   2265
         Left            =   90
         Top             =   90
         Width           =   4770
      End
      Begin VB.Shape Shape1 
         BorderColor     =   &H00FF8080&
         Height          =   2355
         Left            =   45
         Top             =   45
         Width           =   4860
      End
   End
End
Attribute VB_Name = "Frm_部门信息"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim rs As New ADODB.Recordset

Private Sub Form_Load()
    Me.Left = (Screen.Width - Me.Width) / 2
    Me.Top = (Screen.Height - Me.Height) * (1 - 0.618)
        SNXpButtonADD.Enabled = True
        SNXpButtonVIEW.Enabled = True
        TxtDWMC.Enabled = False
        Call txtkong
End Sub

Private Sub SNXpButtonADD_Click()
''    If TxtDWMC.Text = "" Then
''        MsgBox "请先设置单位名称！", 48, "远望提示"
''        Unload Me
''    End If
''    TxtDWMC.Enabled = True
 
    Call txtkong
    If SNXpButtonVIEW.Caption = "取消浏览" Then SNXpButtonVIEW.Caption = "浏览"
    VFG.Visible = False
    If rs.State = 1 Then rs.Close
    rs.Open "select dwmc as 单位名称 from dwxx", Conn, adOpenKeyset, adLockOptimistic
    If rs.EOF = False Then
        TxtDWMC.Text = Trim(rs!单位名称)
''        SNXpButtonDEL.Enabled = True
''        SNXpButtonSAVE.Enabled = True
        TxtBMBH.Enabled = True
        TxtBMMC.Enabled = True
        TxtFZR.Enabled = True
        TxtBMBH.SetFocus
        Exit Sub
    Else
        MsgBox "请先设置单位名称", 48, "远望提示"
        Exit Sub
    End If
End Sub

Private Sub SNXpButtonEXIT_Click()
    Unload Me
End Sub

Private Sub SNXpButtonDEL_Click()
    If Trim(TxtDWMC.Text) <> "" And Trim(TxtBMBH.Text) <> "" Then
        If MsgBox("你确定要删除编号为 '" & TxtBMBH.Text & "'的记录吗?", vbYesNo) = vbYes Then
               Conn.Execute "delete from bmxx where bmbh='" & Trim(TxtBMBH.Text) & "'"
               MsgBox "删除成功", 64
               Call txtkong
               SNXpButtonVIEW.Caption = "浏览"
        Else
            Exit Sub
        End If
    Else
        MsgBox "请指定要删除的单位名称和部门编号", 48
    End If


End Sub


Private Sub SNXpButtonSAVE_Click()
    If TxtDWMC.Text = "" Then
        MsgBox "请先按新增按钮", , "远望提示"
        Exit Sub
    End If
    If TxtBMBH.Text = "" Then
        MsgBox "请输入部门编号", , "远望提示"
        TxtBMBH.SetFocus
        Exit Sub
    End If
    If TxtBMMC.Text = "" Then
        MsgBox "请输入部门名称", , "远望提示"
        TxtBMMC.SetFocus
        Exit Sub
    End If
    If TxtFZR.Text = "" Then
        MsgBox "请输入负责人姓名", , "远望提示"
        TxtFZR.SetFocus
        Exit Sub
    End If
    If rs.State = 1 Then rs.Close
    rs.CursorLocation = adUseClient
    rs.Open "select * from bmxx where bmbh='" & Trim(TxtBMBH.Text) & "'", Conn, adOpenKeyse, adLockOptimistic
    If rs.EOF = False Then
        If Trim(rs!bmbh) = Trim(TxtBMBH.Text) Then
            If MsgBox("您输入的部门编号已经存在，当前操作为修改操作，是否继续？", vbOKCancel, "远望提示") = vbOK Then
                Conn.Execute "delete * from bmxx where bmbh='" & Trim(TxtBMBH.Text) & "'"
                rs.AddNew
                rs!Dwmc = Trim(TxtDWMC.Text)
                rs!bmbh = Trim(TxtBMBH.Text)
                rs!bmmc = Trim(TxtBMMC.Text)
                rs!fzr = Trim(TxtFZR.Text)
                rs.UpdateBatch
                MsgBox "已经成功修改！", , "远望提示"
                Call txtkong
                SNXpButtonVIEW.Caption = "浏览"
                Exit Sub
            Else
                Exit Sub
            End If
        End If
    End If
    If rs.State = 1 Then rs.Close
    rs.CursorLocation = adUseClient
    rs.Open "select * from bmxx", Conn, adOpenKeyset, adLockOptimistic
    rs.AddNew
    rs!Dwmc = Trim(TxtDWMC.Text)
    rs!bmbh = Trim(TxtBMBH.Text)
    rs!bmmc = Trim(TxtBMMC.Text)
    rs!fzr = Trim(TxtFZR.Text)
    rs.UpdateBatch
    MsgBox "已经成功保存！", , "远望提示"
    SNXpButtonVIEW.Caption = "浏览"
    Call txtkong

End Sub

Private Sub SNXpButtonVIEW_Click()
    
    If rs.State = 1 Then rs.Close
    rs.CursorLocation = adUseClient
    rs.Open "select dwmc as 单位名称,bmbh as 部门编号,bmmc as 部门名称,fzr as 负责人 from bmxx", Conn
    If rs.EOF = False Then
        VFG.Visible = True
        Set VFG.DataSource = rs
        If SNXpButtonVIEW.Caption = "浏览" Then
            SNXpButtonVIEW.Caption = "取消浏览"
        ElseIf SNXpButtonVIEW.Caption = "取消浏览" Then
            SNXpButtonVIEW.Caption = "浏览"
            Call txtkong
        End If
    Else
        MsgBox "库中无记录", , "远望提示"
        SNXpButtonVIEW.Caption = "浏览"
        Exit Sub
    End If
End Sub
Sub txtkong()
    TxtBMBH.Text = ""
    TxtBMMC.Text = ""
    TxtFZR.Text = ""
    VFG.Visible = False
End Sub


Private Sub TxtBMBH_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        SendKeys "{tab}"
    End If
End Sub

Private Sub TxtBMMC_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        SendKeys "{tab}"
    End If
End Sub

Private Sub TxtDWMC_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        SendKeys "{tab}"
    End If
End Sub

Private Sub TxtFZR_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        SendKeys "{tab}"
    End If
End Sub

Private Sub VFG_DblClick()
    Call txtkong
    TxtDWMC.Text = VFG.TextMatrix(VFG.RowSel, 0)
    TxtBMBH.Text = VFG.TextMatrix(VFG.RowSel, 1)
    TxtBMMC.Text = VFG.TextMatrix(VFG.RowSel, 2)
    TxtFZR.Text = VFG.TextMatrix(VFG.RowSel, 3)
End Sub