Screenshot

'Windows Cards.DLL demo by Alyce Watson
'based on code by UncleBen, Rod Bird, Stefan Pendl and others.


'Cards.DLL or Cards32.DLL are part of the Windows OS.
'These DLLs are not included in Windows 7.
'This demo checks for the existence of the DLLs
'with LoadLibraryA API.

'this demo uses three functions
'   cdtInit to intiialize
'   cdtDraw to draw card
'   cdtTerm to terminate use of DLL

'Indices of cards in deck, numbered 0-51:
    clubs = 0     'ace of clubs=0,deuce=4,three=8...king=48
    diamonds = 1  'ace of diamonds=1,deuce=5,three=9...king=49
    hearts = 2    'ace of hearts=2,deuce=6,three=10...king=50
    spades = 3    'ace of spades=3,deuce=7,three=11...king=51
    ace=0         'values increment by 4, which is the number of suits
    deuce=4
    three=8
    four=12
    five=16
    six=20
    seven=24
    eight=28
    nine=32
    ten=36
    jack=40
    queen=44
    king=48

    'formula for card index: cardValue+cardSuit
    'queen of hearts is
    queenHearts = queen+hearts

    hDLL=LoadLibrary("cards32.dll")
    if hDLL<>0 then
        dll$="cards32.dll"
    end if

    if hDLL=0 then
        hDLL=LoadLibrary("cards.dll")
        if hDLL<>0 then
            dll$="cards.dll"
        end if
    end if

    if hDLL=0 then
        notice "No DLL available."
        end
    end if
nomainwin
    WindowWidth = 800
    WindowHeight = 500
    UpperLeftX=1
    UpperLeftY=1

    graphicbox #main.g, 0,0,800,600
    open "Cards.DLL" for window as #main
    #main "trapclose [quit]"
    #main.g "down ; fill 0 255 0"

    'Open the card DLL
    open dll$ for dll as #card

    'create structs that allow function to return default card sizes
    struct cardX, cardwidth as long
    struct cardY, cardheight as long

    calldll #card,"cdtInit",_ 'initialize DLL
        cardX as struct,_     'will contain card width
        cardY as struct,_     'will contain card height
        result as long

    cardWide = cardX.cardwidth.struct
    cardHigh = cardY.cardheight.struct

    hgDC=GetDC(hwnd(#main.g))  'device context for graphicbox
    col=MakeRGB(0,127,0)        'color matches fill color of graphicbox
    nDraw=0                     'draw card front

    cardY=10   'draw first row at y=10

    'draw cards in rows
    for i = 0 to 51
        if cardX>700 then
            'move to next row
            cardX=0
            cardY=cardY+10+cardHigh
        end if
        cardX=cardX+int(cardWide/4)

        nCard=i
        r=DrawCard(hgDC,cardX,cardY,nCard,nDraw,col)
    next


    'draw backs and specials, first move to next row
    cardX=0
    cardY=cardY+10+cardHigh

    for j = 53 to 68
        if cardX>600 then
            'move to next row
            cardX=0
            cardY=cardY+10+cardHigh
        end if
        cardX=cardX+int(cardWide)+4

        nCard=j   'backs and special designs: 53-65=backs,67=X,68=O
        nDraw=1   'draw card back

        r=DrawCard(hgDC,cardX,cardY,nCard,nDraw,col)
    next
    wait

[quit]
    'terminate DLL and call FreeLibrary
    calldll #card,"cdtTerm",result as void
    r=FreeLibrary(hDLL)
    close #main
    close #card
    end

Function DrawCard(hDC,x,y,iCard,iDraw,clr)
    calldll #card,"cdtDraw",_
        hDC as ulong,_      'graphics device context
        x as long,_         'desired x location
        y as long,_         'desired y location
        iCard as long,_     '0-51=deck, 52=68=specials
        iDraw as long,_     '0=front, 1=back, 2=invert for active
        clr as long,_       'background color
        result as long
    end function

Function GetDC(hWnd)
    CallDLL #user32, "GetDC",_
        hWnd  As Ulong,_ 'window or control handle
        GetDC As Ulong   'returns device context
    End Function

Function LoadLibrary(file$)
    Calldll #kernel32, "LoadLibraryA", file$ As Ptr, LoadLibrary As Ulong
    End Function

Function FreeLibrary(hDLL)
    Calldll #kernel32, "FreeLibrary", hDLL As Ulong, FreeLibrary As Long
    End Function

function MakeRGB(red,green,blue)
    if red<0 then red=0
    if red>255 then red=255
    if green<0 then green=0
    if green>255 then green=255
    if blue<0 then blue=0
    if blue>255 then blue=255
    MakeRGB=(blue*256*256)+(green*256)+red
    end function