Updated Keno game.

[Ionic Wind Support Team]

This is an update of the original little keno program I wrote long ago.  Now matches pretty much what you would see playing video keno at a casino.  Just for fun of course  

Code Select Expand


'keno example program for Emergence BASIC
'Green = selected, yellow = miss, red = hit
'the balls are represented in an integer array
'values for the array are:
'0 = not selected, 1 = selected, 2 = hit, 3 = miss
'Compile as a WINDOWS target

DEF playwin:window
DEF l,t,w,h,x,y,num,selectcount,picked,hitcount:int
DEF balls[80]:int
DEF pay[10,10]:int
DEF bet:int
DEF credits:int
bet = 1
credits = 100
DEF selected,hit,colorball,miss,cacheDC:int
DEF strball,strstat:STRING
DECLARE selectball(mx:int,my:int)
'The balls colors
selected = RGB(0,255,0)
hit = RGB(255,0,0)
miss = RGB(255,255,0)
'load the paytable
for x=0 to 9
for y=0 to 9
getdata paytable,h
pay[x,y] = h
next y
next x
'the play window
OPENWINDOW playwin,0,0,540,400,@NOAUTODRAW|@MINBOX,0,"Keno",&playhandler
SETWINDOWCOLOR playwin,RGB(0,0,255)
CONTROL playwin,@BUTTON,"START",5,340,70,20,0x50000000,1
CONTROL playwin,@BUTTON,"CLEAR",80,340,70,20,0x50000000,2
CONTROL playwin,@BUTTON,"Up",250,340,30,20,0x50000000,3
CONTROL playwin,@BUTTON,"Dn",311,340,30,20,0x50000000,4
CONTROL playwin,@EDIT,"1",280,340,30,20,0x50000000|@CTEDITRO,5
control playwin,@BUTTON,"+1",410,340,30,20,0x50000000,6
control playwin,@BUTTON,"+5",440,340,30,20,0x50000000,7
control playwin,@BUTTON,"+20",470,340,30,20,0x50000000,8
control playwin,@BUTTON,"+50",500,340,30,20,0x50000000,9

'normal stuff
run = 1
playing  = 0
WAITUNTIL run = 0
CLOSEWINDOW playwin
END

'The playwin window procedure subroutine
'Center the window on creation.
'Process the left mouse button to select/unselect balls.
'Process the timer to pick random balls.
'Start and clear the board in response to our two buttons
SUB playhandler
SELECT @CLASS
CASE @IDCLOSEWINDOW
run = 0
CASE @IDCREATE
CENTERWINDOW playwin
CASE @IDPAINT
GOSUB drawballs
CASE @IDLBUTTONDN
selectball(@MOUSEX,@MOUSEY)
CASE @IDCONTROL
IF @NOTIFYCODE = 0
SELECT @CONTROLID
CASE 1
if credits < bet
MessageBox playwin,"Not enough credits to play","Keno"
else
GOSUB startplay
endif
CASE 2
GOSUB clearboard
CASE 3:'bet up
bet+=1
if bet > 10 then bet = 10
SetControlText playwin,5,LTRIM$(STR$(bet))
GOSUB drawballs
CASE 4:'bet down
bet-=1
if bet < 1 then bet = 1
SetControlText playwin,5,LTRIM$(STR$(bet))
GOSUB drawballs
case 6:
credits+=1
GOSUB drawballs
case 7:
credits+=5
GOSUB drawballs
case 8:
credits+=20
GOSUB drawballs
case 9:
credits+=50
GOSUB drawballs
ENDSELECT
ENDIF
CASE @IDCHAR
SELECT @CODE
CASE ASC("s")
CASE& ASC("S")
GOSUB startplay
CASE ASC("c")
CASE& ASC("C")
GOSUB clearboard
ENDSELECT
CASE @IDTIMER
if picked < 20
GOSUB pickball
picked = picked + 1
GOSUB drawballs
else
GOSUB endplay
playing = 0
endif
ENDSELECT
RETURN
ENDSUB

'------------------- DRAWBALLS ---------------
'Draw 80 balls and the status text
'Balls are colored depending on the value of
'the balls array.
'0 = not selected, 1 = selected, 2 = hit, 3 = miss
'---------------------------------------------
SUB drawballs
int width,height
SETFONT playwin,"Arial",12,400
DRAWMODE playwin,@TRANSPARENT
FRONTPEN playwin,RGB(0,0,0)
cacheDC = GetHDC(playwin)
num = 1
for y = 0 to 7
for x = 0 to 9
colorball = 0xFFFFFF
if balls[num-1] = 1 THEN colorball = selected
if balls[num-1] = 2 THEN colorball = hit
if balls[num-1] = 3 THEN colorball = miss
CIRCLE playwin,(x*40)+20,(y*40)+20,20,0,colorball
MOVE playwin,(x*40) + 10, (y*40) + 10
strball = ltrim$(str$(num))
if num < 10 THEN strball = "0" + strball
PRINT playwin,strball
num = num + 1
next x
next y
ReleaseHDC playwin,cacheDC

SETFONT playwin,"Lucida Console",10,800
cacheDC = GetHDC(playwin)
RECT playwin,407,5,120,310,RGB(255,255,0),RGB(0,0,255)
DRAWMODE playwin,@TRANSPARENT
for x = 1 to selectcount
if(hitcount = x)
RECT playwin,408,x*26-14,118,26,RGB(0,255,0),RGB(0,255,0)
move playwin,410,x*26-10
print playwin,using("##   ######",x,pay[x-1,selectcount-1]*bet)
else
move playwin,410,x*26-10
print playwin,using("##   ######",x,pay[x-1,selectcount-1]*bet)
endif
next x
ReleaseHDC playwin,cacheDC

