frmpeoplesae.frm

一个图书管理系统,界面精美,功能实用.源码整洁

      Width           =   105
   End
   Begin VB.Label Label6 
      Caption         =   "Picture:"
      Height          =   255
      Left            =   240
      TabIndex        =   15
      Top             =   3720
      Width           =   1215
   End
   Begin VB.Label Label5 
      Caption         =   "Last Name:"
      Height          =   255
      Left            =   240
      TabIndex        =   14
      Top             =   2280
      Width           =   1215
   End
   Begin VB.Label Label4 
      Caption         =   "Middle Initial:"
      Height          =   255
      Left            =   240
      TabIndex        =   13
      Top             =   1920
      Width           =   1215
   End
   Begin VB.Label Label3 
      Caption         =   "First Name:"
      Height          =   255
      Left            =   240
      TabIndex        =   12
      Top             =   1560
      Width           =   1215
   End
   Begin VB.Label Label1 
      Caption         =   "Student ID:"
      Height          =   255
      Left            =   240
      TabIndex        =   11
      Top             =   1200
      Width           =   1215
   End
   Begin VB.Line Line2 
      BorderColor     =   &H80000014&
      X1              =   120
      X2              =   5040
      Y1              =   975
      Y2              =   975
   End
   Begin VB.Image Image1 
      Height          =   480
      Left            =   120
      Stretch         =   -1  'True
      Top             =   240
      Width           =   480
   End
   Begin VB.Label Label2 
      BackStyle       =   0  'Transparent
      Caption         =   $"frmPeoplesAE.frx":0FB8
      Height          =   855
      Left            =   840
      TabIndex        =   10
      Top             =   120
      Width           =   4335
   End
   Begin VB.Line Line3 
      BorderColor     =   &H80000014&
      X1              =   120
      X2              =   5040
      Y1              =   5955
      Y2              =   5955
   End
   Begin VB.Line Line1 
      BorderColor     =   &H80000010&
      BorderWidth     =   2
      X1              =   120
      X2              =   5040
      Y1              =   975
      Y2              =   975
   End
   Begin VB.Line Line4 
      BorderColor     =   &H80000010&
      BorderWidth     =   2
      X1              =   120
      X2              =   5040
      Y1              =   5955
      Y2              =   5955
   End
End
Attribute VB_Name = "frmMembersAE"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'-------------------------------------------------------------------
'Members Add/Edit Form
'With this form it is possible to add/modify the members table.
'
'AddState is the bool value that decides whether the form will update
'or modify a record. When AddState = True then Add
'                    When AddState = False then Modify
'-------------------------------------------------------------------
Private RS As ADODB.RecordSet
Public OldID As String, AddState As Boolean

Private Sub Form_Load()

    On Error GoTo Err
    Set RS = New ADODB.RecordSet
    If AddState Then
        Image1.Picture = frmMembers.cmdAMod(1).Picture
        RS.Open "SELECT * FROM tblMembers", CN, adOpenStatic, adLockOptimistic
        Me.Caption = "Add Record"
    Else 'NOT AddState...
        Image1.Picture = frmMembers.cmdAMod(0).Picture
        Me.Caption = "Modify Record"
        cmdAddSave.Caption = "Save"
        RS.Open "SELECT * FROM tblMembers WHERE [Student ID] = '" & OldID & "'", CN, adOpenStatic, adLockOptimistic
        If Len(RS!Picture) > 0 Then
            Photo1.LoadPhoto RS!Picture
        End If
    End If

Exit Sub

Err:
    If Err.Number = 94 Or Err.Number = 3265 Then
        Resume Next 'If a null value is encountered
    Else
        Handler Err 'Unexpected error
    End If

End Sub

Private Sub cmdAddSave_Click()

'Add or save data in the recordset according to AddState

    On Error GoTo hell

    If txtFirst.Text = "" Then txtFirst.SetFocus: Exit Sub
    If txtLast.Text = "" Then txtLast.SetFocus: Exit Sub
    If cmbClass.Text = "" Then cmbClass.SetFocus: Exit Sub
    If cmbSection.Text = "" Then cmbSection.SetFocus: Exit Sub
    If txtRoll.Text = "" Then txtRoll.SetFocus: Exit Sub
    If IsNumeric(txtRoll.Text) <> True Then MsgBox "Roll Numbers must be numeric and between 1 and 99", vbExclamation, "Type Mismatch": HighLight txtRoll: Exit Sub
    txtRoll.Text = Int(txtRoll.Text)
    If txtRoll.Text < 1 Or txtRoll.Text > 99 Then MsgBox "Roll numbers must be between 1 and 99", vbExclamation, "Type Mismatch": HighLight txtRoll: Exit Sub
    MakeCode

    If AddState Then
        If RecordExists("tblMembers", "Student ID", txtCode.Text, txtCode) = True Then Exit Sub
    Else 'NOT AddState...
        If txtCode.Text <> OldID Then
            If RecordExists("tblMembers", "Student ID", txtCode.Text, txtCode) = True Then Exit Sub
        End If
    End If

    CN.BeginTrans
    With RS
        If AddState Then RS.AddNew
        .Fields(0) = txtCode.Text
        .Fields(1) = txtFirst.Text
        .Fields(2) = IIf(txtM.Text = "", " ", txtM.Text)
        .Fields(3) = txtLast.Text
        .Fields(4) = cmbClass.Text
        .Fields(5) = cmbSection.Text
        .Fields(6) = txtRoll.Text
        Photo1.SavePhoto .Fields("Picture")
        RS.Update
    End With
    CN.CommitTrans

    If AddState Then
        FindRecord RS, RS.Fields(0).Name, True, txtCode.Text, 0
        MsgBox "New record has been successfully added", vbInformation

        If MsgBox("Do you want to add a new record?", vbQuestion + vbYesNo + vbDefaultButton1) = vbYes Then
            cmdReset_Click
        Else
            Unload Me
        End If

    Else 'NOT AddState...
        FindRecord RS, RS.Fields(0).Name, True, txtCode.Text, 0

        MsgBox "Changes in record has been successfully saved", vbInformation
        Unload Me
    End If

Exit Sub

hell:
    On Error Resume Next
        CN.RollbackTrans
        Handler Err

End Sub

Private Sub cmbClass_Click()

    MakeCode

End Sub

Private Sub cmbSection_Click()

    MakeCode

End Sub

Private Sub txtRoll_LostFocus()

    MakeCode

End Sub

Private Sub cmdCancel_Click()

    Unload Me

End Sub

Private Sub cmdPicInsert_Click()

'Open photo from disk

    Photo1.OpenPhotoFile

End Sub

Private Sub cmdPicSave_Click()

'Save photo to disk

    On Error GoTo hell
    cmdlg.ShowSave
    If cmdlg.Filename <> "" Then
        SavePicture Photo1.Picture, cmdlg.Filename
    End If
hell:

End Sub

Private Sub cmdPicShow_Click()

'Open photo from a temp file

    On Error Resume Next
        Kill "tmp.jpg"
        SavePicture Photo1.Picture, "tmp.jpg"
        ShellEx "tmp.jpg"

End Sub

Private Sub cmdReset_Click()

    txtCode.Text = ""
    txtFirst.Text = ""
    txtLast.Text = ""
    txtM.Text = ""
    txtRoll.Text = ""
    cmbClass.ListIndex = 0
    cmbSection.ListIndex = 0

End Sub

Private Sub MakeCode()

'This sub automatically generates Student Code

Dim a As String, b As String

    If cmbSection.Text <> "" And txtCode.Text <> "" And txtRoll.Text <> "" Then
        Select Case cmbSection.ListIndex
        Case 0: a = "AQ"
        Case 1: a = "AU"
        Case 2: a = "CG"
        Case 3: a = "PS"
        End Select
        b = cmbClass.ListIndex + 1
        If b = 10 Then b = "X"
        If txtRoll.Text < 10 Then txtRoll.Text = "0" & txtRoll.Text
        txtCode.Text = a & b & txtRoll.Text
    End If

End Sub