PixelWalker

[Skiller]

Hi PB´s,
brauchte ein Programm, welches Pixeln von extern erzeugten Programmen ( z. B. von Mathe o. Vektorprogrammen ) nun in eigenen 2D u. 3D Anwendungen nachfolgt. Vielleicht habt Ihr ja noch Optimierungs- u. Verbesserungsvorschläge.
Gruß Skiller

Code: Alles auswählen

EnableExplicit

;**************************************************************************************
;****************************** PixelWalker *******************************************
;**************************************************************************************
Procedure P_PixWalk_Init(Array aVx(1), Array aVy(1))
  Protected v, x, y 
  For y = -1 To 1 
    For x = -1 To 1
      v + 1
      aVx(v) = x
      aVy(v) = y
    Next x
  Next y 
EndProcedure

Procedure P_PixWalk_FirstXY(*mx_.INTEGER, *my_.INTEGER, Width_, Height_, SearchColor_)
  Protected x, y
  For x = 0 To Width_-1
    For y = 0 To Height_-1
      If Point(x,y) = SearchColor_  
        *mx_\I = x
        *my_\I = y
        Break 2
      EndIf
    Next y
  Next x
EndProcedure

Macro M_PixWalk_V2
   If aV2(rv) = 0
      aV2(rv) = 1
      mx = cx
      my = cy
      dx = aVx(rv)
      dy = aVy(rv)
      Continue  
   EndIf
EndMacro

Procedure PixWalk(Image_, Width_, Height_, SearchColor_, ReplaceColor_)
  #av = 9 ; Array-Vektor
  #cs = 5  ;Color-Search
    
  Define.i mx, my
  Define.i rv, cx, cy, dx, dy
  Define.i ColorSearch, i
  
  rv = 0
  cx = 0
  cy = 0
  ColorSearch = 0     
  
  Dim aV2(#av)
  Dim aVx(#av)
  Dim aVy(#av)
  
  StartDrawing(Image_) 

 ;-------------------------------------------------
  P_PixWalk_Init(aVx(), aVy())
  P_PixWalk_FirstXY(@mx, @my, Width_, Height_, SearchColor_)
 ;-------------------------------------------------
 
  Repeat 
    
    mx + dx
    my + dy   
    
    ;---------------------------------------------------  
    ;Abbruch bei Grenzüberschreitung
    If (mx < 0 Or my < 0) Or (mx >= Width_ Or my >= Height_)
      Break
    EndIf  
    ;---------------------------------------------------  
    ;Farbe suchen und ersetzen      
    If Point(mx,my) = SearchColor_
      Plot(mx,my, ReplaceColor_)
      cx = mx
      cy = my
      ColorSearch = 0
      Continue    
    EndIf
    ;------------
    ;V2 checken 
    rv + 1
    If rv <= #av
      M_PixWalk_V2
    EndIf
    ;------------        
    ;reinitialisieren
    rv = 0
    For i = 1 To #av
      aV2(i) = 0
    Next     
    ColorSearch + 1
    ;--------------------------------------------   
    ;Abbruch wenn keine #SeachColor mehr gefunden wird
    If ColorSearch > #cs
      Break  
    EndIf

  ForEver 
  
  StopDrawing() 
  
EndProcedure  
;**************************************************************************************
;**************************************************************************************
;**************************************************************************************

#Width = 300
#Height= 300
#SearchColor = $FF0000 ;blau
#ReplaceColor= $0000FF ;rot

If OpenWindow(0, 0, 0, #Width, #Height, "Pixelverfolgung", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  
  
  If CreateImage(0, #Width, #Height) And StartDrawing(ImageOutput(0))
    Box(0, 0, #Width, #Height, RGB(255, 255, 255))
    DrawingMode(#PB_2DDrawing_Outlined)
    
    
     ;LineXY(50,90,220,120, #SearchColor);  Beispiel 1
    
      ;Box(50, 50, 100, 100, #SearchColor);  Beispiel 2
    
      Circle(150, 150, 120 ,#SearchColor)  ;Beispiel 3
;     
;     Define.i  x, y                       ;Beispiel 4
;     For x = 40 To 200
;       y = Sin(x * 0.3) * 20 + 150
;       Plot(x,y, RGB(0,0,255)) 
;     Next
    ;      
    StopDrawing() 
    ImageGadget(0, 0, 0, #Width, #Height, ImageID(0))
    
    MessageRequester("Kurze Pause", "Das wird jetzt 'hoffentlich' rot")
    
   ;---------------------------------------------------------------------
    PixWalk(ImageOutput(0), #Width, #Height, #SearchColor, #ReplaceColor)
   ;--------------------------------------------------------------------- 
    
    ImageGadget(0, 0, 0, #Width, #Height, ImageID(0))
    
    
  EndIf
  
  Repeat:Until WaitWindowEvent() = #PB_Event_CloseWindow
  
EndIf