frmdocument.frm

职工信息系统

      End
      Begin VB.Label lblProduct 
         AutoSize        =   -1  'True
         Caption         =   "性别:"
         Height          =   180
         Left            =   840
         TabIndex        =   18
         Top             =   660
         Width           =   450
      End
      Begin VB.Label lblCustomer 
         AutoSize        =   -1  'True
         Caption         =   "学历:"
         Height          =   180
         Left            =   3840
         TabIndex        =   17
         Top             =   660
         Width           =   450
      End
      Begin VB.Label lblOID 
         AutoSize        =   -1  'True
         Caption         =   "姓名:"
         Height          =   180
         Left            =   3840
         TabIndex        =   16
         Top             =   300
         Width           =   450
      End
      Begin VB.Label lblCount 
         AutoSize        =   -1  'True
         Caption         =   "职工编号:"
         Height          =   180
         Left            =   480
         TabIndex        =   15
         Top             =   300
         Width           =   810
      End
   End
   Begin MSDBGrid.DBGrid DataView 
      Align           =   1  'Align Top
      Bindings        =   "frmDocument.frx":014E
      Height          =   5535
      Left            =   0
      OleObjectBlob   =   "frmDocument.frx":0162
      TabIndex        =   0
      Top             =   0
      Width           =   8610
   End
   Begin MSComctlLib.ImageList ImageList1 
      Left            =   0
      Top             =   0
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   32
      ImageHeight     =   32
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   7
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmDocument.frx":157E
            Key             =   ""
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmDocument.frx":2AD2
            Key             =   ""
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmDocument.frx":2C2E
            Key             =   ""
         EndProperty
         BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmDocument.frx":3082
            Key             =   ""
         EndProperty
         BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmDocument.frx":34D6
            Key             =   ""
         EndProperty
         BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmDocument.frx":392A
            Key             =   ""
         EndProperty
         BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmDocument.frx":3D7E
            Key             =   ""
         EndProperty
      EndProperty
   End
End
Attribute VB_Name = "frmDocument"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim DateFlag As Boolean

Private Sub CmdAdd_Click()
On Error GoTo Err:
If CheckInput() = False Then Exit Sub
    If IsDate(txtYear.Text & "/" & txtMonth.Text & "/" & txtday.Text) Then
    txtDate = CDate(txtYear.Text & "/" & txtMonth.Text & "/" & txtday.Text)
    Else
    MsgBox "出生日期输入错误！", vbInformation, "信息提示"
    txtYear.SetFocus
    Exit Sub
    End If
If Data1.Recordset.RecordCount = 0 Then
  Dim db As Database
  Dim rs As Recordset
  Set db = OpenDatabase(CurrentFile)
  Set rs = db.OpenRecordset("职工信息")
With rs
.AddNew
!职工编号 = txtID
!姓名 = txtName
!性别 = cobSex
!出生年月 = txtDate
!职称 = cobPossion
!最后学历 = cobStudy
!工资 = txtSale
!婚否 = cobMarry
.Update
  Data1.Refresh
End With
Else
    Data1.Recordset.AddNew
    Data1.Recordset.Update
    Data1.Recordset.MoveLast
End If
Exit Sub
Err: MsgBox Err.Description, vbCritical, "出错"
End Sub
Function CheckInput() As Boolean
CheckInput = False
If cobMarry <> "是" And cobMarry <> "否" Then
   ShowWrong
   cobMarry.SetFocus
   Exit Function
End If
If cobSex <> "男" And cobSex <> "女" Then
   ShowWrong
   cobSex.SetFocus
   Exit Function
End If
If Len(cobPossion) > 5 Then
   ShowWrong
   cobPossion.SetFocus
   Exit Function
End If
If Len(cobStudy) > 5 Then
   ShowWrong
   cobStudy.SetFocus
   Exit Function
End If
If Len(txtName) > 5 Then
   ShowWrong
   txtName.SetFocus
   txtName.SelStart = 0
   txtName.SelLength = Len(txtName)
   Exit Function
End If
CheckInput = True
End Function
Private Sub ShowWrong()
MsgBox "输入信息有误,或超出限长！", vbInformation, "信息提示"
End Sub
Private Sub ChangeBind(ByVal Flag As Boolean)
If Flag Then
cobSex.DataField = "性别"
cobStudy.DataField = "最后学历"
cobPossion.DataField = "职称"
cobMarry.DataField = "婚否"
Else
cobSex.DataField = Null
cobStudy.DataField = Null
cobPossion.DataField = Null
cobMarry.DataField = Null
End If
End Sub
Private Sub CmdDel_Click()
 If Me.Data1.Recordset.RecordCount > 0 And Not Me.Data1.Recordset.EOF And Not Me.Data1.Recordset.BOF Then
       HXFYN = MsgBox("您确认删除这条记录吗？", 36, "信息提示")
         If HXFYN = vbYes Then
            Me.Data1.Recordset.Delete
            Me.Data1.Recordset.MoveNext
            If Me.Data1.Recordset.EOF And Me.Data1.Recordset.RecordCount > 0 Then
               Me.Data1.Recordset.MovePrevious
            End If
          End If
    End If
End Sub
Private Sub SetCombo()
cobSex.AddItem "男"
cobSex.AddItem "女"
cobSex.ListIndex = 0
With cobPossion
.AddItem "会计"
.AddItem "秘书"
.AddItem "总经理"
.AddItem "司机"
.AddItem "营销人员"
.AddItem "部门经理"
.AddItem "技术人员"
.ListIndex = 5
End With
With cobStudy
.AddItem "初中"
.AddItem "高中"
.AddItem "大专"
.AddItem "本科"
.AddItem "研究生"
.AddItem "硕士"
.AddItem "博土"
.ListIndex = 3
End With
With cobMarry
.AddItem "是"
.AddItem "否"
.ListIndex = 1
End With
End Sub
Private Sub cmdModify_Click()
If Not Data1.Recordset.EOF Then
  If IsDate(txtYear.Text & "/" & txtMonth.Text & "/" & txtday.Text) Then
    txtDate = CDate(txtYear.Text & "/" & txtMonth.Text & "/" & txtday.Text)
    Else
    MsgBox "出生日期输入错误！", vbInformation, "信息提示"
    txtYear.SetFocus
    Exit Sub
    End If
   If CheckInput() = False Then Exit Sub
Data1.Recordset.MoveNext
End If
End Sub

Private Sub Command1_Click()
Dim db As Database
Dim query As String
Set db = OpenDatabase(CurrentFile)
query = "INSERT INTO [职工信息] Values(" & "'" & txtID & "', " & _
            "'" & txtName & "', " & _
            "'" & cobSex & "', " & _
            "'" & txtDate & "', " & _
            "'" & cobPossion & "', " & _
            "'" & cobStudy & "', " & _
            txtSale & ", " & _
            "'" & cobMarry & "'" & ")"
MsgBox query
db.Execute query
Data1.Refresh
'frmInsert.Show
End Sub
Private Sub Command2_Click()
frmSelect.Show
End Sub
Private Sub Command3_Click()
frmSearch.Show
End Sub





Private Sub Data1_Reposition()
DataView.Caption = "单位职工信息一览表  " & "[共 " & Data1.Recordset.RecordCount & " 条记录　当前记录号: " _
& Data1.Recordset.AbsolutePosition + 1 & "]"
Slider1.Min = 1
If Data1.Recordset.RecordCount > 1 Then
Slider1.Max = Data1.Recordset.RecordCount
End If
Slider1.Value = Data1.Recordset.AbsolutePosition + 1
End Sub
Public Property Get Menu() As EnhancedMenu
    Set Menu = m_Menu
End Property

Private Sub Form_Load()
On Error Resume Next
frmSplash.Label1 = "读取职工数据文件......"
Form_Resize
SetCombo
If Dir(CurrentFile) = "" Then
MsgBox CurrentFile & "不存在！", vbCritical, "提示："
Unload Me
End If
Data1.DatabaseName = CurrentFile
Data1.RecordSource = "职工信息"
End Sub
Private Sub Form_Resize()
    On Error Resume Next
    DataView.AllowRowSizing = False
    DataView.Move 100, 100, Me.ScaleWidth - 200, Me.ScaleHeight - 1900
    Frame1.Move 100, DataView.Top + DataView.Height + 10, Me.Width - 300, Frame1.Height
End Sub





Private Sub Slider1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Slider1.Value = Data1.Recordset.AbsolutePosition + 1
End Sub
Private Sub txtDate_Change()
If IsDate(txtDate) Then
txtYear = Year(txtDate): txtMonth = Month(txtDate): txtday = Day(txtDate)
Else
txtYear = "": txtMonth = "": txtday = ""
End If
End Sub