Kleines Problem beim berechnen der Dim Felder

Übersicht

BlitzBasic

Beginners-Corner

	bruce85 Betreff: Kleines Problem beim berechnen der Dim Felder	Fr, Jan 04, 2008 5:16 Antworten mit Zitat
Hallo, ich möchte beim Dim Feld überprüfen wieviele Gleichfarbige Steine angekettet sind, wenn mehr wie 2 Steine angekettet sind, sollen diese gelöscht werden. Das ist ja kein problem für mich, aber ich bekomme es nur hin in einer Reihe zu löschen und nicht die noch oben drauf sitzen, ich könnte das schon machen, aber mit mehr berechnungen und dadurch wird mein Code dann unübersichtlich. Hier ist mal mein Screen, ich habe die stellen rot Markiert, wie das ungefähr ablaufen soll. http://s6.directupload.net/fil...l8_jpg.htm und hier ist mal mein Code, also wie ich es berechnet habe: Code: [AUSKLAPPEN] [EINKLAPPEN] Function check_paare() For F_y=0 To 12 For F_x=0 To 12 If Spielfeld(F_x,F_y) > 0 Then ;überprüfen ob 3 oder mehr Steine nebeneinander sind, wenn ja, dann löschen If Spielfeld(F_x+1,F_y) = Spielfeld(F_x,F_y) And Spielfeld(F_x+2,F_y) = Spielfeld(F_x,F_y) Then zaehler = 1 While Spielfeld(F_x+zaehler,F_y)=Spielfeld(F_x,F_y) Spielfeld(F_x+zaehler,F_y) = 8 zaehler = zaehler +1 Wend Spielfeld(F_x,F_y) = 8 EndIf If Spielfeld(F_x,F_y+1) = Spielfeld(F_x,F_y) And Spielfeld(F_x,F_y+2) = Spielfeld(F_x,F_y) Then zaehler = 1 While Spielfeld(F_x,F_y+zaehler)=Spielfeld(F_x,F_y) Spielfeld(F_x,F_y+zaehler) = 8 zaehler = zaehler +1 Wend Spielfeld(F_x,F_y) = 8 EndIf EndIf Next Next End Function Das funktioniert zwar, aber es werden nicht alle gelöscht, die mit angekettet sind. Ich möchte also, wenn mehr wie 2 Steine aneinander gekettet sind, das auch diese mit gelöscht werden. Ich wäre euch sehr dankbar, wenn Ihr mir helfen könntet. MfG
AMD Athlon(tm) II X2 250, 8 GB DDR, MSI MSI 770-C45, GeForce GTS 250

bruce85

Betreff: Kleines Problem beim berechnen der Dim Felder

Fr, Jan 04, 2008 5:16
Antworten mit Zitat

Hallo,
ich möchte beim Dim Feld überprüfen wieviele Gleichfarbige Steine angekettet sind, wenn mehr wie 2 Steine angekettet sind, sollen diese gelöscht werden.
Das ist ja kein problem für mich, aber ich bekomme es nur hin in einer Reihe zu löschen und nicht die noch oben drauf sitzen, ich könnte das schon machen, aber mit mehr berechnungen und dadurch wird mein Code dann unübersichtlich.

Hier ist mal mein Screen, ich habe die stellen rot Markiert, wie das ungefähr ablaufen soll.

http://s6.directupload.net/fil...l8_jpg.htm

und hier ist mal mein Code, also wie ich es berechnet habe:
Code: [AUSKLAPPEN]

Function check_paare()
For F_y=0 To 12
For F_x=0 To 12
If Spielfeld(F_x,F_y) > 0 Then
;überprüfen ob 3 oder mehr Steine nebeneinander sind, wenn ja, dann löschen
If Spielfeld(F_x+1,F_y) = Spielfeld(F_x,F_y) And Spielfeld(F_x+2,F_y) = Spielfeld(F_x,F_y) Then
zaehler = 1
While Spielfeld(F_x+zaehler,F_y)=Spielfeld(F_x,F_y)
Spielfeld(F_x+zaehler,F_y) = 8
zaehler = zaehler +1
Wend
Spielfeld(F_x,F_y) = 8
EndIf

If Spielfeld(F_x,F_y+1) = Spielfeld(F_x,F_y) And Spielfeld(F_x,F_y+2) = Spielfeld(F_x,F_y) Then
zaehler = 1
While Spielfeld(F_x,F_y+zaehler)=Spielfeld(F_x,F_y)
Spielfeld(F_x,F_y+zaehler) = 8
zaehler = zaehler +1
Wend
Spielfeld(F_x,F_y) = 8
EndIf
EndIf
Next
Next
End Function

