(EDIT (nouvelle version) : les nombreux 'startDrawing()' ralentissaient beaucoup trop...)
Code : Tout sélectionner
; (c) 2007 - Guillaume HUSSON
; Recherche des contours d'une image par la mèthode du filtre de Roberts
UsePNGImageDecoder()
UsePNGImageEncoder()
UseJPEGImageDecoder()
; Le filtre de Roberts :
Global Dim roberts.b(2,2)
; l'image à traiter :
#IMAGE = 0
nom_fichier$ = OpenFileRequester("Choisissez une image","","Image|*.BMP;*.bmp;*.png;*PNG;*.jpeg;*.jpg;*.JPEG;*.JPG",0)
If Not nom_fichier$
End
EndIf
LoadImage(#IMAGE,nom_fichier$)
Global width.l = ImageWidth(#IMAGE)
Global height.l = ImageHeight(#IMAGE)
Global Dim image_in.l(width,height)
StartDrawing(ImageOutput(#IMAGE))
For i.l=0 To width-1
For j.l=0 To height-1
image_in(i,j)=Point(i,j)
Next j
Next i
StopDrawing()
; l'image résultat :
Global Dim image_out.l(width,height)
MessageRequester("Début de la procédure de recherche de contours", "Cliquez sur OK puis patientez jusqu'à la fin de la recherche de contour.", #MB_OK|#MB_ICONINFORMATION)
Procedure.d convolution(i.l,j.l)
r.w = 0
g.w = 0
b.w = 0
For k.b = 0 To 2
For l.b = 0 To 2
If (i+k-1 < width And j+l-1 < height And i+k-1>=0 And j+l-1>=0)
c.l = image_in(i+k-1,j+l-1)
r + Red(c)*roberts(k,l)
g + Green(c)*roberts(k,l)
b + Blue(c)*roberts(k,l)
EndIf
Next l
Next k
r = Abs(r)
g = Abs(g)
b = Abs(b)
If(r>255)
r=255
EndIf
If(g>255)
g=255
EndIf
If(b>255)
b=255
EndIf
ProcedureReturn RGB(r,g,b)
EndProcedure
For i.l=0 To width-1
For j.l=0 To height-1
; initialisation : recherche des contours horizontaux, en premier lieu
roberts(0,0) = 0
roberts(0,1) = -1
roberts(1,0) = 1
roberts(1,1) = 0
convH.l = convolution(i,j)
; recherche des contours verticaux, en second
roberts(0,0) = -1
roberts(0,1) = 0
roberts(1,0) = 0
roberts(1,1) = 1
convV.l = convolution(i,j)
rH.w = Red(convH)
gH.w = Green(convH)
bH.w = Blue(convH)
rV.w = Red(convV)
gV.w = Green(convV)
bV.w = Blue(convV)
r.w = Int(Sqr(rH*rH+rV*rV))
g.w = Int(Sqr(gH*gH+gV*gV))
b.w = Int(Sqr(bH*bH+bV*bV))
If(r>255)
r=255
EndIf
If(g>255)
g=255
EndIf
If(b>255)
b=255
EndIf
image_out(i,j) = RGB(255,255,255)-RGB(r,g,b)
Next j
Next i
MessageRequester("Fin de la procédure de recherche de contours", "Vous pouvez maintenant sauvegarder votre nouvelle image ne contenant que les contours.", #MB_OK|#MB_ICONINFORMATION)
StartDrawing(ImageOutput(#IMAGE))
For i.l=0 To width-1
For j.l=0 To height-1
Plot(i,j,image_out(i,j))
Next j
Next i
StopDrawing()
nom_fichier$ = SaveFileRequester("Sauvegardez votre image","","Image PNG|*.png;*PNG",0)
If(nom_fichier$)
SaveImage(#IMAGE,nom_fichier$+".png",#PB_ImagePlugin_PNG)
EndIf
Un aperçu du résultat :
Avant :
Après :
EDIT : Un exemple plus parlant (quoique) et en couleur :
Avant :
Après :
