frmpart.frm

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

VERSION 5.00
Object = "{0D452EE1-E08F-101A-852E-02608C4D0BB4}#2.0#0"; "FM20.DLL"
Begin VB.Form frmPart 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "部门编辑"
   ClientHeight    =   5010
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   4275
   Icon            =   "frmPart.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5010
   ScaleWidth      =   4275
   StartUpPosition =   1  '所有者中心
   Begin VB.Frame Frame1 
      Height          =   4935
      Left            =   120
      TabIndex        =   0
      Top             =   0
      Width           =   4095
      Begin VB.TextBox Text1 
         Height          =   375
         Left            =   120
         MaxLength       =   30
         TabIndex        =   7
         Top             =   3480
         Width           =   2535
      End
      Begin VB.Frame Frame3 
         Caption         =   "说明"
         Height          =   3615
         Left            =   2880
         TabIndex        =   3
         Top             =   240
         Width           =   1095
         Begin VB.Label Label1 
            Caption         =   "Label1"
            Height          =   3015
            Left            =   120
            TabIndex        =   8
            Top             =   360
            Width           =   855
         End
      End
      Begin VB.ListBox List1 
         Height          =   3120
         Left            =   120
         TabIndex        =   2
         Top             =   240
         Width           =   2535
      End
      Begin VB.Frame Frame2 
         Caption         =   "操作"
         Height          =   855
         Left            =   120
         TabIndex        =   1
         Top             =   3960
         Width           =   3735
         Begin MSForms.CommandButton cmdOk 
            Default         =   -1  'True
            Height          =   375
            Left            =   120
            TabIndex        =   6
            Top             =   360
            Width           =   975
            Caption         =   "确定"
            PicturePosition =   327683
            Size            =   "1720;661"
            Picture         =   "frmPart.frx":0442
            FontName        =   "宋体"
            FontHeight      =   180
            FontCharSet     =   134
            FontPitchAndFamily=   34
            ParagraphAlign  =   3
         End
         Begin MSForms.CommandButton cmdDel 
            Height          =   375
            Left            =   1320
            TabIndex        =   5
            Top             =   360
            Width           =   975
            Caption         =   "删除"
            PicturePosition =   327683
            Size            =   "1720;661"
            Picture         =   "frmPart.frx":07DC
            FontName        =   "宋体"
            FontHeight      =   180
            FontCharSet     =   134
            FontPitchAndFamily=   34
            ParagraphAlign  =   3
         End
         Begin MSForms.CommandButton cmdExit 
            Cancel          =   -1  'True
            Height          =   375
            Left            =   2520
            TabIndex        =   4
            Top             =   360
            Width           =   975
            Caption         =   "退出"
            PicturePosition =   327683
            Size            =   "1720;661"
            Picture         =   "frmPart.frx":2916
            FontName        =   "宋体"
            FontHeight      =   180
            FontCharSet     =   134
            FontPitchAndFamily=   34
            ParagraphAlign  =   3
         End
      End
   End
End
Attribute VB_Name = "frmPart"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Type MYINFO
    InfoNO As Integer
    InfoName As String * 30
End Type
Dim info As MYINFO
    Dim intNum As Integer
    Dim intLast As Integer
    Dim fso As FileSystemObject
    Dim fd As Folder
    Dim fl As File
    Dim blnChanged As Boolean
    Dim strFileName As String
    Dim strFullFilePath As String

Private Sub cmdDel_Click()
  
'删除记录
   If List1.ListIndex >= 0 Then
       blnChanged = True
       List1.RemoveItem List1.ListIndex
   End If
   
End Sub

Private Sub cmdExit_Click()
If blnChanged = True Then
    mbrtn = MsgBox("是否保存改变", vbQuestion + vbYesNo)
     If mbrtn = vbYes Then
         delFile
          If List1.ListCount = 0 Then
              Unload Me
          End If
          
          For i = 0 To List1.ListCount - 1
            SaveInfo List1.List(i)
          Next
      
      End If
    End If


  Unload Me
  
 If dfIsFormLoad("frmRS") = True Then
    frmRS.RefreshPart
  End If
End Sub

Private Sub cmdOk_Click()
'添加记录
   If Text1.Text = "" Then Exit Sub
   For i = 0 To List1.ListCount - 1
       If List1.List(i) = Trim(Text1.Text) Then
       Exit Sub
       End If
   Next
   
   List1.AddItem Trim(Text1.Text)
   blnChanged = True
   Text1.Text = ""
   Text1.SetFocus
End Sub

'删除文件
Private Function delFile()
    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
          fso.DeleteFile (strFullFilePath)
  End If
  Set fso = Nothing
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_Load()
'设文件名
 strFileName = "PartInfo.txt"
 strFullFilePath = pInfoFolderPath & "\" & strFileName
 
 
 Label1.Caption = "在新增条目对话框中输入要新增的条目，按回车即可完成添加资料。" & _
 vbCrLf & _
 "选列表框中的条目，点删除按扭即可删除所选条目"
 blnChanged = False
 
 '文件不存在就退出
 If chkFile = 0 Then Exit Sub
 '读取文件
 intNum = FreeFile
 Open strFullFilePath For Random As intNum Len = Len(info)
 intLast = LOF(1) / Len(info)
  Close intNum
  
 For i = 1 To intLast
    List1.AddItem GetInfo(i)
 Next
 
End Sub

Private Function SaveInfo(ByVal strInfoName As String)
    intNum = FreeFile
    Open strFullFilePath For Random As intNum Len = Len(info)
    intLast = LOF(1) / Len(info)
    intLast = intLast + 1
    info.InfoName = strInfoName
    info.InfoNO = intLast
    Put #intNum, intLast, info
    Close #intNum
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 = info.InfoName
    Close #intNum
End Function
 

Private Sub Label1_Click()

End Sub