Tipp 0252
|
Cards.dll für Kartenspiele nutzen
|
 |
|
Autor/Einsender: Datum: |
|
Christian Lotman 28.06.2002 |
|
Entwicklungsumgebung: |
|
VB 5 |
|
|
Um eigene Kartenspiele programmieren zu können, muss man nicht das Rad neu erfinden. Windows enthält bereits mit der Datei cards.dll (wird z.B. von FreeCell genutzt) eine sehr gute Bibliothek, die ein komplettes Kartenspiel mit allen 52 Karten enthält.
|
Dieses Beispiel zeigt anschaulich, wie die einzelnen Funktionen der DLL genutzt werden können.
|
|
|
Die Betriebssysteme Windows 95/98 und ME enthalten leider eine 16-bit DLL, die mit dem 32-bit VB nicht ohne weiteres angesprochen werden kann. Ab Windows NT ist die Cards.dll eine 32-bit-DLL.
|
Dem Download liegt die 32-bit DLL als cards32.dll bei. Hier müssen dann bei den o.g. Systemen die Deklaration im Quellcode von Cards.dll in Cards32.dll geändert werden.
|
|
Code im Codebereich des Moduls |
|
|
Option Explicit
DefLng A-Z
Public Enum CARD_DRAW
CARD_DRAW_FACE
CARD_DRAW_BACK
CARD_DRAW_INVERT
End Enum
Public Enum CARD_BACK
CARD_BACK_Kariert = 53
CARD_BACK_Geflecht1
CARD_BACK_Geflecht2
CARD_BACK_Roboter
CARD_BACK_Blumen
CARD_BACK_Eiche1
CARD_BACK_Eiche2
CARD_BACK_Fisch1
CARD_BACK_Fisch2
CARD_BACK_Muschel
CARD_BACK_Burg
CARD_BACK_Insel
CARD_BACK_Kartenhand
CARD_BACK_EMPTY
CARD_BACK_X
CARD_BACK_O
End Enum
Declare Function cdtInit Lib "Cards.dll" ( _
dx As Long, dy As Long) As Long
Declare Function cdtDrawExt Lib "Cards.dll" (ByVal hDC As Long, _
ByVal X As Long, ByVal Y As Long, ByVal dx As Long, ByVal _
dy As Long, ByVal ordCard As Long, ByVal iDraw As Long, _
ByVal Clr As Long) As Long
Declare Function cdtDraw Lib "Cards.dll" (ByVal hDC As Long, _
ByVal X As Long, ByVal Y As Long, ByVal iCard As Long, _
ByVal iDraw As Long, ByVal Clr As Long) As Long
Declare Function cdtAnimate Lib "Cards.dll" (ByVal hDC As Long, _
ByVal iCardBack As Long, ByVal X As Long, ByVal Y As Long, _
ByVal iState As Long) As Long
Declare Function cdtTerm Lib "Cards.dll" () As Long
|
|
|
Code im Codebereich der Form |
|
|
Option Explicit
Private Cwidth As Long, Cheight As Long
Private Cfaktor As Single
Private Karte(51) As Long
Private Sub Form_Load()
modDeclares.cdtInit Cwidth, Cheight
With cmbKarten
.AddItem "- keine -"
.AddItem "Alle"
.AddItem "Kreuz"
.AddItem "Karo"
.AddItem "Herz"
.AddItem "Pik"
.ListIndex = 0
End With
With cmbGroesse
.AddItem "100%": .ItemData(0) = 100
.AddItem "90%": .ItemData(1) = 90
.AddItem "80%": .ItemData(2) = 80
.AddItem "70%": .ItemData(3) = 70
.AddItem "60%": .ItemData(4) = 60
.AddItem "50%": .ItemData(5) = 50
.AddItem "33%": .ItemData(6) = 33
.AddItem "25%": .ItemData(7) = 25
.ListIndex = 0
End With
End Sub
Private Sub cmbKarten_Click()
Dim i As Long
Ordnen
Cls
cmdMischen.Enabled = True
Select Case cmbKarten.ListIndex
Case 1
ZeigeAlle
Case Is > 1
For i = 0 To 12
cdtDrawExt hDC, 50 + i * 25, 10 + i * 10, _
Cwidth * Cfaktor, Cheight * Cfaktor, _
Karte((cmbKarten.ListIndex - 2) * 13 + i), _
CARD_DRAW_FACE, vbWhite
Next
Case Else
cmdMischen.Enabled = cmdMischen.Enabled Xor -1
End Select
End Sub
Private Sub cmbGroesse_Click()
With cmbGroesse
Cfaktor = .ItemData(.ListIndex) / 100
End With
cmbKarten_Click
End Sub
Private Sub cmdMischen_Click()
Mischen
ZeigeAlle
End Sub
Private Sub cmdRueckseite_Click()
Dim i As Long
Cls
For i = 0 To 12
cdtDrawExt hDC, 50 + i * 25, 10 + i * 10, _
Cwidth * Cfaktor, Cheight * Cfaktor, _
53 + i, CARD_DRAW_BACK, vbWhite
Next i
End Sub
Private Sub Ordnen()
Dim X As Long, Y As Long
For Y = 0 To 3
For X = 0 To 12
Karte(Y * 13 + X) = X * 4 + Y
Next X
Next Y
End Sub
Private Sub Mischen()
Dim i As Long, r As Long
For i = 0 To 51
Karte(i) = -1
Next i
For i = 0 To 51
r = Rnd() * 51
While Karte(r) > -1
r = (r + 7) Mod 52
Wend
Karte(r) = i
Next i
End Sub
Private Sub ZeigeAlle()
Dim X As Long, Y As Long
Cls
For Y = 0 To 3
For X = 0 To 12
cdtDrawExt hDC, 50 + X * 25 + Y * 10, 10 + Y * 50, _
Cwidth * Cfaktor, Cheight * Cfaktor, _
Karte(Y * 13 + X), CARD_DRAW_FACE, vbWhite
Next X
Next Y
End Sub
Private Sub Form_Unload(Cancel As Integer)
modDeclares.cdtTerm
End Sub
|
|
|
|
|
Windows-Version |
95 |
 |
|
98/SE |
 |
|
ME |
 |
|
NT |
 |
|
2000 |
 |
|
XP |
 |
|
Vista |
 |
|
Win
7 |
 |
|
|
VB-Version |
VBA 5 |
 |
|
VBA 6 |
 |
|
VB 4/16 |
 |
|
VB 4/32 |
 |
|
VB 5 |
 |
|
VB 6 |
 |
|
|
|
Download (38,1
kB)
|
Downloads bisher: [ 983 ]
|
|
|