gzxt.frm

工资管理系统 使用VB写的一个基于文件存取的简单工资管理系统 主要演示了VB的文件操作功能 拥有个性的窗体与程序写的渐变背景

      BackColor       =   &H0080FF80&
      Caption         =   "新 建"
      Height          =   375
      Left            =   4200
      MaskColor       =   &H00FFFFFF&
      Style           =   1  'Graphical
      TabIndex        =   6
      TabStop         =   0   'False
      Top             =   840
      Width           =   755
   End
   Begin VB.Label Label2 
      BackStyle       =   0  'Transparent
      Caption         =   "×"
      BeginProperty Font 
         Name            =   "黑体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H0000FF00&
      Height          =   255
      Left            =   4440
      TabIndex        =   5
      Top             =   120
      Width           =   375
   End
   Begin VB.Label Label1 
      Caption         =   "工资管理系统"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H0000FF00&
      Height          =   255
      Left            =   0
      TabIndex        =   4
      Top             =   120
      Width           =   6375
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim filename1 As String
Dim totalsalary As Currency
Private Sub display()
Get #1, prerecord + 1, gzrecordvar
Text2(0).Text = Trim$(gzrecordvar.gname)
Text2(1).Text = Trim$(gzrecordvar.gunit)
Text2(2).Text = Trim$(gzrecordvar.gage)
Text2(3).Text = Trim$(gzrecordvar.salary)
End Sub
Private Sub saveas()
gzrecordvar.gname = Text2(0).Text
gzrecordvar.gunit = Text2(1).Text
gzrecordvar.gage = Text2(2).Text
gzrecordvar.salary = Text2(3).Text
Put #1, prerecord + 1, gzrecordvar
End Sub
Private Sub infdisplay()
Dim pjsalary As Currency
If recordnumber = 0 Then
pjsalary = 0
Else
pjsalary = CCur(totalsalary / recordnumber)
End If
Text3(0).Text = "总记录:" + Trim$(Str$(recordnumber))
Text3(1).Text = "当前记录:" + Trim$(Str$(prerecord))
Text3(2).Text = "总工资" + Format$(totalsalary, "####.00")
Text3(3).Text = "平均工资" + Format$(pjsalary, "####.00")
End Sub
Private Sub comenabled(nort As Boolean)
Command3.Enabled = nort
Command4.Enabled = nort
Command5.Enabled = nort
Command6.Enabled = nort
Command7.Enabled = nort
Command8.Enabled = nort
Command9.Enabled = nort
Command10.Enabled = nort
Command11.Enabled = nort
End Sub
Private Sub totalrecord()
gzrecordvar.gname = "总"
gzrecordvar.gage = "总"
gzrecordvar.gunit = Str$(totalsalary)
gzrecordvar.salary = Str$(recordnumber)
Put #1, 1, gzrecordvar
End Sub

Private Sub Command1_Click()
On Error GoTo l1
Dim i As Integer
coda1.DialogTitle = "新建工资记录文件"
coda1.FileName = "gzrecord.txt"
coda1.CancelError = True
coda1.DefaultExt = "txt"
coda1.Filter = "all files|*.*|text files(*.txt)|*.txt|word files(*.doc)|*.doc"
coda1.FilterIndex = 2
coda1.Flags = 2050
coda1.ShowSave
If filename1 <> "" Then
Close #1
End If
For i = 0 To 3
Text2(i).Text = ""
Next i
filename1 = coda1.FileName
Text4.Text = "当前文件:" + filename1
Open filename1 For Random As #1 Len = Len(gzrecordvar)
recordnumber = 0
prerecord = 0
totalsalary = 0
Call totalrecord
Call comenabled(True)
Call infdisplay
l1: End Sub

Private Sub Command10_Click()
Form2.Show
Me.Hide
End Sub

Private Sub Command11_Click()
On Error GoTo l1
If Command11.Caption = "修 改" Then
For i = 0 To 3
Text2(i).Locked = False
Next i
Text2(0).SetFocus
Command11.Caption = "确 定"
Else
Get #1, prerecord + 1, gzrecordvar
totalsalary = totalsalary - Val(gzrecordvar.salary)
Call saveas
totalsalary = totalsalary + Val(gzrecordvar.salary)
Call totalrecord
Call infdisplay
For i = 0 To 3
Text2(i).Locked = True
Next i
Command11.Caption = "修 改"
End If
l1: End Sub

Private Sub Command2_Click()
On Error GoTo l1
Dim i As Integer
coda1.DialogTitle = "打开工资记录文件"
coda1.FileName = ""
coda1.Filter = "all files|*.*|text files(*.txt)|*.txt|word files(*.doc)|*.doc"
coda1.FilterIndex = 2
coda1.Flags = 4096
coda1.ShowOpen
If coda1.FileName = "" Then
Exit Sub
End If
If filename1 <> "" Then
Close #1
End If
For i = 0 To 3
Text2(i).Text = ""
Next i
recordnumber = 0
prerecord = 0
totalsalary = 0
filename1 = coda1.FileName
Text4.Text = "当前文件:" + coda1.FileName
Open filename1 For Random As #1 Len = Len(gzrecordvar)
Get #1, 1, gzrecordvar
recordnumber = Val(gzrecordvar.salary)
totalsalary = Val(gzrecordvar.gunit)
If recordnumber = 0 Then
prerecord = 0
Else
prerecord = 1
Call display
End If
Call infdisplay
Call comenabled(True)
l1: End Sub