Das funktioniert zwar, aber es werden nicht alle gelöscht, die mit angekettet sind.
Ich möchte also, wenn mehr wie 2 Steine aneinander gekettet sind, das auch diese mit gelöscht werden.

Ich wäre euch sehr dankbar, wenn Ihr mir helfen könntet.

MfG

AMD Athlon(tm) II X2 250, 8 GB DDR, MSI MSI 770-C45, GeForce GTS 250

	The_Nici	Fr, Jan 04, 2008 10:38 Antworten mit Zitat
Denkansatz: Du brauchst eine Funktion, die sich immer wieder welber aufruft. Eine für die Y-Koordinate und eine für die X-Koordinate. Das wichtige dabei ist, dass man am Ende der Funktion ausgiebt, wo die Funktion stehen geblieben ist. Wenn es kein gleichfarbiger ist,gibt die Funktion 0 zurück. Im Falle einer Y-Koordinate müsste die überprüfung dann eines auf der X weiterrücken. Im Falle einer X-Koordinate eines nach oben. kA ob dies da oben nützlich war, aber wichtig ist eine selbstaufrufende Funktion.

The_Nici

Fr, Jan 04, 2008 10:38
Antworten mit Zitat

Denkansatz:
Du brauchst eine Funktion, die sich immer wieder welber aufruft. Eine für die Y-Koordinate und eine für die X-Koordinate. Das wichtige dabei ist, dass man am Ende der Funktion ausgiebt, wo die Funktion stehen geblieben ist. Wenn es kein gleichfarbiger ist,gibt die Funktion 0 zurück. Im Falle einer Y-Koordinate müsste die überprüfung dann eines auf der X weiterrücken. Im Falle einer X-Koordinate eines nach oben.

kA ob dies da oben nützlich war, aber wichtig ist eine selbstaufrufende Funktion.

	HyDr0x	Fr, Jan 04, 2008 13:31 Antworten mit Zitat
Ich weiss ja nicht wie du dir das gedacht hast, aber du müsstest ja auch noch überprüfen, dass wenn du einen Stein änderst nicht wieder 3 gleiche in einer Reihe sind. Das müsste dan ein schon etwas komplizierterer Algorythmus sein der das macht. Du müsstest dann nämlich zusätzlich prüfen welche Farbe nebenan noch nicht verwendet wurde. Edit: Habs getestet es müsste funktionieren. Mit 1 kannst du ein neues Feld erzeugen, mit 2 schaltest du meinen Algorythmus ein und aus. Code: [AUSKLAPPEN] [EINKLAPPEN] Global zahlerx[4] Global zahlery[4] For z = 0 To 3 ;einlesen der werte Read zahlerx[z] Read zahlery[z] Next Data 1,0,-1,0,0,1,0,-1 Global spielfeldende = 12 Global maxfarben = 5 Dim spf(spielfeldende,spielfeldende) Global farb[5] Graphics 800,600 tiles = CreateImage(32,32,6) For i = 0 To 5 SetBuffer ImageBuffer(tiles,i) Color Rnd(0,255),Rnd(0,255),Rnd(0,255) Rect 0,0,32,32,1 Next SetBuffer BackBuffer() For y = 0 To spielfeldende For x = 0 To spielfeldende spf(x,y) = Rnd(0,maxfarben) Next Next Repeat Cls If KeyHit(2) Then an = 1-an If KeyHit(3) Then an2 = 1-an2 If an = True Then For y = 0 To spielfeldende For x = 0 To spielfeldende spf(x,y) = Rnd(0,maxfarben) Next Next If an2 = True Then horizontalfunc() an = False EndIf For y = 0 To spielfeldende For x = 0 To spielfeldende DrawImage tiles,x32,y32,spf(x,y) Next Next Text 0,500,"Neues Feld: "+an Text 0,510,"mein Algorythmus: "+an2 Flip Until KeyHit(1) End ;meine Function Function horizontalfunc() For y = 0 To spielfeldende ;y Koordinate For x = 0 To spielfeldende ;x koordinate For z = 0 To 3 ;z wert für das oben eingelesene If x+zahlerx[z] <= spielfeldende And y+zahlery[z] <= spielfeldende And x+zahlerx[z] => 0 And y+zahlery[z] => 0 Then;Abrfagen ob das Spielfeld ausreicht If spf(x,y)=spf(x+zahlerx[z],y+zahlery[z]) Then ;wenn ja dann abfragen ob 2 Farben nebeneinander gleich sind For u = 0 To 3;Wenn ja dann Fareben vergleichen damit nicht wieder eine doppelt ist If x+zahlerx[u] <= spielfeldende And y+zahlery[u] <= spielfeldende And x+zahlerx[u] => 0 And y+zahlery[u] => 0 Then farb[spf(x+zahlerx[u],y+zahlery[u])] = 0;Farben die schonmal da sind auf 0 setzten damit sie nicht wieder genommen werden For t = 0 To maxfarben ;alle farben abfragen If farb[t] > 0 Then spf(x,y)= farb[t];wenn eine Farbe nicht null ist, also noch nicht genommen wurde dann verwenden Next Next For t = 0 To maxfarben farb[t] = t;Farben wieder zuruecksetzten Next EndIf EndIf Next Next Next End Function

