FreeBasic
Главная
Вход
Регистрация
Среда, 09.10.2024, 09:35Приветствую Вас Гость | RSS
[ Новые сообщения · Участники · Правила форума · Поиск · RSS ]
  • Страница 1 из 1
  • 1
Карты для карточных игр
haavДата: Понедельник, 07.01.2013, 20:03 | Сообщение # 1
Генералиссимус
Группа: Администраторы
Сообщений: 1363
Репутация: 49
Статус: Offline
Карты для карточных игр




На Windows XP была отличная встроенная DLL. Данная библиотека имела в себе хорошую карточную колоду и на выбор несколько рубашек. В Windows 7 подобной нет, точнее есть, но что-то там все так хитро... Однако для любой системы можно использовать свободно-распространяемую карточную колоду с ЭТОГО сайта. Если сайт накроется, то можно скачать ОТСЮДА.

Ну а для тех , кто пишет для windows xp, есть пример от MichaelW с использованием cards.dll:

Код
#include "windows.bi"
#include "fbgfx.bi"

' enums posted by MichaelW
       
type CARDLIB
     '' card specified in card parameter as rank * 4 + suit,
     '' when the mode parameter is mdFaceUp
     enum SUIT
       CLUBS, DIAMOND, HEARTS, SPADES
     End enum

     enum RANK
       ACE  , TWO  , THREE, FOUR, FIVE, SIX
       SEVEN, EIGHT, NINE , TEN , JACK, QUEEN, KING
     End enum

     '' card back designs, specified in card parameter when
     '' the mode parameter is mdFaceDown
     enum eBACK
       CROSSHATCH = 53 , WEAVE1, WEAVE2, ROBOT
       FLOWERS , VINE1 , VINE2 , FISH1
       FISH2   , SHELLS, CASTLE, ISLAND,
       CARDHAND, UNUSED, THE_X , THE_O
     end enum

     enum eBACK_XP
       CROSSHATCH = 53 , SKY, MINERAL, FISH,
       FROG   , MOONFLOWER,  ISLAND  , SQUARES
       MAGENTA, SANDDUNES ,  SPACE_  , LINES
       TOYCARS, UNUSED    ,  THE_X   , THE_O
     end enum

     '' flags for mode parameter
     enum MODE
       mdFaceUp, mdFaceDown      , mdHilite, mdGhost
       mdRemove, mdInvisibleGhost, mdDeckX , mdDeckO
     end enum

     declare constructor(ScrWidth  as integer=68*13, _
                         ScrHeight as integer=96* 4)
     declare destructor
     declare property CardWidth  as integer
     declare property CardHeight as integer

     declare function CardDraw (x         As Integer, _
                      y         As Integer, _
                      card      As Integer, _
                      mode      As Integer, _
                      BackColor As uInteger ) As Integer

     declare function CardDrawExt(x As Integer, _
                      y As Integer, _
                      dx As Integer, _
                      dy As Integer, _
                      card As Integer, _
                      typ As Integer, _
                      BackColor As uInteger ) As Integer

     declare function CardAnimate (cardBack As Integer, _
                      x As Integer, _
                      y As Integer, _
                      frame As Integer ) As Integer

     declare function Show as integer

     private:

     cdtInit as function (byval cWidth  As Integer ptr, _
                          byval cHeight As Integer ptr) As Integer
     cdtTerm as sub ()
     cdtDraw as function (hdc As HDC, _
                          x As Integer, _
                          y As Integer, _
                          card As Integer, _
                          mode As integer, _
                          BackColor As uInteger ) As Integer

     cdtDrawExt as function (hdc As HDC, _
                             x As Integer, _
                             y As Integer, _
                             dx As Integer, _
                             dy As Integer, _
                             card As Integer, _
                             typ As Integer, _
                             BackColor As uInteger ) As Integer

     cdtAnimate as function  (hdc As HDC, _
                    cardBack As Integer, _
                    x As Integer, _
                    y As Integer, _
                    Frame As Integer ) As Integer

        
     as any ptr hLib,Image,Pixels
     as HDC     MemoryDC
     as HBITMAP hBMP,hOldBMP
     as BITMAPINFO BI
     as integer mCardWidth,mCardHeight
end type

