01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64 |
|
Private Declare PtrSafe Function SetTimer Lib "user32" ( _
ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, _
ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
Private Declare PtrSafe Function KillTimer Lib "user32" ( _
ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
Dim hTimer As LongPtr
Public Sub Programm()
Dim Neustart
KillTimer 0&, hTimer ' Timer stoppen
DoEvents
If Spiel_läuft = False And Aktuelle_Spalte = "0" Then
' Start beginnen
Start
Startpunkt_festlegen
Steuerung
ElseIf Spiel_läuft = False And Aktuelle_Spalte <> "0" Then
' Spiel ist vorbei
MsgBox "Game Over"
Neustart = MsgBox("Soll ein neues Spiel gestartet werden?", vbYesNo)
If Neustart = "6" Then
Aktuelle_Spalte = "0"
Programm
End If
Exit Sub
Else
' Position Ball ermitteln
If Aktuelle_Spalte = "3" Or Aktuelle_Spalte = "91" Then
' Balkentreffer
Balken_getroffen
ElseIf Aktuelle_Reihe = "3" Or Aktuelle_Reihe = "32" Then
' Randtreffer
Rand_getroffen
Else
' Nichts getroffen
Weiterlaufen
End If
' Neues Feld eintragen und altes austragen
Range("C3:CM32").ClearContents
Cells(Aktuelle_Reihe, Aktuelle_Spalte).Value = "2"
Cells(Alte_Reihe, Alte_Spalte).Value = "1"
End If
Steuerung
DoEvents
hTimer = SetTimer(0&, 0&, 250, AddressOf Programm) ' Timer setzen 250 mSec
End Sub
Public Sub Steuerung()
Application.OnKey "{TAB}", "Balken_hoch_S1"
Application.OnKey "{CAPSLOCK}", "Balken_runter_S1"
Application.OnKey "{UP}", "Balken_hoch_S2"
Application.OnKey "{DOWN}", "Balken_runter_S2"
End Sub
Sub TimerStop()
KillTimer 0&, hTimer ' Timer stoppen
End Sub
|