code:

---

break on
 
; KIXPOKER.KIX
; KIXTART POKET POKER
;
; KIXTART 4.0
; KIXFORMS (Build 9)
;
; This is a variation on a public domain
; poker game written in VB. Actually, it
; was written for the Pocket PC - a fact
; that will seem obvious when you run
; this script for the first time. Bells
; and whistles added by your truely
;
; Game play: 
; 
; Press Bet 1 to bet one token
; Press Bet Max to bet the max no. of tokens (5)
; Press Draw to draw a hand full hand of cards
; Press 1-5 to discard your unwanted cards. Press again to bring back.
; Press Draw (again) to draw more cards.
; Press Spin button for a quick larf
 
;
; GAME SETTINGS
;

 
$BACKCOLOR	= &005500 ; Dark Green
$FORECOLOR	= &00ffff ; Yellow
$CR 		= CHR(13)
 
$form = createobject("kixtart.form")
$form.caption = "KiXPoker"
$form.scaleheight = 215
$form.scalewidth = 3480/15
$form.center
$form.backcolor	= $BACKCOLOR
$form.forecolor	= $FORECOLOR
$form.fontsize = 8
$form.fontbold = 1
 
$label1 = $form.label("Current Bet",8,4,45,25)
$label1.backcolor = $form.backcolor
$label1.forecolor = $form.forecolor
$label1.alignment = 2
 
$label2 = $form.label("Current Score",184,4,45,25)
$label2.alignment = 2
$label2.backcolor = $form.backcolor
$label2.forecolor = $form.forecolor
 
$bet = $form.label("0",8,35,45,25)
$bet.alignment = 2
$bet.forecolor = $form.forecolor
$bet.backcolor = $form.backcolor
 
$score = $form.label("0",184,35,45,25)
$score.alignment = 2
$score.forecolor = $form.forecolor
$score.backcolor = $form.backcolor
 
$message1 = $form.label("Welcome",52,4,125,25)
$message1.alignment = 2 ; center
$message1.fontsize = 11
$message1.backcolor = $form.backcolor
$message1.forecolor = $form.forecolor
 
$message2 = $form.label("@userid",52,30,125,25)
$message2.alignment = 2 ; center
$message2.fontsize = 11
$message2.backcolor = $form.backcolor
$message2.forecolor = $form.forecolor

$betone = $form.commandbutton("Bet 1",8,160,65,21)
$betone.onclick = "betone_click"

$betmax = $form.commandbutton("Bet Max",8,184,65,21)
$betmax.onclick = "betmax_click"

$draw = $form.commandbutton("Draw",80,160,68,45)
$draw.fontsize = "12"
$draw.onclick = "draw_click"
  
$spin = $form.commandbutton("Spin!",152,160,65,21)
$spin.onclick = "spin_click"
 
$exit = $form.commandbutton("Exit",152,184,65,21)
$exit.onclick = "exit_click"
  
global $hold[4]
$hold[0] = $form.commandbutton("1",8,132,37,21)
$hold[1] = $form.commandbutton("2",52,132,37,21)
$hold[2] = $form.commandbutton("3",96,132,37,21)
$hold[3] = $form.commandbutton("4",140,132,37,21)
$hold[4] = $form.commandbutton("5",184,132,37,21)
 
for $i=0 to ubound($hold)
 $hold[$i].enabled=0
 $hold[$i].onclick = "hold_click($i)"
next
 
global $values[4]
$values[0] = $form.label("P",8,68,37,28)
$values[1] = $form.label("O",52,68,37,28)
$values[2] = $form.label("K",96,68,37,28)
$values[3] = $form.label("E",140,68,37,28)
$values[4] = $form.label("R",184,68,37,28)
 
for each $label in $values
 $label.alignment = 2
 $label.forecolor = &0
 $label.fontsize = 18
 $label.backcolor = &0ffffff
next
 
global $suites[4]
$suites[0] = $form.label("",8,93,37,28)
$suites[1] = $form.label("",52,93,37,28)
$suites[2] = $form.label("",96,93,37,28)
$suites[3] = $form.label("",140,93,37,28)
$suites[4] = $form.label("",184,93,37,28)
 
for each $label in $suites
 $label.alignment = 2
 $label.forecolor = &0FF
 $label.backcolor = &0FFFFFF
 $label.fontname = "symbol"
 $label.fontsize = 18
 $label.caption = chr(169)
next
 
global $madeck[10]
global $minextcard
global $firstdraw
global $mybet
global $myscore
global $masuite[13]
 
srnd(@ticks)
$myscore = 100
$firstdraw = 1
$draw.enabled = 0
$score.caption = $myscore
$minextcard = 1
 
$form.show
$betmax.setfocus
while $form.visible
 $=execute($form.doevents)
loop
 
exit 1
 
function betone_click()
 if $mybet < 5
  $mybet = $mybet + 1
  $draw.enabled = 1
 endif
 $bet.caption = $mybet
 if $myscore - $mybet = 0
  $betone.enabled = 0
 endif
