Code box #2
Dim lastQuote As Integer
Dim currentQuote As Integer
Dim quote As typQuote
Dim editFlag As Boolean
Public Sub toggleButtons()
cmdBack.Enabled = Not (cmdBack.Enabled)
cmdNext.Enabled = Not (cmdNext.Enabled)
cmdQuit.Visible = Not (cmdQuit.Visible)
cmdNew.Visible = Not (cmdNew.Visible)
cmdEdit.Visible = Not (cmdEdit.Visible)
cmdAdd.Visible = Not (cmdAdd.Visible)
cmdExit.Visible = Not (cmdExit.Visible)
txtQuote.Locked = Not (txtQuote.Locked)
txtAuthor.Locked = Not (txtAuthor.Locked)
End Sub
Private Sub cmdEdit_Click()
'set editFlag to indicate new quote
editFlag = True
'adjust screen buttons
lblQuoteNumber = "Edit quote text. Click Add to save, Exit to exit without saving."
toggleButtons
txtQuote.SetFocus
End Sub
Private Sub cmdExit_Click()
'reinstate buttons and previously displayed quote
toggleButtons
Call readQuote(currentQuote, Me)
End Sub
Private Sub cmdNew_Click()
'set editFlag to indicate new quote
editFlag = False
'clear the text boxes and adjust screen buttons
txtAuthor = ""
txtQuote = ""
lblQuoteNumber = "Type a new quote. Click Add to save, Exit to exit without saving."
toggleButtons
txtQuote.SetFocus
End Sub
Private Sub cmdAdd_click()
crlf = Chr$(13)
lengthQuote = Len(Trim(txtQuote.Text))
lengthAuthor = Len(Trim(txtAuthor.Text))
If (lengthQuote <= 600) And (lengthQuote >= 1) And (lengthAuthor <= 50) Then
'increment number of quotes by one if this is a new entry
If Not (editFlag) Then
lastQuote = lastQuote + 1
currentQuote = lastQuote
End If
'write new quote
quote.quoteText = txtQuote.Text
quote.quoteAuthor = txtAuthor.Text
Put #1, currentQuote, quote
'restore screen and display new quote
Call cmdExit_Click
ElseIf (lengthQuote > 600) Or (lengthQuote < 1) Then
Message = "The quote must be between 1 & 600 characters in length." + crlf
Message = Message + "Edit the quote and click Add or select Exit to quit without saving."
displayAlertMessage (Message)
txtQuote.SetFocus
Else 'Author name is too long
Message = "The author name cannot be longer than 50 characters." + crlf
Message = Message + "edit the quote and click Add or select Exit to quit without saving."
displayAlertMessage (Message)
txtAuthor.SetFocus
End If
End Sub
Private Sub cmdQuit_Click()
Unload Me
End Sub
Private Sub cmdNext_Click()
crlf = Chr$(13)
'Get the next quote in the file
If currentQuote <> lastQuote Then
currentQuote = currentQuote + 1
Call readQuote(currentQuote, Me)
Else
Message = "You are at the end of the file."
Message = Message + crlf + "There are no more quotes."
displayAlertMessage (Message)
End If
End Sub
Private Sub cmdBack_Click()
crlf = Chr$(13)
'Get the previous quote in the file
If currentQuote > 1 Then
currentQuote = currentQuote - 1
Call readQuote(currentQuote, Me)
Else
Message = "You are at the beginning of the file."
Message = Message + crlf + "There are no previous quotes."
displayAlertMessage (Message)
End If
End Sub
Private Sub Form_Load()
'error trap
On Error GoTo fileError
'centre the form
Left = (Screen.Width - Width) / 2
Top = (Screen.Height - Height) / 2
'open the quotes file for reading
Open "c:\quotes.txt" For Random As #1 Len = Len(quote)
If (LOF(1)) = 0 Then
'the file did not already exist so add 2 quotes to it
quote.quoteText = "Optimism is an intellectual choice."
quote.quoteAuthor = "Diana Schneider"
Put #1, 1, quote
quote.quoteText = "He who laughs, lasts."
quote.quoteAuthor = "Mary Pettibone Poole"
Put #1, 2, quote
End If
'calculate the number of the last quote in the file.
lastQuote = LOF(1) / Len(quote)
'display the first quote in the file
currentQuote = 1
Call readQuote(currentQuote, Me)
procedureExit:
Exit Sub
fileError:
Message = "There is a critical file I/O error."
displayAlertMessage (Message)
Resume procedureExit
End Sub
Private Sub Form_Unload(Cancel As Integer)
Close #1
Unload Me
End Sub