HyDr0x

Fr, Jan 04, 2008 13:31
Antworten mit Zitat

Ich weiss ja nicht wie du dir das gedacht hast, aber du müsstest ja auch noch überprüfen, dass wenn du einen Stein änderst nicht wieder 3 gleiche in einer Reihe sind. Das müsste dan ein schon etwas komplizierterer Algorythmus sein der das macht. Du müsstest dann nämlich zusätzlich prüfen welche Farbe nebenan noch nicht verwendet wurde.

Edit: Habs getestet es müsste funktionieren.

Mit 1 kannst du ein neues Feld erzeugen, mit 2 schaltest du meinen Algorythmus ein und aus.

Code: [AUSKLAPPEN]

Global zahlerx[4]
Global zahlery[4]

For z = 0 To 3 ;einlesen der werte
Read zahlerx[z]
Read zahlery[z]
Next

Data 1,0,-1,0,0,1,0,-1

Global spielfeldende = 12
Global maxfarben = 5

Dim spf(spielfeldende,spielfeldende)
Global farb[5]

Graphics 800,600

tiles = CreateImage(32,32,6)
For i = 0 To 5
SetBuffer ImageBuffer(tiles,i)
Color Rnd(0,255),Rnd(0,255),Rnd(0,255)
Rect 0,0,32,32,1
Next

SetBuffer BackBuffer()

For y = 0 To spielfeldende
For x = 0 To spielfeldende
spf(x,y) = Rnd(0,maxfarben)
Next
Next

Repeat
Cls

If KeyHit(2) Then an = 1-an
If KeyHit(3) Then an2 = 1-an2

If an = True Then

For y = 0 To spielfeldende
For x = 0 To spielfeldende
spf(x,y) = Rnd(0,maxfarben)
Next
Next

If an2 = True Then horizontalfunc()
an = False
EndIf

For y = 0 To spielfeldende
For x = 0 To spielfeldende
DrawImage tiles,x*32,y*32,spf(x,y)
Next
Next

Text 0,500,"Neues Feld: "+an
Text 0,510,"mein Algorythmus: "+an2

Flip
Until KeyHit(1)
End

;meine Function
Function horizontalfunc()
For y = 0 To spielfeldende ;y Koordinate
For x = 0 To spielfeldende ;x koordinate
   For z = 0 To 3 ;z wert für das oben eingelesene
      If x+zahlerx[z] <= spielfeldende And y+zahlery[z] <= spielfeldende And x+zahlerx[z] => 0 And y+zahlery[z] => 0 Then;Abrfagen ob das Spielfeld ausreicht
         If spf(x,y)=spf(x+zahlerx[z],y+zahlery[z]) Then ;wenn ja dann abfragen ob 2 Farben nebeneinander gleich sind
            For u = 0 To 3;Wenn ja dann Fareben vergleichen damit nicht wieder eine doppelt ist
               If x+zahlerx[u] <= spielfeldende And y+zahlery[u] <= spielfeldende And x+zahlerx[u] => 0 And y+zahlery[u] => 0 Then farb[spf(x+zahlerx[u],y+zahlery[u])] = 0;Farben die schonmal da sind auf 0 setzten damit sie nicht wieder genommen werden
               For t = 0 To maxfarben ;alle farben abfragen
                  If farb[t] > 0 Then spf(x,y)= farb[t];wenn eine Farbe nicht null ist, also noch nicht genommen wurde dann verwenden
               Next
            Next
               For t = 0 To maxfarben
               farb[t] = t;Farben wieder zuruecksetzten
               Next
         EndIf
      EndIf
   Next
Next
Next
End Function

	bruce85	Fr, Jan 04, 2008 20:16 Antworten mit Zitat
