home *** CD-ROM | disk | FTP | other *** search
/ WDR Computer Club Digital 1997 June / cc970602.bin / ZOCKER / CARDS.FRM < prev    next >
Text File  |  1997-04-24  |  12KB  |  425 lines
  1. VERSION 2.00
  2. Begin Form Form1 
  3.    BackColor       =   &H00008000&
  4.    Caption         =   "Form1"
  5.    ClientHeight    =   5820
  6.    ClientLeft      =   1035
  7.    ClientTop       =   1350
  8.    ClientWidth     =   7365
  9.    Height          =   6225
  10.    Left            =   975
  11.    LinkTopic       =   "Form1"
  12.    ScaleHeight     =   388
  13.    ScaleMode       =   3  'Pixel
  14.    ScaleWidth      =   491
  15.    Top             =   1005
  16.    Width           =   7485
  17.    Begin Timer Timer3 
  18.       Enabled         =   0   'False
  19.       Interval        =   300
  20.       Left            =   960
  21.       Top             =   4800
  22.    End
  23.    Begin PictureBox Picture3 
  24.       AutoRedraw      =   -1  'True
  25.       AutoSize        =   -1  'True
  26.       BorderStyle     =   0  'None
  27.       Height          =   255
  28.       Left            =   3240
  29.       Picture         =   CARDS.FRX:0000
  30.       ScaleHeight     =   17
  31.       ScaleMode       =   3  'Pixel
  32.       ScaleWidth      =   24
  33.       TabIndex        =   4
  34.       Top             =   3600
  35.       Visible         =   0   'False
  36.       Width           =   360
  37.    End
  38.    Begin PictureBox Picture2 
  39.       AutoRedraw      =   -1  'True
  40.       AutoSize        =   -1  'True
  41.       BorderStyle     =   0  'None
  42.       Height          =   255
  43.       Left            =   2760
  44.       Picture         =   CARDS.FRX:069A
  45.       ScaleHeight     =   17
  46.       ScaleMode       =   3  'Pixel
  47.       ScaleWidth      =   24
  48.       TabIndex        =   3
  49.       Top             =   3600
  50.       Visible         =   0   'False
  51.       Width           =   360
  52.    End
  53.    Begin PictureBox Picture1 
  54.       AutoRedraw      =   -1  'True
  55.       AutoSize        =   -1  'True
  56.       BorderStyle     =   0  'None
  57.       Height          =   255
  58.       Left            =   2280
  59.       Picture         =   CARDS.FRX:0D34
  60.       ScaleHeight     =   17
  61.       ScaleMode       =   3  'Pixel
  62.       ScaleWidth      =   24
  63.       TabIndex        =   2
  64.       Top             =   3600
  65.       Visible         =   0   'False
  66.       Width           =   360
  67.    End
  68.    Begin Timer Timer2 
  69.       Enabled         =   0   'False
  70.       Interval        =   1
  71.       Left            =   480
  72.       Top             =   4800
  73.    End
  74.    Begin TextBox Text1 
  75.       BackColor       =   &H00FF0000&
  76.       FontBold        =   -1  'True
  77.       FontItalic      =   0   'False
  78.       FontName        =   "MS Sans Serif"
  79.       FontSize        =   12
  80.       FontStrikethru  =   0   'False
  81.       FontUnderline   =   0   'False
  82.       ForeColor       =   &H0000FFFF&
  83.       Height          =   1095
  84.       Left            =   1920
  85.       MultiLine       =   -1  'True
  86.       ScrollBars      =   2  'Vertical
  87.       TabIndex        =   1
  88.       Top             =   0
  89.       Visible         =   0   'False
  90.       Width           =   4095
  91.    End
  92.    Begin Timer Timer1 
  93.       Enabled         =   0   'False
  94.       Interval        =   1000
  95.       Left            =   0
  96.       Top             =   4800
  97.    End
  98.    Begin ListBox List1 
  99.       Height          =   4320
  100.       Left            =   0
  101.       TabIndex        =   0
  102.       Top             =   0
  103.       Width           =   1575
  104.    End
  105. End
  106. ' allgemeine (Formbezogen) Deklarationen
  107. Dim nwidth As Integer, nheight As Integer
  108. Dim Shared c%()
  109. Dim Shared alt, rⁿcken, besetzt, aus As Integer
  110.  
  111. Sub alle_Karten_anzeigen (flaeche, farbe)
  112.  
  113.  For i = 1 To 13
  114.     If flaeche = 40 And i = 2 Then i = 7
  115.     zaehler = zaehler + 1
  116.     X% = cdtdraw(hDC, 100 + nwidth * 1, (zaehler - 1) * flaeche, i, 1, farbe)
  117.     X% = cdtdraw(hDC, 100 + nwidth * 2, (zaehler - 1) * flaeche, i + 13, 1, farbe)
  118.     X% = cdtdraw(hDC, 100 + nwidth * 3, (zaehler - 1) * flaeche, i + 26, 1, farbe)
  119.     X% = cdtdraw(hDC, 100 + nwidth * 4, (zaehler - 1) * flaeche, i + 39, 1, farbe)
  120. Next i
  121.  
  122. End Sub
  123.  
  124. Sub Form_Click ()
  125. timer2.Enabled = False
  126. End Sub
  127.  
  128. Sub Form_Load ()
  129.      ' (c) Wolfgang Back, K÷ln, 1997
  130.      ' Code in Visual Basic 3 geschrieben
  131.      Show
  132.      Randomize
  133.      windowstate = 2
  134.      caption = "Kartenspiel unter Benutzung der CARDS.DLL"
  135.      X% = cdtinit(nwidth, nheight)
  136.     
  137.     list1.AddItem "alle Kreuz"
  138.     list1.AddItem "alle Pik"
  139.     list1.AddItem "alle Karo"
  140.     list1.AddItem "alle Herz"
  141.     list1.AddItem "alle Buben"
  142.     list1.AddItem "alle Rⁿcken"
  143.     list1.AddItem "Karten invers"
  144.     list1.AddItem "alle Karten"
  145.     list1.AddItem "Kartenfarbe"
  146.     list1.AddItem "normale Karten"
  147.     list1.AddItem "Skatspiel"
  148.     list1.AddItem "kleine Karten"
  149.     list1.AddItem "gro▀e Karten"
  150.     list1.AddItem "sehr gro▀e Karte"
  151.     list1.AddItem "Kartenstapel"
  152.     list1.AddItem "Karten mischen"
  153.     list1.AddItem "Kartenschlange"
  154.     list1.AddItem "Zockerkarte"
  155.     list1.AddItem "neues Spiel"
  156.     list1.AddItem "Declares"
  157.     list1.AddItem "Beschreibung"
  158.     'list1.AddItem "Frecell-Spiel"
  159.     'list1.AddItem "Golf-Kartenspiel"
  160.  
  161.  
  162. text1.Left = 0: text1.Width = ScaleWidth
  163. text1.Top = 0: text1.Height = ScaleHeight
  164.  
  165. End Sub
  166.  
  167.                 Sub Form_Unload (Cancel As Integer)
  168.                  ret% = CdtTerm()
  169.                 End Sub
  170.  
  171. Sub Gross_klein_anzeigen (wert, bis, links, breit, hoch, art)
  172. h÷he = 0
  173. For i = 1 To bis
  174. links = links + breit
  175. X% = cdtdrawext(hDC, links, h÷he, breit, hoch, wert + i, art, &HFFFF)
  176. If i Mod 4 = 0 And i > 0 Then h÷he = h÷he + ver: links = 100
  177. Next i
  178.  
  179. End Sub
  180.  
  181. Sub karten_anzeigen (wert, bis, hor, ver, art)
  182.  
  183. h÷he = 0
  184. links = 100
  185. For i = 1 To bis
  186. links = links + hor
  187. X% = cdtdraw(hDC, links, h÷he, wert + i, art, &HFFFF)
  188. If i Mod 4 = 0 And i > 0 Then h÷he = h÷he + ver: links = 100
  189. Next i
  190. End Sub
  191.  
  192. Sub Karten_mischen ()
  193.  
  194.  
  195. End Sub
  196.  
  197. Sub Karten_schlange ()
  198. For i = 1 To ScaleHeight - 100 Step 3
  199. X% = cdtdraw(hDC, i, i - Cos(i) * 30, 13, 1, &HFFFF)
  200. X% = cdtdraw(hDC, nwidth + i, i - Cos(i) * 30, 26, 1, &HFFFF)
  201. X% = cdtdraw(hDC, 2 * nwidth + i, i - Cos(i) * 30, 39, 1, &HFFFF)
  202. X% = cdtdraw(hDC, 3 * nwidth + i, i - Cos(i) * 30, 52, 1, &HFFFF)
  203. Next i
  204. End Sub
  205.  
  206. Sub Karten_stapel ()
  207. For i = 0 To 50
  208. verschiebung = verschiebung + 2
  209. X% = cdtdraw(hDC, 150 + verschiebung, 10 + verschiebung, 60, 1, &HFFFF)
  210. Next i
  211. End Sub
  212.  
  213. Sub List1_Click ()
  214. list1.Left = 0: list1.Top = 0
  215. timer1.Enabled = False
  216. timer2.Enabled = False
  217. timer3.Enabled = False
  218. DoEvents
  219. Cls
  220.  
  221. Select Case list1.ListIndex
  222. Case Is = 0
  223. ' alle Kreuz
  224. Call karten_anzeigen(0, 13, nwidth, nheight, 1)
  225. Case Is = 1
  226. ' alle Pik
  227. Call karten_anzeigen(39, 13, nwidth, nheight, 1)
  228. Case Is = 2
  229. ' alle Karo
  230. Call karten_anzeigen(14, 13, nwidth, nheight, 1)
  231. Case Is = 3
  232. ' alle Herz
  233. Call karten_anzeigen(26, 13, nwidth, nheight, 1)
  234. Case Is = 4
  235. ' alle Buben
  236. Call karten_anzeigen(39, 4, nwidth, nheight, 0)
  237. Case Is = 5
  238. ' Rⁿcken
  239. Call karten_anzeigen(52, 16, nwidth, nheight, 1)
  240. Case Is = 6
  241. ' Invers
  242. Call karten_anzeigen(39, 12, nwidth, nheight, 2)
  243. timer1.Enabled = True
  244. Case Is = 7
  245. ' alle Karten
  246. Call alle_Karten_anzeigen(25, &HFFFF)
  247. Case Is = 8
  248. ' Kartenfarbe
  249. Static color As Integer
  250. color = color + 1
  251. Select Case color
  252. Case Is = 1: Call alle_Karten_anzeigen(25, RGB(255, 0, 0))
  253. Case Is = 2: Call alle_Karten_anzeigen(25, RGB(0, 255, 0))
  254. Case Is = 3: Call alle_Karten_anzeigen(25, RGB(0, 0, 255))
  255. End Select
  256. If color = 3 Then color = 0
  257. Case Is = 9
  258. ' Normale Karten
  259. Call alle_Karten_anzeigen(40, &HFFFF)
  260. Case Is = 10
  261. ' Skatspiel
  262. Call Skat_spiel
  263. Case Is = 11
  264. ' kleine Karten
  265. Call Gross_klein_anzeigen(20, 4, 100, 40, 50, 1)
  266. Case Is = 12
  267. ' gro▀e Karten
  268. Call Gross_klein_anzeigen(20, 4, 100, 105, 105 * nheight / nwidth, 1)
  269. Case Is = 13
  270. ' ganz gro▀e Karte
  271. Call Gross_klein_anzeigen(23, 1, -100, 300, 300 * nheight / nwidth, 1)
  272. Case Is = 14
  273. ' Kartenstapel
  274. Call Karten_stapel
  275. Case Is = 15
  276. ' Karten mischen
  277. timer2.Enabled = True
  278. Case Is = 16
  279. ' Kartenschlange
  280. list1.Left = ScaleWidth - list1.Width
  281. Call Karten_schlange
  282. Case Is = 17
  283. ' Zockerkarte
  284. X = cdtdraw(hDC, 120, 50, hand, C_BACKS, &HFFFF)
  285. timer3.Enabled = True
  286. Case Is = 18
  287. ' Neues Spiel
  288. Call Neues_Spiel
  289. Case Is = 19
  290. lf = Chr(13) + Chr(10)
  291. text1 = lf + "Declare Function Cdtinit Lib " + Chr(34) + "CARDS.DLL" + Chr(34) + " (nWidth%, nHeight%) As Integer" + lf + lf
  292. 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
  293. 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
  294. text1 = text1 + "Declare Function Cdtterm Lib " + Chr(34) + "CARDS.DLL" + Chr(34) + "()"
  295. text1.Visible = True
  296. Case Is = 20
  297. ' Beschreibung
  298.     Open "cards.bas" For Input As #1
  299.     While Not EOF(1)
  300.     Line Input #1, a$
  301.     text1 = text1 + a$ + Chr(13) + Chr(10)
  302.     Wend
  303.     Close #1
  304.     text1.Visible = True
  305. Case Is = 21
  306.     X = Shell("C:\spiele\freecell.exe", 1)
  307. Case Is = 22
  308.     X = Shell("C:\spiele\Golf.exe", 1)
  309. End Select
  310.  
  311. End Sub
  312.  
  313. Sub Neues_Spiel ()
  314. Static a, b As Integer
  315. a = Not a
  316. If Not a Then b = b + 1
  317. If b > 13 Then b = 0
  318. radius = 170
  319. mittex = 330
  320. mittey = radius
  321. ' 52 Karten ziehen
  322. For i = -pi To pi Step 2 * pi / 52
  323. zaehler = zaehler + 1
  324. If a / 2 <> Int(a / 2) Then
  325. X% = cdtdraw(hDC, mittex + Cos(i) * radius, mittey + Sin(i) * radius, zaehler - 1, 1, &HFFFF)
  326. Else
  327. X% = cdtdraw(hDC, mittex + Cos(i) * radius, mittey + Sin(i) * radius, 52 + b, 1, &HFFFF)
  328. End If
  329. Next i
  330.  
  331. End Sub
  332.  
  333.  Sub Skat_spiel ()
  334. Static a As Integer
  335. a = a + 1
  336. ' mit a wird nach und nach aufgedeckt
  337.  
  338. If a > 1 Then GoTo anzeigen
  339. ReDim c(32)
  340. ' das Skatspiel hat 32 Karten
  341. For i = 0 To 31
  342. nochmals:
  343. DoEvents
  344.  
  345. c%(i) = Int(Rnd * 32)
  346. For j = 0 To i - 1
  347. If c%(j) = c%(i) Then GoTo nochmals
  348. Next j
  349. Next i
  350. ' die Variable wird angehoben, 2,3,4,5,6er werden ausgeschieden
  351. For i = 0 To 31
  352. If c%(i) > 3 Then c%(i) = c%(i) + 20
  353. Next i
  354. anzeigen:
  355. ' flaeche gibt die ▄berlappung an
  356.  
  357. flaeche = 35
  358. ' jeweils 10 Karten werden dargestellt
  359. For i = 1 To 10
  360. DoEvents
  361. X% = cdtdraw(hDC, 100 + flaeche * i, 10, c%(i - 1), 0, &HFFFF)
  362.  
  363. If a = 1 Then
  364. X% = cdtdraw(hDC, 100 + flaeche * i, 10 + nheight + 10, 54, 1, &HFFF)
  365. Else
  366. X% = cdtdraw(hDC, 100 + flaeche * i, 10 + nheight + 10, c%(i + 10 - 1), 0, &HFFF&)
  367. End If
  368.  
  369. If a = 1 Or a = 2 Then
  370. X% = cdtdraw(hDC, 100 + flaeche * i, 10 + 2 * (nheight + 10), 54, 1, &HFFF&)
  371. Else
  372. X% = cdtdraw(hDC, 100 + flaeche * i, 10 + 2 * (nheight + 10), c%(i + 20 - 1), 0, &HFFF&)
  373.  
  374. End If
  375. Next i
  376. ' hier wird der Stock angezeigt
  377.  
  378. For i = 1 To 2
  379. If a < 4 Then
  380. X% = cdtdraw(hDC, 250 + flaeche * i, 10 + 3 * (nheight + 10), 54, 1, &HFFFF&)
  381. Else
  382. X% = cdtdraw(hDC, 250 + flaeche * i, 10 + 3 * (nheight + 10), c%(29 + i), 0, &HFFFF&)
  383. End If
  384. Next i
  385. If a = 4 Then a = 0
  386. End Sub
  387.  
  388. Sub Text1_DblClick ()
  389. text1.Visible = False
  390. End Sub
  391.  
  392. Sub Timer1_Timer ()
  393. Static a As Integer
  394. a = Not a
  395. If a Then invers = 0 Else invers = 2
  396. Call karten_anzeigen(39, 12, nwidth, nheight, invers)
  397. DoEvents
  398. End Sub
  399.  
  400. Sub Timer2_Timer ()
  401. ' zeichnet die Kartenschlange
  402. For i = 1 To 10
  403. verschiebung = verschiebung + 2
  404. X% = cdtdraw(hDC, 150 + Cos(verschiebung) * 20, 10 + Cos(verschiebung) * 10, 60, 1, &HFFFF)
  405. DoEvents
  406. For j = 1 To 60000: Next
  407. Next i
  408. verschiebung = 0
  409.  
  410. Cls
  411. End Sub
  412.  
  413. Sub Timer3_Timer ()
  414. ' Timer fⁿr die Zockerkarte
  415. Static zahl As Integer
  416. links = 36: hoch = 34
  417. zahl = zahl + 1
  418. If zahl = 1 Then r = bitblt(hDC, 120 + links, 50 + hoch, picture1.ScaleWidth, picture1.ScaleHeight, picture2.hDC, 0, 0, srccopy)
  419. If zahl = 2 Then r = bitblt(hDC, 120 + links, 50 + hoch, picture1.ScaleWidth, picture1.ScaleHeight, picture3.hDC, 0, 0, srccopy)
  420. If zahl = 3 Then r = bitblt(hDC, 120 + links, 50 + hoch, picture1.ScaleWidth, picture1.ScaleHeight, picture2.hDC, 0, 0, srccopy)
  421. If zahl = 4 Then r = bitblt(hDC, 120 + links, 50 + hoch, picture1.ScaleWidth, picture1.ScaleHeight, picture1.hDC, 0, 0, srccopy)
  422. If zahl = 4 Then zahl = 0
  423. End Sub
  424.  
  425.