endfunction
 
function betmax_click()
 $mybet = 5
 $bet.caption = $mybet
 $draw.enabled = 1
 $draw.setfocus()
 $draw.default = 1
 draw_click()
endfunction
 
function hold_click($button)
 if $values[$button].visible = 0
  $values[$button].visible = 1
  $suites[$button].visible = 1
 else
  $values[$button].visible = 0
  $suites[$button].visible = 0
 endif
 $draw.setfocus()
endfunction
 
function draw_click()
 
 dim $icounter
 
 if $firstdraw
 
  $message1.caption = ""
  $message2.caption = ""
 
  $betone.enabled = 0
  $betmax.enabled = 0
  $spin.enabled = 0

  $myscore = $myscore - $mybet
  $score.caption = $myscore
 
  shufflecards()
 
  for $i=0 to ubound($values)
   $values[$i].tag = getnextcard()
   $values[$i].caption = getcardvalue(val($values[$i].tag))
   $values[$i].forecolor = getcardcolor(val($values[$i].tag))
   $suites[$i].caption = getsuitimage(val($values[$i].tag))
   $suites[$i].forecolor = $values[$i].forecolor
  next
 
  $firstdraw = 0
 
  for each $button in $hold
   $button.enabled = 1
  next
 
  $message2.caption = "Discard ..."

 else

  $draw.enabled = 0

  for $i = 0 to ubound($values)

   if $values[$i].visible = 0
    $values[$i].tag = getnextcard()
    $values[$i].caption = getcardvalue(val($values[$i].tag))
    $values[$i].forecolor = getcardcolor(val($values[$i].tag))
    $suites[$i].caption = getsuitimage(val($values[$i].tag))
    $suites[$i].forecolor = $values[$i].forecolor
    $values[$i].visible = 1
    $suites[$i].visible = 1
   endif

  next

  checkforwinninghand()

  $mybet = 0

  $bet.caption = $mybet

  if $myscore > 0
   $betone.enabled = 1
  endif

  if $myscore > 4
   $betmax.enabled = 1
  endif

  for each $button in $hold
   $button.enabled = 0
  next
  $spin.enabled = 1
  $firstdraw = 1

 endif

endfunction


function checkforwinninghand()

 dim $x

 for $x = 1 to ubound($masuite)
  $masuite[$x] = 0
 next

 for $i = 0 to ubound($values)
  $number = getcardnumber(val($values[$i].tag))
  $masuite[$number] = $masuite[$number] + 1
 next

 select

  $message2.caption = ""

  case isroyalflush()

   $myscore = $myscore + ($mybet * 1000)
   $message2.caption = "Royal Flush!"

  case isstraightflush()

   $myscore = $myscore + ( $mybet * 50 )
   $message2.caption = "Straight Flush"

  case isfourofakind()

   $myscore = $myscore + ( $mybet * 25 )
   $message2.caption = "Four of a Kind"

  case isfullhouse()

   $myscore = $myscore + ( $mybet * 8 )
   $message2.caption = "Full House"

  case isflush()

   $myscore = $myscore + ( $mybet * 5 )
   $message2.caption = "Flush"

  case isstraight()

   $myscore = $myscore + ( $mybet * 4 )
   $message2.caption = "Straight"

  case isthreeofakind()

   $myscore = $myscore + ( $mybet * 3 )
   $message2.caption = "Three of a Kind"

  case istwopair()

   $myscore = $myscore + ( $mybet * 2 )
   $message2.caption = "Two Pair"

  case istwoofakind()

   $myscore = $myscore + $mybet
   $message2.caption = "One Pair"

  case 1

   $message2.caption = ""

 endselect
 
 if $message2.caption
  $message1.caption = "WINNER!!!"
 else
  $message1.caption = "Sorry"
  $message2.caption = "Place your bet"
 endif
 
 $score.caption = $myscore
 
endfunction
 
function istwoofakind()
 dim $i
 $istwoofakind = 0
 for $i = 1 to ubound($masuite)
  if $masuite[$i] = 2
   $istwoofakind = 1
;   if $jacks_or_better and ($i < 11 and $i > 1)
;    $handisapair = 0
;   endif
  endif
 next
endfunction
 
function istwopair()
 dim $found
 dim $i
 $istwopair = 0
 $found = 0
 for $i = 1 to ubound($masuite)
  if $masuite[$i] = 2
   if $found
    $istwopair = 1
   else
    $found = 1
   endif
  endif
 next
endfunction
 
function isthreeofakind()
 dim $i
 $isthreeofakind = 0
 for $i = 1 to ubound($masuite)
  if $masuite[$i] = 3
   $isthreeofakind = 1
  endif
 next
endfunction
 