Vielen Dank. Aber so habe ich das nicht gemeint, es dürfen schon gleichfarbige Steine nebeneinander sein, ich möchte ja nur, wenn mehr wie 2 Steine aneinander sind, das diese Steine wo auch oben drüber und auch vieleicht wieder rechts nebeneinander gleichfarbig sind, gelöscht werden. Mein Code löscht nur die Steine, die in einer Reihe gleichfarbig sind. Ich werde mal kucken, wie ich das ambesten hinbekomme. Lösungsvorschläge sind noch gewünscht, Danke. MfG
AMD Athlon(tm) II X2 250, 8 GB DDR, MSI MSI 770-C45, GeForce GTS 250

bruce85

Fr, Jan 04, 2008 20:16
Antworten mit Zitat

Vielen Dank.

Aber so habe ich das nicht gemeint, es dürfen schon gleichfarbige Steine nebeneinander sein, ich möchte ja nur, wenn mehr wie 2 Steine aneinander sind, das diese Steine wo auch oben drüber und auch vieleicht wieder rechts nebeneinander gleichfarbig sind, gelöscht werden.

Mein Code löscht nur die Steine, die in einer Reihe gleichfarbig sind.

Ich werde mal kucken, wie ich das ambesten hinbekomme.

Lösungsvorschläge sind noch gewünscht, Danke.

MfG

AMD Athlon(tm) II X2 250, 8 GB DDR, MSI MSI 770-C45, GeForce GTS 250

	HyDr0x	Fr, Jan 04, 2008 20:59 Antworten mit Zitat
Wenn du meinen Code bzw. die Funktion innerhalb meines Codes verstanden hast, wird es ein leichtes für dich sein diesen so umzuformen das das was du willst dabei raus kommst.

HyDr0x

Fr, Jan 04, 2008 20:59
Antworten mit Zitat

Wenn du meinen Code bzw. die Funktion innerhalb meines Codes verstanden hast, wird es ein leichtes für dich sein diesen so umzuformen das das was du willst dabei raus kommst.

	PSY	Sa, Jan 05, 2008 3:16 Antworten mit Zitat
Du meinst wohl sowas: Code: [AUSKLAPPEN] [EINKLAPPEN] Graphics3D 640,480,16,2 SetBuffer BackBuffer() cam=createcamera() SeedRnd MilliSecs() Dim feld(8,8) ;88 felder, der wert gibt die farbe an Dim stein(64) Dim checked(8,8) ;feld schon geprüft oder nicht? Global serie%=1, groesste_serie%=1 ;6 farben auf ein 88 spielfeld zufällig verteilen For y=1 To 8 For x=1 To 8 checked(x,y)=false i=i+1 stein(i)=createcube() f=rand(1,6) Select f Case 1: EntityColor stein(i),255,0,0 : feld(x,y)=1 Case 2: EntityColor stein(i),255,255,0 : feld(x,y)=2 Case 3: EntityColor stein(i),120,120,120 : feld(x,y)=3 Case 4: EntityColor stein(i),0,255,0 : feld(x,y)=4 Case 5: EntityColor stein(i),0,255,255 : feld(x,y)=5 Case 6: EntityColor stein(i),0,0,255 : feld(x,y)=6 End Select Next Next ;feld aufbauen For y=0 To 7 For x=0 To 7 PositionEntity stein(1+x+y8),-6+2x,7-2y,13 Next Next Repeat RenderWorld() Text 0,2,"Hit SPACE" Flip Until KeyHit(57) While KeyDown(57) : Wend : FlushKeys ;spielbrett durchsuchen For y=1 To 8 For x=1 To 8 If checked(x,y)=false Then checked(x,y)=true: check(x,y) ;wenn feld noch nicht überprüft wurde, machs jetzt If serie>groesste_serie Then groesste_serie=serie ;aktuelle serie = groesste serie bislang? serie=1 ;serie wieder zurücksetzen, da momentane rekursion beendet Next Next Text 0,15,"Groesste Serie an angrenzenden Feldern gleicher Farbe: "+groesste_serie : Flip : waitkey End ;rekursive funktion, die aneinanderliegende felder auf gleiche farben überprüft Function check(x,y) If x<8 And checked(x+1,y)=false ;feld rechts von aktuellem feld testen If feld(x,y)=feld(x+1,y) Then serie=serie+1 :checked(x+1,y)=true :check(x+1,y) EndIf If x>1 And checked(x-1,y)=false;feld links von aktuellem feld testen If feld(x,y)=feld(x-1,y) Then serie=serie+1 :checked(x-1,y)=true :check(x-1,y) EndIf If y<8 And checked(x,y+1)=false;feld unter aktuellem feld testen If feld(x,y)=feld(x,y+1) Then serie=serie+1 :checked(x,y+1)=true : check(x,y+1) endif If y>1 And checked(x,y-1)=false;feld ueber aktuellem feld testen If feld(x,y)=feld(x,y-1) Then serie=serie+1 :checked(x,y-1)=true:check(x,y-1): EndIf End function Der Code erzeugt ein 88 grosses Feld mit 6 zufälligen Farben. Die Funktion check() überprüft rekursiv, ob angrenzende Spielsteine die gleiche Farbe haben. Müsste eigentlich korrekt funzen, allerdings wird nix gelöscht, sondern nur die zwecks Demonstrationszwecken die längste Kette angrenzender gleichfarbiger Steine ausgegeben (Drück Space). Keine Garantie, bin müde L8er, PSY

