Eigentlich sollte ich ja Delphi Programmieren.....

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Antworten
Benutzeravatar
Franky
Beiträge: 1132
Registriert: 29.08.2004 16:31
Wohnort: Münsterland
Kontaktdaten:
Kontaktdaten von Franky

Eigentlich sollte ich ja Delphi Programmieren.....

Beitrag 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

î
|
\/
Zuletzt geändert von Franky am 23.12.2011 01:09, insgesamt 2-mal geändert.
Falsch zugeordnetes Zitat des Tages: "O'zapft is" - Edward Snowden :)
Nach oben
Benutzeravatar
Ground0
Beiträge: 318
Registriert: 05.02.2005 02:09
Wohnort: Stilli, Schweiz
Kontaktdaten:
Kontaktdaten von Ground0

Beitrag von Ground0 »

Super für mal schnell... allerdings wars bei mir erst Spielbar ab einem Delay von 15

Gruss G0
lmon Monitoring Service inkl. Clients
lweb Multi-Threaded Webserver
lbup-server Backup Server applikation
lmanager ERP Applikation.
Nach oben
Kaeru Gaman
Beiträge: 17389
Registriert: 10.11.2004 03:22

Beitrag 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."
Der Narr denkt er sei ein weiser Mann.
Der Weise weiß, dass er ein Narr ist.
Nach oben
bommel
Beiträge: 32
Registriert: 31.07.2006 13:21

Beitrag von bommel »

:allright: Gefällt mir.
Aber auf einem Bildschirm im 16:10-Format wohl nicht spielbar, oder? Jedenfalls nicht, ohne den Code anzupassen.
PB 4
Nach oben
Benutzeravatar
ts-soft
Beiträge: 22292
Registriert: 08.09.2004 00:57
Computerausstattung: Mainboard: MSI 970A-G43
CPU: AMD FX-6300 Six-Core Processor
GraKa: GeForce GTX 750 Ti, 2 GB
Memory: 16 GB DDR3-1600 - Dual Channel
Wohnort: Berlin

Beitrag 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:
PureBasic 5.73 LTS | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Nutella hat nur sehr wenig Vitamine. Deswegen muss man davon relativ viel essen.
Bild
Nach oben
Benutzeravatar
Franky
Beiträge: 1132
Registriert: 29.08.2004 16:31
Wohnort: Münsterland
Kontaktdaten:
Kontaktdaten von Franky

Beitrag 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
Falsch zugeordnetes Zitat des Tages: "O'zapft is" - Edward Snowden :)
Nach oben
Benutzeravatar
ts-soft
Beiträge: 22292
Registriert: 08.09.2004 00:57
Computerausstattung: Mainboard: MSI 970A-G43
CPU: AMD FX-6300 Six-Core Processor
GraKa: GeForce GTX 750 Ti, 2 GB
Memory: 16 GB DDR3-1600 - Dual Channel
Wohnort: Berlin

Beitrag 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
PureBasic 5.73 LTS | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Nutella hat nur sehr wenig Vitamine. Deswegen muss man davon relativ viel essen.
Bild
Nach oben
Benutzeravatar
Max_der_Held
Beiträge: 595
Registriert: 18.04.2006 17:01
Wohnort: Bavaria
Kontaktdaten:
Kontaktdaten von Max_der_Held

Beitrag 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:
Nach oben
Benutzeravatar
Batze
Beiträge: 1492
Registriert: 03.06.2005 21:58
Wohnort: Berlin
Kontaktdaten:
Kontaktdaten von Batze

Beitrag von Batze »

Nur um mal drauf hinzuweisen wie verbreitet die Idee doch ist. :lol:
http://purearea.net/pb/CodeArchiv/Games ... pTennis.pb
Hier sind meine Codes (aber die Seite geht gerade nicht):
http://www.basicpure.de.vu
Nach oben
Antworten

Zurück zu „Code, Tipps und Tricks“