function isstraight()
 $isstraight = 0
 $n = 0
 $ace = 0
 for $x = 1 to ubound($masuite)
  if $masuite[$x] = 1
   $n = $n + 1
   if $n = 1 and $x = 10 and $ace
    $n = $n + 1
   endif
   if $n = 5
    $x = ubound($masuite)+1
   endif
  else
   if $n > 0 and $n < 5
    if $n = 1 and $x = 2
     $n = 0
     $ace = 1
    else
     $x = ubound($masuite)+1
    endif
   endif
  endif
 next
 if $n = 5
  $isstraight = 1
 endif
endfunction
 
function isflush()
 $isflush = 0
 $suite1 = $suites[0].caption
 $suite2 = $suites[1].caption
 $suite3 = $suites[2].caption
 $suite4 = $suites[3].caption
 $suite5 = $suites[4].caption
 if $suite2 = $suite1 and $suite3 = $suite1 
    and $suite4 = $suite1 and $suite5 = $suite1
  $isflush = 1
 endif
endfunction
 
function isfullhouse()
 $isfullhouse = 0
 if isthreeofakind()
  for $i = 1 to ubound($masuite)
   if $masuite[$i] = 2
    $isfullhouse = 1
   endif
  next
 endif
endfunction
 
function isfourofakind()
 $isfourofakind = 0
 for $i = 1 to ubound($masuite)
  if $masuite[$i] = 4
   $isfourofakind = 1
  endif
 next
endfunction
 
function isstraightflush()
 $isstraightflush = 0
 if isstraight()
  if isflush()
   $isstraightflush = 1
  endif
 endif
endfunction
 
function isroyalflush()
 $isroyalflush = 0
 if isstraightflush()
  if $masuite[10] = 1 and $masuite[1] = 1
   $isroyalflush = 1
  endif
 endif
endfunction
 
function testshuffle()
 $madeck[1] = 1
 $madeck[2] = 10
 $madeck[3] = 11
 $madeck[4] = 12
 $madeck[5] = 13
 $manextcard = 1
endfunction
 
function shufflecards()
 dim $i,$found,$value,$exists
 for $i = 1 to ubound($madeck)
  $madeck[$i] = 0
  $found = 0
  do
   $value = rnd(51)+1
   $exists = 0
   for $j = 1 to $i
    if $madeck[$j] = $value
     $exists = 1
    endif
   next
  until $exists = 0
  $madeck[$i] = $value
 next
 $minextcard = 1
endfunction
 
function getnextcard()
 $getnextcard = $madeck[$minextcard]
 $minextcard = $minextcard + 1
endfunction
 
function getcardvalue($icard)
 if $icard > 39
  $icard = $icard - 39
 else
  if $icard > 26
   $icard = $icard - 26
  else
   if $icard > 13
    $icard = $icard - 13
   endif
  endif
 endif
 if $icard < 11 and $icard > 1
  $getcardvalue = "$icard"
 else
  select
   case $icard = 1
    $getcardvalue = "A"
   case $icard = 11
    $getcardvalue = "J"
   case $icard = 12
    $getcardvalue = "Q"
   case $icard = 13
    $getcardvalue = "K"
  endselect
 endif
endfunction
 
function getsuitimage($icard)
 select
  case $icard > 39
   $getsuitimage = chr(167)
  case $icard > 26
   $getsuitimage = chr(168)
  case $icard > 13
   $getsuitimage = chr(169)
  case 1
   $getsuitimage = chr(170)
 endselect
endfunction
 
function getcardcolor($icard)
 select
  case $icard > 39
   $getcardcolor = &0
  case $icard > 26
   $getcardcolor = &0FF
  case $icard > 13
   $getcardcolor = &0FF
  case 1
   $getcardcolor = &0
 endselect
endfunction
 
function getcardnumber($icard)
 if $icard > 39
  $getcardnumber = $icard - 39
 else
  if $icard > 26
   $getcardnumber = $icard - 26
  else
   if $icard > 13
    $getcardnumber = $icard - 13
   else
    $getcardnumber = $icard
   endif
  endif
 endif
endfunction

function spin_click
 
 ; this function is just for fun.
 ; it is possible to get duplicate
 ; cards with this button but thats
 ; just part of the fun.
 
 $mybet = 1
 $myscore = $myscore - $mybet
 $score.caption = $myscore
 for $j = 0 to 4
  for $i = 1 to 50
   for $k = $j to 4
    $card = rnd(51)+1
    $values[$k].tag = $card
    $values[$k].caption = getcardvalue($card)
    $suites[$k].caption = getsuitimage($card)
    $suites[$k].forecolor = getcardcolor($card)
    $values[$k].forecolor = $suites[$k].forecolor
   next
  next 
 next
 checkforwinninghand()
endfunction

function exit_click
 dim $prev
 if $form.visible
  $prev = 0
  while $form.scaleheight <> $prev
   $prev = $form.scaleheight
   $form.scaleheight = $form.scaleheight - 3 
  loop
  while $form.scalewidth <> $prev
   $prev = $form.scalewidth
   $form.scalewidth = $form.scalewidth - 3
  loop
 endif
 quit()
endfunction 

---

[ 16 March 2002, 15:09: Message edited by: Shawn ]