其他行业

开发平台：
Visual Basic

frmGZRYDJ.frm：源码内容
							VERSION 5.00
Object = "{F0D2F211-CCB0-11D0-A316-00AA00688B10}#1.0#0"; "MSDATLST.OCX"
Begin VB.Form frmGZRYDJ 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "工作人员登记"
   ClientHeight    =   6825
   ClientLeft      =   465
   ClientTop       =   1635
   ClientWidth     =   7695
   HelpContextID   =   1
   Icon            =   "frmGZRYDJ.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6825
   ScaleWidth      =   7695
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  '所有者中心
   WhatsThisButton =   -1  'True
   WhatsThisHelp   =   -1  'True
   Begin VB.CommandButton cmdExit 
      Caption         =   "关闭"
      Height          =   360
      Left            =   6000
      TabIndex        =   13
      Tag             =   "确定"
      Top             =   6360
      Width           =   1260
   End
   Begin VB.Frame Frame1 
      Height          =   6255
      Left            =   120
      TabIndex        =   14
      Top             =   0
      Width           =   7455
      Begin VB.CommandButton cmdEditMm 
         Cancel          =   -1  'True
         Caption         =   "设置密码"
         Height          =   360
         Left            =   5775
         TabIndex        =   10
         Tag             =   "取消"
         Top             =   1515
         Width           =   1245
      End
      Begin VB.ListBox lstSzqx 
         Height          =   1320
         ItemData        =   "frmGZRYDJ.frx":000C
         Left            =   2400
         List            =   "frmGZRYDJ.frx":001C
         Style           =   1  'Checkbox
         TabIndex        =   5
         Top             =   2805
         Width           =   4815
      End
      Begin VB.TextBox txtDh 
         Height          =   300
         Left            =   3240
         MaxLength       =   8
         TabIndex        =   3
         Top             =   1185
         Width           =   1935
      End
      Begin VB.TextBox txtZyID 
         Enabled         =   0   'False
         Height          =   300
         Left            =   3240
         MaxLength       =   8
         TabIndex        =   1
         Top             =   480
         Width           =   1935
      End
      Begin VB.CommandButton cmdSaveQx 
         Caption         =   "授权(&Q)"
         Height          =   300
         Left            =   5775
         TabIndex        =   6
         Top             =   2445
         Width           =   1245
      End
      Begin MSDataListLib.DataList dblRylb 
         Height          =   2370
         Left            =   240
         TabIndex        =   0
         Top             =   480
         Width           =   1935
         _ExtentX        =   3413
         _ExtentY        =   4180
         _Version        =   393216
         ListField       =   ""
         BoundColumn     =   ""
      End
      Begin VB.CommandButton cmdSaveZp 
         Caption         =   "照片存档"
         Height          =   300
         Left            =   240
         TabIndex        =   12
         Top             =   5760
         Width           =   1935
      End
      Begin VB.TextBox txtXm 
         Height          =   300
         Left            =   3240
         MaxLength       =   8
         TabIndex        =   2
         Top             =   840
         Width           =   1935
      End
      Begin VB.CommandButton cmdOpenZp 
         Caption         =   "从文件取照片"
         Height          =   300
         Left            =   240
         TabIndex        =   11
         Top             =   5400
         Width           =   1935
      End
      Begin VB.CommandButton cmdAdd 
         Caption         =   "添加(&A)"
         Height          =   360
         Left            =   5775
         TabIndex        =   8
         Top             =   495
         Width           =   1245
      End
      Begin VB.CommandButton cmdDel 
         Caption         =   "删除(&D)"
         Height          =   360
         Left            =   5775
         TabIndex        =   9
         Top             =   915
         Width           =   1245
      End
      Begin VB.TextBox txtSm 
         Height          =   1560
         Left            =   2400
         MaxLength       =   255
         MultiLine       =   -1  'True
         ScrollBars      =   2  'Vertical
         TabIndex        =   7
         Top             =   4485
         Width           =   4815
      End
      Begin VB.CheckBox chkZt 
         Caption         =   "暂停使用"
         Height          =   255
         Left            =   3240
         TabIndex        =   4
         Top             =   1980
         Width           =   1215
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "权限列表:"
         Height          =   180
         Index           =   4
         Left            =   2385
         TabIndex        =   22
         Top             =   2565
         Width           =   810
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "联系电话:"
         Height          =   180
         Index           =   7
         Left            =   2400
         TabIndex        =   21
         Top             =   1185
         Width           =   810
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "职员ID:"
         Height          =   180
         Index           =   6
         Left            =   2400
         TabIndex        =   20
         Top             =   480
         Width           =   630
      End
      Begin VB.Label lblRq 
         BorderStyle     =   1  'Fixed Single
         Height          =   300
         Left            =   3240
         TabIndex        =   19
         Top             =   1545
         Width           =   1935
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "登记日期:"
         Height          =   180
         Index           =   5
         Left            =   2400
         TabIndex        =   18
         Top             =   1545
         Width           =   810
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "工作人员列表:"
         Height          =   180
         Index           =   2
         Left            =   240
         TabIndex        =   17
         Top             =   240
         Width           =   1170
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "姓名:"
         Height          =   180
         Index           =   0
         Left            =   2400
         TabIndex        =   16
         Top             =   840
         Width           =   450
      End
      Begin VB.Image imgZp 
         BorderStyle     =   1  'Fixed Single
         Height          =   2295
         Left            =   240
         Stretch         =   -1  'True
         Top             =   3000
         Width           =   1935
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "说明:"
         Height          =   180
         Index           =   3
         Left            =   2400
         TabIndex        =   15
         Top             =   4245
         Width           =   450
      End
   End
