⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frm_settings.frm

📁 Library Management System 1
💻 FRM
📖 第 1 页 / 共 3 页
字号:
      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 + -