Older Version Newer Version

JackBurman JackBurman Aug 31, 2011

A quick submission of simple made-up game.

[[code format="lb"]]
'KenoCard by jaba
'Aug 31, 2011

dim card(52)                'card index for full deck before shuffle
dim x(53), y(53)

nomainwin
    WindowWidth=750:WindowHeight=600
    UpperLeftX=1:UpperLeftY=1

    menu #1, "&File", "E&xit", [quit]
    graphicbox #1.g, 0, 0, 750, 540
    open "KenoCard Game" for window_nf as #1
    #1 "trapclose [quit]"

    hBox=hWnd(#1.g)

    open "qcard32.dll " for dll as #qc
    call InitializeDeck hBox

[start]
    #1.g "cls"
    #1.g "down; fill 10 225 127"
    #1.g "backcolor 10 225 127;place 20 20;\PLAY KENOCARD - Click to select 7 cards:"

[fillCardArray]
    for i = 1 to 52
        card(i)=i   ':print card(i)
    next

[shuffleCards]
    for i = 1 to 52
        newIndex=int(rnd(0)*52)+1
        tempCard=card(i)
        card(i)=card(newIndex)
        card(newIndex)=tempCard
    next

[dealDeck]
    y=30
    j=0
    for i = 1 to 52
        j=j+1
        call SetCardStatus card(i), 1
        call DealCard hBox, card(i), j*24, y
        x(i)=j*24:y(i)=y

        call Pause 20
        if i mod 26 = 0 then y = y+120:j=0
    next i

    #1.g "setfocus; when leftButtonDown [selectCard]"
    wait

[selectCard]
    mx=MouseX:my=MouseY
        'if mouse is within visible part of card, get
        ' that card's index
        if my > 30 AND my < 130 then
            for i = 1 to 26'52
            if mx >x(i) AND mx <x(i)+24 then
                cardSelected=card(i)
                exit for
            end if
            next i
        end if

        if my > 150 AND my < 250 then
            for i = 27 to 52'1 to 52
            if mx >x(i) AND mx <x(i)+24 then
                cardSelected=card(i)
                exit for
            end if
            next i
        end if

    gosub [checkDoubles]
    if dbl then wait
'   print cardSelected
    cnt=cnt+1
    #1.g "place 200 265;color yellow;\ ";cnt
    cs(cnt)=cardSelected
    if cnt=7 then [stopSelecting]

wait

[stopSelecting]
    #1.g "when leftButtonDown"
    #1.g "place 30 265;color yellow;\Please wait..."
    call Pause 500

    for i = 1 to 7
        call SetCardStatus cs(i), 1
        call DealCard hBox, cs(i), (i)*80, 270
        call Pause 20
    next i

    call Pause 200

    cnt=0
    for i = 1 to 20
        call SetCardStatus card(i), 1
        call DealCard hBox, card(i), i*24, 390
        call Pause 20
        for j = 1 to 7
            if j=card(i) then cnt=cnt+1
        next j
    next i
    #1.g "place 20 500;color black"
    #1.g "\You got " ;cnt; "matches."

wait

[checkDoubles]
    dbl=0
    for k = 1 to cnt
        if cardSelected = cs(cnt) then
            notice "Please make another selection."
            dbl=1
            cardSelected = 0
        end if
    next k
    return

[quit]
    close #qc
    close #1
    end

'========================================================
'subs and functions
'========================================================

sub Pause ms
    'pause ms number of milliseconds
    calldll #kernel32, "Sleep",_
    ms as long,_
    re as void
    end sub

sub InitializeDeck hndle
    calldll #qc, "InitializeDeck",_
    hndle as ulong,_
    r as long
    end sub

sub DealCard hndle,nC,x,y
    'places cards on window whose handle is hndle at x,y
    'nC is number of card - 1-52 in first deck and
    '53-104 in second deck, if used
    calldll #qc, "DealCard",_
    hndle as ulong,_
    nC as long,_
    x as long,_
    y as long,_
    r as void
    end sub

sub SetCardStatus nC, face
    'nC is  number of card - 1-52 in first deck and
    '53-104 in second deck if used
    'face: 0=facedown, 1=faceup
    calldll #qc, "SetCardStatus",_
    nC as long,_
    face as long,_
    r as void
    end sub



[[code]]