|
Option Explicit
Private Declare Function cdtInit Lib "cards.dll" (ByRef _
CardWidth As Long, ByRef CardHeight As Long) As Long
Public Declare Function cdtDraw Lib "cards.dll" (ByVal hDC _
As Long, ByVal xOrg As Long, ByVal yOrg As Long, _
ByVal nCard As Long, ByVal nDraw As Long, ByVal _
nColor As OLE_COLOR) As Long
Private Declare Function cdtTerm Lib "cards.dll" () As Long
Public Const LB_KARTEN As Byte = 1
Public Const UB_KARTEN As Byte = 5
Public tmpK(LB_KARTEN To UB_KARTEN) As Karte
Public Enum enFarbe
fbKreuz
fbKaro
fbHerz
fbPik
End Enum
Public Enum enPokerblatt
pbRoyal_Flush
pbStraight_Flush
pbVier_gleiche
pbFull_House
pbFlush
pbStraight
pbDrei_gleiche
pbZwei_Paare
pbPaar
pbFehler
End Enum
Public Type Karte
Wert As Byte
Farbe As enFarbe
ID As Byte
End Type
Public CardW As Long
Public CardH As Long
Public Sub Init()
cdtInit CardW, CardH
End Sub
Public Sub DeInit()
cdtTerm
End Sub
Public Sub Ordnen(K() As Karte)
Dim I As Byte
Dim Min As Byte, tmp As Karte
Dim L As Byte
L = LB_KARTEN
Do While L < UB_KARTEN
Min = L
For I = (L + 1) To UB_KARTEN
If K(I).Wert < K(Min).Wert Then Min = I
Next I
tmp = K(L)
K(L) = K(Min)
K(Min) = tmp
L = L + 1
Loop
End Sub
Private Function FindeGleiche(K() As Karte, _
Optional ByVal Wieviel As Byte = 2, _
Optional Ignore As Byte = 0) As Boolean
Dim Akt As Byte
Dim N As Byte
Dim bn As Boolean
Akt = 1
N = 1
Do While Akt <= (UB_KARTEN - 1)
bn = CBool(K(Akt).Wert = K(Akt + 1).Wert) And _
CBool(K(Akt).Wert <> Ignore)
If bn Then
N = N + 1
If N = Wieviel Then
Ignore = K(Akt).Wert
FindeGleiche = True
Exit Function
End If
Else
N = 1
End If
Akt = Akt + 1
Loop
If N < Wieviel Then FindeGleiche = False
End Function
Public Function Karte_Position(K As Karte) As Byte
Select Case K.Wert
Case 15
Karte_Position = K.Farbe
Case Is > 10
Karte_Position = 4 * (K.Wert - 2) + K.Farbe
Case Else
Karte_Position = 4 * (K.Wert - 1) + K.Farbe
End Select
End Function
Public Function Karte_Bewerten(ByVal ID As Byte) As Karte
Dim tmp As Byte
With Karte_Bewerten
Select Case ID
Case 0 To 3
.Wert = 15
.Farbe = ID
Case 4 To 39
tmp = ID Mod 4
.Farbe = tmp
.Wert = ((ID - tmp) / 4) + 1
Case 40 To 51
tmp = ID Mod 4
.Farbe = tmp
.Wert = ((ID - tmp) / 4) + 2
End Select
Karte_Bewerten.ID = ID
End With
End Function
Public Sub Karte_Tauschen(K() As Karte, nKarte As Byte, _
Neu As Karte)
K(nKarte) = Neu
End Sub
Public Sub Karten_Zeichnen(xPos As Long, yPos As Long, _
Abstand As Integer, Karten() As Karte, hDC As Long)
Dim Akt As Byte
For Akt = 0 To (UB_KARTEN - 1)
cdtDraw hDC, (xPos + Akt * Abstand + Akt * CardW), yPos, _
Karte_Position(Karten(Akt + 1)), 0, vbWhite
Next Akt
End Sub
Public Function Hat_Paar(K() As Karte) As Boolean
Hat_Paar = FindeGleiche(K(), 2)
End Function
Public Function Hat_2Paare(K() As Karte) As Boolean
Dim Ign As Byte
Ign = 0
Hat_2Paare = FindeGleiche(K(), 2, Ign)
Hat_2Paare = FindeGleiche(K(), 2, Ign)
End Function
Public Function Hat_3gleiche(K() As Karte) As Boolean
Hat_3gleiche = FindeGleiche(K(), 3)
End Function
Public Function Hat_Straight(K() As Karte) As Boolean
Dim Akt As Byte
For Akt = LB_KARTEN To (UB_KARTEN - 1)
If K(Akt).Wert = 10 Then
Hat_Straight = CBool(K(Akt).Wert = K(Akt + 1).Wert - 2)
Else
Hat_Straight = CBool(K(Akt).Wert = K(Akt + 1).Wert - 1)
End If
If Not Hat_Straight Then Exit Function
Next Akt
End Function
Public Function Hat_Flush(K() As Karte) As Boolean
Dim Akt As Byte
For Akt = LB_KARTEN To (UB_KARTEN - 1)
Hat_Flush = CBool(K(Akt).Farbe = K(Akt + 1).Farbe)
If Not Hat_Flush Then Exit Function
Next Akt
End Function
Public Function Hat_FullHouse(K() As Karte) As Boolean
Dim Ign As Byte
Ign = 0
Hat_FullHouse = False
If FindeGleiche(K(), 3, Ign) Then
Hat_FullHouse = FindeGleiche(K(), 2, Ign)
End If
End Function
Public Function Hat_4gleiche(K() As Karte) As Boolean
Hat_4gleiche = FindeGleiche(K(), 4)
End Function
Public Function Hat_StraightFlush(K() As Karte) As Boolean
Hat_StraightFlush = Hat_Straight(K()) And Hat_Flush(K())
End Function
Public Function Hat_RoyalFlush(K() As Karte) As Boolean
Hat_RoyalFlush = Hat_StraightFlush(K()) And _
CBool(K(UB_KARTEN).Wert = 15) '15 = Ass
End Function
Public Function Karten_Pruefen(K() As Karte) As enPokerblatt
If Hat_RoyalFlush(K()) Then
Karten_Pruefen = pbRoyal_Flush
ElseIf Hat_StraightFlush(K()) Then
Karten_Pruefen = pbStraight_Flush
ElseIf Hat_4gleiche(K()) Then
Karten_Pruefen = pbVier_gleiche
ElseIf Hat_FullHouse(K()) Then
Karten_Pruefen = pbFull_House
ElseIf Hat_Flush(K()) Then
Karten_Pruefen = pbFlush
ElseIf Hat_Straight(K()) Then
Karten_Pruefen = pbStraight
ElseIf Hat_3gleiche(K()) Then
Karten_Pruefen = pbDrei_gleiche
ElseIf Hat_2Paare(K()) Then
Karten_Pruefen = pbZwei_Paare
ElseIf Hat_Paar(K()) Then
Karten_Pruefen = pbPaar
Else
Karten_Pruefen = pbFehler
End If
End Function
|
|