PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

Eigentlich sollte ich ja Delphi Programmieren.....

https://www.purebasic.fr/german/viewtopic.php?t=17926

Seite 1 von 1

Eigentlich sollte ich ja Delphi Programmieren.....

Verfasst: 15.10.2008 10:07
von Franky
Tja, wat soll ich sagen 8)

Edit: Bessere Version, alte VErsion weiter unten:

Code: Alles auswählen

;============================================
;==========FENSTER-PONG======================
;===================by Franky========
;===================Copyright 2008===========
;============================================
;============================================
;============================================

Enumeration 
  #Player1
  #player2
  #Ball
EndEnumeration

Structure Player
      x.l
      y.l
      move.l
      bmove.f
EndStructure

Structure Ball
    x.l
    y.l
    movx.f
    movy.f
EndStructure

ExamineDesktops()

Global Dim Player.Player(1)
Global Ball.Ball
Player(0)\x=10
Player(0)\y=10
player(0)\bmove=5
player(0)\move=25
Player(1)\x=DesktopWidth(0)-110
Player(1)\y=10
player(1)\bmove=5
player(1)\move=25

Ball\x=500
Ball\y=300
Ball\movx=6
Ball\movy=7

Structure Desk
    width.l
    height.l
EndStructure



For a=0 To 1
    OpenWindow(a,Player(a)\x,Player(a)\y,50,200,"Player"+Str(a),#PB_Window_Normal)
    StickyWindow(a,#True)
Next

OpenWindow(#ball,Ball\x,Ball\y,50,50,"",#PB_Window_BorderLess)
    StickyWindow(#ball,#True)
    SetWindowColor(#ball,RGB(255,0,0))
Repeat
    While WindowEvent(): Wend 
    Delay(5)
Until GetAsyncKeyState_(#VK_SPACE)<>0
Repeat
    While WindowEvent():Wend
    Delay(15)
    Ball\x=Ball\x+Ball\movx
    Ball\y=Ball\y+Ball\movy
    ResizeWindow(#Ball,BAll\x,Ball\y,#PB_Ignore,#PB_Ignore)
    For a=0 To 1
        ResizeWindow(a,Player(a)\x,Player(a)\y,#PB_Ignore,#PB_Ignore)
    Next
    If GetAsyncKeyState_(#VK_W)<>0
            Player(0)\y=Player(0)\y-Player(0)\move
            If Player(0)\y<0
                Player(0)\y=0
            EndIf
    EndIf
    If GetAsyncKeyState_(#VK_S)<>0
            Player(0)\y=Player(0)\y+Player(0)\move
            If Player(0)\y>DesktopHeight(0)-100
                Player(0)\y=DesktopHeight(0)-100
            EndIf
    EndIf
    If GetAsyncKeyState_(#VK_UP)<>0
            Player(1)\y=Player(1)\y-Player(1)\move
            If Player(1)\y<0
                Player(1)\y=0
            EndIf
    EndIf
    If GetAsyncKeyState_(#VK_DOWN)<>0
            Player(1)\y=Player(1)\y+Player(1)\move
            If Player(1)\y>DesktopHeight(0)-200
                Player(1)\y=DesktopHeight(0)-200
            EndIf
    EndIf
    
    If Ball\movx<0
        If Ball\x<Player(0)\x+WindowWidth(0) And (Ball\y>Player(0)\y-50) And Ball\y<Player(0)\y+WindowHeight(#Player1)
            Player(1)\bmove=Player(1)\bmove+0.5
            Ball\movx=(6+Random(Player(1)\bmove))
        EndIf
    EndIf

    If Ball\movx>0
        If Ball\x+WindowWidth(#Ball)>Player(1)\x And (Ball\y>Player(1)\y-50) And Ball\y<Player(1)\y+WindowHeight(#Player2)
            Player(0)\bmove=Player(0)\bmove+0.5
            Ball\movx=-(6+Random(Player(0)\bmove))
        EndIf
    EndIf

    
    If Ball\x<0
          quit=2
    ElseIf Ball\x>DesktopWidth(0)-WindowWidth(#ball)
          quit=1
    EndIf
    
    If Ball\y<0 And Ball\movy<0
        Ball\movy=(6+Random(5))
    EndIf

    If Ball\y>DesktopHeight(0) And Ball\movy>0
        Ball\movy=-(6+Random(5))
    EndIf
Until quit<>0

MessageRequester("Gewinner:","Gewonnen hat Spieler"+Str(quit))

Code: Alles auswählen

;============================================
;==========FENSTER-PONG======================
;===================by Franky========
;===================Copyright 2008===========
;============================================
;============================================
;============================================

Enumeration 
  #Player1
  #player2
  #Ball
EndEnumeration

Structure Player
      x.l
      y.l
      move.l
EndStructure

Structure Ball
    x.l
    y.l
    movx.f
    movy.f
EndStructure

ExamineDesktops()

Global Dim Player.Player(1)
Global Ball.Ball
Player(0)\x=10
Player(0)\y=10
player(0)\move=25
Player(1)\x=DesktopWidth(0)-110
Player(1)\y=10
player(1)\move=25

Ball\x=500
Ball\y=300
Ball\movx=12
Ball\movy=14

Structure Desk
    width.l
    height.l
EndStructure



For a=0 To 1
    OpenWindow(a,Player(a)\x,Player(a)\y,50,200,"Player"+Str(a),#PB_Window_Normal)
    StickyWindow(a,#True)
Next

OpenWindow(#ball,Ball\x,Ball\y,50,50,"",#PB_Window_BorderLess)
    StickyWindow(#ball,#True)
    SetWindowColor(#ball,RGB(255,0,0))
    
Repeat
    While WindowEvent():Wend
    Delay(5)
    Ball\x=Ball\x+Ball\movx
    Ball\y=Ball\y+Ball\movy
    ResizeWindow(#Ball,BAll\x,Ball\y,#PB_Ignore,#PB_Ignore)
    For a=0 To 1
        ResizeWindow(a,Player(a)\x,Player(a)\y,#PB_Ignore,#PB_Ignore)
    Next
    If GetAsyncKeyState_(#VK_W)<>0
            Player(0)\y=Player(0)\y-Player(0)\move
            If Player(0)\y<0
                Player(0)\y=0
            EndIf
    EndIf
    If GetAsyncKeyState_(#VK_S)<>0
            Player(0)\y=Player(0)\y+Player(0)\move
            If Player(0)\y>DesktopHeight(0)-100
                Player(0)\y=DesktopHeight(0)-100
            EndIf
    EndIf
    If GetAsyncKeyState_(#VK_UP)<>0
            Player(1)\y=Player(1)\y-Player(1)\move
            If Player(1)\y<0
                Player(1)\y=0
            EndIf
    EndIf
    If GetAsyncKeyState_(#VK_DOWN)<>0
            Player(1)\y=Player(1)\y+Player(1)\move
            If Player(1)\y>DesktopHeight(0)-200
                Player(1)\y=DesktopHeight(0)-200
            EndIf
    EndIf
    
    If Ball\movx<0
        If Ball\x<Player(0)\x+WindowWidth(0) And (Ball\y>Player(0)\y-50) And Ball\y<Player(0)\y+WindowHeight(#Player1)
            Ball\movx=(10+Random(5))
        EndIf
    EndIf

    If Ball\movx>0
        If Ball\x>Player(1)\x And (Ball\y>Player(1)\y-50) And Ball\y<Player(1)\y+WindowHeight(#Player2)
            Ball\movx=-(10+Random(5))
        EndIf
    EndIf

    
    If Ball\x<0
          quit=1
    ElseIf Ball\x>1180
          quit=1
    EndIf
    
    If Ball\y<0 And Ball\movy<0
        Ball\movy=(10+Random(5))
    EndIf

    If Ball\y>DesktopHeight(0) And Ball\movy>0
        Ball\movy=-(10+Random(5))
    EndIf
Until quit=1
Ne schönheit ist der Code nicht, aber für 10 Minuten programmieren (und nebenbei noch Delphi programmieren) find ich´s garnicht mal schlecht.


Steuerung:
w
s

î
|
\/

Verfasst: 15.10.2008 11:32
von Ground0
Super für mal schnell... allerdings wars bei mir erst Spielbar ab einem Delay von 15

Gruss G0

Verfasst: 15.10.2008 13:11
von Kaeru Gaman
LOL ... was eine abgedrehte idee ... :allright:


*untern Arm klemm* *nach CT&T schlepp*
"Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten ... einfach nur cool sein."

Verfasst: 15.10.2008 13:29
von bommel
:allright: Gefällt mir.
Aber auf einem Bildschirm im 16:10-Format wohl nicht spielbar, oder? Jedenfalls nicht, ohne den Code anzupassen.

Verfasst: 15.10.2008 13:30
von ts-soft
Wenn ich run drücke sehe ich kurz das rote quadrat und bevor ich
überhaupt die Finger an den Tasten habe ist es aus :mrgreen:

Verfasst: 15.10.2008 19:52
von Franky
ts-soft hat geschrieben:Wenn ich run drücke sehe ich kurz das rote quadrat und bevor ich
überhaupt die Finger an den Tasten habe ist es aus :mrgreen:
Willkommen in den 40ern :mrgreen:

@(Noch) junger Rest:
Ja, dass es leicht schwer zu spielen ist, weiß ich, ich hätt ja noch ne Start-Taste einbauen können. Aber war halt ne Nebenbei-Aktion und n Pingpong aus fenstern wollt ich immer schon bauen

Verfasst: 15.10.2008 20:27
von ts-soft
Franky hat geschrieben:Willkommen in den 40ern :mrgreen:
Was hat das damit zu tun? Es gibt mit Sicherheit keinen Menschen auf dieser
Erde, der das auf meinem oder schnelleren PC schafft.
Wie sollte das gehen, der Weg ist bei meiner Auflösung viel zu weit

Verfasst: 15.10.2008 20:43
von Max_der_Held
o_O.. ich seh ja kaum nen ball.. wenn man das delay erhöht kann mans erkennen ^^. (Quadcore Q6600 und Gforce 8800GTX)
und beim 16:10 monitor ist die gewinnchance gleich 0 o_O ;) ( wie wärs in zeile 109 mit desktopwidth(0) -50?)
aber lustige Idee ^^ :mrgreen:

Verfasst: 16.10.2008 20:47
von Batze
Nur um mal drauf hinzuweisen wie verbreitet die Idee doch ist. :lol:
http://purearea.net/pb/CodeArchiv/Games ... pTennis.pb
Alle Zeiten sind UTC+02:00
Seite 1 von 1

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de