In einem DIM-Feld gleiche Werte finden ... - wichtig!

Übersicht BlitzBasic Beginners-Corner

Neue Antwort erstellen

JPD

Betreff: In einem DIM-Feld gleiche Werte finden ... - wichtig!

 BeitragSa, Jan 15, 2005 13:17
Antworten mit Zitat
Benutzer-Profile anzeigen
Hallo,

also ich habe ein DIM feld z.B. P(X,Y) ... ich habe 4 verschiedene Farben. Wenn sich mindestens 3 Farben vertikal, horizontal oder diagonal in Reihe befinden sollen diese entfernt werden.

Z.B.

Code: [AUSKLAPPEN]

00401101001
10141555550
11014100010
11011410010 -siehe 4444 oder 55555


Ich habe zwar einen Code, nur ist dieser 40 Zeilen lang und drückt meine FPS auf 10 runter ... gibts da ne schnelle Lösung`?

MfG J.P.D

Kryan

 BeitragSa, Jan 15, 2005 14:08
Antworten mit Zitat
Benutzer-Profile anzeigen
Dim senkrecht$(10)
Dim horizontal$(10)
For i=1 To 10
for j=1 To 10
senkrecht$(i)=senkrecht$(i)+LEVEL(i,j)
horizontal$(j)=horizontal$(j)+LEVEL(i,j)
Next
Next
For i=1 To 10
For j=0 To 4
If Instr(senkrecht$(i),String$(Str$(j),3)) Then senkrecht$(i)=Replace$(senkrecht$(i),String$(Str$(j),3," "
End If
If Instr(horizontal$(i),String$(Str$(j),3)) Then horizontal$(i)=Replace$(horizontal$(i),String$(Str$(j),3," "
End If
Next
Next
For i=1 To 10
For j=1 To 10
If Level(i,j)<>Int(Mid$(senkrecht$(i))) Then Level(i,j)=Int(Mid$(senkrecht$(i)))
End If
If Level(i,j)<>Int(Mid$(horizontal$(i))) Then Level(i,j)=Int(Mid$(horizontal$(i)))
ENd If
Next
Next

Das dürfte für Horizontal und Senkrecht klappen
Diagonal geht wahrscheinlich genauso

Viel Spaß mit dem code Wink
Webspaceanbieter?
Klick hier!
Kultige Spieleschmiede?
Klick hier!

JPD

 BeitragSa, Jan 15, 2005 14:13
Antworten mit Zitat
Benutzer-Profile anzeigen
Also:

Ich habe ein Feld mit 20x20. Das heißt, bei waagrecht / senkrecht würde ein String mit 400 Zeichen entstehen. Wie's diagonal funktionieren soll, muss ich noch überlegen.

MfG JPD

JPD

 BeitragSa, Jan 15, 2005 15:40
Antworten mit Zitat
Benutzer-Profile anzeigen
Ne, also der Code tut zwar auch, aber komm von 75 fps auf 30!!!! Des kanns doch net sein.

Muss mal das Web danach durchwühlen ...

mfg JPD Confused
 

noir

 BeitragSa, Jan 15, 2005 16:34
Antworten mit Zitat
Benutzer-Profile anzeigen
also durch diesen code dürftest du nicht soviele frames verlieren!
das liegt eher an etwas anderem...
 

junky

 BeitragSa, Jan 15, 2005 16:42
Antworten mit Zitat
Benutzer-Profile anzeigen
jup - zeig lieber mal deinen Code...
wenn es sowas wie ein Brettspiel ist (hört sich in der Beschreibung so an), dann musste ja z.B. nit in jedem Schleifendurchlauf diese Abfrage machen - deshalb wäre es schon wichtig, WIE du diese Abfrage einsetzt
gestern stand ich noch vorm Abgrund
heute bin ich einen Schritt weiter...

JPD

 BeitragSa, Jan 15, 2005 17:36
Antworten mit Zitat
Benutzer-Profile anzeigen
Naja, schaut euch mal die Version1 an. Die 2 funzt eh net so.

Code: [AUSKLAPPEN]

If K = 0
For ZG = 1 To 20
For ZF = 1 To 20
F$ = ""
G$ = ""
H$ = ""
I$ = ""
F$ = Str$(P(ZF,ZG)) + Str$(P(ZF+1,ZG)) + Str$(P(ZF+2,ZG)) + Str$(P(ZF+3,ZG)) ;Horizontal
G$ = Str$(P(ZF,ZG)) + Str$(P(ZF,ZG+1)) + Str$(P(ZF,ZG+2)) + Str$(P(ZF,ZG+3)) ;Diagonal
H$ = Str$(P(ZF,ZG)) + Str$(P(ZF+1,ZG+1)) + Str$(P(ZF+2,ZG+2)) + Str$(P(ZF+3,ZG+3)) ;Rechtsrunter vertikal
I$ = Str$(P(ZF,ZG)) + Str$(P(ZF-1,ZG+1)) + Str$(P(ZF-2,ZG+2)) + Str$(P(ZF-3,ZG+3)) ;Linksrunter vertikal

For K = 1 To 5
   If F$ = String$(Str$(K),ZL) Then
      P(ZF,ZG)= 0
      P(ZF+1,ZG) = 0
      P(ZF+2,ZG) = 0
      P(ZF+3,ZG) = 0
   EndIf
   
   If G$ = String$(Str$(K),ZL) Then
      P(ZF,ZG)= 0
      P(ZF,ZG+1) = 0
      P(ZF,ZG+2) = 0
      P(ZF,ZG+3) = 0
   EndIf

   If H$ = String$(Str$(K),ZL) Then
      P(ZF,ZG)= 0
      P(ZF+1,ZG+1) = 0
      P(ZF+2,ZG+2) = 0
      P(ZF+3,ZG+3) = 0
   EndIf

   If I$ = String$(Str$(K),ZL) Then
      P(ZF,ZG)= 0
      P(ZF-1,ZG+1) = 0
      P(ZF-2,ZG+2) = 0
      P(ZF-3,ZG+3) = 0
   EndIf

   
Next
Next
Next
EndIf


Dieser Code funktioniert wunderbar mit 4erReihen. Aber zu langsam!
 

junky

 BeitragSa, Jan 15, 2005 17:50
Antworten mit Zitat
Benutzer-Profile anzeigen
habs mir nit nehmen lassen und mal en bisl was zusammengebastelt... Wink - stelle da aber keine Geschwindigkeitseinbußen fest.
ich hoffe der Code hilft dir weiter - wenn noch Fragen sind, frag 8)
Code: [AUSKLAPPEN]

Graphics(640, 480 ,32, 2)

;================================================;

Global BoardX=220
Global BoardY=140
Global BoardWidth=200
Global BoardHeight=200
Dim Board(4,4)
Global ImageField
Global FieldCounter

;================================================;

ImageField=CreateImage(47, 47, 4)
SetBuffer(ImageBuffer(ImageField, 1))
Color(150, 0, 0)
Rect(0, 0, 47, 47, 1)
SetBuffer(ImageBuffer(ImageField, 2))
Color(0, 0, 150)
Rect(0, 0, 47, 47, 1)



ImageBoard=CreateImage(200, 200)
SetBuffer(ImageBuffer(ImageBoard))
Color(200, 200, 200)
Rect(0, 0, 200, 200, 0)
For a=1 To 4
   Line(a*50, 0, a*50, 200)
Next
For a=1 To 4
   Line(0, a*50, 200, a*50)
Next

;================================================;

Function CheckMouse()
   FieldX=MouseX()-BoardX
   FieldY=MouseY()-BoardY
   If FieldX>0 And FieldX<BoardWidth And FieldY>0 And FieldY<BoardHeight
      For x=1 To 4
         If FieldX<50 : Exit : EndIf
         FieldX=FieldX-50
      Next
      For y=1 To 4
         If FieldY<50 : Exit : EndIf
         FieldY=FieldY-50
      Next
      If MouseHit(1)
         If FieldCounter=0
            Board(x,y)=1
            CheckBoard()
         EndIf
      EndIf
   EndIf
End Function

Function DrawFields()
   For y=1 To 4
      For x=1 To 4
         If Board(x,y)>0
            DrawImage(ImageField, BoardX+((x-1)*50)+2, BoardY+((y-1)*50)+2, Board(x,y))
         EndIf
      Next
   Next
End Function

Function CheckBoard()
   For x=1 To 4
      For y=1 To 2
         If Board(x,y) And Board(x,y+1) And Board(x,y+2)
            FieldCounter = 100
            Board(x,y)   = 2
            Board(x,y+1) = 2
            Board(x,y+2) = 2
            Return(1)
         EndIf
      Next
   Next
   For y=1 To 4
      For x=1 To 2
         If Board(x,y) And Board(x+1,y) And Board(x+2,y)
            FieldCounter = 100
            Board(x,y)   = 2
            Board(x+1,y) = 2
            Board(x+2,y) = 2
            Return(1)
         EndIf
      Next
   Next
   For x=1 To 2
      For y=1 To 2
         If Board(x,y) And Board(x+1,y+1) And Board(x+2,y+2)
            FieldCounter = 100
            Board(x,y)     = 2
            Board(x+1,y+1) = 2
            Board(x+2,y+2) = 2
            Return(1)
         EndIf
      Next
   Next
   For x=3 To 4
      For y=1 To 2
         If Board(x,y) And Board(x-1,y+1) And Board(x-2,y+2)
            FieldCounter = 100
            Board(x,y)     = 2
            Board(x-1,y+1) = 2
            Board(x-2,y+2) = 2
            DebugLog(4)
            Return(1)
         EndIf
      Next
   Next
End Function

Function CheckFieldCounter()
   If FieldCounter>0
      FieldCounter=FieldCounter-1
      If FieldCounter=0
         For y=1 To 4
            For x=1 To 4
               If Board(x,y)=2
                  Board(x,y)=0
               EndIf
            Next
         Next
      EndIf
   EndIf
End Function

;================================================;

Global SysTime, FpsTime, FpsCT, FPS
Function CheckFPS()
   SysTime=MilliSecs()
   If SysTime>FpsTime+1000
      FPS=FpsCT : FpsTime=SysTime : FpsCT=0
   Else
      FpsCT=FpsCT+1
   EndIf
End Function

;================================================;

SetBuffer(BackBuffer())
Repeat
   Cls
   CheckFPS()
   CheckMouse()
   CheckFieldCounter()
   DrawImage(ImageBoard, BoardX, BoardY)
   DrawFields()
   Text(0, 0, FPS)
   Flip
Until KeyHit(1)
End
gestern stand ich noch vorm Abgrund
heute bin ich einen Schritt weiter...

JPD

 BeitragSa, Jan 15, 2005 18:00
Antworten mit Zitat
Benutzer-Profile anzeigen
ok, danke erstmal, melde mich wieder bei Problemen Wink ...

mfg JPD

Neue Antwort erstellen


Übersicht BlitzBasic Beginners-Corner

Nach Oben

Gehe zu:

Powered by phpBB © 2001 - 2006, phpBB Group