Multiplayer Grundlage von ???
Hoi Leuts! Ich hab mal ein kleines Proggy gemacht, das zeigt, wie man mit Direct Play Multiplayer Games machen kann! Dabei kann man mit bis zu 50 Kreisen online herumlaufen und deren Farbe wechseln. Natürlich kann man auch Chatten.

Hier der Code:

[code:1:f6b770e8fd]
;---------Vorbereiten
Const vers$ = "V2"
Graphics 640, 480, 16, 2 ;Grafikmodus
AppTitle "US Multiplayer Test"+vers$ ;Titel des Programms

Global eingabe$ ;Variable für Input Aktionen
Global ausgabe ;Variable für Ausgaben von FUnktionen
Global host ;Ist man der Host?
Global mynum ;Welche Multiplayer Nummer hat man?
Global myplayer ;Welchen Spieler aus dem Array steuert man?
myplayer = -1 ;Myplayer auf -1 sonst wäre man direkt Spieler mit nr. 0!

Const pl_c=50 ;Maximale Player Anzahl (player count)
Dim pl_on(pl_c) ;Player Da?
Dim pl_rgb(pl_c) ;Color
Dim pl_x(pl_c) ;X Pos
Dim pl_y(pl_c) ;Y Pos

Dim msg$(10) ;Nachrichten

For i = 0 To pl_c ;Schleife zum setzen der Player Werte
pl_on(i)=0 ;
pl_rgb(i)=1 ;Farbe
pl_x(i)=640/2 ;X In Mitte
pl_y(i)=480/2 ;Y In Mitte
Next ;


;---------Connecten/Hosten?!
StopNetGame
Print "Willkommen zum US Multiplayer Test! "+vers$
.start_joinorhost
Print " "
eingabe$ = Input("Möchtest du joinen oder hosten? Gebe J oder H ein! Oder x zum Beenden!")
If eingabe$ = "x" Then End
If eingabe$ <> "J" And eingabe$ <> "H" Then Print "Falsche Eingabe!" Gosub start_joinorhost
If eingabe$ = "H" Then Gosub start_host
If eingabe$ = "J" Then Gosub start_join


;---------Hosten!
.start_host
host=1
ausgabe = HostNetGame ("US_MP_TEST")
If ausgabe <> 2 Then Print "Fehler! Spiel konnte nicht erstellt werden! :(" Gosub start_joinorhost
Print "Das Spiel wurde erfolgreich erstellt! ^_^"
myplayer=0 ;(Der Hoster ist automatisch Player 0!)
pl_on(0)=1 ;
Gosub start_makeplayer


;---------Connecten!
.start_join
host=0
eingabe$ = Input ("Gebe bitte eine IP Adresse ein oder x zum Beenden:")
If eingabe$ = "x" Then End
ausgabe = JoinNetGame ("US_MP_TEST", eingabe$)
If ausgabe <> 1 Then Print "Fehler! Spiel konnte nicht gejoint werden! :(" Gosub start_joinorhost
Print "Das Spiel wurde erfolgreich gejoint! ^_^"
pl_on(0)=1 ;Array Platz 0 ist automatisch schon vom Hoster belegt!
Gosub start_makeplayer


;---------Player erstellen
.start_makeplayer
eingabe$ = Input ("Wie möchtest du heissen? Gebe einen Namen ein oder x zum Beenden:")
If eingabe$ = "x" Then End
If eingabe$ = "" Then Print "Du musst was eingeben!" Gosub start_makeplayer
ausgabe = CreateNetPlayer (eingabe$)
If ausgabe = 0 Then Print "Fehler! Konnte keinen Spieler erstellen :(" Gosub start_joinorhost
Print "Spieler erfolgreich erstellt! Deine Multiplayer Nummer ist "+ ausgabe
mynum=ausgabe
Print "Bitte eine Taste drücken!"
WaitKey()
Gosub runtime




;---------Runtime
.runtime
Repeat
SetBuffer BackBuffer()
Cls
Color 255,255,255


;Beenden
If KeyDown(1) Then End

;Chatten
If KeyHit(57) Then FlushKeys: SendNetMsg 1, Input("Say:" ), mynum, 0, 1