End
Attribute VB_Name = "frmGZRYDJ"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim WithEvents rs As ADODB.Recordset
Attribute rs.VB_VarHelpID = -1
Dim mstrZpFile As String
Private Sub cmdAdd_Click()
        '追加新记录
        On Error Resume Next
        rs.AddNew
        rs("职员ID") = "新职员"
        rs("姓名") = ""
        rs("操作权限") = "00000"
        rs("停用") = False
        rs("联系电话") = ""
        rs("日期") = Date
        rs("说明") = ""
        txtZyID.Enabled = True
        txtZyID.SetFocus
End Sub
Private Sub cmdDel_Click()
    On Error Resume Next
    '删除记录
    Dim intWlcs As Integer
    Dim rsWlcsTj As ADODB.Recordset
    Set rsWlcsTj = mCdt.rsWlcsTj_ZyID(rs("职员ID"))
    intWlcs = rsWlcsTj(0)
    rsWlcsTj.Close
    
    If intWlcs > 0 Then
        MsgBox "该职员已经手物品流通,不能被删除!", vbInformation
        Exit Sub
    End If
    
    If Not (rs.EOF Or rs.BOF) Then
        rs.Delete
        rs.MoveNext
    End If
End Sub
Private Sub cmdEditMm_Click()
    Dim newForm As New frmXgmm
    newForm.lblZyID = rs("职员ID")
    newForm.Show vbModal
    Set newForm = Nothing
End Sub
Private Sub cmdExit_Click()
    On Error Resume Next
    rs.Update
    Unload Me
End Sub
Private Sub cmdOpenZp_Click()
    On Error Resume Next
    '调用过程取得图片文件路径
    mstrZpFile = fMain.File_Open("*.BMP;*.JPG;*.GIF|*.BMP;*.JPG;" _
     & "*.GIF|*.BMP|*.BMP|*.JPG|*.JPG|*.GIF|*.GIF|*.*|*.*", "从文件取照片")
     
    If mstrZpFile = "" Then Exit Sub
    imgZp.Picture = LoadPicture(mstrZpFile)
