4k - PingPong

    Diese Seite verwendet Cookies. Durch die Nutzung unserer Seite erklären Sie sich damit einverstanden, dass wir Cookies setzen. Weitere Informationen

    Unsere Datenschutzerklärung wurde aktualisiert. Mit der Nutzung unseres Forums akzeptierst Du unsere Datenschutzerklärung. Du bestätigst zudem, dass Du mindestens 16 Jahre alt bist.

    • 4k - PingPong

      Das gute ale Videospiel nachempfunden für den Wettbewerb. Man muß schon sehr konzentriert spielen, der Computer irrt sich sehr selten. Steuerung mit den Pfeiltasten hoch und runter.

      [Blockierte Grafik: http://s21.postimage.org/s5i3muu7n/Screen_08_03_2013_14_Uhr_29_31_Sek.jpg]

      Quellcode

      1. ' 4k-Wettbewerb @Volkmar 2013
      2. Declare Int SX, SY, CX, CY, SW, SL, FL, FO, FW, FH, BX, BY, BRV, BRH, SP, CP, VZ, TI
      3. WindowTitle "Ping Pong 5"
      4. WindowStyle 24
      5. Window 600, 400
      6. CLS 0
      7. Randomize
      8. FL = 4 : FO = 4
      9. FW = Width(%HWnd, 0) - 2 * FL
      10. FH = Height(%HWnd, 0) - 2 * FO
      11. SW = 2
      12. SL = 30
      13. SX = 4 : CX = FW - (4 + SW)
      14. SY = FO
      15. CY = FO
      16. BX = FW \ 2
      17. BY = 6 + Rnd(FH - 12)
      18. BRH = 1
      19. VZ = 10
      20. MCLS FW, FH, 0
      21. UserMessages 16
      22. While %UMessage <> 16
      23. TI = &gettickcount
      24. If (SP + CP) < 7
      25. Malen
      26. Else
      27. Ergebnis
      28. EndIf
      29. If (CY + 9) > BY
      30. If BRH
      31. If BX > ((FW \ 3) * 2)
      32. Dec CY, 2
      33. EndIf
      34. EndIf
      35. ElseIf CY < (FH - SL)
      36. If BRH
      37. If BX > ((FW \ 3) * 2)
      38. Inc CY, 2
      39. EndIf
      40. EndIf
      41. EndIf
      42. If IsKey(38)
      43. If SY > FO
      44. Dec SY, 2
      45. EndIf
      46. ElseIf IsKey(40)
      47. If SY < (FH - SL)
      48. Inc SY, 2
      49. EndIf
      50. ElseIf IsKey(93) Or IsKey(2)
      51. Menu
      52. EndIf
      53. While 1
      54. Case &gettickcount-TI > VZ : BREAK
      55. Sleep 1
      56. EndWhile
      57. EndWhile
      58. Proc Menu
      59. CreateMenu
      60. AppendMenu 1, "&Langsam"
      61. AppendMenu 2, "&Mittel"
      62. AppendMenu 3, "&Schnell"
      63. If SL > 28
      64. AppendMenu 8, "Schläger &Klein"
      65. Else
      66. AppendMenu 9, "Schläger &groß"
      67. EndIf
      68. TrackMenu 0, 0
      69. If MenuItem(1)
      70. VZ = 22
      71. ElseIf MenuItem(2)
      72. VZ = 16
      73. ElseIf MenuItem(3)
      74. VZ = 10
      75. ElseIf MenuItem(8)
      76. SL = 20
      77. ElseIf MenuItem(9)
      78. SL = 30
      79. EndIf
      80. EndProc
      81. Proc BallCalc
      82. If BRH
      83. If (BX > (FW - 13)) And (BY > CY) And (BY < (CY + SL))
      84. BRH = 0
      85. Sound 300, 20
      86. ElseIf BX > FW - 8
      87. BRH = 0
      88. Sound 1400, 28
      89. Inc SP
      90. Else
      91. Inc BX, 2
      92. EndIf
      93. Else
      94. If (BX < 11) And (BY > SY) And (BY < (SY + SL))
      95. BRH = 1
      96. Sound 300, 20
      97. ElseIf BX < 6
      98. BRH = 1
      99. Sound 1400, 28
      100. Inc CP
      101. Else
      102. Dec BX, 2
      103. EndIf
      104. EndIf
      105. If BRV
      106. If BY > FH - 8
      107. BRV = 0
      108. Sound 1200, 16
      109. Else
      110. Inc BY, 2
      111. EndIf
      112. Else
      113. If BY < 7
      114. BRV = 1
      115. Sound 1200, 16
      116. Else
      117. Dec BY, 2
      118. EndIf
      119. EndIf
      120. EndProc
      121. Proc Punkte
      122. UseFont "COURIER NEW", 24, 0, 1, 0, 0
      123. TextColor RGB(200, 220, 32), -1
      124. DrawText (FW \ 2) - 22, 10, (FW \ 2) - 4, 30, Str$(CP), 1
      125. DrawText (FW \ 2) + 4, 10, (FW \ 2) + 22, 30, Str$(SP), 1
      126. EndProc
      127. Proc Ergebnis
      128. StartPaint -1
      129. UseBrush 1, 0
      130. UsePen 0, 1, RGB(240, 64, 64)
      131. Rectangle 0, 0 - FW, FH
      132. Line FW \ 2 , 2 - FW \ 2 , FH - 4
      133. Punkte
      134. UseFont "ARIAL", 24, 0, 0, 0, 0
      135. If SP > CP
      136. TextColor RGB(0, 255, 48), -1
      137. DrawText 22, 96, "Du hast gewonnen"
      138. Else
      139. TextColor RGB(255, 96, 0), -1
      140. DrawText 22, 96, "Du hast verloren"
      141. EndIf
      142. EndPaint
      143. MCopyBMP 0, 0 - FW, FH > FL, FO; 0
      144. EndProc
      145. Proc Malen
      146. BallCalc
      147. StartPaint -1
      148. UseBrush 1, 0
      149. UsePen 0, 1, RGB(240, 64, 64)
      150. Rectangle 0, 0 - FW, FH
      151. Line FW \ 2 , 2 - FW \ 2 , FH - 2
      152. UsePen 0, 1, RGB(240, 240, 64)
      153. Rectangle SX, SY - SW + SX, SY + SL - 2
      154. UsePen 0, 1, RGB(64, 240, 240)
      155. Rectangle CX, CY - CX + SW, CY + SL - 2
      156. UsePen 0, 1, RGB (240, 64, 64)
      157. UseBrush 1, RGB(240, 64, 64)
      158. Ellipse BX - 3, (BY - 3) - BX + 8, BY + 8
      159. Punkte
      160. EndPaint
      161. MCopyBMP 0, 0 - FW, FH > FL, FO; 0
      162. EndProc
      Alles anzeigen
      Gruß Volkmar
    • Hehe, das macht richtig Spass, da kommt richtig 8 Bit-Feeling hoch. :-)

      Fenster könnte allerdings etwas größer sein. Was noch stört ist, dass das Spiel etwas unregelmässig abläuft, mal läuft es recht zügig, dann stockt es wieder. Da fehlt vielleicht eine Synkronisation. - Sound höre ich seltsamerweise auch nicht. Kann natürlich alles an meinem lahmen Netbook liegen, probiere ich nachher nochmal am PC.
      :pc2:

      Vielleicht hast du auch noch Platz für ein/zwei Extras, sind ja erst 3k? :-D
      Gruß, Frank
    • Ach ja. Statt ~getAsyncKeyState(n) kannst Du die XProfanfunktion isKey(n) ersetzen. Die macht das Gleiche und Du brauchst keine Header-Datei ... und funktioniert auch mit FreeProfan64.

      Gruß
      Roland
      (Intel Duo E8400 3,0 GHz / 4 GB RAM / 250 GB HDD / ATI Radeon HD4770 512 MB / Windows Vista - ausgemustert zum Verkauf)
      AMD Athlon II X2 2,9 GHz / 8 GB RAM / 500 + 1000 GB HDD / ATI Radeon 3000 (onboard) / Windows 10(64) - XProfan X4


      http://www.xprofan.de
    • Frabbing;960279 schrieb:

      Header-Dateien sind kein Problem, wie im Ausschreibungs-Thread schon beschrieben. :-)


      Ja, aber in diesem Fall ist sie unnötig, da isKey exakt das gleiche macht! (Und es spart einige Bytes Programmcode. ;-) )

      Gruß
      Roland
      (Intel Duo E8400 3,0 GHz / 4 GB RAM / 250 GB HDD / ATI Radeon HD4770 512 MB / Windows Vista - ausgemustert zum Verkauf)
      AMD Athlon II X2 2,9 GHz / 8 GB RAM / 500 + 1000 GB HDD / ATI Radeon 3000 (onboard) / Windows 10(64) - XProfan X4


      http://www.xprofan.de
    • Neue Version, danke für den Tip, Roland. Größeres Fenster und Optionen: 3 Geschwindigkeiten und 2 Schlägergrößen zu erreichen über rechte Maustate oder Kontexttaste. Abschlußmeldung kann nicht mehr versehentlich "abgeschossen" werden.
      Bei mir läuft's auf Vista und Win7 gleichmäßig, keine Geschwindigkeitsänderungen. Es wird ja immer bei einem wmTimer der Tastaturstatus abgefragt und dann die Schläger- und Ballposition neu berechnet und angezeigt.

      Quellcode

      1. ' 4k-Wettbewerb @Volkmar 2013
      2. Declare Int SX, SY, CX, CY, SW, SL, FL, FO, FW, FH, BX, BY, BRV, BRH, SP, CP, IT
      3. WindowTitle "Ping Pong 2"
      4. WindowStyle 24
      5. Window 600, 400
      6. CLS 0
      7. FL = 4 : FO = 4
      8. FW = Width(%HWnd, 0) - 2 * FL
      9. FH = Height(%HWnd, 0) - 2 * FO
      10. SW = 2
      11. SL = 30
      12. SX = 4 : CX = FW - (4 + SW)
      13. SY = FO
      14. CY = FO
      15. BX = FW \ 2
      16. BY = FH \ 2
      17. BRH = 1
      18. MCLS FW, FH, 0
      19. SetTimer 16:IT = 1
      20. UserMessages 16
      21. While %UMessage <> 16
      22. If (SP + CP) < 7
      23. Malen
      24. Else
      25. Ergebnis
      26. EndIf
      27. WaitInput
      28. If %wmTimer
      29. If (CY + 9) > BY
      30. If BRH
      31. If BX > ((FW \ 3) * 2)
      32. Dec CY, 2
      33. EndIf
      34. EndIf
      35. ElseIf CY < (FH - SL)
      36. If BRH
      37. If BX > ((FW \ 3) * 2)
      38. Inc CY, 2
      39. EndIf
      40. EndIf
      41. EndIf
      42. If IsKey(38)
      43. If SY > FO
      44. Dec SY, 2
      45. EndIf
      46. ElseIf IsKey(40)
      47. If SY < (FH - SL)
      48. Inc SY, 2
      49. EndIf
      50. ElseIf IsKey(93) Or IsKey(2)
      51. Menu
      52. EndIf
      53. EndIf
      54. EndWhile
      55. Case IT:KillTimer
      56. Proc Menu
      57. CreateMenu
      58. AppendMenu 1, "&Langsam"
      59. AppendMenu 2, "&Mittel"
      60. AppendMenu 3, "&Schnell"
      61. If SL > 28
      62. AppendMenu 8, "Schläger &Klein"
      63. Else
      64. AppendMenu 9, "Schläger &groß"
      65. EndIf
      66. TrackMenu 0, 0
      67. If MenuItem(1)
      68. KillTimer
      69. SetTimer 20
      70. ElseIf MenuItem(2)
      71. KillTimer
      72. SetTimer 16
      73. ElseIf MenuItem(3)
      74. Killtimer
      75. SetTimer 14
      76. ElseIf MenuItem(8)
      77. SL = 20
      78. ElseIf MenuItem(9)
      79. SL = 30
      80. EndIf
      81. EndProc
      82. Proc BallCalc
      83. If BRH
      84. If (BX > (FW - 13)) And (BY > CY) And (BY < (CY + SL))
      85. BRH = 0
      86. Sound 300, 20
      87. ElseIf BX > FW - 8
      88. BRH = 0
      89. Sound 1400, 28
      90. Inc SP
      91. Else
      92. Inc BX, 2
      93. EndIf
      94. Else
      95. If (BX < 11) And (BY > SY) And (BY < (SY + SL))
      96. BRH = 1
      97. Sound 300, 20
      98. ElseIf BX < 6
      99. BRH = 1
      100. Sound 1400, 28
      101. Inc CP
      102. Else
      103. Dec BX, 2
      104. EndIf
      105. EndIf
      106. If BRV
      107. If BY > FH - 8
      108. BRV = 0
      109. Sound 1200, 16
      110. Else
      111. Inc BY, 2
      112. EndIf
      113. Else
      114. If BY < 7
      115. BRV = 1
      116. Sound 1200, 16
      117. Else
      118. Dec BY, 2
      119. EndIf
      120. EndIf
      121. EndProc
      122. Proc Punkte
      123. UseFont "COURIER NEW", 24, 0, 1, 0, 0
      124. TextColor RGB(200, 220, 32), -1
      125. DrawText (FW \ 2) - 22, 10, (FW \ 2) - 4, 30, Str$(CP), 1
      126. DrawText (FW \ 2) + 4, 10, (FW \ 2) + 22, 30, Str$(SP), 1
      127. EndProc
      128. Proc Ergebnis
      129. StartPaint -1
      130. UseBrush 1, 0
      131. UsePen 0, 1, RGB(240, 64, 64)
      132. Rectangle 0, 0 - FW, FH
      133. Line FW \ 2 , 2 - FW \ 2 , FH - 4
      134. Punkte
      135. UseFont "ARIAL", 24, 0, 0, 0, 0
      136. If SP > CP
      137. TextColor RGB(0, 255, 48), -1
      138. DrawText 22, 96, "Du hast gewonnen"
      139. Else
      140. TextColor RGB(255, 96, 0), -1
      141. DrawText 22, 96, "Du hast verloren"
      142. EndIf
      143. EndPaint
      144. MCopyBMP 0, 0 - FW, FH > FL, FO; 0
      145. Case IT:KillTimer:IT = 0
      146. EndProc
      147. Proc Malen
      148. BallCalc
      149. StartPaint -1
      150. UseBrush 1, 0
      151. UsePen 0, 1, RGB(240, 64, 64)
      152. Rectangle 0, 0 - FW, FH
      153. Line FW \ 2 , 2 - FW \ 2 , FH - 2
      154. UsePen 0, 1, RGB(240, 240, 64)
      155. Rectangle SX, SY - SW + SX, SY + SL - 2
      156. UsePen 0, 1, RGB(64, 240, 240)
      157. Rectangle CX, CY - CX + SW, CY + SL - 2
      158. UsePen 0, 1, RGB (240, 64, 64)
      159. UseBrush 1, RGB(240, 64, 64)
      160. Ellipse BX - 3, (BY - 3) - BX + 8, BY + 8
      161. Punkte
      162. EndPaint
      163. MCopyBMP 0, 0 - FW, FH > FL, FO; 0
      164. EndProc
      Alles anzeigen


      Gruß Volkmar
    • Die Einstellungen sind klasse! :-)

      Tempo läuft aber nach wie vor instabil, wobei ich denke, dass die Technik SetTimer 14 / 16 / 20 auch eher ungeeignet ist. Sooo genau sind diese Timer ja nicht, dass sie millisekundengenau arbeiten. Auch GetTickCount ist so ein Kandidat und ermittelt mitunter nicht sonderlich genau, auf meinem Netbook beträgt die Genauigkeit oft nur 16 ms. ;-)

      Mit dem Timer aus der WinMM-Lib hab ich bessere Erfahrungen gemacht, der ist wirklich millisekundengenau:

      Quellcode

      1. Def timeGetTime(0)!"WINMM","timeGetTime"
      2. Def timeBeginPeriod(1)!"WINMM","timeBeginPeriod"
      3. Def timeEndPeriod(1)!"WINMM","timeEndPeriod"
      4. timeBeginPeriod(1)
      5. WhileLoop 2000
      6. AddString "Wert in ms: "+Str$(timeGetTime())
      7. EndWhile
      8. ListBox$("Counter",2)
      9. WaitInput
      10. timeEndPeriod(1)
      11. End
      Alles anzeigen
      P.S.: Hier mal ein Genauigkeitstest von SetTimer:

      Quellcode

      1. Cls
      2. SetTimer 8
      3. WhileLoop 100
      4. WaitInput
      5. AddString "Wert in ms: "+Str$(&gettickcount)
      6. EndWhile
      7. KillTimer
      8. ListBox$("Counter",2)
      9. WaitInput
      10. End
      Alles anzeigen
      Gruß, Frank
    • Frabbing;960401 schrieb:

      Mit dem Timer aus der WinMM-Lib hab ich bessere Erfahrungen gemacht, der ist wirklich millisekundengenau


      Genau der wird schon seit vielen Profan-Versionen für &GetTickCount genutzt! ;-) &GetTickCount ist in der Tat millisekundengenau!

      Gruß
      Roland
      (Intel Duo E8400 3,0 GHz / 4 GB RAM / 250 GB HDD / ATI Radeon HD4770 512 MB / Windows Vista - ausgemustert zum Verkauf)
      AMD Athlon II X2 2,9 GHz / 8 GB RAM / 500 + 1000 GB HDD / ATI Radeon 3000 (onboard) / Windows 10(64) - XProfan X4


      http://www.xprofan.de
    • Frabbing;960443 schrieb:

      Du meinst wohl &GetTickCount...

      Ja, natürlich. Ich hab's korrigiert.
      Hin und wieder programmiere ich ja auch mal nicht mit XProfan. ;-)

      Verräter! :-D

      Gruß
      Roland
      (Intel Duo E8400 3,0 GHz / 4 GB RAM / 250 GB HDD / ATI Radeon HD4770 512 MB / Windows Vista - ausgemustert zum Verkauf)
      AMD Athlon II X2 2,9 GHz / 8 GB RAM / 500 + 1000 GB HDD / ATI Radeon 3000 (onboard) / Windows 10(64) - XProfan X4


      http://www.xprofan.de
    • Eine &GetTickCount-Lösung gefällt mir nicht so gut. Da kann ich das Spiel am Lüftergeräusch erkennen :D. Damit geht die Prozessorlast steil nach oben. Wie sieht es denn mit der Genauigkeit von Sleep aus? Hier mal eine Variante damit

      Quellcode

      1. ' 4k-Wettbewerb @Volkmar 2013
      2. Declare Int SX, SY, CX, CY, SW, SL, FL, FO, FW, FH, BX, BY, BRV, BRH, SP, CP, VZ
      3. WindowTitle "Ping Pong 3"
      4. WindowStyle 24
      5. Window 600, 400
      6. CLS 0
      7. FL = 4 : FO = 4
      8. FW = Width(%HWnd, 0) - 2 * FL
      9. FH = Height(%HWnd, 0) - 2 * FO
      10. SW = 2
      11. SL = 30
      12. SX = 4 : CX = FW - (4 + SW)
      13. SY = FO
      14. CY = FO
      15. BX = FW \ 2
      16. BY = FH \ 2
      17. BRH = 1
      18. VZ = 10
      19. MCLS FW, FH, 0
      20. UserMessages 16
      21. While %UMessage <> 16
      22. If (SP + CP) < 7
      23. Malen
      24. Else
      25. Ergebnis
      26. EndIf
      27. Sleep VZ
      28. If (CY + 9) > BY
      29. If BRH
      30. If BX > ((FW \ 3) * 2)
      31. Dec CY, 2
      32. EndIf
      33. EndIf
      34. ElseIf CY < (FH - SL)
      35. If BRH
      36. If BX > ((FW \ 3) * 2)
      37. Inc CY, 2
      38. EndIf
      39. EndIf
      40. EndIf
      41. If IsKey(38)
      42. If SY > FO
      43. Dec SY, 2
      44. EndIf
      45. ElseIf IsKey(40)
      46. If SY < (FH - SL)
      47. Inc SY, 2
      48. EndIf
      49. ElseIf IsKey(93) Or IsKey(2)
      50. Menu
      51. EndIf
      52. EndWhile
      53. Proc Menu
      54. CreateMenu
      55. AppendMenu 1, "&Langsam"
      56. AppendMenu 2, "&Mittel"
      57. AppendMenu 3, "&Schnell"
      58. If SL > 28
      59. AppendMenu 8, "Schläger &Klein"
      60. Else
      61. AppendMenu 9, "Schläger &groß"
      62. EndIf
      63. TrackMenu 0, 0
      64. If MenuItem(1)
      65. VZ = 22
      66. ElseIf MenuItem(2)
      67. VZ = 16
      68. ElseIf MenuItem(3)
      69. VZ = 10
      70. ElseIf MenuItem(8)
      71. SL = 20
      72. ElseIf MenuItem(9)
      73. SL = 30
      74. EndIf
      75. EndProc
      76. Proc BallCalc
      77. If BRH
      78. If (BX > (FW - 13)) And (BY > CY) And (BY < (CY + SL))
      79. BRH = 0
      80. Sound 300, 20
      81. ElseIf BX > FW - 8
      82. BRH = 0
      83. Sound 1400, 28
      84. Inc SP
      85. Else
      86. Inc BX, 2
      87. EndIf
      88. Else
      89. If (BX < 11) And (BY > SY) And (BY < (SY + SL))
      90. BRH = 1
      91. Sound 300, 20
      92. ElseIf BX < 6
      93. BRH = 1
      94. Sound 1400, 28
      95. Inc CP
      96. Else
      97. Dec BX, 2
      98. EndIf
      99. EndIf
      100. If BRV
      101. If BY > FH - 8
      102. BRV = 0
      103. Sound 1200, 16
      104. Else
      105. Inc BY, 2
      106. EndIf
      107. Else
      108. If BY < 7
      109. BRV = 1
      110. Sound 1200, 16
      111. Else
      112. Dec BY, 2
      113. EndIf
      114. EndIf
      115. EndProc
      116. Proc Punkte
      117. UseFont "COURIER NEW", 24, 0, 1, 0, 0
      118. TextColor RGB(200, 220, 32), -1
      119. DrawText (FW \ 2) - 22, 10, (FW \ 2) - 4, 30, Str$(CP), 1
      120. DrawText (FW \ 2) + 4, 10, (FW \ 2) + 22, 30, Str$(SP), 1
      121. EndProc
      122. Proc Ergebnis
      123. StartPaint -1
      124. UseBrush 1, 0
      125. UsePen 0, 1, RGB(240, 64, 64)
      126. Rectangle 0, 0 - FW, FH
      127. Line FW \ 2 , 2 - FW \ 2 , FH - 4
      128. Punkte
      129. UseFont "ARIAL", 24, 0, 0, 0, 0
      130. If SP > CP
      131. TextColor RGB(0, 255, 48), -1
      132. DrawText 22, 96, "Du hast gewonnen"
      133. Else
      134. TextColor RGB(255, 96, 0), -1
      135. DrawText 22, 96, "Du hast verloren"
      136. EndIf
      137. EndPaint
      138. MCopyBMP 0, 0 - FW, FH > FL, FO; 0
      139. 'Case IT:KillTimer:IT = 0
      140. EndProc
      141. Proc Malen
      142. BallCalc
      143. StartPaint -1
      144. UseBrush 1, 0
      145. UsePen 0, 1, RGB(240, 64, 64)
      146. Rectangle 0, 0 - FW, FH
      147. Line FW \ 2 , 2 - FW \ 2 , FH - 2
      148. UsePen 0, 1, RGB(240, 240, 64)
      149. Rectangle SX, SY - SW + SX, SY + SL - 2
      150. UsePen 0, 1, RGB(64, 240, 240)
      151. Rectangle CX, CY - CX + SW, CY + SL - 2
      152. UsePen 0, 1, RGB (240, 64, 64)
      153. UseBrush 1, RGB(240, 64, 64)
      154. Ellipse BX - 3, (BY - 3) - BX + 8, BY + 8
      155. Punkte
      156. EndPaint
      157. MCopyBMP 0, 0 - FW, FH > FL, FO; 0
      158. EndProc
      Alles anzeigen


      Gruß Volkmar
    • Noch 'ne Variante, &GetTickCount + Sleep. Dank an Frank für den Hinweis.

      Quellcode

      1. ' 4k-Wettbewerb @Volkmar 2013
      2. Declare Int SX, SY, CX, CY, SW, SL, FL, FO, FW, FH, BX, BY, BRV, BRH, SP, CP, VZ, TI
      3. WindowTitle "Ping Pong 4"
      4. WindowStyle 24
      5. Window 600, 400
      6. CLS 0
      7. FL = 4 : FO = 4
      8. FW = Width(%HWnd, 0) - 2 * FL
      9. FH = Height(%HWnd, 0) - 2 * FO
      10. SW = 2
      11. SL = 30
      12. SX = 4 : CX = FW - (4 + SW)
      13. SY = FO
      14. CY = FO
      15. BX = FW \ 2
      16. BY = FH \ 2
      17. BRH = 1
      18. VZ = 10
      19. MCLS FW, FH, 0
      20. UserMessages 16
      21. While %UMessage <> 16
      22. TI = &gettickcount
      23. If (SP + CP) < 7
      24. Malen
      25. Else
      26. Ergebnis
      27. EndIf
      28. If (CY + 9) > BY
      29. If BRH
      30. If BX > ((FW \ 3) * 2)
      31. Dec CY, 2
      32. EndIf
      33. EndIf
      34. ElseIf CY < (FH - SL)
      35. If BRH
      36. If BX > ((FW \ 3) * 2)
      37. Inc CY, 2
      38. EndIf
      39. EndIf
      40. EndIf
      41. If IsKey(38)
      42. If SY > FO
      43. Dec SY, 2
      44. EndIf
      45. ElseIf IsKey(40)
      46. If SY < (FH - SL)
      47. Inc SY, 2
      48. EndIf
      49. ElseIf IsKey(93) Or IsKey(2)
      50. Menu
      51. EndIf
      52. While 1
      53. Case &gettickcount-TI > VZ : BREAK
      54. Sleep 1
      55. EndWhile
      56. EndWhile
      57. Proc Menu
      58. CreateMenu
      59. AppendMenu 1, "&Langsam"
      60. AppendMenu 2, "&Mittel"
      61. AppendMenu 3, "&Schnell"
      62. If SL > 28
      63. AppendMenu 8, "Schläger &Klein"
      64. Else
      65. AppendMenu 9, "Schläger &groß"
      66. EndIf
      67. TrackMenu 0, 0
      68. If MenuItem(1)
      69. VZ = 22
      70. ElseIf MenuItem(2)
      71. VZ = 16
      72. ElseIf MenuItem(3)
      73. VZ = 10
      74. ElseIf MenuItem(8)
      75. SL = 20
      76. ElseIf MenuItem(9)
      77. SL = 30
      78. EndIf
      79. EndProc
      80. Proc BallCalc
      81. If BRH
      82. If (BX > (FW - 13)) And (BY > CY) And (BY < (CY + SL))
      83. BRH = 0
      84. Sound 300, 20
      85. ElseIf BX > FW - 8
      86. BRH = 0
      87. Sound 1400, 28
      88. Inc SP
      89. Else
      90. Inc BX, 2
      91. EndIf
      92. Else
      93. If (BX < 11) And (BY > SY) And (BY < (SY + SL))
      94. BRH = 1
      95. Sound 300, 20
      96. ElseIf BX < 6
      97. BRH = 1
      98. Sound 1400, 28
      99. Inc CP
      100. Else
      101. Dec BX, 2
      102. EndIf
      103. EndIf
      104. If BRV
      105. If BY > FH - 8
      106. BRV = 0
      107. Sound 1200, 16
      108. Else
      109. Inc BY, 2
      110. EndIf
      111. Else
      112. If BY < 7
      113. BRV = 1
      114. Sound 1200, 16
      115. Else
      116. Dec BY, 2
      117. EndIf
      118. EndIf
      119. EndProc
      120. Proc Punkte
      121. UseFont "COURIER NEW", 24, 0, 1, 0, 0
      122. TextColor RGB(200, 220, 32), -1
      123. DrawText (FW \ 2) - 22, 10, (FW \ 2) - 4, 30, Str$(CP), 1
      124. DrawText (FW \ 2) + 4, 10, (FW \ 2) + 22, 30, Str$(SP), 1
      125. EndProc
      126. Proc Ergebnis
      127. StartPaint -1
      128. UseBrush 1, 0
      129. UsePen 0, 1, RGB(240, 64, 64)
      130. Rectangle 0, 0 - FW, FH
      131. Line FW \ 2 , 2 - FW \ 2 , FH - 4
      132. Punkte
      133. UseFont "ARIAL", 24, 0, 0, 0, 0
      134. If SP > CP
      135. TextColor RGB(0, 255, 48), -1
      136. DrawText 22, 96, "Du hast gewonnen"
      137. Else
      138. TextColor RGB(255, 96, 0), -1
      139. DrawText 22, 96, "Du hast verloren"
      140. EndIf
      141. EndPaint
      142. MCopyBMP 0, 0 - FW, FH > FL, FO; 0
      143. EndProc
      144. Proc Malen
      145. BallCalc
      146. StartPaint -1
      147. UseBrush 1, 0
      148. UsePen 0, 1, RGB(240, 64, 64)
      149. Rectangle 0, 0 - FW, FH
      150. Line FW \ 2 , 2 - FW \ 2 , FH - 2
      151. UsePen 0, 1, RGB(240, 240, 64)
      152. Rectangle SX, SY - SW + SX, SY + SL - 2
      153. UsePen 0, 1, RGB(64, 240, 240)
      154. Rectangle CX, CY - CX + SW, CY + SL - 2
      155. UsePen 0, 1, RGB (240, 64, 64)
      156. UseBrush 1, RGB(240, 64, 64)
      157. Ellipse BX - 3, (BY - 3) - BX + 8, BY + 8
      158. Punkte
      159. EndPaint
      160. MCopyBMP 0, 0 - FW, FH > FL, FO; 0
      161. EndProc
      Alles anzeigen


      Gruß Volkmar