PureBasic

■ Dessiner sur un canvas (ou une image) revient à faire un dessin souvent en pointillé comme le montre cette animation. Veuillez pardonner mon piètre talent de dessinateur.

Le code de base pour vous rendre compte par vous même.

Code : Tout sélectionner

Enumeration Window
  #MainForm
EndEnumeration

Enumeration Gadgets
  #Canvas
EndEnumeration

Global Draw

Declare EventDraw()

If OpenWindow(#MainForm, 0, 0, 1024, 768, "Canvas Draw", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  CanvasGadget(#Canvas, 0, 0, 1024, 768)
  BindGadgetEvent(#Canvas, @EventDraw())
  
  Repeat : Until WaitWindowEvent(10) = #PB_Event_CloseWindow
EndIf

Procedure EventDraw()
  Protected x.i = GetGadgetAttribute(#Canvas, #PB_Canvas_MouseX)
   Protected y.i = GetGadgetAttribute(#Canvas, #PB_Canvas_MouseY)
   Protected image
   
   Select EventType()
       
     Case #PB_EventType_LeftButtonDown
       Draw = #True
              
     Case #PB_EventType_LeftButtonUp
       Draw = #False
       
   EndSelect
   
   If Draw
     If StartDrawing(CanvasOutput(#Canvas))          
       Circle(x, y, 2, $000000)
       StopDrawing()
      EndIf
   EndIf
   
EndProcedure

■ L'astuce pour dessiner sans pointiller, consiste à connaitre à tout moment quel est le dernier point dessiner et le nouveau et d'utiliser LineXY() entre les deux.

le code pour vous rendre compte par vous même.

Code : Tout sélectionner

Enumeration Window
  #MainForm
EndEnumeration

Enumeration Gadgets
  #Canvas
EndEnumeration

Structure Canvas
  LeftButtonDown.i
  RightButtonDown.i
	LastX.i
	LastY.i
EndStructure

Global Draw, This.Canvas

Declare EventDraw()

If OpenWindow(#MainForm, 0, 0, 1024, 768, "Canvas Draw", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  CanvasGadget(#Canvas, 0, 0, 1024, 768)
  BindGadgetEvent(#Canvas, @EventDraw())
  
  Repeat : Until WaitWindowEvent(10) = #PB_Event_CloseWindow
EndIf

Procedure EventDraw()
  Protected x.i = GetGadgetAttribute(#Canvas, #PB_Canvas_MouseX)
	Protected y.i = GetGadgetAttribute(#Canvas, #PB_Canvas_MouseY)
		
	With This
	  Select EventType()
	    Case #PB_EventType_LeftButtonDown
	      \LeftButtonDown = #True
				\LastX = x
				\LastY = y 
				
			Case #PB_EventType_LeftButtonUp
			  \LeftButtonDown = #False
			  
			Case #PB_EventType_RightButtonDown			  
				\RightButtonDown = #True
				\lastX = x
				\lastY = y
				
			Case #PB_EventType_RightButtonUp
			  \RightButtonDown = #False
			  
			Case #PB_EventType_MouseMove	
			  Draw = #False
			  If (\LeftButtonDown Or \RightButtonDown)
						Draw = #True
			  EndIf
				
		EndSelect
		
		If Draw
		  If StartDrawing(CanvasOutput(#Canvas))
		    Protected color.l = $000000
		    
		    If (\rightButtonDown)
		      color = $ffffff ;RGB(255, 255, 255)  
		    EndIf
		   
		    LineXY(\lastX, \lastY, x, y, color)
				\lastX = x
				\lastY = y
				StopDrawing()
			EndIf
		EndIf
		
	EndWith
EndProcedure

Le code précédent ne permettant pas de régler l'épaisseur de la ligne, j'ai remplacé LineXY() par la procédure de substitution DrawLine(x1,y1,x2,y2, color=#Black, Radius=1)

Le code précédent modifié.

Code : Tout sélectionner

Enumeration Window
  #MainForm
EndEnumeration

Enumeration Gadgets
  #Canvas
EndEnumeration

Structure Canvas
  LeftButtonDown.i
  RightButtonDown.i
  LastX.i
  LastY.i
EndStructure

Global Draw, This.Canvas

Declare EventDraw()
Declare DrawLine(x1,y1,x2,y2,color=#Black, Radius=1)

If OpenWindow(#MainForm, 0, 0, 1024, 768, "Canvas Draw", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  CanvasGadget(#Canvas, 0, 0, 1024, 768)
  BindGadgetEvent(#Canvas, @EventDraw())
  
  Repeat : Until WaitWindowEvent(10) = #PB_Event_CloseWindow
EndIf

Procedure EventDraw()
  Protected x.i = GetGadgetAttribute(#Canvas, #PB_Canvas_MouseX)
  Protected y.i = GetGadgetAttribute(#Canvas, #PB_Canvas_MouseY)
      
  With This
    Select EventType()  
      Case #PB_EventType_LeftButtonDown
        \LeftButtonDown = #True
        \LastX = x
        \LastY = y 
              
      Case #PB_EventType_LeftButtonUp
        \LeftButtonDown = #False
           
      Case #PB_EventType_RightButtonDown           
         \RightButtonDown = #True
         \lastX = x
         \lastY = y
            
      Case #PB_EventType_RightButtonUp
         \RightButtonDown = #False
           
      Case #PB_EventType_MouseMove   
         Draw = #False
         If (\LeftButtonDown Or \RightButtonDown)
           Draw = #True
         EndIf
                
     EndSelect
      
     If Draw
       If StartDrawing(CanvasOutput(#Canvas))
         Protected color.l = $000000
          
       If (\rightButtonDown)
         color = $ffffff  
       EndIf
         
       DrawLine(\lastX, \lastY, x, y, Color, 2)
       \lastX = x
       \lastY = y
       StopDrawing()  
     EndIf  
   EndIf  
 EndWith
EndProcedure

Procedure DrawLine(x1,y1,x2,y2, color=#Black, Radius=1)
  Protected n.f
  Protected c.f
  Protected x
  Protected y

  LineXY(x1,y1,x2,y2,color)
  If Radius> 1 And Radius < 180
    c=360/Radius/#PI/2/6
    n=0
    While n<360
      x=Sin(n/180*#PI) * Radius
      y=Cos(n/180*#PI) * Radius 
      LineXY(x1+x,y1+y,x2+x,y2+y,color)
      n+c  
    Wend  
  EndIf
EndProcedure

■ Pour sauvegarder une image provenant d'un canvas, utiliser la fonction SaveImage() combinée à GrabDrawingImage() entre un StartDrawing() et StopDrawing()

Code : Tout sélectionner

SaveImage(GrabDrawingImage(#PB_Any, 0, 0, 1024, 768), "image.jpg", #PB_ImagePlugin_JPEG)

sans oublier d'intialiser l'encodeur d'image jpeg.

Enjoy

Très bien ton code falsam

, j'ai bien aimé l'astuce pour dessiner une ligne épaisse !
Super l'exemple avec BindGadgetEvent() ! Fred nous a fait un gros cadeau avec ça

Voici une correction du dernier code, qui permet de régler l'épaisseur de la ligne. J'ai accéléré la fonction par 5 fois, et il n'y a jamais d'artéfact.

Au lieu de trouver les points du bord avec un angle, je les calcule simplement tous.
C'est plus rapide car il n'y a que le nombre de traits qu'il faut.

et il ne faut jamais faire ça :

Code : Tout sélectionner

n/180*#PI

dans une boucle ! Lorsque c'est en radian, il faut utiliser des radians pour ne pas à avoir une division et une multiplication à faire à chaque fois

Il y a aussi une modif pour ne pas dessiner un point d'une couleur différente lorsqu'on lâche le clic droit

Code : Tout sélectionner

Structure Canvas
	IS_LeftButton.i
	IS_ButtonDown.i
	LastX.i
	LastY.i
EndStructure

Global Draw, This.Canvas


Declare EventDraw()
Declare DrawLine(x1,y1,x2,y2, Radius.d = 1, color = 0)
Declare DrawLine_(x1,y1,x2,y2, Radius.d = 1, color = 0)

If OpenWindow(0, 0, 0, 1024, 768, "Canvas Draw", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
	CanvasGadget(0, 0, 0, 1024, 768, #PB_Canvas_Keyboard)
	BindGadgetEvent(0, @EventDraw())
	
	SetActiveGadget(0)
	
	Repeat : Until WaitWindowEvent(10) = #PB_Event_CloseWindow
EndIf

Procedure EventDraw()
	Protected x.i = GetGadgetAttribute(0, #PB_Canvas_MouseX)
	Protected y.i = GetGadgetAttribute(0, #PB_Canvas_MouseY)
	
	Static r = 20
	
	Draw = #False
	
	
	With This
		Select EventType()
			Case #PB_EventType_MouseWheel
				r + GetGadgetAttribute(0, #PB_Canvas_WheelDelta) * 2
				
				If r < 1 : r = 1 : EndIf
				If r > 200 : r = 200 : EndIf
				
				
			Case #PB_EventType_LeftButtonDown
				\IS_ButtonDown = #True
				\IS_LeftButton = #True
				\LastX = x
				\LastY = y 
					Draw = #True
				
			Case #PB_EventType_LeftButtonUp
				\IS_ButtonDown = #False
				\IS_LeftButton = #True
				
			Case #PB_EventType_RightButtonDown           
				\IS_ButtonDown = #True
				\IS_LeftButton = #False
				\lastX = x
				\lastY = y
					Draw = #True
				
			Case #PB_EventType_RightButtonUp
				\IS_ButtonDown = #False
				\IS_LeftButton = #False
				
			Case #PB_EventType_MouseMove   
				If \IS_ButtonDown
					Draw = #True
				EndIf
				
		EndSelect
		
		If Draw
			If And StartDrawing(CanvasOutput(0))
				Protected color.l = $000000
				
				If \IS_LeftButton = #False
					color = $ff0000
				EndIf
				
				;{ tests de vitesse
; 				DisableDebugger
; 				time = ElapsedMilliseconds()
; 				For j = 0 To 100
; ; 					DrawLine(\lastX, \lastY, x, y, 20, Color)
; 					DrawLine(100, 100, 300, 200, r, Color)
; 				Next
; 				time = ElapsedMilliseconds() - time
; 				
; 				time1 = ElapsedMilliseconds()
; 				For j = 0 To 100
; ; 					DrawLine(\lastX, \lastY, x, y, 20, Color)
; 					DrawLine_(100, 400, 300, 500, r, Color)
; 				Next
; 				time1 = ElapsedMilliseconds() - time1
; 				
; 				EnableDebugger
; 				Debug "" + time + " - " + time1 + " -> " + StrD(time1 / time, 2)
				;}
				
				DrawLine(\lastX, \lastY, x, y, r, Color)
				
				\lastX = x
				\lastY = y
				StopDrawing()
			EndIf
		EndIf
		
	EndWith
EndProcedure


Procedure DrawLine(x1,y1,x2,y2, r.d = 1, color = 0)
	Protected.l j, l, ol, n, i
	Protected r2.d = r * r, tmp.d
	
	j = -r
	
	Circle(x2, y2, r, color)
	
	ol = 0
	
	Repeat
		j + 1
		
		tmp = r2 - j * j
		
		If tmp < 0
			Break
		EndIf
		
		l = Sqr(tmp)
		n = Sign(l - ol)
		
		i = ol - n
		Repeat
			i + n
			
			LineXY(x1 - i, y1 + j, x2 - i, y2 + j, color)
			LineXY(x1 + i, y1 + j, x2 + i, y2 + j, color)
		Until(n = 1 And i >= l) Or (n = -1 And i <= l) Or n = 0 
		
		ol = l
	ForEver
	
EndProcedure

; 3 fois plus lent en virant la conversion degree / radian
Procedure DrawLine_(x1,y1,x2,y2, Radius.d = 1, color = 0)
	Protected.d n, c, x, y
	
	LineXY(x1,y1,x2,y2,color)
	c = #PI / 2 / 6 / Radius
	
	n=0
	While n < 2 * #PI
		x=Sin(n) * Radius
		y=Cos(n) * Radius
		
		LineXY(x1+x,y1+y,x2+x,y2+y,color)
		n+c  
	Wend  
EndProcedure

; 5 fois plus lent et ne fonctionne plus lorsque radius > 180
Procedure DrawLine__(x1,y1,x2,y2, Radius.d = 1, color = 0) 
	Protected n.f 
	Protected c.f 
	Protected x 
	Protected y 
	
	LineXY(x1,y1,x2,y2,color) 
	If Radius> 1 And Radius < 180 
		c=360/Radius/#PI/2/6 
		n=0 
		While n<360 
			x=Sin(n/180*#PI) * Radius 
			y=Cos(n/180*#PI) * Radius  
			LineXY(x1+x,y1+y,x2+x,y2+y,color) 
			n+c   
		Wend   
	EndIf 
EndProcedure

pensez aux debutants, lorsque vous faites des exemples

utilisez les enumeration , #Canvas, #win est plus parlant que "0"
je ferai la meme remarque aux exemples de la Doc ...

bonjour
Excellent!
merci pour le partage

Mais dans le cas d'une épaisseur des points a "0" je propose plutôt de le faire avec lineXY dans la procédure DrawLine

Maintenant reste plus qu'a faire la même chose pour les styles

Cordialement

Code : Tout sélectionner

; modifications pour le code précédent afin de dessiner avec 1 pixel
;######################################
With This
  Select EventType()
    Case #PB_EventType_MouseWheel
      r + GetGadgetAttribute(0, #PB_Canvas_WheelDelta) * 2
      
      If r < 0 : r = 0 : EndIf                ; modifier le test pour avoir points a zéro dans la procédure EventDraw() 
      If r > 200 : r = 200 : EndIf

;######################################
Procedure DrawLine(x1,y1,x2,y2, r.d = 1, color = 0)
  Protected.l j, l, ol, n, i
  Protected r2.d = r * r, tmp.d
  
  j = -r
  
  if r=0
    LineXY(x2, y2, x1, y1 , color)   ; ajout d'une fonction LineXY pour r = 0
  Else
    Circle(x2, y2, r, color)
  EndIf

Dobro a écrit :pensez aux debutants, lorsque vous faites des exemples. utilisez les enumeration

Une seule fenêtre et un seul gadget, ça ne prêtait pas à confusion, mais tu as raison, il faut penser aux débutants. Les code précédents sont modifiés.

@Graph: Merci pour ces quelques corrections. Quand tu as parlé d'artefact je me suis dit mais "Ou a t'il pu voir un artefact ?" en grossissant l'épaisseur de la ligne (20 pts) j'ai bien vu cet artefact.

Merci aussi d'avoir ajouter le réglage de l'épaisseur de la ligne au défilement de la molette de la souris.

kernadec a écrit :Maintenant reste plus qu'a faire la même chose pour les styles

Voila .... il n'y a qu'à

falsam a écrit :Une seule fenêtre et un seul gadget, ça ne prêtait pas à confusion, mais tu as raison, il faut penser aux débutants. Les code précédents sont modifiés.

si ça pouvait, car la fenêtre et le Gadget avait le même numéro !
lorsque tu débarques dans Purebasic , c'est pas évident de savoir que les Gadgets, et les fenêtres puissent avoir un même numéro

d’où la confusion possible

la Doc est rempli d'exemples fait ainsi , je me souviens que cela a été l'une de mes premières confusion justement

lorsque j'ai commencé la Prg du GEM avec GFA basic , on utilisait justement des numéros pour les "Gadget" (nous appelions ça autrement mais j'ai oublié le nom)

et justement, il fallait faire gaffe que "objet" n'ait pas le même numéro

K-ressource aidait bien a la création d'interface , mais il fallait quand même bien surveillé ce point

La prochaine étape serait d'utiliser l'algorithme de Bresenham modifié, par exemple :

http://www.zoo.co.uk/~murphy/thickline/index.html

Code modifié avec la suggestion de Kernadec et Comtois.

Utiliser la molette de la souris pour modifier la largeur de la ligne.

Code : Tout sélectionner

Enumeration Window
  #MainForm
EndEnumeration

Enumeration Gadgets
  #Canvas
EndEnumeration

Structure Canvas
  IS_LeftButton.i
  IS_ButtonDown.i
  LastX.i
  LastY.i
EndStructure

Global Draw, This.Canvas

Declare EventDraw()
Declare BresenhamLine(x0 ,y0 ,x1 ,y1, Thickness, Color=$000000)

If OpenWindow(#MainForm, 0, 0, 1024, 768, "Canvas Draw", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
   CanvasGadget(#Canvas, 0, 0, 1024, 768, #PB_Canvas_Keyboard)
   BindGadgetEvent(#Canvas, @EventDraw())
   
   Repeat : Until WaitWindowEvent(10) = #PB_Event_CloseWindow
EndIf

Procedure EventDraw()
   Protected x.i = GetGadgetAttribute(#Canvas, #PB_Canvas_MouseX)
   Protected y.i = GetGadgetAttribute(#Canvas, #PB_Canvas_MouseY)
   
   Static r = 1
   
   Draw = #False
   
   With This
     Select EventType()
       Case #PB_EventType_MouseWheel
         r + GetGadgetAttribute(#Canvas, #PB_Canvas_WheelDelta) 
            
         If r < 1 : r = 1 : EndIf
         If r > 200 : r = 200 : EndIf
                  
       Case #PB_EventType_LeftButtonDown
         \IS_ButtonDown = #True
         \IS_LeftButton = #True
         \LastX = x
         \LastY = y 
         Draw = #True
              
       Case #PB_EventType_LeftButtonUp
         \IS_ButtonDown = #False
         \IS_LeftButton = #True
              
       Case #PB_EventType_RightButtonDown           
         \IS_ButtonDown = #True
         \IS_LeftButton = #False
         \lastX = x
         \lastY = y
         Draw = #True
    
       Case #PB_EventType_RightButtonUp
         \IS_ButtonDown = #False
         \IS_LeftButton = #False
            
      Case #PB_EventType_MouseMove   
         If \IS_ButtonDown
           Draw = #True
         EndIf
                
     EndSelect
      
     If Draw
       If And StartDrawing(CanvasOutput(#Canvas))
         Protected color.l = $000000
         
         If \IS_LeftButton = #False
           color = $ff0000
         EndIf
                        
         ;DrawLine(\lastX, \lastY, x, y, r, Color)
         BresenhamLine(\lastX ,\lastY ,x ,y, r, Color)
         
         \lastX = x
         \lastY = y
         StopDrawing()
         
       EndIf  
     EndIf  
   EndWith
EndProcedure


Procedure BresenhamLine(x0 ,y0 ,x1 ,y1, Thickness, Color=$000000)
  If Thickness=1 ;Suggestion de kernadec
    LineXY(x1, y1, x0, y0 , color)
    
  Else  
    
    ;Suggestion de comtois : l'algorithme de Bresenham
    If Abs(y1 - y0) > Abs(x1 - x0)
      steep =#True 
      Swap x0, y0
      Swap x1, y1  
    EndIf    
  
    If x0 > x1 
      Swap x0, x1
      Swap y0, y1  
    EndIf 
  
    deltax = x1 - x0
    deltay = Abs(y1 - y0)
    error = deltax / 2
    y = y0
    If y0 < y1  
      ystep = 1
    Else
      ystep = -1 
    EndIf 
  
    For x = x0 To x1
      If steep 
        Circle(y,x, Thickness, Color)
      Else 
        Circle(x,y, Thickness, Color)  
      EndIf
    
      error - deltay
      If error < 0 
        y + ystep
        error + deltax
      EndIf  
    Next    
  EndIf 
EndProcedure

PS : l'algorithme de Bresenham n'est pas codé par moi

Cette nouvelle procedure est vraiment, vraiment plus lente.

dessiner avec des cercles est très couteux en temps !

graph100 a écrit :Cette nouvelle procedure est vraiment, vraiment plus lente.

dessiner avec des cercles est très couteux en temps !

C'est clair, dessiner des cercles perd tout l'intérêt de l'algo de bresenham . La mise en oeuvre de l'algo modifié est moins simple mais sûrement plus efficace

il s'agit à mon avis de dessiner ligne par ligne. Dans ce cas, chaque pixel est dessiné une seule fois.
Dans mon algo, chaque pixel est dessiné 2fois, ce qui montre qu'on peut accélérer le dessin.
Dans celui de faslam initial, je dirais que chaque pixel est dessiné environ 3 fois + que le moins, c'est à dire environ 6 fois.

C'est le dessin qui prend beaucoup de temps !

l'algorithme de Bresenham suggéré par Comtois est intéressant car il permet d'obtenir une ligne moins crénelé. Par contre, c'est vrai il va consommé un peu plus de ressource pour chaque point. Mais ça reste visuellement négligeable

comtois a écrit :
graph100 a écrit :Cette nouvelle procedure est vraiment, vraiment plus lente.

dessiner avec des cercles est très couteux en temps !
C'est clair, dessiner des cercles perd tout l'intérêt de l'algo de bresenham . La mise en oeuvre de l'algo modifié est moins simple mais sûrement plus efficace

Ce n'est pas une question de créneaux. Cet algo permet de parcourir la surface du trait épais qu'une seule fois !

Bref, un code est plus clair :

-> ma fonction WideLine() modifiée pour aller 2*fois plus vite (qu'avant)
-> la fonction bresenhamLine() qui est en règle générale un peu plus rapide. (mais pas bcp, et sérieusement, pour la galère que c'est à faire, je préfère l'autre)

Le tout dans un module "Draw".
Je me suis dis que si on faisait d'autres fonctions de dessin "native" PB, ça pourrait être intéressant de les regrouper dans un seul module !

Code : Tout sélectionner

DeclareModule Draw
	
	Declare WideLine(x1,y1,x2,y2, Thickness, color = 0)
	Declare BresenhamLine(x0 ,y0 ,x1 ,y1, Thickness, Color = 0)
	
EndDeclareModule


Module Draw
	
	Procedure WideLine(x1,y1,x2,y2, Thickness, color = 0)
		
		If Thickness = 0
			LineXY(x1, y1, x2, y2, color)
			ProcedureReturn
		Else
			Circle(x2, y2, Thickness, color)
		EndIf
		
		Protected.l j, l, ol, n, i
		Protected r2.d = Thickness * Thickness, tmp.d
		
		j = -Thickness - 1
		
		
		u.d = x2 - x1
		v.d = y2 - y1
		
		ol = 0
		
		
		Repeat
			j + 1
			
			tmp = r2 - j * j
			
			If tmp < 0
				If j > 0
					Break
				EndIf
			Else
				
				l = Sqr(tmp)
				n = Sign(l - ol)
				
				i = ol - n
				Repeat
					i + n
					
					tmp = - v * j
					
					If tmp + u * i >= 0
						LineXY(x1 - i, y1 + j, x2 - i, y2 + j, color)
					EndIf
					
					If tmp - u * i >= 0
						LineXY(x1 + i, y1 + j, x2 + i, y2 + j, color)
					EndIf
					
				Until(n = 1 And i >= l) Or (n = -1 And i <= l) Or n = 0 
			EndIf
			
			ol = l
		ForEver
		
	EndProcedure
	
	Procedure BresenhamLine(x0 ,y0 ,x1 ,y1, Thickness, Color = 0)
		If Thickness = 0 ;Suggestion de kernadec
			LineXY(x1, y1, x0, y0 , color)
			
		Else  
			
			Circle(x0, y0, Thickness, Color)
			Circle(x1, y1, Thickness, Color)
			
			;Suggestion de comtois : l'algorithme de Bresenham
			If Abs(y1 - y0) > Abs(x1 - x0)
				steep =#True 
				Swap x0, y0
				Swap x1, y1  
			EndIf    
			
			If x0 > x1 
				Swap x0, x1
				Swap y0, y1  
			EndIf 
			
			deltax = x1 - x0
			deltay = Abs(y1 - y0)
			
			L.d = Sqr(deltax * deltax + deltay * deltay)
			
			If L < 2
				ProcedureReturn 
			EndIf
			
			error = deltax / 2
			
			If y0 < y1  
				ystep = 1
			Else
				ystep = -1 
			EndIf 
			
			
			h1.d = L * Thickness / deltax
			
			h2D.d = deltay * Thickness / L
			h2.l = h2D
			h22.d = h1 / (h2D * 2)
			
			y = y0 - ystep * deltay * h2 / deltax
			
			x1_p_h2 = x1 + h2
			x0_p_h2 = x0 + h2
			x1_m_h2 = x1 - h2
			
			
			For x = x0 - h2 To x1_p_h2
				If ystep = 1
					If x < x0_p_h2
						h = 0
					Else
						h = h1
					EndIf
					
					If x > x1_m_h2
						h3 = 0
					Else
						h3 = h1
					EndIf
				Else
					If x < x0_p_h2
						h3 = 0
					Else
						h3 = h1
					EndIf
					
					If x > x1_m_h2
						h = 0
					Else
						h = h1
					EndIf
				EndIf
				
				If steep
					LineXY(y - h, x, y + h3, x, Color)
				Else 
					LineXY(x, y - h, x, y + h3, Color)
				EndIf
				
				error - deltay
				
				If error <= 0
					y + ystep
					error + deltax
				EndIf  
			Next
			
		EndIf 
	EndProcedure
	
EndModule

;{ exemple

CompilerIf #PB_Compiler_IsMainFile
	
#WD_main = 0
#GD_canvas = 0


Structure Canvas
	IS_LeftButton.i
	IS_ButtonDown.i
	LastX.i
	LastY.i
EndStructure


Procedure EventDraw()
	Protected x.i = GetGadgetAttribute(#GD_canvas, #PB_Canvas_MouseX)
	Protected y.i = GetGadgetAttribute(#GD_canvas, #PB_Canvas_MouseY)
	Static r = 20, This.Canvas
	
	Static Mode = 0
	
	Draw = #False
	
	
	With This
		Select EventType()
			Case #PB_EventType_KeyUp
				
				If GetGadgetAttribute(#GD_canvas, #PB_Canvas_Key) = #PB_Shortcut_W
					mode = 0
				ElseIf GetGadgetAttribute(#GD_canvas, #PB_Canvas_Key) = #PB_Shortcut_B
					mode = 1
				Else
					StartDrawing(CanvasOutput(#GD_canvas))
					
					Box(0, 0, OutputWidth(), OutputHeight(), $ffffff)
					
					StopDrawing()
				EndIf
				
			Case #PB_EventType_MouseWheel
				r + GetGadgetAttribute(#GD_canvas, #PB_Canvas_WheelDelta) * 1
				
				If r < 0 : r = 0 : EndIf
				If r > 200 : r = 200 : EndIf
				
			Case #PB_EventType_LeftButtonDown
				\IS_ButtonDown = #True
				\IS_LeftButton = #True
				\LastX = x
				\LastY = y 
					Draw = #True
				
			Case #PB_EventType_LeftButtonUp
				\IS_ButtonDown = #False
				\IS_LeftButton = #True
				
			Case #PB_EventType_RightButtonDown           
				\IS_ButtonDown = #True
				\IS_LeftButton = #False
				\lastX = x
				\lastY = y
					Draw = #True
				
			Case #PB_EventType_RightButtonUp
				\IS_ButtonDown = #False
				\IS_LeftButton = #False
				
			Case #PB_EventType_MouseMove   
				If \IS_ButtonDown
					Draw = #True
				EndIf
				
		EndSelect
		
		If Draw
			If And StartDrawing(CanvasOutput(#GD_canvas))
				Protected color.l = $000000
				
				If \IS_LeftButton = #False
					color = $ff0000
				EndIf
				
				;{ vitesse
; 				
; 				t = 100
; 				
; 				DisableDebugger
; 				time = ElapsedMilliseconds()
; 				For i = 0 To t
; 					Draw::WideLine(100, 100, 500, 200, r, color)
; 				Next
; 				time = ElapsedMilliseconds() - time
; 				
; 				time1 = ElapsedMilliseconds()
; 				For i = 0 To t
; 					Draw::BresenhamLine(100, 300, 500, 400, r, color)
; 				Next
; 				time1 = ElapsedMilliseconds() - time1
; 				EnableDebugger
; 				
; 				Debug " rayon = " + r + " : " + time + " - " + time1 + " -> " + StrD(time1 / time, 2)
; 				
				;}
				
				If mode = 0
					Draw::WideLine(\lastX, \lastY, x, y, r, Color)
					
					DrawText(0, 0, "[W/B] : MODE = WideLine          ")
				Else
					Draw::BresenhamLine(\lastX, \lastY, x, y, r, Color)
					
					DrawText(0, 0, "[W/B] : MODE = BresenhamLine")
				EndIf
				
				\lastX = x
				\lastY = y
				StopDrawing()
			EndIf
		EndIf
		
	EndWith
EndProcedure

OpenWindow(#WD_main, 0, 0, 1024, 768, "Canvas Draw", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
CanvasGadget(#GD_canvas, 0, 0, 1024, 768, #PB_Canvas_Keyboard)
BindGadgetEvent(#GD_canvas, @EventDraw())

SetActiveGadget(#GD_canvas)

Repeat : Until WaitWindowEvent(10) = #PB_Event_CloseWindow

CompilerEndIf

;}

détails sur la comparaison en vitesse des 2 fonctions :

thickness = 0 :
idem (puisque = lineXY() )

thickness < 20 :
WideLine() est plus rapide que BresenhamLine()

thickness >= 20 & thickness < 100
BresenhamLine() est plus rapide que WideLine()

thickness >= 100
il semble que WideLine() soit à nouveau plus rapide.

PureBasic

Dessiner sur un canvas

Dessiner sur un canvas

Re: Dessiner sur un canvas

Re: Dessiner sur un canvas

Re: Dessiner sur un canvas

Re: Dessiner sur un canvas

Re: Dessiner sur un canvas

Re: Dessiner sur un canvas

Re: Dessiner sur un canvas

Re: Dessiner sur un canvas

Re: Dessiner sur un canvas

Re: Dessiner sur un canvas

Re: Dessiner sur un canvas

Re: Dessiner sur un canvas

Re: Dessiner sur un canvas