VB icon

8 Ball Type Fortune Teller

Email
Submitted on: 1/2/2015 12:16:00 PM
By: Chapin Walton (from psc cd)  
Level: Not Given
User Rating: By 40 Users
Compatibility: VB 5.0, VB 6.0
Views: 1037
 
     Random call to find your Fortune. Like an 8 Ball. Contains a litte Easter Egg too, just for fun. This would look much nicer if you put an 8 Ball Graphic in which I didn't do, sorry
 
code:
Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!
				
'**************************************
' Name: 8 Ball Type Fortune Teller
' Description:Random call to find your Fortune. Like an 8 Ball. Contains a litte Easter Egg too, just for fun. This would look much nicer if you put an 8 Ball Graphic in 
which I didn't do, sorry
' By: Chapin Walton (from psc cd)
'
' Inputs:Ask a Question
'
' Returns:a Random Answer
'
' Assumes:I assume you know what an 8 ball is. To use this add a command button textbox and label, after that have fun :)
'
' Side Effects:Insanity - Just like me :)
'**************************************

Dim ans As Integer
Private Sub Command1_Click()
If Text1.Text = " " Or "Question_Goes_Here" Then
MsgBox "ah, ask a question first!", vbCritical, "ERROR!!!!"
' calls random Change the # 8 to get more varibles
' but don't forget to add them below
Else
ans = (Int(Rnd * 8) + 1)
'If you want diffrent answers put them in below
If ans = 1 Then
Label1.Caption = "Its not likely"
End If
If ans = 2 Then
Label1.Caption = "It looks possible"
End If
If ans = 3 Then
Label1.Caption = "Yes"
End If
If ans = 4 Then
Label1.Caption = "No"
End If
If ans = 5 Then
Label1.Caption = "Things are looking up"
End If
If ans = 6 Then
Label1.Caption = "Ask again later"
End If
If ans = 7 Then
Label1.Caption = "Only if you get me a brownie"
End If
If ans = 8 Then
Label1.Caption = "Certinally"
End If
End If
End Sub
Private Sub Form_DblClick()
MsgBox "MMM.... YOUR EYE TASTES LIKE CHEESE"
'EASTER EGG!!!! ALL PROGRAMS SHOULD HAVE THESE!!
End Sub
End Sub
Private Sub Form_Load()
Text1.Text = "Question_Goes_Here"
Command1.Caption = "Ask me..."
End Sub
Private Sub Text1_Click()
Text1.Text = " "
End Sub


Report Bad Submission
Use this form to tell us if this entry should be deleted (i.e contains no code, is a virus, etc.).
This submission should be removed because:

Your Vote

What do you think of this code (in the Not Given 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


 There are no comments on this submission.
 

Add Your Feedback
Your feedback will be posted below and an email sent to the author. Please remember that the author was kind enough to share this with you, so any criticisms must be stated politely, or they will be deleted. (For feedback not related to this particular code, please click here instead.)
 

To post feedback, first please login.