constructor CARDLIB(ScrW as integer,ScrH as integer)
     hLib = DyLibLoad("C:\WINDOWS\system32\cards.dll")    
     if hLib=NULL then
       hLib=DyLibLoad("cards32.dll")    
     end if
     if (hLib=NULL) then
       print "error: can't load cards[32].dll !"
       beep:sleep:end
     else
       this.cdtInit    = DyLibSymbol(hLib,"cdtInit")
       this.cdtTerm    = DyLibSymbol(hLib,"cdtTerm")
       this.cdtDraw    = DyLibSymbol(hLib,"cdtDraw")
       this.cdtDrawExt = DyLibSymbol(hLib,"cdtDrawExt")
       this.cdtAnimate = DyLibSymbol(hLib,"cdtAnimate")
       if cdtInit(@mCardWidth,@mCardHeight)<>TRUE then
         DyLibFree hLib: hLib=NULL
         print "error: CardInit() failed !"
         beep:sleep:end
       else
         dim as HWND    hWin
         dim as HDC     hDC
         ScrW and = &HFFC
         ScreenRes ScrW,ScrH,32
         ScreenControl FB.GET_WINDOW_HANDLE,cast (INTEGER,hWin)
         hDC=GetDC(hWin)
         MemoryDC=CreateCompatibleDC(hDC)
         hBMP=CreateCompatibleBitmap(hDC,ScrW,ScrH)
         hOldBMP=SelectObject(MemoryDC,hBMP)
         BI.bmiHeader.biSize=SizeOF(BITMAPINFOHEADER)
         GetDIBits(MemoryDC,hBMP,0,0,NULL,@BI,DIB_RGB_COLORS)
         BI.bmiHeader.biHeight *=-1
         Image=ImageCreate(scrW,scrH,0,BI.bmiHeader.biBitCount)
         Pixels=Image+32
         ReleaseDC(hWin,hDC)
       end if
     end if
end constructor

destructor CARDLIB
     if hLib<>NULL then
       cdtTerm()
       DyLibFree hLib
       hLib=NULL
       if (MemoryDC<>NULL) then
         if (hBMP<>NULL) then
           if (hOldBMP<>NULL) then
             SelectObject(MemoryDC,hOldBMP)
             hOldBMP=NULL
           end if
           DeleteObject(hBMP)
           hBMP=NULL
         end if
         DeleteDC(MemoryDC)    
         MemoryDC=NULL
       end if
     end if
end destructor

property CardLib.CardWidth as integer
     return mCardWidth
end property    

property CardLib.CardHeight as integer
     return mCardHeight
end property    

function CardLib.CardDraw(x    As Integer, _
                             y    As Integer, _
                             card As Integer, _
                             mode As integer, _
                             BackColor As uinteger) As Integer
     return cdtDraw(MemoryDC,x,y,card,mode,BackColor)
end function

function CardLib.CardDrawExt(x         As Integer, _
                      y         As Integer, _
                      dx        As Integer, _
                      dy        As Integer, _
                      card      As Integer, _
                      typ       As Integer, _
                      BackColor As uInteger ) As Integer
     return cdtDrawExt(MemoryDC,x,y,dx,dy,card,typ,Backcolor)
end function

function CardLib.CardAnimate (cardBack As Integer, _
                      x        As Integer, _
                      y        As Integer, _
                      frame    As Integer ) As Integer
     return cdtAnimate(MemoryDC,cardBack,x,y,frame)

end function

function CardLib.Show As Integer
     dim as integer ret = GetDIBits(MemoryDC, _
                      hBMP, _
                      0, _
                      abs(BI.bmiHeader.biHeight), _
                      Pixels, _
                      @BI,DIB_RGB_COLORS)
     'screenlock
     put (0,0),Image,PSET
     'screenunlock
     return ret
end function

' main
dim as CARDLIB Cards
dim as integer x,y,card,col,backface

for backface =54 to 66
     for card = 0 to 51
       x = (card mod 13) * 68
       y = (card \   13) * 96
       Cards.CardDraw(x,y, backface, Cards.mdFaceDown,RGB(0,0,0) )
     next
     Cards.Show    
     sleep 1000,1
next    

for col=0 to 3
     for card = 0 to 12
       Cards.CardDraw(card*68,col*96, card*4+col,Cards.mdFaceUp,RGB(0,0,0) )
     next
next
Cards.Show    
Sleep
Прикрепления: cards20.zip (82.7 Kb) · 5546465.gif (2.2 Kb)


Вы сохраняете власть над людьми покуда оставляете им что-то…Отберите у человека все, и этот человек уже будет неподвластен вам…
 
  • Страница 1 из 1
  • 1
Поиск: