'**************************************
' Name: Joke Randomizer Module
' Description:This code will retrieve a 
'     list of jokes in a file, place them into
'     a list box, and when commanded will rand
'     omly select a joke from the list.
' By: David A. Edwards
'
' Assumes:You must place two listboxes i
'     nto frmMain (or rename frmMain in my cod
'     e to the name of your main form): lstQ a
'     nd lstA
'
'This code is copyrighted and has' limited warranties.Please see http://w
'     ww.Planet-Source-Code.com/vb/scripts/Sho
'     wCode.asp?txtCodeId=50357&lngWId;=1'for details.'**************************************

Attribute VB_Name = "modJoke"
'Joke randomizer module
'Created December 6, 2003 (12-6-03) by D
'     avid Edwards
'For contact information, http://hook.sy
'     tes.net
'AIM: NMHS Dave
'Module dedicated to Joe, who requested 
'     I make a randomizer.
'IMPORTANT NOTES:
'1.) Add two lists to your main form: ls
'     tQ and lstA, be sure to make sure this m
'     odule links to them
'I.E. Change lstA to frmMain.ListA or so
'     mething.
'2.) Be sure the source file is set up a
'     s Q: and A:
'3.) Make sure your main form makes this
'     module call the LoadList() Sub
'Otherwise, there will be no source.
'4.) Stick something in your Form_Load()
'     saying modJokeProcess.LoadList("C:\jokes
'     .txt")
'where that path example is the actual l
'     ocation of a joke file.
'5.) The joke file should be set up like
'     this example:
'Q: WHAT DO YOU DO WHEN A BLONDE THROWS 
'     A PIN AT YOU?
'A: Run like Hell....she's got a hand gr
'     enade in her mouth.
'
'
'Q: How do blonde braincells die ?
'A: Alone.
'
'
'Q: How do you brainwash a blonde?
'A: Give her a douche and shake her upsi
'     de down.
'
'
'Q: HOW DO YOU KEEP A BLONDE BUSY ALL DA
'     Y?
'A: Put her in a round room and tell her
'     to sit in the corner.
'
'
'Q: HOW DID THE BLONDE DIE ICE FISHING?
'A: She was run over by the zambonis mac
'     hine.
'Be sure to use proper caps and such tho
'     ugh, and place two "enter"s between joke
'     s
'and be sure the Question and Answer sta
'     rt with "Q: " or "A: "
'Enjoy!

Function RandomJoke() As String

    Randomize
    'Randomly make a number, round it off so
    '     that it's not a part of a number like 34
    '     35.12
    theRand = Round(Rnd * 100)
    'Make sure it's not out of bounds

    Do Until theRand <= frmMain.lstA.ListCount
        theRand = theRand - 12
    Loop

    'Turn the selected item on list into a s
    '     tring
    theQuestion = frmMain.lstQ.List(theRand)
    theAnswer = frmMain.lstA.List(theRand)
    'Change the case of the strings (Capital
    '     ization)
    'Commented out these two code lines. The
    '     y used to edit each one so only the firs
    '     t
    'letter of the string was capitalized, b
    '     ut that causes some errors for files tha
    '     t
    'are already properly typed (proper punc
    '     tuation and such),if there are two sente
    '     nces
    'within a string, like if the question a
    '     nd answer was:
    'Why do blondes have more fun?
    'Because they don't know any better. the
    '     y are easier to keep amused.
    'Notice how "they" is lowercase though i
    '     t should be capitalized, because of the 
    '     two lines
    'below. Uncomment them if you wish thoug
    '     h.
    'theQuestion = UCase(Left(theQuestion, 1
    '     )) & LCase(Mid(theQuestion, 2))
    'theAnswer = UCase(Left(theAnswer, 1)) &
    '     LCase(Mid(theAnswer, 2))
    RandomJoke = theQuestion & " " & theAnswer
End Function


Function LoadList(FilePath As String)

    Dim theFile As String
    openfile = FreeFile
    Open FilePath For Binary Access Read As #openfile
    theFile = Space$(LOF(openfile))
    Get openfile, , theFile
    Close #openfile
    'Take out double-enters and quotes
    theFile = Replace(theFile, vbCrLf & vbCrLf, "")
    theFile = Replace(theFile, Chr(34), "")
    theLines = Split(theFile, vbCrLf)
    'Seperate into two lists

    For l = 0 To UBound(theLines)
        If Left(theLines(l), 3) = "A: " Then frmMain.lstA.AddItem Mid(theLines(l), 4)
        If Left(theLines(l), 3) = "Q: " Then frmMain.lstQ.AddItem Mid(theLines(l), 4)
        DoEvents
        Next

        'Ensure to the programmer that the lists
        '     are balanced
        Debug.Print frmMain.lstQ.ListCount & " questions, " & frmMain.lstA.ListCount & " answers."
        If frmMain.lstQ.ListCount <> frmMain.lstA.ListCount Then Debug.Print "Not a balanced amount!"
    End Function