PSY

Sa, Jan 05, 2008 3:16
Antworten mit Zitat

Du meinst wohl sowas:

Code: [AUSKLAPPEN]

Graphics3D 640,480,16,2
SetBuffer BackBuffer()

cam=createcamera()
SeedRnd MilliSecs()

Dim feld(8,8) ;8*8 felder, der wert gibt die farbe an
Dim stein(64)
Dim checked(8,8) ;feld schon geprüft oder nicht?
Global serie%=1, groesste_serie%=1

;6 farben auf ein 8*8 spielfeld zufällig verteilen
For y=1 To 8
   For x=1 To 8
         checked(x,y)=false
i=i+1
stein(i)=createcube()
f=rand(1,6)
Select f
   Case 1: EntityColor stein(i),255,0,0    : feld(x,y)=1
Case 2: EntityColor stein(i),255,255,0    : feld(x,y)=2
Case 3: EntityColor stein(i),120,120,120 : feld(x,y)=3
Case 4: EntityColor stein(i),0,255,0    : feld(x,y)=4
Case 5: EntityColor stein(i),0,255,255    : feld(x,y)=5
Case 6: EntityColor stein(i),0,0,255    : feld(x,y)=6
End Select
   Next
Next

;feld aufbauen
For y=0 To 7
   For x=0 To 7
         PositionEntity stein(1+x+y*8),-6+2*x,7-2*y,13
   Next
Next

Repeat
   RenderWorld()
Text 0,2,"Hit SPACE"
Flip
Until KeyHit(57)

While KeyDown(57) : Wend : FlushKeys

;spielbrett durchsuchen
For y=1 To 8
   For x=1 To 8
   If checked(x,y)=false Then checked(x,y)=true: check(x,y) ;wenn feld noch nicht überprüft wurde, machs jetzt
If serie>groesste_serie Then groesste_serie=serie ;aktuelle serie = groesste serie bislang?
serie=1 ;serie wieder zurücksetzen, da momentane rekursion beendet
   Next
Next
Text 0,15,"Groesste Serie an angrenzenden Feldern gleicher Farbe: "+groesste_serie : Flip : waitkey
End

;rekursive funktion, die aneinanderliegende felder auf gleiche farben überprüft
Function check(x,y)

If x<8 And checked(x+1,y)=false ;feld rechts von aktuellem feld testen
   If feld(x,y)=feld(x+1,y) Then serie=serie+1 :checked(x+1,y)=true :check(x+1,y)
EndIf

If x>1 And checked(x-1,y)=false;feld links von aktuellem feld testen
If feld(x,y)=feld(x-1,y) Then serie=serie+1 :checked(x-1,y)=true :check(x-1,y)
EndIf

If y<8 And checked(x,y+1)=false;feld unter aktuellem feld testen
If feld(x,y)=feld(x,y+1) Then serie=serie+1 :checked(x,y+1)=true : check(x,y+1)
endif

If y>1 And checked(x,y-1)=false;feld ueber aktuellem feld testen
If feld(x,y)=feld(x,y-1) Then serie=serie+1 :checked(x,y-1)=true:check(x,y-1):
EndIf

End function

Der Code erzeugt ein 8*8 grosses Feld mit 6 zufälligen Farben.
Die Funktion check() überprüft rekursiv, ob angrenzende Spielsteine die gleiche Farbe haben.

Müsste eigentlich korrekt funzen, allerdings wird nix gelöscht, sondern nur die zwecks Demonstrationszwecken die längste Kette angrenzender gleichfarbiger Steine ausgegeben (Drück Space).

Keine Garantie, bin müde Rolling Eyes

L8er,
PSY

Übersicht

BlitzBasic

Beginners-Corner

Nach Oben

BlitzBasic Portal

Kleines Problem beim berechnen der Dim Felder

bruce85

Betreff: Kleines Problem beim berechnen der Dim Felder

The_Nici

HyDr0x

bruce85

HyDr0x

PSY