frmrs.frm

企业人事管理系统,有考勤,人员管理等功能,值得研究,也是我付费弄来的,绝对超值

Private Sub CommandButton2_Click()
 SendKeys "{F1}"
End Sub
 















Private Sub Form_Load()
Me.Left = ReadIni("人事资料管理", "left")
Me.Top = ReadIni("人事资料管理", "top")

 Me.MousePointer = 11
 Timer1.Enabled = True
 DoEvents
End Sub

Public Function RefreshGrid()
 Dim strSql As String
 Dim rs As ADODB.Recordset
 Dim strMsg As String
 
 strSql = "select 工号,姓名 from t_br"
 Set rs = ExecuteSQL(strSql, strMsg)
 
  Call FillData(rs, Grid1)
End Function

Public Function sqlRefreshGrid(strSql As String)
 Dim rs As ADODB.Recordset
 Dim strMsg As String
 
 Set rs = ExecuteSQL(strSql, strMsg)
 
  Call FillData(rs, Grid1)
End Function
'*************************************************************
'读取文件并添加数据到ComboBox
'**************************************************************
Public Sub RefreshInfo()
 '数据处理
  Call ReadInfoFile("PayStyleInfo.txt", cboPayStyle) '工资类别
  Call ReadInfoFile("CultureInfo.txt", cboCulture) '文化程度
  Call ReadInfoFile("EmployeeStyleInfo.txt", cboEmployeeStyle) '职工类型
  Call ReadInfoFile("DutyInfo.txt", cboDuty) '职务
  Call ReadInfoFile("NationInfo.txt", cboNation) '民族
  Call ReadInfoFile("PartInfo.txt", cboPart) '部门
  Call ReadInfoFile("SpecialityInfo.txt", cboSpec) '所学专业
  Call ReadInfoFile("NativePlaceInfo.txt", cboNativePlace) '籍贯
End Sub

Public Sub RefreshPayStyle()
      Call ReadInfoFile("PayStyleInfo.txt", cboPayStyle) '工资类别
End Sub

Public Sub RefreshCulture()
      Call ReadInfoFile("CultureInfo.txt", cboCulture) '文化程度
End Sub

Public Sub RefreshEmployeeStyle()
      Call ReadInfoFile("EmployeeStyleInfo.txt", cboEmployeeStyle) '职工类型
End Sub

Public Sub RefreshDuty()
     Call ReadInfoFile("DutyInfo.txt", cboDuty) '职务
End Sub

Public Sub RefreshNation()
     Call ReadInfoFile("NationInfo.txt", cboNation) '民族
End Sub

Public Sub RefreshPart()
     Call ReadInfoFile("PartInfo.txt", cboPart) '部门
End Sub

Public Sub RefreshSpeciality()
     Call ReadInfoFile("SpecialityInfo.txt", cboSpec) '所学专业
End Sub

Public Sub RefreshNativePlace()
      Call ReadInfoFile("NativePlaceInfo.txt", cboNativePlace) '籍贯
End Sub


Private Function ReadInfoFile(ByVal strFileName As String, objCom As Object)
 Dim gi As String
 strFullFilePath = pInfoFolderPath & "\" & strFileName
 
 '文件不存在就退出
 If chkFile = 0 Then Exit Function
 '读取文件
 intFF = FreeFile
 Open strFullFilePath For Random As intFF Len = Len(info)
 intLast = LOF(1) / Len(info)
  Close intFF
 objCom.Clear
 For i = 1 To intLast
    gi = GetInfo(i)
    gi = Replace(gi, Chr("0"), "")
    objCom.AddItem Trim(gi)
 Next
   
End Function

Private Function GetInfo(ByVal intInfoNum As Integer)
    intNum = FreeFile
     Open strFullFilePath For Random As intNum Len = Len(info)
     Get #intNum, intInfoNum, info
     GetInfo = Trim(info.InfoName)
    Close #intNum
End Function

Private Function chkFile()
    Dim p As String
    Dim f As String
  Set fso = New FileSystemObject
  
  
  If Not fso.FolderExists(pInfoFolderPath) Then
     fso.CreateFolder (pInfoFolderPath)
  End If
  If fso.FileExists(strFullFilePath) Then
  chkFile = 1
  Else
  chkFile = 0
  End If
  Set fso = Nothing
End Function




Private Sub Form_Unload(Cancel As Integer)
  Call WriteIni("人事资料管理", "left", Me.Left)
  Call WriteIni("人事资料管理", "top", Me.Top)
End Sub

Private Sub grdHM_DblClick()
If grdHM.Row <= 0 Or frdhm > grdHM.Rows - 1 Then Exit Sub
Call cmdChgHM_Click

End Sub

Private Sub grdHM_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
If grdHM.Row <= 0 Or frdhm > grdHM.Rows - 1 Then Exit Sub
Me.PopupMenu frmRS2.popHM
End If
End Sub

Private Sub grdJob_DblClick()
If grdHM.Row <= 0 Or frdhm > grdHM.Rows - 1 Then Exit Sub
Call cmdChgJob_Click
End Sub

Private Sub grdJob_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
If grdHM.Row <= 0 Or frdhm > grdHM.Rows - 1 Then Exit Sub
Me.PopupMenu frmRS2.popJob
End If
End Sub

Private Sub Grid1_Click()
 
'控件不可用
Call DisabledControl
cmdNew.Enabled = True
cmdOk.Enabled = False
cmdChange.Enabled = True
cmdDel.Enabled = True
blnChange = False

Dim getRow As Integer
Dim getValue As String
   getRow = Grid1.Row
  If getRow < 1 Or getRow >= Grid1.Rows Then
  Exit Sub
  End If
  getValue = Grid1.TextMatrix(getRow, 1)
  
  Dim strSql As String
  Dim rs As ADODB.Recordset
  Dim strMsg As String
  
  strSql = "select * from t_br where 工号='" & getValue & "'"
  Set rs = ExecuteSQL(strSql, strMsg)
  
  txtGH.Text = rs.Fields("工号").Value
  txtName.Text = rs.Fields("姓名").Value
  
  If IsNull(rs.Fields("工资类别").Value) Then
  cboPayStyle.Text = ""
  Else
  cboPayStyle.Text = rs.Fields("工资类别").Value
  End If
  
  If IsNull(rs.Fields("健康状况").Value) Then
    cboHealthy.Text = ""
  Else
    cboHealthy.Text = rs.Fields("健康状况").Value
  End If
  
  If IsNull(rs.Fields("性别").Value) Then
     cboSex.Text = ""
  Else
    cboSex.Text = rs.Fields("性别").Value
  End If
  
   If IsNull(rs.Fields("职工类型").Value) Then
    cboEmployeeStyle.Text = ""
  Else
    cboEmployeeStyle.Text = rs.Fields("职工类型").Value
  End If
  
   If IsNull(rs.Fields("部门").Value) Then
     cboPart.Text = ""
  Else
    cboPart.Text = rs.Fields("部门").Value
  End If
  
   If IsNull(rs.Fields("文化程度").Value) Then
     cboCulture.Text = ""
  Else
    cboCulture.Text = rs.Fields("文化程度").Value
  End If
  
   If IsNull(rs.Fields("民族").Value) Then
     cboNation.Text = ""
  Else
    cboNation.Text = rs.Fields("民族").Value
  End If
  
   If IsNull(rs.Fields("所学专业").Value) Then
     cboSpec.Text = ""
  Else
    cboSpec.Text = rs.Fields("所学专业").Value
  End If
  
  '数字型
  txtMoney.Text = rs.Fields("薪金").Value
  txtAge.Text = rs.Fields("年龄").Value
  
    If IsNull(rs.Fields("政治面貌").Value) Then
     cboPolity.Text = ""
  Else
    cboPolity.Text = rs.Fields("政治面貌").Value
  End If
  
  If IsNull(rs.Fields("婚姻状况").Value) Then
     cboMarry.Text = ""
  Else
    cboMarry.Text = rs.Fields("婚姻状况").Value
  End If
  
  If IsNull(rs.Fields("籍贯").Value) Then
     cboNativePlace.Text = ""
  Else
    cboNativePlace.Text = rs.Fields("籍贯").Value
  End If
  
  If IsNull(rs.Fields("手机").Value) Then
  txtHandset.Text = ""
  Else
  txtHandset.Text = rs.Fields("手机").Value
  End If
  
  
   If IsNull(rs.Fields("身份证号").Value) Then
     txtIdentity.Text = ""
  Else
    txtIdentity.Text = rs.Fields("身份证号").Value
  End If
  
   If IsNull(rs.Fields("联系电话").Value) Then
      txtTelphone.Text = ""
  Else
     txtTelphone.Text = rs.Fields("联系电话").Value
  End If

  
   If IsNull(rs.Fields("家庭住址").Value) Then
      txtHomeAddress.Text = ""
  Else
     txtHomeAddress.Text = rs.Fields("家庭住址").Value
  End If
  
  dtpBBargain.Value = rs.Fields("合同开始时间").Value
  dtpEBargain.Value = rs.Fields("合同终止时间").Value
  dtpBirthday.Value = rs.Fields("生日").Value
  
  txtLong.Text = rs.Fields("工龄").Value
  
  '保存到文件
  Dim tmpPath As String
  Dim iStm As ADODB.Stream
    tmpPath = App.path & "\temp.jpg"
    
    Dim fso As FileSystemObject
    Set fso = New FileSystemObject
    If fso.FileExists(tmpPath) Then
       fso.DeleteFile (tmpPath)
    End If
    
    Set fso = Nothing

    
   If IsNull(rs.Fields("照片").Value) Then
      pic.Picture = LoadPicture()
   Else
    Set iStm = New ADODB.Stream
    With iStm
        .Mode = adModeReadWrite
        .Type = adTypeBinary
        .Open
        .Write rs.Fields("照片").Value
        .SaveToFile tmpPath
    End With
      ' MsgBox iStm.Size
        pic.Picture = LoadPicture(tmpPath)
        Kill tmpPath
     iStm.Close
    End If
     
      rs.Close
  Set rs = Nothing


'显示grdHM
Call showHM(getValue)
Call showJob(getValue)
fGH.Caption = getValue
End Sub
'*****************************************************************************************
'显示msflexgrid
Public Sub showHM(ByVal gh As String)
   Dim strSql As String
   Dim strMsg As String
   Dim rs As ADODB.Recordset
   
   strSql = "select * from t_hm where 工号='" & gh & "'"
   Set rs = ExecuteSQL(strSql, strMsg)
   Call FillData(rs, grdHM)
   

   
End Sub

Public Sub showJob(ByVal gh As String)
   Dim strSql As String
   Dim strMsg As String
   Dim rs As ADODB.Recordset
   
   strSql = "select * from t_job where 工号='" & gh & "'"
   Set rs = ExecuteSQL(strSql, strMsg)
   Call FillData(rs, grdJob)
  
End Sub
'*********************************************************************************************
'控制不可用
Private Sub DisabledControl()
     txtGH.Enabled = False
     txtName.Enabled = False
     cboPayStyle.Enabled = False
     cboHealthy.Enabled = False
     cboSex.Enabled = False
     cboEmployeeStyle.Enabled = False
     cboPart.Enabled = False
     cboDuty.Enabled = False
     cboCulture.Enabled = False
     cboNation.Enabled = False
     txtMoney.Enabled = False
     cboSpec.Enabled = False
     txtAge.Enabled = False
     dtpBirthday.Enabled = False
     cboPolity.Enabled = False
     cboMarry.Enabled = False
     cboNativePlace.Enabled = False
     txtIdentity.Enabled = False
     txtTelphone.Enabled = False
     txtHomeAddress.Enabled = False
    dtpBBargain.Enabled = False
    dtpEBargain.Enabled = False
    txtLong.Enabled = False
    txtHandset.Enabled = False
    
     cmdAddPhoto.Enabled = False
    cmdDelPhoto.Enabled = False
    
    cmdOk.Enabled = False
End Sub

Private Sub EnabledControl()
     txtGH.Enabled = True
     txtName.Enabled = True
     cboPayStyle.Enabled = True
     cboHealthy.Enabled = True
     cboSex.Enabled = True
     cboEmployeeStyle.Enabled = True
     cboPart.Enabled = True
     cboDuty.Enabled = True
     cboCulture.Enabled = True
     cboNation.Enabled = True
     txtMoney.Enabled = True
     cboSpec.Enabled = True
     txtAge.Enabled = True
     dtpBirthday.Enabled = True
     cboPolity.Enabled = True
     cboMarry.Enabled = True
     cboNativePlace.Enabled = True
     txtIdentity.Enabled = True
     txtTelphone.Enabled = True
     txtHomeAddress.Enabled = True
    dtpBBargain.Enabled = True
    dtpEBargain.Enabled = True
    txtLong.Enabled = True
    txtHandset.Enabled = True
    
    cmdAddPhoto.Enabled = True
    cmdDelPhoto.Enabled = True
    cmdOk.Enabled = True
End Sub

Private Sub Grid1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
 If Button = 2 Then
 sstBase.Visible = Not sstBase.Visible
 If sstBase.Visible = True Then
 Grid1.Width = 2175
 Else
 Grid1.Width = 11950
 End If
 End If
End Sub

Private Sub Grid1_SelChange()
Call Grid1_Click
End Sub

Private Sub Timer1_Timer()
  '设定控件可输入的最大字节数
txtHandset.MaxLength = 11
txtIdentity.MaxLength = 18
txtAge.MaxLength = 3
txtLong.MaxLength = 3
txtMoney.MaxLength = 15
'使控件可用
Call EnabledControl
cmdNew.Enabled = False
cmdChange.Enabled = False
cmdDel.Enabled = False

'添加数据到combobox
  Call RefreshInfo
'刷新左侧的表
 Call RefreshGrid

 sstBase.Tab = 0
 
 If Grid1.Rows > 1 Then
 Grid1.RowSel = 1
 Call Grid1_Click
 End If
 
 cmdWait.Visible = False
 Me.MousePointer = 0
 Timer1.Enabled = False
End Sub