DRAWMODE playwin,@OPAQUE
SETFONT playwin,"MS Sans Serif",10,400
cacheDC = GetHDC(playwin)
BACKPEN playwin,RGB(0,0,255)
GETTEXTSIZE playwin,"Hits",width,height
move playwin,407+60-width/2,0
print playwin,"Hits"

MOVE playwin,155,342
strstat = "Drawn: " + ltrim$(str$(picked))
PRINT playwin,strstat,"  "
MOVE playwin,420,322
FRONTPEN playwin,RGB(255,255,100)
PRINT "CREDITS: ",ltrim$(str$(credits)),"    "
MOVE playwin,282,322
PRINT "BET"
ReleaseHDC playwin,cacheDC
RETURN
ENDSUB
'------------------- SELECTBALL ---------------
'The mouse coordinates are converted to a ball number
'Balls can be deselected by clicking a second time
'Only a maximum of 10 balls can be selected in standard keno
'----------------------------------------------
SUB selectball(mx:int,my:int)
IF playing THEN RETURN
x = (mx - 10) / 40.0
y = (my - 10) / 40.0
num = x + (y * 10)
if (num > 79) | (num < 0) THEN RETURN
SELECT balls[num]
CASE 3
CASE& 0
IF selectcount < 10
balls[num] = 1
selectcount = selectcount + 1
ENDIF
CASE 1
CASE& 2
balls[num] = 0
selectcount = selectcount - 1
ENDSELECT
GOSUB drawballs
RETURN
ENDSUB
'---------------- STARTPLAY -----------------
'The previous draws are cleared and a timer is
'started. One ball will be randomly picked every
'time the timer expires
'The two buttons are disabled until play completes
'--------------------------------------------
SUB startplay
IF selectcount > 0
credits -= bet
playing = 1
picked = 0
hitcount = 0
FOR x = 0 to 79
IF balls[x]=3 THEN balls[x] = 0
IF balls[x]=2 THEN balls[x] = 1
NEXT x
drawballs()
for x=1 to 9
ENABLECONTROL playwin,x,0
next x
STARTTIMER playwin,100
ENDIF
RETURN
ENDSUB
'----------------- ENDPLAY ------------------
'After 20 balls are generated the timer is stopped
'The two buttons are re-enabled
'--------------------------------------------
SUB endplay
STOPTIMER playwin
for x=1 to 9
ENABLECONTROL playwin,x,1
next x
credits += pay[hitcount-1,selectcount-1]*bet
DrawBalls()
RETURN
ENDSUB
'---------------- CLEARBOARD ----------------
'Clears all the selected balls and resets the counters
'--------------------------------------------
SUB clearboard
FOR x = 0 TO 79
balls[x] = 0
NEXT x
selectcount = 0
picked = 0
hitcount = 0
GOSUB drawballs
RETURN
ENDSUB
'---------------- PICKBALL -----------------
'Generates a random number between 0 and 79
'if the number has already been drawn then
'continues generating a random number until
'a non drawn ball is found
'-------------------------------------------
SUB pickball
done = 0
DO
x = int(rnd(80))
if (balls[x] <> 3) & (balls[x] <> 2) THEN done = 1
UNTIL done
'If its a selected ball then set it to 'hit'
IF balls[x] = 1
balls[x] = 2
hitcount = hitcount + 1
ENDIF
'If its a non selected ball then set it to 'miss'
IF balls[x] = 0 THEN balls[x] = 3
RETURN
ENDSUB

'balls picked
'    1,2,3,4,5,6,7,8,9,10
databegin paytable
data 3,0,0,0,0,0,0,0,0,0: 'match 1
data 0,15,2,2,0,0,0,0,0,0: 'match 2
data 0,0,46,5,3,3,1,0,0,0: 'match 3
data 0,0,0,91,12,4,2,2,1,0: 'match 4
data 0,0,0,0,810,70,26,12,6,5: 'match 5
data 0,0,0,0,0,1600,400,98,44,24: 'match 6
data 0,0,0,0,0,0,7000,1652,335,142: 'match 7
data 0,0,0,0,0,0,0,10000,4700,1000: 'match 8
data 0,0,0,0,0,0,0,0,10000,4700: 'match 9
data 0,0,0,0,0,0,0,0,0,20000: 'match 10
dataend

/*                                       TABLE 1
                               NUMBER OF SPOTS SELECTED
     HITS     1     2   3     4     5       6     7         8       9      10
       1      3     0   0     0     0       0     0         0       0       0
       2     --    15   2     2     0       0     0         0       0       0
       3     --    --  46     5     3       3     1         0       0       0
       4     --    --  --    91    12       4     2         2       1       0
       5     --    --  --    --   810      70    26        12       6       5
       6     --    --  --    --    --    1600   400        98      44      24
       7     --    --  --    --    --      --  7000      1652     335     142
       8     --    --  --    --    --      --    --     10000    4700    1000
       9     --    --  --    --    --      --    --        --   10000    4700
      10     --    --  --    --    --      --    --        --      --   20000
*/


[maurice1]

Very nice Paul.

I am slowly looking over old Ibasic Pro and Ebasic code on the forums to get programing examples like this one to learn Ebasic. As I program more as a hobby, its slow but example code like this really shows what can be done.