Quick Search for:  in language:    
code,will,retrieve,list,jokes,file,place,them
   Code/Articles ╗ |  Newest/Best ╗ |  Community ╗ |  Jobs ╗ |  Other ╗ |  Goto ╗ | 
CategoriesSearch Newest CodeCoding ContestCode of the DayAsk A ProJobsUpload
Visual Basic Stats

 Code: 3,290,928. lines
 Jobs: 215. postings

 How to support the site

 
Sponsored by:

 
You are in:
 
Login





Latest Code Ticker for Visual Basic.
Click here to see a screenshot of this code!WheelCipher Encryption
By Michael D. on 1/5

(Screen Shot)

Blackjack games ver 1.0
By Yu Jiunn Shyang on 1/4


Click here to see a screenshot of this code!Transparent Tiler
By Roger Gilchrist on 1/4

(Screen Shot)

bitblt example with invintory, levels, and chat.
By Mike Aka Sono on 1/4


Game Programming Dilemma (DirectX or OpenGL?)
By abandoned_progr ammer on 1/4


Click here to see a screenshot of this code![[ XP Theme
By Pamela RAI on 1/4

(Screen Shot)

____Transparent class module____
By Mathieu Chartier on 1/4


[[ a1 Tie Remote MySQL DB to MSHflexgrid
By Pamela RAI on 1/4


Click here to see a screenshot of this code!internet logger, updated see info
By stephen whittle on 1/4

(Screen Shot)

Click here to put this ticker on your site!


Add this ticker to your desktop!


Daily Code Email
To join the 'Code of the Day' Mailing List click here!

Affiliate Sites



 
 
   

Joke Randomizer Module

Print
Email
 

Submitted on: 12/6/2003 5:28:43 PM
By: David A. Edwards  
Level: Intermediate
User Rating: Unrated
Compatibility:VB 3.0, VB 4.0 (16-bit), VB 4.0 (32-bit), VB 5.0, VB 6.0

Users have accessed this code 277 times.
 
 
     This code will retrieve a list of jokes in a file, place them into a list box, and when commanded will randomly select a joke from the list.
 
code:
Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!
 
Terms of Agreement:   
By using this code, you agree to the following terms...   
1) You may use this code in your own programs (and may compile it into a program and distribute it in compiled format for languages that allow it) freely and with no charge.   
2) You MAY NOT redistribute this code (for example to a web site) without written permission from the original author. Failure to do so is a violation of copyright laws.   
3) You may link to this code from another website, but ONLY if it is not wrapped in a frame. 
4) You will abide by any additional copyright restrictions which the author may have placed in the code or code's description.

'**************************************
' 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

 
Report Bad Submission
Use this form to notify us if this entry should be deleted (i.e contains no code, is a virus, etc.).
Reason:
 
Your Vote!

What do you think of this code(in the Intermediate category)?
(The code with your highest vote will win this month's coding contest!)
Excellent  Good  Average  Below Average  Poor See Voting Log
 
Other User Comments
12/6/2003 5:41:00 PM:
Apologies for the mild language and 
crude jokes in the comments, I didn't 
fully review the example list file I 
pulled before submitting.
P.S.  I 
think you can remove the Quote removal 
code, I was testing with a buggy file 
that contained things like A1: and 
such, from the person who wanted me to 
code this.  As for the - 12 part, you 
could add a math formula so that it 
doesn't go into the negatives and such. 
 Sorry this was a hasty submission 
really.
Keep the Planet clean! If this comment was disrespectful, please report it:
Reason:

 
12/7/2003 2:23:23 PM:David A. Edwards
*CONSTRUCTIVE* feedback please "A 
Allen"?  You could at least say what's 
wrong with it.  However, you feel 
you're powerful enough to not use the 
word filter and insult 15 year olds...  
How egotistically sad.
Keep the Planet clean! If this comment was disrespectful, please report it:
Reason:

 
Add Your Feedback!
Note:Not only will your feedback be posted, but an email will be sent to the code's author in your name.

NOTICE: The author of this code has been kind enough to share it with you.  If you have a criticism, please state it politely or it will be deleted.

For feedback not related to this particular code, please click here.
 
Name:
Comment:

 

Categories | Articles and Tutorials | Advanced Search | Recommended Reading | Upload | Newest Code | Code of the Month | Code of the Day | All Time Hall of Fame | Coding Contest | Search for a job | Post a Job | Ask a Pro Discussion Forum | Live Chat | Feedback | Customize | Visual Basic Home | Site Home | Other Sites | About the Site | Feedback | Link to the Site | Awards | Advertising | Privacy

Copyrightę 1997 by Exhedra Solutions, Inc. All Rights Reserved.  By using this site you agree to its Terms and Conditions.  Planet Source Code (tm) and the phrase "Dream It. Code It" (tm) are trademarks of Exhedra Solutions, Inc.