Private Sub Command3_Click()
Dim i As Integer
If recordnumber = 0 Then
Exit Sub
End If
If recordnumber = 1 Then
For i = 0 To 3
Text2(i).Text = ""
Next i
totalsalary = 0
GoTo l1
End If
Get #1, prerecord + 1, gzrecordvar
totalsalary = totalsalary - Val(gzrecordvar.salary)
If prerecord = recordnumber Then
prerecord = prerecord - 1
Call display
prerecord = prerecord + 1
GoTo l1
End If
For i = prerecord To recordnumber - 1
Get #1, prerecord + 2, gzrecordvar
Put #1, prerecord + 1, gzrecordvar
prerecord = prerecord + 1
Call display
Call infdisplay
Next i
l1: recordnumber = recordnumber - 1
prerecord = prerecord - 1
Call totalrecord
Call infdisplay
End Sub

Private Sub Command4_Click()
On Error GoTo l1
If Command4.Caption = "添 加" Then
For i = 0 To 3
Text2(i).Locked = False
Text2(i).Text = ""
Next i
Text2(0).SetFocus
Command4.Caption = "确 定"
Else
recordnumber = recordnumber + 1
prerecord = recordnumber
Call saveas
totalsalary = totalsalary + Val(gzrecordvar.salary)
Call totalrecord
Call infdisplay
For i = 0 To 3
Text2(i).Locked = True
Next i
Command4.Caption = "添 加"
End If
l1: End Sub

Private Sub Command5_Click()
prerecord = 1
Call display
Call infdisplay
End Sub

Private Sub Command6_Click()
prerecord = recordnumber
Call display
Call infdisplay
End Sub

Private Sub Command7_Click()
If prerecord > 1 Then
prerecord = prerecord - 1
Call display
Call infdisplay
End If
End Sub

Private Sub Command8_Click()
If prerecord < recordnumber Then
prerecord = prerecord + 1
Call display
Call infdisplay
End If
End Sub

Private Sub Command9_Click()
Dim i As Integer
Static findname As String
If Command9.Caption = "继 续" Then
GoTo l1
End If
findname = Trim$(InputBox("请输入要查找的姓名", "查找记录"))
If findname = "" Then
Exit Sub
End If
prerecord = 1
l1: For i = prerecord To recordnumber
Get #1, i + 1, gzrecordvar
Call display
Call infdisplay
prerecord = prerecord + 1
If findname = Trim$(gzrecordvar.gname) Then
flag1 = 1
Command9.Caption = "继 续"
Exit For
End If
Next i
If flag1 = 0 Then
MsgBox "对不起，没有此人！", vbCritical, "查找记录"
End If
If prerecord > recordnumber Then
prerecord = prerecord - 1
Command9.Caption = "查 找"
flag1 = 0
End If
End Sub

Private Sub Form_load()
Dim i As Integer
Me.Top = 4000
Me.Left = 4000
Me.Height = 4500
Me.Width = 6000
Me.BackColor = RGB(230, 250, 230)
x1 = CreateRoundRectRgn(0, 0, 400, 17, 5, 5)
x2 = CreateRoundRectRgn(0, 18, 400, 300, 5, 5)
CombineRgn x1, x1, x2, 2
SetWindowRgn hwnd, x1, 1
Label1.Top = 0
Label1.Left = 0
Label1.Height = 250
Label1.Width = Me.Width
Label1.BackColor = RGB(230, 255, 230)
Label2.Top = 20
Label2.Left = Me.Width - 300
Label2.ForeColor = QBColor(11)
Label2.ZOrder 0
For i = 0 To 3
Text2(i).Locked = True
Next i
recordnubmer = 0
prerecord = 0
totalsalary = 0
filedata = 0
Call comenabled(False)
Text4.Text = "当前没有加载数据文件"
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call formcolor1
Label2.ForeColor = QBColor(12)
End Sub

Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
                     Dim ReturnVal As Long
                     X = ReleaseCapture()
                     ReturnVal = SendMessage(Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)
              End If
              Label2.ForeColor = QBColor(12)
              End Sub

Private Sub Label2_Click()
Close #1
Unload Me
End Sub

Private Sub Label2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Label2.ForeColor = QBColor(11)
End Sub

Private Sub formcolor1()
Dim a1 As Integer
For i = 25 To 600
a1 = Int(i / 3)
Me.Line (Me.ScaleWidth, 10 * i)-(0, 10 * i), RGB(255 - a1, 255, 255 - a1)
Next i
End Sub