End Sub
Private Sub cmdSaveQx_Click()
    On Error Resume Next
    Dim strQxqd As String
    Dim I As Byte
    strQxqd = "0"
    For I = 0 To lstSzqx.ListCount - 1
        If lstSzqx.Selected(I) Then
            strQxqd = strQxqd & 1
        Else
            strQxqd = strQxqd & 0
        End If
    Next
    rs.Update "操作权限", strQxqd
    MsgBox "授权成功！", vbInformation
End Sub
Private Sub cmdSaveZp_Click()
    '调用过程保存图片
    fMain.SaveZp "照片", rs, mstrZpFile
End Sub
Private Sub dblRylb_Click()
    On Error Resume Next
    Dim strZyID As String
    strZyID = dblRylb.Text
    rs.MoveFirst
    rs.Find "职员ID='" & strZyID & "'"
End Sub
Private Sub Form_Load()
    On Error Resume Next
    Set rs = mCdt.rsGZRYDJ
    Set dblRylb.RowSource = rs
    dblRylb.ListField = "职员ID"
    Set txtZyID.DataSource = rs
    txtZyID.DataField = "职员ID"
    Set txtXm.DataSource = rs
    txtXm.DataField = "姓名"
    Set lblRq.DataSource = rs
    lblRq.DataField = "日期"
    Set txtDh.DataSource = rs
    txtDh.DataField = "联系电话"
    Set txtSm.DataSource = rs
    txtSm.DataField = "说明"
    Set chkZt.DataSource = rs
    chkZt.DataField = "停用"
    Set imgZp.DataSource = rs
    imgZp.DataField = "照片"
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If rs.EditMode = adEditAdd Or rs.EditMode = adEditInProgress Then
        Cancel = 1
    End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    rs.Close
    Set rs = Nothing
End Sub
Private Sub imgZp_Click()
    Dim frmNewWin As New frmZp
    frmNewWin.Image1.Picture = imgZp.Picture
    frmNewWin.Show vbModal
    Set frmNewWin = Nothing
End Sub
Private Sub rs_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
    rsRefresh
End Sub
Private Sub ReadQx()
    On Error Resume Next
    Dim strQxqd As String
    Dim I As Byte
    strQxqd = Right(rs("操作权限"), 4)
    For I = 0 To 3
        lstSzqx.Selected(I) = CBool(Mid(strQxqd, I + 1, 1))
    Next
End Sub
Private Sub txtZyID_GotFocus()
    txtZyID.SelStart = 0
    txtZyID.SelLength = Len(txtZyID)
End Sub
Private Sub txtZyID_LostFocus()
    '检验数据
    On Error Resume Next
    If Trim(txtZyID) = "" Then
        MsgBox "职员ID不能为空字串!", vbExclamation
        txtZyID.SetFocus
        Exit Sub
    End If
    
    rs.Update
    
    Select Case Err
        Case 0
            rsRefresh
            txtZyID.Enabled = False
        Case -2147467259
            MsgBox "职员ID发生重名冲突!", vbExclamation
            txtZyID.SetFocus
        Case Else
            txtZyID.SetFocus
    End Select
End Sub
Private Sub rsRefresh()
    On Error Resume Next
    If rs.AbsolutePosition < 1 Then
        txtXm.Enabled = False
        txtDh.Enabled = False
        chkZt.Enabled = False
        txtSm.Enabled = False
        cmdOpenZp.Enabled = False
        cmdSaveZp.Enabled = False
        cmdDel.Enabled = False
        cmdSaveQx.Enabled = False
        lstSzqx.Enabled = False
    Else
        txtXm.Enabled = True
        txtDh.Enabled = True
        txtSm.Enabled = True
        cmdOpenZp.Enabled = True
        cmdSaveZp.Enabled = True
        If CBool(Left(rs("操作权限"), 1)) Then
            cmdDel.Enabled = False
            chkZt.Enabled = False
            cmdSaveQx.Enabled = False
            lstSzqx.Enabled = False
        Else
            cmdDel.Enabled = True
            chkZt.Enabled = True
            cmdSaveQx.Enabled = True
            lstSzqx.Enabled = True
        End If
        ReadQx
        
    End If
End Sub

						