;Bewegen
If myplayer > -1
x=pl_x(myplayer)
y=pl_y(myplayer)
If KeyDown(2) Then pl_rgb(myplayer)=1 :SendNetMsg 3, myplayer+","+pl_rgb(myplayer), mynum, 0, 1: write_msg("Color = 1")
If KeyDown(3) Then pl_rgb(myplayer)=2 :SendNetMsg 3, myplayer+","+pl_rgb(myplayer), mynum, 0, 1: write_msg("Color = 2")
If KeyDown(4) Then pl_rgb(myplayer)=3 :SendNetMsg 3, myplayer+","+pl_rgb(myplayer), mynum, 0, 1: write_msg("Color = 3")
If KeyDown(5) Then pl_rgb(myplayer)=4 :SendNetMsg 3, myplayer+","+pl_rgb(myplayer), mynum, 0, 1: write_msg("Color = 4")
If KeyDown(6) Then pl_rgb(myplayer)=5 :SendNetMsg 3, myplayer+","+pl_rgb(myplayer), mynum, 0, 1: write_msg("Color = 5")
If KeyDown(7) Then pl_rgb(myplayer)=6 :SendNetMsg 3, myplayer+","+pl_rgb(myplayer), mynum, 0, 1: write_msg("Color = 6")
If KeyDown(8) Then pl_rgb(myplayer)=7 :SendNetMsg 3, myplayer+","+pl_rgb(myplayer), mynum, 0, 1: write_msg("Color = 7")
If KeyDown(9) Then pl_rgb(myplayer)=8 :SendNetMsg 3, myplayer+","+pl_rgb(myplayer), mynum, 0, 1: write_msg("Color = 8")
If KeyDown(10)Then pl_rgb(myplayer)=9 :SendNetMsg 3, myplayer+","+pl_rgb(myplayer), mynum, 0, 1: write_msg("Color = 9")
If KeyDown(200) Then pl_y(myplayer)=pl_y(myplayer)-10
If KeyDown(205) Then pl_x(myplayer)=pl_x(myplayer)+10
If KeyDown(208) Then pl_y(myplayer)=pl_y(myplayer)+10
If KeyDown(203) Then pl_x(myplayer)=pl_x(myplayer)-10
If x<>pl_x(myplayer) Or y<>pl_y(myplayer) Then SendNetMsg 2, myplayer+","+pl_x(myplayer)+","+pl_y(myplayer), mynum, 0, 0
EndIf


;Nachrichten erhalten
While RecvNetMsg() = 1
typ=NetMsgType()
mssg$=NetMsgData()
from=NetMsgFrom()
name$=NetPlayerName$(from)
If typ=1 Then write_msg(name$+": "+mssg$) ;Chat Nachricht
If typ=2 Then setpos(mssg$) ;Postion setzen
If typ=3 Then setcolor(mssg$) ;Farbe setzen
If typ=10 Then myplayer=mssg$: pl_on(myplayer)=1 ;Spieler bekommt Spielernummer!
If typ=11 Then zahl=mssg$: pl_on(zahl)=1 ;Spieler aktivieren
If typ=100 Then write_msg(name$+" hat gejoint! :)") ;Neuer Spieler Nachricht
If typ=100 Then SendNetMsg (11, myplayer, mynum, from, 1) ;Neuem Spieler die Eigene Nummer sagen, damit einen sieht!
If typ=100 And host=1 Then give_nummer(from) ;Neuem Spieler eine Nummer zuteilen geben!
If typ=101 Then write_msg("Spieler ist gegangen! :(") ;Spieler ist gegangen!
If typ=102 Then write_msg("Der Hoster ist weg! Du bist jetzt der Host!"):Host=1 ;Host ist gegangen! Du bist Host!
If typ=200 Then write_msg("EIN FEHLER IST AUFGETRETEN! PROGRAMM ABGEBROCHEN!") ;Fehler
Wend


;Spieler Anzeigen
For i=0 To pl_c
If pl_on(i)=1 Then
Select pl_rgb(i)
Case 1 Color 100,100,100
Case 2 Color 200,0,0
Case 3 Color 0,200,0
Case 4 Color 0,0,200
Case 5 Color 200,200,0
Case 6 Color 0,200,200
Case 7 Color 200,0,200
Case 8 Color 200,200,200
Case 9 Color 50,50,50
End Select
Oval pl_x(i)+16, pl_y(i)+16, 32, 32, 1
EndIf
Next

;Nachrichten Anzeigen
Color 255,255,255
For i=0 To 10
Text 5, 20*i, msg$(i)
Next


;Info Text
Text 5, 460, "Programm läuft! Pfeiltasten=Bewegen, Space=Chatten, ESC=Beenden, 1-9=Color"

Delay 50
Flip
Forever




;----------Funktionen
Function write_msg(nachricht$) ;Eine Nachricht anzeigen
Local i ;
For i=0 To 9 ;
msg$(i)=msg$(i+1) ;
Next ;
msg$(10)=nachricht$ ;
End Function ;

Function give_nummer(target) ;Neuem Spieler ein Array Nummer geben
Local freenum, x ;
x=1 ;
freenum=0 ;
While freenum=0 ;
If pl_on(x)=0 Then freenum=x ;
x=x+1 ;
Wend ;
SendNetMsg (10, freenum, mynum, target, 1) ;Nummer speziell an den Spieler der sie angefordert hat senden
SendNetMsg (11, freenum, mynum, 0, 1) ;Nummer an alle Senden
write_msg("Player "+target+" hat Kreis Nr. "+freenum+" bekommen!") ;
pl_on(freenum)=1 ;
End Function ;

Function setpos(pstr$) ;Andere Spieler an gesendete Position setzen
Local sub1$, sub2$, sub3$, sub1n, sub2n, sub3n, pos, pos2 ;
pos = Instr (pstr$, ",", 1) ;
sub1$ = Mid$ (pstr$, 1, pos-1) ;
pos2 = Instr (pstr$, ",", pos+1) ;
sub2$ = Mid$ (pstr$, pos+1, pos2-(pos+1)) ;
sub3$ = Mid$ (pstr$, pos2+1, -1) ;
sub1n=sub1$ ;
sub2n=sub2$ ;
sub3n=sub3$ ;
pl_x(sub1n)=sub2n ;
pl_y(sub1n)=sub3n ;
End Function ;

Function setcolor(pstr$) ;Andere Spieler Farbe setzen
Local sub1$, sub2$, sub1n, sub2n, pos, pos2 ;
pos = Instr (pstr$, ",", 1) ;
sub1$ = Mid$ (pstr$, 1, pos-1) ;
sub2$ = Mid$ (pstr$, pos+1, -1) ;
sub1n=sub1$ ;
sub2n=sub2$ ;
pl_rgb(sub1n)=sub2n ;
End Function ;
[/code:1:f6b770e8fd]

Dazu muss ich noch was sagen:
Wenn man joint und schon andere da sind, werden deren Positionen und Farben nicht direkt übermittelt! Erst wenn sie sich ändern. Kreise von Spielern die gehen bleiben da.

Außerdem:
Wenn man etwas sagt, wird es bei einem selbst nicht nochmal angezeigt! Bei den anderen kommt es aber an!!!

Ich wünsche Viel Spass mit dem kleinen Prog
Vielleicht hilft es ja irgend jemandem :D
===
von ???
Hi!
sehr gut!
endlich hat sich mal jemand die mühe gemacht, und
ein funktionierendes Example zu DP gecodet. Es funktioniert
mit localhost, mit anderen habe ich es noch nicht probiert, wird
aber sicherlich auch gehn.
mfg olli
===
von ???
Joa funzt auch online, hab ich getestet.
Schön das es jemandem gefällt :D
===
von ???
:D
Genial danke für den Code. Das hat eine Menge arbeit gespart.
===
von ???
ich bin ganz alleine mit meinem schönen kreis :cry:
===
von ???
Wieso alleine mit den Kreisen?
===
von ???
WOW, danke, ohne dich würde ich bestimmt 2 Stunden mehr am Online StarTrade sitzen !!
Dankedankedankedankedankedankedanke !!!!!!!!!!!!!
===
von ???
NP, mach ich doch gerne 8)

Den Code habe ich übrigens ursprünglich nicht fürs Code Archiv geschrieben sondern nur um selbst zu sehen wie das so Funktioniert. Deshalb sind einige Sachen nicht so toll gelöst ...



Suche:
(unterstützt mySQL Wildcards ala %)
Titel:
Text:
Autor: