frm_settings.frm

library management system that help in runnning a file

         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
   Begin VB.Label Label9 
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "Apply"
      Height          =   255
      Left            =   6480
      TabIndex        =   46
      Top             =   4605
      Width           =   1095
   End
   Begin VB.Label Label8 
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "OK"
      Height          =   255
      Left            =   5280
      TabIndex        =   45
      Top             =   4605
      Width           =   1095
   End
   Begin VB.Label Label7 
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "Change"
      Height          =   255
      Left            =   4080
      TabIndex        =   44
      Top             =   4605
      Width           =   1095
   End
   Begin VB.Label Label6 
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "Default"
      Height          =   255
      Left            =   2880
      TabIndex        =   43
      Top             =   4605
      Width           =   1095
   End
   Begin VB.Label Label5 
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "Delete fine"
      Height          =   255
      Left            =   120
      TabIndex        =   42
      Top             =   4605
      Width           =   1215
   End
   Begin VB.Label Label3 
      BackStyle       =   0  'Transparent
      Caption         =   $"Frm_settings.frx":4DEA
      Height          =   615
      Left            =   720
      TabIndex        =   40
      Top             =   120
      Width           =   6855
   End
   Begin VB.Image Image1 
      Height          =   585
      Left            =   120
      Top             =   120
      Width           =   600
   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 & "Welcome=" & Check1.Value & ", "
                    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
                        Label8.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)
                Welcome = Check1.Value
                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
                Label8.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
                Check1.Enabled = Not 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 & "Welcome = True,"
                    str = str & "Welcometime =1000   WHERE Key=1"
        db.Execute str
        Call showdata
        Check1.Value = 1
        MsgBox "Default Changes are Applied.", vbInformation, "Save"
                        
                        cmd_Change.Enabled = True
                        cmd_deletea.Enabled = True
                        cmd_apply.Enabled = False
                        Label8.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)
'                Welcome = Check1.Value
                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

Image1.Picture = mdi_start.ImageList1.ListImages(15).Picture
 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,Welcome from Custom", db, adOpenStatic, adLockOptimistic
ps = rs.Fields(3)
Label8.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 (rs.Fields(11) = True) Then
             Check1.Value = 1
           Else
             Check1.Value = 0
           End If
           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