PureBasic Forums - English

Posted: **Wed Jun 15, 2005 1:37 am**

i am trying to write my own drawing fill routine for my personal usage! i know purebasic has the command FillArea() - but this command doesnt do the job as i need!

So i tried to code a routine that fills any object(s) / background(s) - Even objects where the outline uses more as only color instead the pure command require! (I found an article about this in an basic coding book from 1986 and tried to rewrite it for purebasic)

The trick is to check only for the backgroundcolor you want to fill (or replace)... just take a look to the bad code and you may realise how it would work...

Code: Select all

Procedure MyFill(x,y,lColorSrc.l,lColorDes.l)
  
  If Point(x,y) = lColorDes 
    ;
  Else
    If Point(x,y) = lColorSrc
      ;
      If x > 0 And y > 0  
        Plot(x,y,lColorDes)
      EndIf
      ;
      ; ---- Check nearest pixel ----
      ;
      If Point (x-1, y  ) = lColorSrc : MyFill (x-1, y  , lColorSrc, lColorDes) : EndIf
      If Point (x+1, y  ) = lColorSrc : MyFill (x+1, y  , lColorSrc, lColorDes) : EndIf
;     If Point (x  , y-1) = lColorSrc : MyFill (x  , y-1, lColorSrc, lColorDes) : EndIf
      If Point (x  , y+1) = lColorSrc : MyFill (x  , y+1, lColorSrc, lColorDes) : EndIf 
    EndIf
  EndIf
  
EndProcedure

The routine works in my example as long as i unmark the 3rd if condition... I dont like this way (because of resulting an Overflow and i dont like Gotos!!) - If someone can help me to recode the routine and maybe speed it up, would be really cool! Thanks!

Edit: You have to call StartDrawing() before calling MyFill() procedure and call StopDrawing() after MyFill!

Posted: **Wed Jun 15, 2005 1:50 am**

If you are having problems with the 3rd "if" then maybe this will help. Sorry if it doesn't, haven't tried it.

Code: Select all

Procedure MyFill(x,y,lColorSrc.l,lColorDes.l) 
  
  If Point(x,y) = lColorDes 
    ; 
  Else 
    If Point(x,y) = lColorSrc 
      ; 
      If x > 0 And y > 0  
        Plot(x,y,lColorDes) 
      ; 
      ; ---- Check nearest pixel ---- 
      ; 
      If Point (x-1, y  ) = lColorSrc : MyFill (x-1, y  , lColorSrc, lColorDes) : EndIf 
      If Point (x+1, y  ) = lColorSrc : MyFill (x+1, y  , lColorSrc, lColorDes) : EndIf 
;     If Point (x  , y-1) = lColorSrc : MyFill (x  , y-1, lColorSrc, lColorDes) : EndIf 
      If Point (x  , y+1) = lColorSrc : MyFill (x  , y+1, lColorSrc, lColorDes) : EndIf
     EndIf
   EndIf
 EndIf 
  
EndProcedure

Posted: **Wed Jun 15, 2005 2:08 am**

oh sorry, i think i explained the 3rd if condition problem a bit wired... i mean the 3rd if condition in following part...

If Point (x-1, y ) = lColorSrc : MyFill (x-1, y , lColorSrc, lColorDes) : EndIf
If Point (x+1, y ) = lColorSrc : MyFill (x+1, y , lColorSrc, lColorDes) : EndIf
; If Point (x , y-1) = lColorSrc : MyFill (x , y-1, lColorSrc, lColorDes) : EndIf ; <<<< Its this If condition
If Point (x , y+1) = lColorSrc : MyFill (x , y+1, lColorSrc, lColorDes) : EndIf

Btw, i just search for a more code friendly and maybe faster routine
Thanks for the fast answer J. Baker

(ps: your routine doesnt work)

Posted: **Wed Jun 15, 2005 2:16 am**

If you could post a little more of your source, I might be able to help more as I'm not even sure what drawing method your are using. As there are a few ways to go about everything.

Posted: **Wed Jun 15, 2005 2:30 am**

Works for me, if a bit slow, but a little suggestion, make the line

Code: Select all

If x > 0 And y > 0

Read as

Code: Select all

If x => 0 And y => 0

or it leaves a line of single pixels top and left if you want to fill to the edge.

MikeB

Posted: **Wed Jun 15, 2005 2:52 am**

@J. Baker: Thanks for your help! In following example i use ImageOutput() but i will need it for SpriteOutput() - but the routine should works on all drawing modes. thanks!

@all
here is a small example, creating a bitmap, draw some circle objects in different colors and only in outline modus! Then i try to fill the background outside the circle objects to darkblue! As you may see, this works left/right/down but not for up... (just take a look to the created and saved bitmap and you will understand waht i mean, before i try to explain it to wired

At last i try to fill the background inside one circle to white!

Code: Select all


CreateImage(1,300,200)

; ---- MyFill Procedure ----

Procedure MyFill(x,y,lColorSrc.l,lColorDes.l)
  
  If Point(x,y) = lColorDes 
    ;
  Else
    If Point(x,y) = lColorSrc
      ;
      If x > 0 And y > 0  
        Plot(x,y,lColorDes)
      EndIf
      ;
      ; ---- Check nearest pixel ----
      ;
      If Point (x-1, y  ) = lColorSrc : MyFill (x-1, y  , lColorSrc, lColorDes) : EndIf
      If Point (x+1, y  ) = lColorSrc : MyFill (x+1, y  , lColorSrc, lColorDes) : EndIf
;     If Point (x  , y-1) = lColorSrc : MyFill (x  , y-1, lColorSrc, lColorDes) : EndIf
      If Point (x  , y+1) = lColorSrc : MyFill (x  , y+1, lColorSrc, lColorDes) : EndIf 
    EndIf
  EndIf
  
EndProcedure

; ---- Draw some stuff to image ----
  
StartDrawing(ImageOutput())
 
  RandomSeed(2631)
  DrawingMode(4)
  
  For i = 0 To 6 
    lPosX   = Random(300)
    lPosY   = Random(200)
    lRadius = Random(20)+10
    Circle(lPosX,lPosY,lRadius,RGB(Random(255),Random(255),Random(255)))
  Next

StopDrawing()

; ---- Fill Objects and Background ----

StartDrawing(ImageOutput())
  MyFill(1,1,$0,$990000)              ; Fill Background Outside Objects to DarkBlue
  MyFill(144,111,$0,$FFFFFF)          ; Fill Background inside Circle to White
StopDrawing()

; ---- Save Sprite ----

SaveImage(1,"c:\CheckThisSprite.bmp")

End

If you may have problems to compile, resize the imagesize... because if you try to set the imagesize to 800x600 for example it may not work, because of buffer overflow...

Any way to rewrite/fix/speed up the routine without calling a the same procedure again and again inside its own procedure!?

EDIT:
The Fillroutine would work, if you reduce the imagesize to 150x120 (not bigger due fact of overflow!) and unmark follwoing line:

Code: Select all

 If Point (x  , y-1) = lColorSrc : MyFill (x  , y-1, lColorSrc, lColorDes) : EndIf

Posted: **Wed Jun 15, 2005 4:28 am**

Why not work with something like this? Still needs work but it works.

Code: Select all

CreateImage(1,300,200) 

; ---- Draw some stuff to image ---- 
  
StartDrawing(ImageOutput()) 
  
  RandomSeed(2631) 
  DrawingMode(4) 
  
  For i = 0 To 6 
    lPosX   = Random(300) 
    lPosY   = Random(200) 
    lRadius = Random(20)+10 
    Circle(lPosX,lPosY,lRadius,RGB($FF,$FF,$FF)) 
  Next 

StopDrawing() 

; ---- Fill Objects and Background ---- 

StartDrawing(ImageOutput()) 
  FillArea(200, 20, RGB($FF,$FF,$FF), RGB($FD,$07,$02))
  FillArea(50, 150, RGB($FF,$FF,$FF), RGB($F2,$F3,$0D)) 
StopDrawing() 

; ---- Save Sprite ---- 

SaveImage(1,"c:\CheckThisSprite.bmp") 

End

Posted: **Wed Jun 15, 2005 5:16 am**

va!n wrote:If you may have problems to compile, resize the imagesize... because if you try to set the imagesize to 800x600 for example it may not work, because of buffer overflow...

Any way to rewrite/fix/speed up the routine without calling a the same procedure again and again inside its own procedure!?

See here

Sorry not a PB code

, but easy to understand ?

Code: Select all

void remplissage(int xx,int yy,
                 int c,int lim) {
  int x,y,xi,xf ;
  p.sp = 1 ;
  p.x = calloc(1000,sizeof(int)) ;
  p.y = calloc(1000,sizeof(int)) ;
  p.x[0] = xx ;
  p.y[0] = yy ;
  setcolor(c) ;
  while ( p.sp != 0 ) {
    xi = xf = x = p.x[p.sp-1] ;
    y = p.y[p.sp-1] ;
    x++ ;
    cp = getpixel(x,y) ;
    while ( cp != lim ) {
      xf = x ;
      x++ ;
      cp = getpixel(x,y) ; }
    x = p.x[p.sp-1]-1 ;
    cp = getpixel(x,y) ;
    while ( cp != lim ) {
      xi = x ;
      x-- ;
      cp = getpixel(x,y) ; }
    line(xi,y,xf,y) ;
    p.sp-- ;
    x = xf ;
    while ( x >= xi  ) {
      cp = getpixel(x,y+1) ;
      while ( ((cp == lim) || (cp == c))
              && (x >= xi) ){
        x-- ;
        cp = getpixel(x,y+1) ; }
      if ( (x >= xi) && (cp != lim)
           && (cp != c) ) {
        p.x[p.sp] = x ;
        p.y[p.sp] = y+1 ;
        p.sp++ ; }
      cp = getpixel(x,y+1) ;
      while ( ( cp != lim )
              && ( x >= xi ) ) {
        x-- ;
        cp = getpixel(x,y+1) ; } }
    x = xf ;
    while ( x >= xi  ) {
      cp = getpixel(x,y-1) ;
      while ( ((cp == lim) || (cp == c))
              && (x >= xi) ){
        x-- ;
        cp = getpixel(x,y-1) ; }
      if ( (x >= xi)
           && (cp != lim)
           && (cp != c) ) {
        p.x[p.sp] = x ;
        p.y[p.sp] = y-1 ;
        p.sp++ ; }
      cp = getpixel(x,y-1) ;
      while ( ( cp != lim )
              && ( x >= xi ) ) {
        x-- ;
        cp = getpixel(x,y-1) ; } } }
  free(p.x) ;
  free(p.y) ;
}

Posted: **Wed Jun 15, 2005 11:58 am**

J. Baker wrote:Why not work with something like this? Still needs work but it works.

Code: Select all

CreateImage(1,300,200) 

; ---- Draw some stuff to image ---- 
  
StartDrawing(ImageOutput()) 
  
  RandomSeed(2631) 
  DrawingMode(4) 
  
  For i = 0 To 6 
    lPosX   = Random(300) 
    lPosY   = Random(200) 
    lRadius = Random(20)+10 
    Circle(lPosX,lPosY,lRadius,RGB($FF,$FF,$FF)) 
  Next 

StopDrawing() 

; ---- Fill Objects and Background ---- 

StartDrawing(ImageOutput()) 
  FillArea(200, 20, RGB($FF,$FF,$FF), RGB($FD,$07,$02))
  FillArea(50, 150, RGB($FF,$FF,$FF), RGB($F2,$F3,$0D)) 
StopDrawing() 

; ---- Save Sprite ---- 

SaveImage(1,"c:\CheckThisSprite.bmp") 

End

Thats exactly the problem i tried to explain and solve my own usage! In your example you are drawing circles (all with the same outline color instead different outline colors!)

If an object has more as one outline color, or if you have some circles in different color and only want to fill the background "OUTSIDE!!!" of the circles, you can forgott FillArea()

@Comtois:
Thanks, i will take a look to this... Maybe someone has an idea how to use way to seep up Point() command? (its very very slow)

Posted: **Wed Jun 15, 2005 1:02 pm**

@Comtois:
I taked a look to the psydo code and atm i have some probs to convert it to PB...

Code: Select all

While ( p.sp != 0 ) 
  xi = xf = x = p.x[p.sp-1] ;
  y = p.y[p.sp-1] ;
  x++ ;

What is "p.sp" and what should be "xi = xf = x = p.x[p.sp-1]" ?? x++ means x=x+1 !?? Can someone help me a bit or can give some tips for converting?

Isnt there any API for doing this???

Posted: **Wed Jun 15, 2005 7:02 pm**

example

Code: Select all

CreateImage(1,300,200)

; ---- MyFill Procedure ----

Procedure remplissage(xx, yy, lim, c)
  Psp = 1 
  Dim Px(1000)
  Dim Py(1000)
  Px(0) = xx 
  Py(0) = yy 
  FrontColor(Red(c), Green(c), Blue(c))
  While Psp <> 0 
    xi = Px(Psp - 1)
    xf = Px(Psp - 1)
    x  = Px(Psp - 1)
    y  = Py(Psp - 1) 
    x + 1
    cp = Point(x, y) 
    While cp <> lim  
      xf = x 
      x + 1
      cp = Point(x,y)  
    Wend
    x = Px(Psp - 1) - 1 
    cp = Point(x, y) 
    While cp <> lim  
      xi = x 
      x - 1
      cp = Point(x, y)  
    Wend  
    LineXY(xi, y, xf, y) 
    Psp - 1 
    x = xf 
    While x >= xi   
      cp = Point(x, y + 1) 
      While (((cp = lim) Or (cp = c)) And (x >= xi))
        x - 1 
        cp = Point(x, y + 1)  
      Wend
      If ((x >= xi) And (cp <> lim) And (cp <> c)) 
        Px(Psp) = x 
        Py(Psp) = y + 1 
        Psp + 1 
      EndIf
      cp = Point(x, y + 1) 
      While (( cp <> lim ) And ( x >= xi )) 
        x - 1 
        cp = Point(x,y+1) 
      Wend
    Wend  
    x = xf 
    While x >= xi  
      cp = Point(x, y - 1) 
      While (((cp = lim) Or (cp = c)) And (x >= xi))
        x - 1
        cp = Point(x, y - 1)  
      Wend
      If ((x >= xi) And (cp <> lim) And (cp <> c)) 
        Px(Psp) = x 
        Py(Psp) = y - 1 
        Psp + 1  
      EndIf
      cp = Point(x, y - 1) 
      While (( cp <> lim ) And ( x >= xi )) 
        x - 1
        cp = Point(x,y-1) 
      Wend
    Wend 
  Wend
EndProcedure


; ---- Draw some stuff to image ----
 
StartDrawing(ImageOutput())
 
RandomSeed(2631)
DrawingMode(4)
 
 Circle(150,100,40,RGB(255,255,255))

StopDrawing()

; ---- Fill Objects and Background ----

StartDrawing(ImageOutput())
remplissage(150,100,RGB(255,255,255),$990000)
StopDrawing()

; ---- Save Sprite ----

SaveImage(1,"c:\CheckThisSprite.bmp")

End

Or , ( not complet )

Code: Select all

CreateImage(1,600,400)

; ---- MyFill Procedure ----

Procedure remplissage(xx, yy, c)
  Psp = 1 
  Dim Px(1000)
  Dim Py(1000)
  Px(0) = xx 
  Py(0) = yy 
  FrontColor(Red(c), Green(c), Blue(c))
  
  lim = Point(xx, yy)
  MaxX = ImageWidth()
  MaxY = ImageHeight()
  
  While Psp <> 0 
    xi = Px(Psp - 1)
    xf = Px(Psp - 1)
    x  = Px(Psp - 1)
    y  = Py(Psp - 1) 
    x + 1
    cp = Point(x, y) 
    While cp = lim And x < MaxX 
      xf = x 
      x + 1
      cp = Point(x,y)  
    Wend
    x = Px(Psp - 1) - 1 
    cp = Point(x, y) 
    While cp = lim And x > 0  
      xi = x 
      x - 1
      cp = Point(x, y)  
    Wend  
    LineXY(xi, y, xf, y) 
    Psp - 1 
    x = xf 
    While x >= xi   
      cp = Point(x, y + 1) 
      While (((cp <> lim) Or (cp = c)) And (x >= xi) And x > 0)
        x - 1 
        cp = Point(x, y + 1)  
      Wend
      If ((x >= xi) And (cp = lim) And (cp <> c)) 
        Px(Psp) = x 
        Py(Psp) = y + 1 
        Psp + 1 
      EndIf
      cp = Point(x, y + 1) 
      While (( cp = lim ) And ( x >= xi ) And x > 0) 
        x - 1 
        cp = Point(x,y+1) 
      Wend
    Wend  
    x = xf 
    While x >= xi  
      cp = Point(x, y - 1) 
      While (((cp <> lim) Or (cp = c)) And (x >= xi) And x > 0)
        x - 1
        cp = Point(x, y - 1)  
      Wend
      If ((x >= xi) And (cp = lim) And (cp <> c)) 
        Px(Psp) = x 
        Py(Psp) = y - 1 
        Psp + 1  
      EndIf
      cp = Point(x, y - 1) 
      While (( cp = lim ) And ( x >= xi ) And x > 0) 
        x - 1
        cp = Point(x, y - 1) 
      Wend
    Wend 
  Wend
EndProcedure


; ---- Draw some stuff to image ----
 
StartDrawing(ImageOutput())
 
RandomSeed(2631)
DrawingMode(4)
For i = 0 To 15
  lPosX   = Random(600)
  lPosY   = Random(400)
  lRadius = Random(40)+10
  Circle(lPosX,lPosY,lRadius,RGB(Random(255),Random(255),Random(255)))

Next 

StopDrawing()

; ---- Fill Objects and Background ----

StartDrawing(ImageOutput())
remplissage(1,1,$990000)              ; Fill Background Outside Objects to DarkBlue
StopDrawing()

; ---- Save Sprite ----

SaveImage(1,"c:\CheckThisSprite.bmp")

End

Posted: **Wed Jun 15, 2005 11:54 pm**

Hi Comtois!
Many thanks for the great source! Example2 is exactly what i was looking for! Great! Thanks men!

i will try to understand the source... but i am not really sure if it is so easy... is there any way to optimize this routine? (asm?)

Posted: **Thu Jun 30, 2005 7:50 pm**

new version

Code: Select all

; Comtois
; 02/07/05
 
; La fonction FillArea() est un peu limitée , elle impose de connaitre à l'avance la couleur de bord.
; Dans ce programme , la couleur du tracé est aléatoire ,donc impossible d'utiliser FillArea ,du moins pas à ma connaissance .

; La fonction Remplissage() est lente pour des grandes zones à remplir
; Pour tester faites des petites formes fermées (cercles ou autres) avec la souris en maintenant le bouton gauche de la souris
; Et utilisez le bouton droit de la souris pour remplir une zone d'une couleur aléatoire.
; [F1] pour effacer l'écran

; Delta limite la zone de remplissage à partir de la position de la souris
; Mettre 800 pour prendre en compte la totalité de l'écran
; ou changez les paramètres de remplissage() de cette façon remplissage(MouseX(), MouseY(), 0, 0, 800, 600, Random($FFFFFF))


InitSprite()
InitKeyboard()
InitMouse()
OpenScreen(800,600,32,"Remplissage")

Enumeration
    #Fond
    #Souris
    #Temoin
EndEnumeration
   
CreateSprite(#Fond,800,600)
CreateSprite(#Souris,3,3)
StartDrawing(SpriteOutput(#Souris))
Box(0,0,3,3,RGB(255,255,255))
StopDrawing()

;Delta limite la zone de remplissage à partir de la position de la souris
Delta = 400

Procedure remplissage(xx, yy, MinX, MinY, MaxX, MaxY, c)
    ;Toutes les options de remplissage sont envisageables en modifiant légèrement ce code
    
    ;La version originale de ce code se trouve ici (ainsi que les explications)
    ;http://raphaello.univ-fcomte.fr/IG/Algorithme/Algorithmique.htm#remplissage
    
    ;Remarque : j'ai ajouté les paramètres Min et Max ,
    ;parce qu'une personne sur le forum anglais m'a demandé comment faire pour limiter la zone de remplissage.
    
    Psp = 1
    Dim Px(1000)
    Dim Py(1000)
    Px(0) = xx
    Py(0) = yy
    FrontColor(Red(c), Green(c), Blue(c))
    
    lim = Point(xx, yy)
    If MinX < 0 : MinX = 0 : EndIf
    If MinY < 0 : MinY = 0 : EndIf
    If MaxX > SpriteWidth(#Fond)  : MaxX = SpriteWidth(#Fond)  : EndIf
    If MaxY > SpriteHeight(#Fond) : MaxY = SpriteHeight(#Fond) : EndIf
    
    While Psp <> 0
        xi = Px(Psp - 1)
        xf = Px(Psp - 1)
        x  = Px(Psp - 1)
        y  = Py(Psp - 1)
        
        x + 1
        cp = Point(x, y)
        While cp = lim And x < MaxX
            xf = x
            x + 1
            cp = Point(x,y)
        Wend
        
        x = Px(Psp - 1) - 1
        cp = Point(x, y)
        
        While cp = lim And x > MinX
            xi = x
            x - 1
            cp = Point(x, y)
        Wend
        
        LineXY(xi, y, xf, y)
        Psp - 1
        
        ; Y + 1
        x = xf
        While x >= xi And y < MaxY
            cp = Point(x, y + 1)
            While (((cp <> lim) Or (cp = c)) And (x >= xi))
                x - 1
                cp = Point(x, y + 1)
            Wend
            If ((x >= xi) And (cp = lim) And (cp <> c))
                Px(Psp) = x
                Py(Psp) = y + 1
                Psp + 1
            EndIf
            cp = Point(x, y + 1)
            While (( cp = lim ) And ( x >= xi ))
                x - 1
                cp = Point(x,y+1)
            Wend
        Wend
        
        ; Y - 1
        x = xf
        While x >= xi And y > MinY
            cp = Point(x, y - 1)
            While (((cp <> lim) Or (cp = c)) And (x >= xi))
                x - 1
                cp = Point(x, y - 1)
            Wend
            If ((x >= xi) And (cp = lim) And (cp <> c))
                Px(Psp) = x
                Py(Psp) = y - 1
                Psp + 1
            EndIf
            cp = Point(x, y - 1)
            While (( cp = lim ) And ( x >= xi ))
                x - 1
                cp = Point(x, y - 1)
            Wend
        Wend
    Wend
EndProcedure


Repeat
    FlipBuffers()
    ExamineMouse()
    ExamineKeyboard()
    DisplaySprite(#Fond,0,0)
    DisplaySprite(#Souris, MouseX(), MouseY())
    
    ;Efface le fond
    If KeyboardPushed(#PB_Key_F1)
        StartDrawing(SpriteOutput(#Fond))
        Box(0,0,SpriteWidth(#Fond) ,SpriteHeight(#Fond) , 0)
        StopDrawing()
    EndIf   
    
    ;trace des formes
    If MouseButton(1)
        StartDrawing(SpriteOutput(#Fond))
        Line(MouseX(),MouseY(),-MouseDeltaX(),-MouseDeltaY(), Couleur)
        StopDrawing()
    Else
        Couleur = Random($FFFFFF)
    EndIf
    
    ;Remplissage
    If MouseButton(2)
        StartDrawing(SpriteOutput(#Fond))
        remplissage(MouseX(), MouseY(),MouseX() - Delta, MouseY() - Delta, MouseX() + Delta, MouseY() + Delta, Random($FFFFFF))
        StopDrawing()
    EndIf   
    
Until KeyboardPushed(#PB_Key_Escape)

PureBasic Forums - English

Need help with coding style of a Fill() routine

Need help with coding style of a Fill() routine