📄 frm_settings.frm
字号:
End
Begin VB.Label lbl_wl
Caption = "Welcome screen stay time"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 255
Left = -74640
TabIndex = 37
Top = 2160
Width = 2295
End
Begin VB.Label lbl_spl
Caption = "Splash screen stay time"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 255
Left = -74640
TabIndex = 36
Top = 1800
Width = 2175
End
End
End
Attribute VB_Name = "Frm_settings"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim temp As Integer
Dim str As String
Dim ps As String
Dim rs As ADODB.Recordset
Dim db As ADODB.Connection
Private Sub cmd_apply_Click()
On Error GoTo errlable
If (cheak = True) Then
If (opt_tl.Value = True) Then
temp = 1
ElseIf (opt_ce.Value = True) Then
temp = 2
Else
temp = 3
End If
str = " UPDATE Custom SET "
str = str & "Dayslimit = " & CDbl(txt_maxday.Text) & ", "
str = str & "Fratepday = " & CDbl(txt_fine.Text) & ", "
str = str & "Maxhold = " & CDbl(txt_maxhold.Text) & ", "
str = str & "Pass = '" & Trim(txt_pass1.Text) & "', "
str = str & "Refcopy = " & CDbl(txt_ref.Text) & ", "
str = str & "Salnew = " & CDbl(txt_new.Text) & ", "
str = str & "Salper = " & CDbl(txt_per.Text) & ", "
str = str & "Saltemp = " & CDbl(txt_temp.Text) & ", "
str = str & "Splashtime = " & CDbl(txt_splash.Text) & ", "
str = str & "Viewe = " & temp & ", "
str = str & "Welcometime = " & CDbl(txt_welcome.Text) & " WHERE Key=1"
db.Execute str
MsgBox "Changes are Applied.", vbInformation, "Save"
cmd_Change.Enabled = True
cmd_deletea.Enabled = True
cmd_apply.Enabled = False
cmd_cancel.Caption = "OK"
Call locktext(True)
'Activate currently running variable with new value
view = temp
fratepday = CDbl(txt_fine.Text)
dayslimit = CDbl(txt_maxday.Text)
refcopy = CDbl(txt_ref.Text)
maxhold = CDbl(txt_maxhold.Text)
salnew = CDbl(txt_new.Text)
saltemp = CDbl(txt_temp.Text)
salper = CDbl(txt_per.Text)
splashtime = CDbl(txt_splash.Text)
welcometime = CDbl(txt_welcome.Text)
If (temp = 1) Then
opt_tl.Value = True
ElseIf temp = 2 Then
opt_ce.Value = True
Else
opt_def.Value = True
End If
End If
Exit Sub
errlable:
MsgBox Err.Number & Err.Description
End Sub
Private Function cheak() As Boolean
Dim flag As Boolean
flag = False
If (txt_fine.Text = "") Then
MsgBox "Please enter fine amount.", vbInformation, "Field missing"
ElseIf txt_maxday.Text = "" Then
MsgBox "Please enter max. value of days for bookhold.", vbInformation, "Field missing"
ElseIf txt_ref.Text = "" Then
MsgBox "Please enter no. for refcopy.", vbInformation, "Field missing"
ElseIf txt_maxhold.Text = "" Then
MsgBox "Please enter max no. copy hold by Member.", vbInformation, "Field missing"
ElseIf txt_new.Text = "" Then
MsgBox "Please enter Salary for newly joined.", vbInformation, "Field missing"
ElseIf txt_temp.Text = "" Then
MsgBox "Please enter Salary for temporarily working.", vbInformation, "Field missing"
ElseIf txt_per.Text = "" Then
MsgBox "Please enter Salary for permenently working.", vbInformation, "Field missing"
ElseIf txt_splash.Text = "" Then
MsgBox "Please enter splashscreen stay time in ms.", vbInformation, "Field missing"
ElseIf txt_welcome.Text = "" Then
MsgBox "Please enter Welcome screen stay time in ms.", vbInformation, "Field missing"
ElseIf txt_pass1.Text = "" Then
MsgBox "Please enter Password.", vbInformation, "Field missing"
ElseIf txt_pass2.Text = "" Then
MsgBox "Please enter Passwordconfirm.", vbInformation, "Field missing"
ElseIf Not IsNumeric(txt_fine.Text) Then
MsgBox "Fine amount mustbe Numeric.", vbInformation, "Improper value"
ElseIf Not IsNumeric(txt_maxday.Text) Then
MsgBox "Max. day of bookhold mustbe Numeric.", vbInformation, "Improper value"
ElseIf Not IsNumeric(txt_ref.Text) Then
MsgBox "Max no.of refrence copy mustbe Numeric.", vbInformation, "Improper value"
ElseIf Not IsNumeric(txt_maxhold.Text) Then
MsgBox "Max no.of bookhold by member mustbe Numeric.", vbInformation, "Improper value"
ElseIf Not IsNumeric(txt_new.Text) Then
MsgBox "Salary mustbe Numeric.", vbInformation, "Improper value"
ElseIf Not IsNumeric(txt_temp.Text) Then
MsgBox "Salary mustbe Numeric.", vbInformation, "Improper value"
ElseIf Not IsNumeric(txt_per.Text) Then
MsgBox "Salary mustbe Numeric.", vbInformation, "Improper value"
ElseIf Not IsNumeric(txt_splash.Text) Then
MsgBox "Splash screen stay time mustbe Numeric.", vbInformation, "Improper value"
ElseIf Not IsNumeric(txt_welcome.Text) Then
MsgBox "Welcome screen stay time mustbe Numeric.", vbInformation, "Improper value"
ElseIf txt_pass2.Text <> txt_pass1.Text Then
MsgBox "May be typing mistake,plese verify the password.", vbCritical, "Invalid password"
Else
flag = True
End If
cheak = flag
End Function
Private Sub cmd_cancel_Click()
Unload Me
End Sub
Private Sub cmd_Change_Click()
Call locktext(False)
cmd_Change.Enabled = False
cmd_deletea.Enabled = False
cmd_apply.Enabled = True
cmd_cancel.Caption = "Cancel"
End Sub
Private Sub locktext(val As Boolean)
txt_fine.Locked = val
txt_maxday.Locked = val
txt_ref.Locked = val
txt_maxhold.Locked = val
txt_new.Locked = val
txt_temp.Locked = val
txt_per.Locked = val
txt_splash.Locked = val
txt_welcome.Locked = val
txt_pass1.Locked = val
txt_pass2.Locked = val
opt_tl.Enabled = Not val
opt_ce.Enabled = Not val
opt_def.Enabled = Not val
End Sub
Private Sub cmd_default_Click()
On Error GoTo errlable
str = " UPDATE Custom SET "
str = str & "Dayslimit = 15,"
str = str & "Fratepday = 1,"
str = str & "Maxhold = 2,"
str = str & "Pass = '" & Trim(ps) & "', "
str = str & "Refcopy = 2,"
str = str & "Salnew = 2000,"
str = str & "Salper = 4500,"
str = str & "Saltemp = 3000,"
str = str & "Splashtime = 2000,"
str = str & "Viewe = 3,"
str = str & "Welcometime =1000 WHERE Key=1"
db.Execute str
Call showdata
MsgBox "Default Changes are Applied.", vbInformation, "Save"
cmd_Change.Enabled = True
cmd_deletea.Enabled = True
cmd_apply.Enabled = False
cmd_cancel.Caption = "OK"
Call locktext(True)
'Activate currently running variable with new value
view = 3
fratepday = CDbl(txt_fine.Text)
dayslimit = CDbl(txt_maxday.Text)
refcopy = CDbl(txt_ref.Text)
maxhold = CDbl(txt_maxhold.Text)
salnew = CDbl(txt_new.Text)
saltemp = CDbl(txt_temp.Text)
salper = CDbl(txt_per.Text)
splashtime = CDbl(txt_splash.Text)
welcometime = CDbl(txt_welcome.Text)
If (view = 1) Then
opt_tl.Value = True
ElseIf view = 2 Then
opt_ce.Value = True
Else
opt_def.Value = True
End If
Exit Sub
errlable:
MsgBox Err.Number & Err.Description
End Sub
Private Sub cmd_deletea_Click()
On erro GoTo lable
Beep
If MsgBox("Execution of command will delete all the information about Library database except admin. settings,Are you sure you wan't to delete Datarecord ?", vbYesNo + vbExclamation, "Confirm Delete") = vbYes Then
If MsgBox("You will never be able to retrive information back,Are you sure you wan't to delete Datarecord ?", vbYesNo + vbCritical, "Warning") = vbYes Then
str = "DELETE FROM Book"
db.Execute str
str = "DELETE FROM Member"
db.Execute str
str = "DELETE FROM Issue"
db.Execute str
str = "DELETE FROM fine"
db.Execute str
MsgBox "All entry except Administrator settings and employee information are deleted sucessfully.", vbInformation, "Database formatted"
End If
End If
Exit Sub
lable:
MsgBox Err.Number & Err.Description
End Sub
Private Sub cmd_finedel_Click()
On erro GoTo lable
Beep
If MsgBox("Execution of command will delete all the Fine information,Are you sure you wan't to delete Datarecord ?", vbYesNo + vbExclamation, "Confirm Delete") = vbYes Then
str = "DELETE FROM fine"
db.Execute str
MsgBox "Fine database entry deleted successfully.", vbInformation, "Delete"
End If
Exit Sub
lable:
MsgBox Err.Number & Err.Description
End Sub
Private Sub Form_Load()
On erro GoTo errlable
If (view = 1) Then
Me.Top = 50
Me.Left = 50
ElseIf (view = 2) Then
Me.Top = 700
Me.Left = (Screen.Width - Me.Width) / 2
End If
Set db = New ADODB.Connection
db.CursorLocation = adUseClient
db.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\Database\Library.mdb;Jet OLEDB:Database Password=Library;"
Set rs = New ADODB.Recordset
rs.Open "select Dayslimit,Fratepday,Maxhold,Pass,Refcopy,Salnew,Salper,Saltemp,Splashtime,Viewe,Welcometime from Custom", db, adOpenStatic, adLockOptimistic
ps = rs.Fields(3)
cmd_cancel.Caption = "OK"
cmd_apply.Enabled = False
Call showdata
Exit Sub
errlable:
MsgBox Err.Number & Err.Description
End Sub
Private Sub showdata()
If rs.EOF = False And rs.BOF = False Then
temp = rs.Fields(9)
txt_fine.Text = rs.Fields(1)
txt_maxday.Text = rs.Fields(0)
txt_ref.Text = rs.Fields(4)
txt_maxhold.Text = rs.Fields(2)
txt_new.Text = rs.Fields(5)
txt_temp.Text = rs.Fields(7)
txt_per.Text = rs.Fields(6)
txt_splash.Text = rs.Fields(8)
txt_welcome.Text = rs.Fields(10)
txt_pass1.Text = rs.Fields(3)
txt_pass2.Text = rs.Fields(3)
If (temp = 1) Then
opt_tl.Value = True
ElseIf temp = 2 Then
opt_ce.Value = True
Else
opt_def.Value = True
End If
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -