home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
WDR Computer Club Digital 1997 June
/
cc970602.bin
/
ZOCKER
/
CARDS.FRM
< prev
next >
Wrap
Text File
|
1997-04-24
|
12KB
|
425 lines
VERSION 2.00
Begin Form Form1
BackColor = &H00008000&
Caption = "Form1"
ClientHeight = 5820
ClientLeft = 1035
ClientTop = 1350
ClientWidth = 7365
Height = 6225
Left = 975
LinkTopic = "Form1"
ScaleHeight = 388
ScaleMode = 3 'Pixel
ScaleWidth = 491
Top = 1005
Width = 7485
Begin Timer Timer3
Enabled = 0 'False
Interval = 300
Left = 960
Top = 4800
End
Begin PictureBox Picture3
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 255
Left = 3240
Picture = CARDS.FRX:0000
ScaleHeight = 17
ScaleMode = 3 'Pixel
ScaleWidth = 24
TabIndex = 4
Top = 3600
Visible = 0 'False
Width = 360
End
Begin PictureBox Picture2
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 255
Left = 2760
Picture = CARDS.FRX:069A
ScaleHeight = 17
ScaleMode = 3 'Pixel
ScaleWidth = 24
TabIndex = 3
Top = 3600
Visible = 0 'False
Width = 360
End
Begin PictureBox Picture1
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 255
Left = 2280
Picture = CARDS.FRX:0D34
ScaleHeight = 17
ScaleMode = 3 'Pixel
ScaleWidth = 24
TabIndex = 2
Top = 3600
Visible = 0 'False
Width = 360
End
Begin Timer Timer2
Enabled = 0 'False
Interval = 1
Left = 480
Top = 4800
End
Begin TextBox Text1
BackColor = &H00FF0000&
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 12
FontStrikethru = 0 'False
FontUnderline = 0 'False
ForeColor = &H0000FFFF&
Height = 1095
Left = 1920
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 1
Top = 0
Visible = 0 'False
Width = 4095
End
Begin Timer Timer1
Enabled = 0 'False
Interval = 1000
Left = 0
Top = 4800
End
Begin ListBox List1
Height = 4320
Left = 0
TabIndex = 0
Top = 0
Width = 1575
End
End
' allgemeine (Formbezogen) Deklarationen
Dim nwidth As Integer, nheight As Integer
Dim Shared c%()
Dim Shared alt, rⁿcken, besetzt, aus As Integer
Sub alle_Karten_anzeigen (flaeche, farbe)
For i = 1 To 13
If flaeche = 40 And i = 2 Then i = 7
zaehler = zaehler + 1
X% = cdtdraw(hDC, 100 + nwidth * 1, (zaehler - 1) * flaeche, i, 1, farbe)
X% = cdtdraw(hDC, 100 + nwidth * 2, (zaehler - 1) * flaeche, i + 13, 1, farbe)
X% = cdtdraw(hDC, 100 + nwidth * 3, (zaehler - 1) * flaeche, i + 26, 1, farbe)
X% = cdtdraw(hDC, 100 + nwidth * 4, (zaehler - 1) * flaeche, i + 39, 1, farbe)
Next i
End Sub
Sub Form_Click ()
timer2.Enabled = False
End Sub
Sub Form_Load ()
' (c) Wolfgang Back, K÷ln, 1997
' Code in Visual Basic 3 geschrieben
Show
Randomize
windowstate = 2
caption = "Kartenspiel unter Benutzung der CARDS.DLL"
X% = cdtinit(nwidth, nheight)
list1.AddItem "alle Kreuz"
list1.AddItem "alle Pik"
list1.AddItem "alle Karo"
list1.AddItem "alle Herz"
list1.AddItem "alle Buben"
list1.AddItem "alle Rⁿcken"
list1.AddItem "Karten invers"
list1.AddItem "alle Karten"
list1.AddItem "Kartenfarbe"
list1.AddItem "normale Karten"
list1.AddItem "Skatspiel"
list1.AddItem "kleine Karten"
list1.AddItem "gro▀e Karten"
list1.AddItem "sehr gro▀e Karte"
list1.AddItem "Kartenstapel"
list1.AddItem "Karten mischen"
list1.AddItem "Kartenschlange"
list1.AddItem "Zockerkarte"
list1.AddItem "neues Spiel"
list1.AddItem "Declares"
list1.AddItem "Beschreibung"
'list1.AddItem "Frecell-Spiel"
'list1.AddItem "Golf-Kartenspiel"
text1.Left = 0: text1.Width = ScaleWidth
text1.Top = 0: text1.Height = ScaleHeight
End Sub
Sub Form_Unload (Cancel As Integer)
ret% = CdtTerm()
End Sub
Sub Gross_klein_anzeigen (wert, bis, links, breit, hoch, art)
h÷he = 0
For i = 1 To bis
links = links + breit
X% = cdtdrawext(hDC, links, h÷he, breit, hoch, wert + i, art, &HFFFF)
If i Mod 4 = 0 And i > 0 Then h÷he = h÷he + ver: links = 100
Next i
End Sub
Sub karten_anzeigen (wert, bis, hor, ver, art)
h÷he = 0
links = 100
For i = 1 To bis
links = links + hor
X% = cdtdraw(hDC, links, h÷he, wert + i, art, &HFFFF)
If i Mod 4 = 0 And i > 0 Then h÷he = h÷he + ver: links = 100
Next i
End Sub
Sub Karten_mischen ()
End Sub
Sub Karten_schlange ()
For i = 1 To ScaleHeight - 100 Step 3
X% = cdtdraw(hDC, i, i - Cos(i) * 30, 13, 1, &HFFFF)
X% = cdtdraw(hDC, nwidth + i, i - Cos(i) * 30, 26, 1, &HFFFF)
X% = cdtdraw(hDC, 2 * nwidth + i, i - Cos(i) * 30, 39, 1, &HFFFF)
X% = cdtdraw(hDC, 3 * nwidth + i, i - Cos(i) * 30, 52, 1, &HFFFF)
Next i
End Sub
Sub Karten_stapel ()
For i = 0 To 50
verschiebung = verschiebung + 2
X% = cdtdraw(hDC, 150 + verschiebung, 10 + verschiebung, 60, 1, &HFFFF)
Next i
End Sub
Sub List1_Click ()
list1.Left = 0: list1.Top = 0
timer1.Enabled = False
timer2.Enabled = False
timer3.Enabled = False
DoEvents
Cls
Select Case list1.ListIndex
Case Is = 0
' alle Kreuz
Call karten_anzeigen(0, 13, nwidth, nheight, 1)
Case Is = 1
' alle Pik
Call karten_anzeigen(39, 13, nwidth, nheight, 1)
Case Is = 2
' alle Karo
Call karten_anzeigen(14, 13, nwidth, nheight, 1)
Case Is = 3
' alle Herz
Call karten_anzeigen(26, 13, nwidth, nheight, 1)
Case Is = 4
' alle Buben
Call karten_anzeigen(39, 4, nwidth, nheight, 0)
Case Is = 5
' Rⁿcken
Call karten_anzeigen(52, 16, nwidth, nheight, 1)
Case Is = 6
' Invers
Call karten_anzeigen(39, 12, nwidth, nheight, 2)
timer1.Enabled = True
Case Is = 7
' alle Karten
Call alle_Karten_anzeigen(25, &HFFFF)
Case Is = 8
' Kartenfarbe
Static color As Integer
color = color + 1
Select Case color
Case Is = 1: Call alle_Karten_anzeigen(25, RGB(255, 0, 0))
Case Is = 2: Call alle_Karten_anzeigen(25, RGB(0, 255, 0))
Case Is = 3: Call alle_Karten_anzeigen(25, RGB(0, 0, 255))
End Select
If color = 3 Then color = 0
Case Is = 9
' Normale Karten
Call alle_Karten_anzeigen(40, &HFFFF)
Case Is = 10
' Skatspiel
Call Skat_spiel
Case Is = 11
' kleine Karten
Call Gross_klein_anzeigen(20, 4, 100, 40, 50, 1)
Case Is = 12
' gro▀e Karten
Call Gross_klein_anzeigen(20, 4, 100, 105, 105 * nheight / nwidth, 1)
Case Is = 13
' ganz gro▀e Karte
Call Gross_klein_anzeigen(23, 1, -100, 300, 300 * nheight / nwidth, 1)
Case Is = 14
' Kartenstapel
Call Karten_stapel
Case Is = 15
' Karten mischen
timer2.Enabled = True
Case Is = 16
' Kartenschlange
list1.Left = ScaleWidth - list1.Width
Call Karten_schlange
Case Is = 17
' Zockerkarte
X = cdtdraw(hDC, 120, 50, hand, C_BACKS, &HFFFF)
timer3.Enabled = True
Case Is = 18
' Neues Spiel
Call Neues_Spiel
Case Is = 19
lf = Chr(13) + Chr(10)
text1 = lf + "Declare Function Cdtinit Lib " + Chr(34) + "CARDS.DLL" + Chr(34) + " (nWidth%, nHeight%) As Integer" + lf + lf
text1 = text1 + "Declare Function Cdtdraw Lib " + Chr(34) + "CARDS.DLL" + Chr(34) + " (ByVal hDC%, ByVal xOrg%, ByVal yOrg%, ByVal nCard%, ByVal nDraw%, ByVal nColor&) As Integer" + lf + lf
text1 = text1 + "Declare Function Cdtdrawext Lib " + Chr(34) + "CARDS.DLL" + Chr(34) + " (ByVal hDC%, ByVal xOrg%, ByVal yOrg%, ByVal xWidth%, ByVal yHeight%, ByVal nCard%, ByVal nDraw%, ByVal nColor&) As Integer" + lf + lf
text1 = text1 + "Declare Function Cdtterm Lib " + Chr(34) + "CARDS.DLL" + Chr(34) + "()"
text1.Visible = True
Case Is = 20
' Beschreibung
Open "cards.bas" For Input As #1
While Not EOF(1)
Line Input #1, a$
text1 = text1 + a$ + Chr(13) + Chr(10)
Wend
Close #1
text1.Visible = True
Case Is = 21
X = Shell("C:\spiele\freecell.exe", 1)
Case Is = 22
X = Shell("C:\spiele\Golf.exe", 1)
End Select
End Sub
Sub Neues_Spiel ()
Static a, b As Integer
a = Not a
If Not a Then b = b + 1
If b > 13 Then b = 0
radius = 170
mittex = 330
mittey = radius
' 52 Karten ziehen
For i = -pi To pi Step 2 * pi / 52
zaehler = zaehler + 1
If a / 2 <> Int(a / 2) Then
X% = cdtdraw(hDC, mittex + Cos(i) * radius, mittey + Sin(i) * radius, zaehler - 1, 1, &HFFFF)
Else
X% = cdtdraw(hDC, mittex + Cos(i) * radius, mittey + Sin(i) * radius, 52 + b, 1, &HFFFF)
End If
Next i
End Sub
Sub Skat_spiel ()
Static a As Integer
a = a + 1
' mit a wird nach und nach aufgedeckt
If a > 1 Then GoTo anzeigen
ReDim c(32)
' das Skatspiel hat 32 Karten
For i = 0 To 31
nochmals:
DoEvents
c%(i) = Int(Rnd * 32)
For j = 0 To i - 1
If c%(j) = c%(i) Then GoTo nochmals
Next j
Next i
' die Variable wird angehoben, 2,3,4,5,6er werden ausgeschieden
For i = 0 To 31
If c%(i) > 3 Then c%(i) = c%(i) + 20
Next i
anzeigen:
' flaeche gibt die ▄berlappung an
flaeche = 35
' jeweils 10 Karten werden dargestellt
For i = 1 To 10
DoEvents
X% = cdtdraw(hDC, 100 + flaeche * i, 10, c%(i - 1), 0, &HFFFF)
If a = 1 Then
X% = cdtdraw(hDC, 100 + flaeche * i, 10 + nheight + 10, 54, 1, &HFFF)
Else
X% = cdtdraw(hDC, 100 + flaeche * i, 10 + nheight + 10, c%(i + 10 - 1), 0, &HFFF&)
End If
If a = 1 Or a = 2 Then
X% = cdtdraw(hDC, 100 + flaeche * i, 10 + 2 * (nheight + 10), 54, 1, &HFFF&)
Else
X% = cdtdraw(hDC, 100 + flaeche * i, 10 + 2 * (nheight + 10), c%(i + 20 - 1), 0, &HFFF&)
End If
Next i
' hier wird der Stock angezeigt
For i = 1 To 2
If a < 4 Then
X% = cdtdraw(hDC, 250 + flaeche * i, 10 + 3 * (nheight + 10), 54, 1, &HFFFF&)
Else
X% = cdtdraw(hDC, 250 + flaeche * i, 10 + 3 * (nheight + 10), c%(29 + i), 0, &HFFFF&)
End If
Next i
If a = 4 Then a = 0
End Sub
Sub Text1_DblClick ()
text1.Visible = False
End Sub
Sub Timer1_Timer ()
Static a As Integer
a = Not a
If a Then invers = 0 Else invers = 2
Call karten_anzeigen(39, 12, nwidth, nheight, invers)
DoEvents
End Sub
Sub Timer2_Timer ()
' zeichnet die Kartenschlange
For i = 1 To 10
verschiebung = verschiebung + 2
X% = cdtdraw(hDC, 150 + Cos(verschiebung) * 20, 10 + Cos(verschiebung) * 10, 60, 1, &HFFFF)
DoEvents
For j = 1 To 60000: Next
Next i
verschiebung = 0
Cls
End Sub
Sub Timer3_Timer ()
' Timer fⁿr die Zockerkarte
Static zahl As Integer
links = 36: hoch = 34
zahl = zahl + 1
If zahl = 1 Then r = bitblt(hDC, 120 + links, 50 + hoch, picture1.ScaleWidth, picture1.ScaleHeight, picture2.hDC, 0, 0, srccopy)
If zahl = 2 Then r = bitblt(hDC, 120 + links, 50 + hoch, picture1.ScaleWidth, picture1.ScaleHeight, picture3.hDC, 0, 0, srccopy)
If zahl = 3 Then r = bitblt(hDC, 120 + links, 50 + hoch, picture1.ScaleWidth, picture1.ScaleHeight, picture2.hDC, 0, 0, srccopy)
If zahl = 4 Then r = bitblt(hDC, 120 + links, 50 + hoch, picture1.ScaleWidth, picture1.ScaleHeight, picture1.hDC, 0, 0, srccopy)
If zahl = 4 Then zahl = 0
End Sub