99 Bottles Of Beer Basic
- Basic for Casio FX 2
- BASIC-PLUS
- BasicBasic
- BBC Basic
- FreeBASIC
- GABasic
- GBasic
- GFA Basic
- HotBasic
- Hummingbird Basic
- IBasic
- JustBasic
- QBasic
- QuickBASIC
- RBasic+
- S-BASIC
- Sbasic
- ScriptBasic
- Small Basic
- SmallBasic
- StarBasic
- UniBasic
- Visual Basic
- Visual Basic (.NET)
- wxBasic
- XBasic
- Yabasic
'99 bottles of beer
'for
'Casio Algebra FX 2
'By Jan Prazak, www.amarok.cz
'Note: "->" is the assignment arrow, it's a special symbol;
'function "GetKey" returns key codes to the variable "Ans",
'0 = no key, 47 = ESC (escape)
For 99->B To 1 Step -1
ClrText
4->X
If B<10
Then 3->X
IfEnd
Locate 1,1,B
Locate X,1,"BOTTLE(S) OF BEER"
Locate 1,2,"ON THE WALL,"
Locate 1,3,B
Locate X,3,"BOTTLE(S) OF BEER"
Locate 1,4,"-- TAKE ONE DOWN"
Locate 1,5,"AND PASS IT AROUND,"
4->X
If B-1<10:Then 3->X
IfEnd
Locate 1,6,B-1
Locate X,6,"BOTTLE(S) OF BEER"
Locate 1,7,"ON THE WALL"
Do:GetKey
LpWhile Ans=0
If Ans=47:Then Break
IfEnd
Next
ClrText
1 EXTEND
10 !
Basic Plus version of 99 bottles of beer
Modified by George Hames (george.hames@ihs.com)
from prior versions found on this site.
1000 FOR BOTTLES% = 99% TO 1% STEP -1% \
PRINT BOTTLES%; "bottle"; \
PRINT "s"; UNLESS BOTTLES% = 1% \
PRINT " of beer on the wall,"; BOTTLES%; "bottle"; \
PRINT "s"; UNLESS BOTTLES% = 1% \
PRINT " of beer" \
PRINT "Take one down and pass it around," \
PRINT BOTTLES% - 1%; "bottle"; IF BOTTLES% > 1% \
PRINT " no more bottles"; IF BOTTLES% = 1% \
PRINT "s"; IF BOTTLES% > 2% \
PRINT " of beer on the wall" \
NEXT bottles%
32767 END
rem BasicBasic version of 99 Bottles of beer (Bottles.bas)
rem See http://www.programmersheaven.com/search/Download.asp?FileID=16394
rem Philipp Winterberg, http://www.winterbergs.de
a$=" bottle(s) of beer" : c$=" on the wall"
for b = 99 to 1 step -1
print b; a$; c$; ","
print b; a$; "."
print "Take one down, pass it around,"
print b-1; a$; c$; "."
print
next b
if ostype = 1 then
do while inkey$=""
loop
end if
end
REM BBC BASIC version of 99 Bottles of beer (Bottles.bbc)
REM See: http://www.bbcbasic.com/
REM Philipp Winterberg, http://www.winterbergs.de
FOR b=99 TO 1 STEP -1
PRINT 'b;, " bottle(s) of beer on the wall,"
PRINT b;,, " bottle(s) of beer."
PRINT ,,,, "Take one down, pass it around,"
PRINT b-1; " bottle(s) of beer on the wall."
NEXT b
Dim bottles as Integer
Dim text as String
screen 12
declare sub dprint(text as string)
For bottles = 99 to 1 Step -1
text=ltrim$(str$(bottles))+" bottle(s) of beer on the wall . . ."
dprint text
text=ltrim$(str$(bottles))+" bottles(s) of beer!"
dprint text
text="Take one down, pass it around . . ."
dprint text
text=ltrim$(str$(bottles-1))+" bottle(s) of beer on the wall!"
dprint text
print
next
Sub dprint(text as string)
Dim scroll as integer
static scrollold
for i = 1 to len(text)
getmouse null,null,scroll
If scroll<scrollold-1 then scroll=scrollold
scrollold=scroll
If scroll>25 Then
scroll=25
Elseif scroll<0 Then
scroll=0
End IF
PRINT mid$(text,i,1);
sleep 50-(scroll*2)
if inkey$=CHR$(255)+"k" Then end
next i
print
end sub
Sleep
End
' GABasic version of 99 Bottles of beer (Bottles.bas)
' See http://mitglied.lycos.de/movaxworldhq/basic.htm
' Philipp Winterberg, http://www.winterbergs.de
cls
for b = 99 to 1 step -1
temp = b - 1
print " "
print str$(b) + " bottle(s) of beer on the wall,"
print str$(b) + " bottle(s) of beer."
print "Take one down, pass it around,"
print str$(temp) + " bottle(s) of beer on the wall."
next
sleep
REM GBasic version of 99 Bottles of beer (Bottles.b)
REM See http://mitglied.lycos.de/movaxworldhq/basic.htm
REM Philipp Winterberg, http://www.winterbergs.de
color(255, 0) : screen 13
for b = 99 to 1 step -1 : print
print str$(b) + " bottle(s) of beer on the wall,"
print str$(b) + " bottle(s) of beer."
print "Take one down, pass it around,"
print str$(b-1) + " bottle(s) of beer on the wall."
next : wait_key
// GFA Basic for Windows version of 99 Bottles of beer (Bottles.gfw)
// See http://www.beepcastle.de/gfa/index.htm#trial
// Philipp Winterberg, http://www.winterbergs.de
OPENW #1
b = 99
WHILE b > 0
? b; " bottle(s) of beer on the wall,"
? b; " bottle(s) of beer."
? "Take one down, pass it around,"
b--
? b; " bottle(s) of beer on the wall."; CHR$(13,10)
WEND
KEYGET a%
CLOSEW #1
QUIT
'--------------------------------
' 99-Bottles
' GUI Version
'
' Coded By: AirrSongs - www.airsys.org
' Language: HotBasic - www.hotbasic.org
' Date: 10/03/05'
'--------------------------------
$apptype gui:$typecheck on
declare Function Get_Bottles(num as byte) as string
create form1 as form
width=300
height=350
minimizebox=false
maximizebox=false
center
onshow=Count_Bottles
create list1 as listbox
top=0
left=0
width=form1.clientwidth
height=form1.clientheight
end create
end create
form1.showmodal
end
Function Get_Bottles(num as byte) as string
defstr Ret
select case num
case 0: Ret = "No more bottles of beer"
case 1: Ret = "1 bottle of beer"
case else: Ret = str$(num) + " bottles of beer"
end select
result = Ret
end Function
Count_Bottles:
defbyte i =99
do
list1.additems(Get_Bottles(i) + " on the wall, "
list1.additems(Get_Bottles(i) + ",")
list1.additems("take one down, pass it around,")
list1.additems(Get_Bottles(i-1) + " on the wall.")
list1.additems(NULL)
dec(i)
loop until i = 0
return
' Hummingbird Basic version of the Beer Song
' By Eric Korpela (http://setiathome.ssl.berkeley.edu/~korpela)
Function DisplayBox(verse$, i%)
If (i<>1) Then
DisplayBox=Msgbox(verse, 4, "Verse")
Else
DisplayBox=Msgbox(verse, 0, "Verse")
End If
End Function
Function Plural$(i%)
If (i%=1) Then Plural="" Else Plural="s"
End Function
Function NewFormat$(i%)
If (i%=0) Then NewFormat="No" Else NewFormat=Format(i%)
End Function
Sub Main
Dim verse$, i%
For i%=99 to 1 step -1
verse=Format(i%) & " bottle" & Plural(i%) & " of beer on the wall." & chr$(13)
verse=verse & Format(i%) & " bottle" & Plural(i%) & " of beer."& chr$(13)
verse=verse & "You take one down and pass it around" & chr$(13)
verse=verse & NewFormat(i%-1) & " bottle" & Plural(i%-1)
verse=verse & " of beer on the wall." & chr$(13) & chr$(13)
If (i<>1) Then verse=verse & "Drink more?"
If (DisplayBox(verse, i)=7) Then
Msgbox "What a light weight!",48,"Wimp Out"
Exit For
End If
Next i%
End Sub
'=== 99 Bottles of Beer by L a r r y A d c o c k ===
'=== Language: IBasic Professional by Pyxia www.pyxia.com ===
'=== Windows program with beer bottle graphics ===
'=== Plurals and last two verses properly handled ===
DEF win:WINDOW
DEF st[6]:string
def aa, bb, brown, white, run:int
autodefine "off"
st=" bottle","","s"," of beer"," on the wall", "take one down and pass it around "
OPENWINDOW win, 5, 10, 630, 200, @caption, 0, "99 Bottles of Beer", &winhandler
control win, @button, "DRINK A BEER !", 300, 130, 150, 25, 0, 1
brown=rgb(90,80,0) : white=rgb(255,255,255)
rect win, 5, 40, 596, 3, brown, brown
for bb=1 to 99
rect win, bb*6+1, 20, 3, 6, brown, brown
rect win, bb*6, 26, 5, 10, brown, brown
next bb
aa=100
drink_one()
run = 1 : WAITUNTIL run = 0 : CLOSEWINDOW win : END
'=============================================
SUB winhandler
SELECT @CLASS
CASE @IDCLOSEWINDOW
run = 0
CASE @IDCONTROL
select @controlid
case 1
if aa>0 then drink_one() else run=0
endselect
ENDSELECT
RETURN
ENDSUB
'=============================================
SUB drink_one
def a$, b$, music:string
def x, xx:int
aa=aa-1
rect win, 4, 56, 596, 60, white, white
rect win, 4, 19, 596-aa*6, 20, white, white
move win, 5, 60
select 1
case (aa=0)
x=2 : xx=2
setcontroltext win, 1, "NO BEER - QUIT"
case (aa>2)
x=2 : xx=2
case (aa=2)
x=2 : xx=1
case (aa=1)
x=1 : xx=2
endselect
a$=st[0]+st[x]+st[3]
if aa>0
b$=str$(aa)
else
b$="No more"
endif
print win, b$+a$+st[4]+"... ",b$+a$+"... "
move win, 10 , 85
a$=st[0]+st[xx]+st[3]
select aa
case 0
print win, "Go to the store and buy some more...99 bottles of beer."
case 1
print win, st[5]+"... "+"no more"+a$+st[4]
default
print win, st[5]+"... "+str$(aa-1)+a$+st[4]
endselect
'instrument is a glasswind (beer bottle)
music="I75 O5G16 G16 G16 D16 D16 D16 G16 G16 G16 G16 R8 "
music=music+"A16 A16 A16 E16 E16 E16 A8 R16 "
music=music+"G16 F#16 F#16 F#16 F#16 F#16 F#16 F#16 F#16 F#16 F#8 R16 "
music=music+"D16 D16 D16 D16 E16 F#16 G16 G16 G16 G8 R16"
playmidi$ music, true
return
ENDSUB
REM 99 Bottles of Beer on the wall
REM John Fredrickson, Washington DC, jafred@BellAtlantic.net
REM JustBasic http://www.justbasic.com is a subset of
REM LibertyBasic http://www.LibertyBasic.com
Bottles = 99
While Bottles >= 1
if Bottles > 1 then
Print Bottles; " bottles of beer on the wall,"
Print Bottles; " bottles of beer."
Print "Take one down and pass it around,"
else
Print Bottles; " bottle of beer on the wall,"
Print Bottles; " bottle of beer."
Print "Take it down and pass it around,"
end if
Bottles = Bottles - 1
Select Case Bottles
Case 1
Print "A single bottle of beer on the wall."
Case 0
Print "No more bottles of beer on the wall."
Case Else
Print Bottles; " bottles of beer on the wall."
End Select
Print
Wend
End
' "99 Bottles of Beer on the Wall" QBasic / Perl Polyglot '.
' Copyright (C) 2000 Jeff Connelly <polyglotqbperl@xyzzy.cjb.net> '.
' May be freely distributed '.
' '.
' Probably only works in DOS. You can get QBasic 1.1 with DOS, or '.
' on the World Wide Web at http://www.neozones.com/ . '.
' Note that QBasic reformats source code as it is opened; so do not '.
' save this file inside QBasic if you want it to be parsed by Perl. ';
'';sub function{}sub st{}
function st$(x1, y!, m$)
st$ = ltrim$(str$(y!))
end function
'!;
m%=99'%;$STATIC=9x2;
do
'NUL'; do {
print st$(x1,m%-0%,z.$); '',print"\cH"x3;print
'',$STATIC;
print " bottles of beer on the wall";
print ''; print "\n"x2; <<;
print
print st$(x1,m%-0%,z.$); '',print"\cH"x3;print
'',$STATIC;
print " bottles of beer on the wall,";
print ''; print "\n";
print st$(x1,m%-0%,z.$); '',print"\cH"x3;print
'',$STATIC;
print " bottles of beer,";
print '' and print "\n";
print "Take one down, pass it around,";
print ""; ''; print "\n";
''; <<;
print
''; --$STATIC;
m%=m%-1+foo.
''} until $STATIC == 0 or !<<;;
loop until m%=0'%-1
system
'set fridge capacity, beverage type, and container type
X = 99
B$ = "beer"
C$ = "bottle"
'build number strings so "0" can be sung correctly in second to last verse
DIM N$(X)
FOR L = 1 TO X
N$(L) = LTRIM$(STR$(L))
NEXT
N$(0) = "no more"
'fully stock the fridge, and then start singing!
F = X
DO
'each verse has four "phrases"
FOR P = 1 TO 4
SELECT CASE P:
'three phrases are very similar - first, second, and fourth
CASE 1, 2, 4:
'use some boolean algebra to handle the "what-ifs":
PRINT N$(F); " "; C$; LEFT$("s", -(F <> 1)); " of "; B$;
'-(F=1) evaluates to 1 when F=1.... [-(-1)]
' 0 when F<>1... [-(0) ]
'(don't want to pluralize a lone container)
PRINT LEFT$(" on the wall", -12 * (P <> 2));
'-12*(P<>2) evaluates to 0 when P=2.... [-12*(0) ]
' 12 when P<>2... [-12*(-1)]
'(don't want to sing those words in the second phrase)
PRINT MID$(", ." + CHR$(13), 3 + 2 * (P = 1), 2);
'3+2*(P=1) evaluates to 1 when P=1.... [3+2*(-1)]
' 3 when P<>1... [3+2*(0) ]
'(brief pause after first phrase, long pause after other two)
'[using length of zero with Left$ results in empty string]
'third phrase of the song never changes
CASE 3:
PRINT "Take one down and pass it around, ";
F = F - 1
END SELECT
NEXT
'take an extra breath between verses
PRINT
'F evaluates to FALSE when F=0 [exactly zero is always FALSE]
' TRUE when F<>0 [every nonzero is always TRUE]
'(continue singing verses until fridge is empty)
LOOP WHILE F
'sing final verse the easy way
PRINT "No more "; C$; "s of "; B$; " on the wall, no more "; C$; " of "; B$; "."
PRINT "Go to the store and buy some more, "; N$(X); " "; C$; "s of "; B$; " on the wall."
'boolean algebra is your friend :)
function NintyNine_BottlesOfBeer( void )
/*
abstract: simple rbasic program for the 99bottlesofbeer site
nothing fancy .. can be run from editor or put
in a text box .. or simple oswrite to disk
Note .. this source is cross compatible with Advanced Revealtion
and except for SWAP and function .. compatible with Revelation
author: dsig (David Tod Sigafoos)
date: 17jul05
*/
*-- just equate some items ..
equ TRUE$ to 1
equ FALSE$ to 0
equ NULL$ to ''
equ CRLF$ to char(13):char(10)
*- build our default strings ..
strSong = NULL$
line1 = '%%count1%% bottles of beer on the wall, %%count1%% bottles of beer ...'
line2 = 'take one down and pass it around, %%count2%% bottles of beer on the wall'
endSongLine1 = 'No more bottle of beer on the wall. No more bottles of beer...'
endSongLine2 = 'Go to the store and buy some more...99 bottles of beer.'
*-- simple for/next going backwards. Use simple replacement text to
* stuff correct numbers and text
for bottlesOfBeer = 99 to 0 step -1
begin case
case bottlesOfBeer GT 1
strSong := CRLF$ : line1 : CRLF$ : line2
swap '%%count1%%' with bottlesOfBeer in strSong
* when we hit 2 bottles .. take one down should leave 1 BOTTLE
if bottlesOfBeer = 2 then
swap '%%count2%% bottles' with bottlesOfBeer-1:' bottle' in strSong
end else
swap '%%count2%%' with bottlesOfBeer-1 in strSong
end
case bottlesOfBeer = 1
strSong := CRLF$:line1 : CRLF$ : line2
swap '%%count1%% bottles' with bottlesOfBeer:' bottle' in strSong
swap '%%count2%%' with 'no more' in strSong
case bottlesOfBeer = 0
strSong := CRLF$:endSongLine1 : CRLF$ : endSongLine2
end case
*-- need that space between verses
strSong := CRLF$
next bottlesOfBeer
return strSong
comment
print lyrics to "99 bottles of beer"
written for S-BASIC compiler for 8-bit CP/M systems
end
$constant maxbottles = 99
rem - computes p mod q
function mod(p, q = integer) = integer
end = p - q * (p/q)
function wordnumber(i = integer) = string
var w = string
if i < 11 then
case i of
0 : w = ""
1 : w = "One "
2 : w = "Two "
3 : w = "Three "
4 : w = "Four "
5 : w = "Five "
6 : w = "Six "
7 : w = "Seven "
8 : w = "Eight "
9 : w = "Nine "
10: w = "Ten "
end
else if i < 20 then
case i of
11: w = "Eleven "
12: w = "Twelve "
13: w = "Thirteen "
14: w = "Fourteen "
15: w = "Fifteen "
16: w = "Sixteen "
17: w = "Seventeen "
18: w = "Eighteen "
19: w = "Nineteen "
end
else
case i/10 of
2: w = "Twenty " + wordnumber(mod(i,10))
3: w = "Thirty " + wordnumber(mod(i,10))
4: w = "Forty " + wordnumber(mod(i,10))
5: w = "Fifty " + wordnumber(mod(i,10))
6: w = "Sixty " + wordnumber(mod(i,10))
7: w = "Seventy " + wordnumber(mod(i,10))
8: w = "Eighty " + wordnumber(mod(i,10))
9: w = "Ninety " + wordnumber(mod(i,10))
end
end = w
function bottle_string(n = integer) = string
var b = string
if n = 1 then
b = "bottle"
else
b = "bottles"
end = b
procedure delay
var i = integer
for i = 1 to 500 do
rem - nothing
next
end
rem - begin main program
var n = integer
n = maxbottles
while n > 0 do
begin
print
print wordnumber(n); bottle_string(n); " of beer on the wall"
print wordnumber(n); bottle_string(n); " of beer"
print "Take one down, and pass it around"
if (n = 1) then
print "No more bottles";
else
print wordnumber(n-1); bottle_string(n-1);
print " of beer on the wall"
n = n - 1
delay
end
end
var n as Int
var t as Int //Time delay between line prints (1000 = 1 second)
var vBottle as String
t=20
For n = 99 downto 1
If n=1 Then vBottle = " bottle" else vBottle = " bottles"
WriteLn(n + vBottle + " of beer on the wall,")
Loiter(t)
WriteLn(n + vBottle + " of beer,")
Loiter(t)
WriteLn("Take one down and pass it around,")
Loiter(t)
WriteLn(n + vBottle + " of beer on the wall." + @NewLine() )
Loiter(t)
Next
WriteLn("......hic.........hic, hic..........hic")
WriteLn("Set 'em up again, Sam")
' ScriptBasic version of 99 Bottles of beer (Bottles.bas)
' See http://script.basic.hu/html/index.html
' Philipp Winterberg, http://www.winterbergs.de
a$ = " \98\111\116\116\108\101\40\115\41\32\111\102\32\98\101\101\114"
c$ = " \111\110\32\116\104\101\32\119\97\108\108\99\32\32\8\8\8\8\108"
for b = 99 to 1 step -1
print "\13\10",b,a$,c$,"\44\n",b,a$,"\46\n\84\97\107\101\32\111\110"
print "\101\32\100\111\119\110", ",\32\112\97\115\115\32\105\116\32"
print "\97\114\111\117\110\100\44\13\10",(b-1),a$,c$,"\46\32 \13\10"
next b
end
'Define Variables - this appears to bey very loosely typed?
bottles = 99
next_bottles = 0
bottle_text = " bottle"
bottles_text = " bottles"
text1 = " of beer"
text2 = " on the wall"
text3 = "Take one down, pass it around"
text4 = "No more"
text5 = "Go to the store and buy some more, 99 "
text_line = " "
full_stop = ". "
comma = ", "
'Loop - 1 iteration per count until we've done all.
For bottles = 99 To 1 Step -1
next_bottles = bottles - 1
If bottles = 2 Then
TextWindow.WriteLine(bottles + bottle_text + text1 + text2 + comma + bottles + bottles_text +
text1 + full_stop)
TextWindow.WriteLine(text3+ " " + next_bottles + bottle_text + text1 + text2 + full_stop)
Else
If bottles = 1 Then
' TextWindow.WriteLine(bottles)
TextWindow.WriteLine(bottles + bottle_text + text1 + text2 + comma + bottles + text1 +
full_stop)
TextWindow.WriteLine(text3 + comma + text4 + bottles_text + text1 + text2 + full_stop)
TextWindow.WriteLine(text4 + bottles_text + text1 + text2 + comma + text4 + bottles_text +
text1 + full_stop)
TextWindow.WriteLine(text5 + bottles_text + text1 + text2 + full_stop)
Else
'TextWindow.WriteLine(bottles)
TextWindow.WriteLine(bottles + bottles_text + text1 + text2 + comma + bottles + bottles_text +
text1 + full_stop)
TextWindow.WriteLine(text3 + " " + next_bottles + bottles_text + text1 + text2 + full_stop)
EndIf
EndIf
EndFor
# SmallBasic version of 99 Bottles of beer (Bottles.bas)
# See http://smallbasic.sourceforge.net/
# Philipp Winterberg, http://www.winterbergs.de
a=" bottle(s) of beer":c=" on the wall":cls
for b=99 to 1 step -1
?b;a+c+",":?b;a+".":?"Take one down, pass it around,":?b-1;a+c+".":?
next
sub Main
' Ninety-nine bottles of beer in StarBasic
' for usage in StarOffice/OpenOffice
'
' Daniel Hanke
' http://www2.hs-harz.de/~359/
' June 7, 2002
'
oDesktop = createUnoService("com.sun.star.frame.Desktop")
sUrl = "staroffice.factory:swriter"
oDoc = oDesktop.LoadComponentFromURL(sURL,"_blank",0,mNoArgs)
oText = oDoc.Text
oCursor = oText.createTextCursor()
dim bottles
dim stext
oCursor.CharHeight = 18
p(oText,"99 bottles of beer")
oCursor.CharHeight = 12
for bottles = 99 to 1 step -1
dim sbottle
sbottle = cstr(bottles)+iif(bottles=1," bottle"," bottles")
l(oText,sbottle+" of beer on the wall")
l(oText,sbottle+" of beer ...")
l(oText,"Take one down, pass it around,")
l(oText,iif(bottles=1,"No more bottles",cstr(bottles-1)+_
iif(bottles-1=1," bottle"," bottles"))+" of beer on the wall")
p(oText,"")
next bottles
p(oText,"Time 2 go home")
end sub
sub l(otext as object,stext as string)
otext.insertString(oCursor,stext,FALSE)
otext.insertControlCharacter(oCursor,_
com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,FALSE)
end sub
sub p(otext as object,stext as string)
otext.insertString(oCursor,stext,FALSE)
otext.insertControlCharacter(oCursor,_
com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,FALSE)
end sub
program MORE.BEER
*// This one is only slightly different but I hope,
*// more interesting than the previous submission.
*// Stu Boydell 2005-09-23
equ MAX.BEERS to 99
equ CONV to 'MR%':len(MAX.BEERS) ;* zero filled - others might be: NR (roman numerals), MP
(packed decimal), MX (hex), MO (octal), MB (binary)
equ BOTTLE.TEXT to ' bottles of beer on the wall,':@am:' bottles of beer.':@am:'Take one down, pass
it around.'
enum = ''
for i = MAX.BEERS to 1 step -1
enum<dcount(enum,@am)+1> = str(oconv(i,CONV):@am,2)
next
subj = str(BOTTLE.TEXT:@am,MAX.BEERS-1)
subj := change(BOTTLE.TEXT,'s ',' ',2)
crt convert(@am,char(10),cats(enum,subj))
'-------------------------------------------
'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
Step 1: Create a New Console Application and then, add the following code in
the principal Module:
Module Bottles
Sub Main()
' Visual Basic.NET version of 99 Bottles of beer (Bottles.vb)
' Fabrício Costa, fabricio_costa@msn.com
Dim Count As Int32
For Count = 99 To 1 Step -1
Console.WriteLine(Count & " bottle(s) of beer on the wall, " & Count & " bottle(s) of
beer.")
Console.WriteLine("Take one down, pass it around, " & (Count - 1) & " bottle(s) of beer
on the wall.")
Next
End Sub
End Module
// wxBasic version of 99 Bottles of beer (Bottles.wx)
// See http://wxbasic.sourceforge.net/
// Philipp Winterberg, http://www.winterbergs.de
a$=" bottle(s) of beer" : A$= a$ + " on the wall"
B$=".\nTake one down, pass it around,\n"
for b = 99 to 1 step -1
? b; A$; ",\n"; b; a$; B$; b-1; A$; ".\n"
next
'1) Copy this into a text file and save as BeerOnDaWall.x
'2) Get XBasic 6.2.3 at http://xbasic.sourceforge.net/
'3) Open the IDE
'4) Load BeerOnDaWall.x using file/load
'5) Run by clicking on the exclamation mark `!'
'
' This version handles the plurals correctly with
' (I hope) a bit of humor. My proudest moment!!
' etf
PROGRAM "BeerOnDaWall"
VERSION "1.0"
DECLARE FUNCTION Brewski ()
FUNCTION Brewski ()
beer = 99
DO
GOSUB Wasted: PRINT "r on the wall,"
GOSUB Wasted: PRINT "eer. (Hic!)"
PRINT " Take one down, pass it around,"
DEC beer
GOSUB Wasted: PRINT "r on the wall.\n"
LOOP WHILE beer
SUB Wasted
PRINT beer; " bottle";
IF beer <> 1 PRINT "s";
PRINT " of bee";
END SUB
END FUNCTION
END PROGRAM
rem Yabasic version of 99 Bottles of beer (Bottles.yab)
rem See http://www.yabasic.de/
rem Philipp Winterberg, http://www.winterbergs.de
b = 99
while (b > 0)
print b, " bottle(s) of beer on the wall,"
print b, " bottle(s) of beer."
print "Take one down, pass it around,"
b = b - 1
print b, " bottle(s) of beer on the wall." + chr$(13) + chr$(10)
wend
Podobne strony
Podobne Strony
Pokaż komentarze
wersja strony: 1, ostatnia edycja: 17 Jul 2009 17:36
Edytuj sekcje
Dołącz tekst
Edytuj tagi meta
Obserwowane przez
Linki zwrotne
Źródło strony
Strona nadrzędna
Zablokuj stronę
Zmień nazwę
Usuń