Voting

Category

real language

Bookmarking

Del.icio.us Digg Diigo DZone Earthlink Google Kick.ie
Windows Live LookLater Ma.gnolia Reddit Rojo StumbleUpon Technorati

Language Visual Basic

(Scrolling text using the print command.)

Date:02/27/06
Author:Seirian J. Pardoe
URL:http://www.freewebs.com/blackdragonvb/
Comments:7
Info:http://en.wikipedia.org/wiki/Visual_Basic
Score: (2.98 in 49 votes)
'-------------------------------------------
'99 Bottles of Beer (scroling text version)
'by Seirian J. Pardoe
'in Visual Basic 6
'on 25/2/05
'-------------------------------------------

'Just start a starndard .exe project right click on the form
'click "view code" and paste in this code.

Option Explicit

'Verse data structure

Private Type cVerse
    Line1 As String
    Line2 As String
    Position As Double
End Type

Dim Verse() As cVerse

Dim Pan As Double

Dim EndNow As Boolean

'The speed of the text will vary depending on the speed of your computer
'so ajust this constant untill you get a pan speed of your liking

Const PanSpeed = 0.1

Private Sub Form_Load()
Dim X%
    
    'Set the starting number of bottles
    X = 99
    
    'Set the form's Title
    Form1.Caption = Str(X) + " Bottles of Beer"
    
    'Set the form's size
    Form1.Width = 8000
    Form1.Height = 5000
    
    'set the forms position to the centere of the screen
    Form1.Left = (Screen.Width / 2) - (Form1.Width / 2)
    Form1.Top = (Screen.Height / 2) - (Form1.Height / 2)
    
    'Set scale mode to pixel
    Form1.ScaleMode = 3
    
    'Start with all the text at the bottom of the form
    Pan = -Form1.ScaleHeight
    
    'Set background color to black
    Form1.BackColor = 0
    
    'Set the foreground color* to dark green (*text color in this case)
    Form1.ForeColor = RGB(25, 150, 25)
    
    'Set the form's font
    Form1.Font = "Arial"
    Form1.FontSize = 12
    
    'Turn on auto redraw for flicker free display
    Form1.AutoRedraw = True
    
    'Show the form, this is needed when an infinit loop is used
    Form1.Show
    
    'Write the song withe X number of bottles
    WriteSong X
    
    'Display the results as scroling text
    DisplayResults
    
End Sub

Sub WriteSong(NoOfBottles As Integer)
Dim i%, n%
    
    'Dont alow a negative number of bottles
    If NoOfBottles < 0 Then NoOfBottles = 0
    
    'Resize the verse array
    ReDim Verse(NoOfBottles)

    'Loop through the number of bottles
    For i = NoOfBottles To 0 Step -1
    
        'Set n to 0, it is used to select the phrase of the first line
        n = 0
        
        'Select the current verse
        With Verse(NoOfBottles - i)
        
        'Write first line of the verse

NextPhrase: '** Return here to write the second phrase of the first line

            If i > 0 Then .Line1 = .Line1 + Right(Str(i), Len(Str(i)) - 1)
            If i = 0 And n = 0 Then .Line1 = .Line1 + "No more"
            If i = 0 And n = 1 Then .Line1 = .Line1 + "no more"
            If i <> 1 Then .Line1 = .Line1 + " bottles of beer"
            If i = 1 Then .Line1 = .Line1 + " bottle of beer"
            If n = 0 Then .Line1 = .Line1 + " on the wall, ": n = 1: GoTo NextPhrase '**
            If n = 1 Then .Line1 = .Line1 + "."
            
            
            'Write the second line of the verse

            If i > 0 Then .Line2 = "Take one down and pass it around, "
            If i = 0 Then .Line2 = "Go to the store and buy "
            If i = 0 And NoOfBottles > 1 Then .Line2 = .Line2 + "some more, "
            If i = 0 And NoOfBottles = 1 Then .Line2 = .Line2 + "one more, "
            If i = 0 And NoOfBottles = 0 Then .Line2 = .Line2 + "no more, "
            If i > 2 Then .Line2 = .Line2 + Str(i - 1) + " bottles"
            If i = 2 Then .Line2 = .Line2 + Str(i - 1) + " bottle"
            If i = 1 Then .Line2 = .Line2 + "no more bottles"
            If i = 0 And NoOfBottles > 1 Then .Line2 = .Line2 + Str(NoOfBottles) + " bottles"
            If i = 0 And NoOfBottles = 1 Then .Line2 = .Line2 + Str(NoOfBottles) + " bottle"
            If i = 0 And NoOfBottles = 0 Then .Line2 = .Line2 + "no bottles"
            .Line2 = .Line2 + " of beer on the wall."
            
            
            'Set the text's position
            .Position = (NoOfBottles - i) * 60
            
        End With
    Next i
    
End Sub

Sub DisplayResults()
Dim i%

    Do
        'Clear the form
        Form1.Cls
        
        'Exit the loop when the app is closed
        If EndNow = True Then Exit Sub
        
        'loop through the verse array
        For i = 0 To UBound(Verse)
        
            With Verse(i)
            
                'Check if text is on screen
                If .Position - Pan > -60 And .Position - Pan < Form1.ScaleHeight + 60 Then
                    
                    'Print the first line
                    CurrentX = 20
                    CurrentY = .Position - Pan
                    Form1.Print .Line1
                    
                    'Print Line 2 (Y Position is automaticly set)
                    CurrentX = 20
                    Form1.Print .Line2
                    
                End If
            End With
        Next i
        
        'Increment the pan value once per frame
        Pan = Pan + PanSpeed
        
        'Do OS events
        DoEvents
        
    Loop
End Sub

Private Sub Form_Unload(Cancel As Integer)
    EndNow = True
    Unload Me
End Sub

Download Source | Write Comment

Alternative Versions

VersionAuthorDateCommentsRate
1Jeff Shepherd04/20/051

Comments

>>   said on 09/08/06 16:21:29

very good congratz are in order here :p

>>  rossco said on 04/21/07 22:31:49

rossco this lanuage rocks

>>  Paul said on 06/14/07 23:52:37

Paul You should always use CStr instead of Str - Str adds an unwanted extra space. But nice use of DoEvents and % (type declaration char).

>>  VB6.0DaMan said on 11/23/07 15:53:49

VB6.0DaMan Very Nice DoEvents...
Loved it!! to bad there is not much room for formatting spaces and stuff in VB but you did an awesome job!

>>  MOSFET said on 04/20/08 15:50:06

MOSFET Fine.. Make it easy... VB is good, though, but don't shoot me if I claim Java to be better...

>>  Marc said on 07/12/09 20:49:56

Marc Much too complicate, far too many if's. Who would write that in real life?

>>  Kyle Eppley said on 07/24/09 17:57:51

Kyle Eppley VB is a very advanced language. Here is a threaded scrolling console app version using many version 10 features in 43 lines of code:

Imports System.Console 'namespace needed for .net console commands
Imports System.Threading
Imports System.Threading.Tasks

Module BeerSpace 'world namespace that beer app lives in
Private Interval As Integer
Const a As String = " of beer " 'strings used by app in order of appearance
Const b As String = "on the wall"
Const c As String = "take one down pass it around"
Const z As String = "No more bottles of beer on the wall, no more bottles of beer." & vbCrLf &
"Go to the store and buy some more, 99 bottles of beer on the wall."

Sub Main(ByVal args() As String) 'main program enterance arg(0) is the delay for singing
If args.Length > 0 Then Interval = CInt(Val(args(0)))
Dim Thd As task = Task.Factory.StartNew(AddressOf ThdLoop) 'start thread to run beer
Console.ReadKey() 'hold program to review output
End Sub

Sub ThdLoop()
beer()
End Sub

Function beer(Optional ByRef i As Integer = 99) As Long 'recusive beer function
Select Case i
Case 1 To i
Console.WriteLine(bs(i) & a & b & ", " & bs(i) & a)
Thread.Sleep(Interval)
Console.WriteLine(c & ", " & bs(i - 1) & a & b & vbCrLf)
Thread.Sleep(Interval)
beer(i - 1)
Case 0 : Console.WriteLine(z) 'last verse
End Select
End Function

Function bs(ByRef n As Integer) As String 'function to correct bottle(s)
Select Case n
Case 0 : Return "no more bottles"
Case 1 : Return "1 bottle"
Case Else : Return n.ToString & " bottles"
End Select
End Function

End Module

Download Source | Write Comment

Add Comment

Please provide a value for the fields Name, Comment and Security Code.
This is a gravatar-friendly website.
E-mail addresses will never be shown.
Enter your e-mail address to use your gravatar.

Please don't post large portions of code here! Use the form to submit new examples or updates instead!

Name:

eMail:

URL:

Security Code:
  
Comment: