📄 main.frm
字号:
Width = 1695
End
End
Begin VB.Frame Frame2
BackColor = &H00FF8080&
Caption = "Operations"
BeginProperty Font
Name = "Verdana"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 2655
Left = 720
TabIndex = 0
Top = 7920
Width = 7695
Begin VB.CommandButton cmd_emp_add
BackColor = &H00FFFFFF&
Caption = "&Add"
Height = 855
Left = 360
Picture = "Main.frx":0E42
Style = 1 'Graphical
TabIndex = 8
Top = 360
Width = 1215
End
Begin VB.CommandButton cmd_emp_save
BackColor = &H00FFFFFF&
Caption = "&Save"
Height = 855
Left = 1800
Picture = "Main.frx":12F5
Style = 1 'Graphical
TabIndex = 7
Top = 360
Width = 1215
End
Begin VB.CommandButton cmd_emp_modify
BackColor = &H00FFFFFF&
Caption = "&Modify"
Height = 855
Left = 3240
Picture = "Main.frx":17A3
Style = 1 'Graphical
TabIndex = 6
Top = 360
Width = 1215
End
Begin VB.CommandButton cmd_emp_viewall
BackColor = &H00FFFFFF&
Caption = "&View All"
Height = 855
Left = 3240
Picture = "Main.frx":1C7A
Style = 1 'Graphical
TabIndex = 5
Top = 1440
Width = 1215
End
Begin VB.CommandButton cmd_emp_delete
BackColor = &H00FFFFFF&
Caption = "&Delete"
Height = 855
Left = 6120
Picture = "Main.frx":2135
Style = 1 'Graphical
TabIndex = 4
Top = 360
Width = 1215
End
Begin VB.CommandButton cmd_emp_search
Appearance = 0 'Flat
BackColor = &H00FFFFFF&
Caption = "Search"
CausesValidation= 0 'False
Height = 855
Left = 4680
Picture = "Main.frx":25F8
Style = 1 'Graphical
TabIndex = 3
Top = 360
Width = 1215
End
Begin VB.CommandButton cmd_employee_refresh
Appearance = 0 'Flat
BackColor = &H00FFFFFF&
Caption = "Refresh"
Height = 855
Left = 1800
Picture = "Main.frx":2AD0
Style = 1 'Graphical
TabIndex = 2
Top = 1440
Width = 1215
End
Begin VB.CommandButton cmd_emp_back
BackColor = &H00FFFFFF&
Caption = "&Close"
Height = 855
Left = 4680
Picture = "Main.frx":2F76
Style = 1 'Graphical
TabIndex = 1
Top = 1440
Width = 1215
End
End
Begin ActiveResizeCtl.ActiveResize ActiveResize1
Left = 0
Top = 0
_ExtentX = 847
_ExtentY = 847
Resolution = 4
ScreenHeight = 1024
ScreenWidth = 1280
ScreenHeightDT = 1024
ScreenWidthDT = 1280
FormHeightDT = 11280
FormWidthDT = 9270
FormScaleHeightDT= 10770
FormScaleWidthDT= 9150
ResizeFormBackground= -1 'True
ResizePictureBoxContents= -1 'True
End
Begin VB.Label Label11
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "EMPLOYEE DETAILS"
BeginProperty Font
Name = "Verdana"
Size = 18
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 435
Left = 2880
TabIndex = 31
Top = 120
Width = 3990
End
End
Attribute VB_Name = "frm_add_employee"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "RVB_UniqueId" ,"3CBB30590295"
Private rsDocs As New ADODB.Recordset
'##ModelId=3CBB3059029F
Private ddate As Date
'##ModelId=3CBB305902A0
Private Sub cmd_emp_add_Click()
Dim ctl As Control
For Each ctl In Controls
If TypeOf ctl Is TextBox Then
ctl.Locked = False
End If
If TypeOf ctl Is ComboBox Then
ctl.Locked = False
End If
Next
cmd_emp_add.Enabled = False
cmd_emp_save.Enabled = True
Call clear
End Sub
'##ModelId=3CBB305902A9
Private Sub cmd_emp_back_Click()
Unload Me
frm_employee.Show
End Sub
'##ModelId=3CBB305902AA
Private Sub cmd_emp_delete_Click()
If txt_empid = "" Then
MsgBox "There Is No Current Record", vbInformation
Else
res = MsgBox("Do You Want To Delete The Current Record ? ", vbCritical + vbYesNo, "Data Deletion")
If res = vbYes Then
cnPatients.Execute ("delete from employee where emp_id='" & txt_empid & "'")
Call clear
ElseIf res = vbNo Then
MsgBox "Deletion Cancled", vbInformation
End If
End If
End Sub
'##ModelId=3CBB305902B3
Private Sub cmd_emp_modify_Click()
txt_empid.Enabled = False
If txt_empid = "" Then
MsgBox "There Is No Current Record", vbInformation
Else
res = MsgBox("Do You Want To Modify The Current Record ? ", vbCritical + vbYesNo, "Data Modification")
If res = vbYes Then
cnPatients.Execute ("delete from employee where emp_id='" & txt_empid & "'")
cnPatients.Execute ("Insert into employee values('" & txt_empid & "','" & txt_emp_name & "','" & txt_emp_address & "','" & txt_emp_telephone & "','" & DTPicker1.Value & "','" & sex & "','" & cmb_emp_department.Text & "','" & txt_emp_insurecorp & "','" & txt_emp_insurno & "','" & txt_emp_bsal & "')")
Call clear
ElseIf res = vbNo Then
MsgBox "Modifcation Cancled", vbInformation
End If
End If
End Sub
'##ModelId=3CBB305902B4
Private Sub cmd_emp_save_Click()
cmd_emp_save.Enabled = False
cmd_emp_add.Enabled = True
Dim sex As String
Dim x As String
x = "0"
If Option1(0).Value = True Then
sex = "male"
Else
sex = "female"
End If
cnPatients.Execute ("Insert into employee values('" & txt_empid & "','" & txt_emp_name & "','" & txt_emp_address & "','" & txt_emp_telephone & "','" & ddate & "','" & sex & "','" & cmb_emp_department.Text & "','" & txt_emp_insurecorp & "','" & txt_emp_insurno & "','" & txt_emp_bsal & "')")
cnPatients.Execute ("Insert into slip values('" & txt_empid & "','" & txt_emp_name & "','" & cmb_emp_department.Text & "','" & txt_emp_address & "','" & txt_emp_bsal & "','" & x & "','" & x & "','" & x & "','" & x & "','" & x & "','" & x & "','" & x & "','" & x & "','" & x & "','" & x & "','" & x & "')")
Call clear
End Sub
Private Sub cmd_emp_search_Click()
txt_empid.Enabled = False
str_search_number = InputBox("Enter The Employee Number", "Data Search")
rsDocs.MoveFirst
While Not rsDocs.EOF
If rsDocs.Fields(0) = str_search_number Then
MsgBox "Record Found"
Call recassign
End If
rsDocs.MoveNext
Wend
txt_empid.Enabled = False
End Sub
Private Sub cmd_emp_viewall_Click()
frm_employee_view.Show
End Sub
Private Sub cmd_employee_refresh_Click()
rsDocs.Close
rsDocs.Open "select * from employee where emp_id='" & txt_empid & "' ", cnPatients, adOpenDynamic, adLockOptimistic
If rsDocs.RecordCount = 0 Then
MsgBox "No Current Records To Refresh", vbInformation, "Alert"
ElseIf rsDocs.RecordCount > 0 Then
With rsDocs
.Requery
.MoveFirst
End With
End If
End Sub
'##ModelId=3CBB305902C8
Private Sub Form_Load()
Dim ctl As Control
For Each ctl In Controls
If TypeOf ctl Is TextBox Then
ctl.Locked = True
End If
If TypeOf ctl Is ComboBox Then
ctl.Locked = True
End If
Next
Set con = New ADODB.Connection
Set rs = New ADODB.Recordset
Set rs1 = New ADODB.Recordset
Set rsadd = New ADODB.Recordset
Set rsmod = New ADODB.Recordset
Set rsdel = New ADODB.Recordset
con.CursorLocation = adUseClient
'con.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\pay\Pay.mdb;persist security info=false"
strst = "del"
Dim dep
Set rsDocs = New ADODB.Recordset
rsDocs.Open "select * from employee ", cnPatients, adOpenDynamic, adLockOptimistic
rs1.Open "select * from Department", cnPatients, adOpenDynamic, adLockOptimistic
rs.Open "select * from slip", cnPatients, adOpenDynamic, adLockOptimistic
rs1.MoveFirst
While rs1.EOF = False
cmb_emp_department.AddItem rs1!dept_na
rs1.MoveNext
Wend
If rsDocs.RecordCount > 0 Then
rsDocs.MoveFirst
End If
cmd_emp_save.Enabled = False
ddate = DTPicker1.Value
End Sub
'##ModelId=3CBB305902D1
Public Sub recassign()
txt_empid.Text = rsDocs.Fields(0)
txt_emp_name.Text = rsDocs.Fields(1)
txt_emp_address.Text = rsDocs.Fields(2)
txt_emp_telephone.Text = rsDocs.Fields(3)
DTPicker1.Value = rsDocs.Fields(4)
cmb_emp_department.Text = rsDocs.Fields(6)
txt_emp_insurecorp.Text = rsDocs.Fields(7)
txt_emp_insurno.Text = rsDocs.Fields(8)
txt_emp_bsal.Text = rsDocs.Fields(9)
If rsDocs.Fields(5) = "male" Then
Option1(0).Value = True
Option1(1).Value = False
ElseIf rsDocs.Fields(5) = "female" Then
Option1(0).Value = False
Option1(1).Value = True
End If
End Sub
'##ModelId=3CBB305902D2
Public Sub clear()
With frm_add_employee
.txt_emp_address = ""
.txt_emp_bsal = ""
.DTPicker1.Value = ddate
.txt_emp_insurecorp = ""
.txt_emp_insurno = ""
.txt_emp_name = ""
.txt_emp_telephone = ""
.txt_empid = ""
.cmb_emp_department = ""
End With
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -