mirror of
http://gitlab.expertsoft.com.ua/git/expertcad
synced 2026-01-11 22:45:39 +02:00
292 lines
7.0 KiB
ObjectPascal
292 lines
7.0 KiB
ObjectPascal
{Copyright Francesco Savastano 2001 : This source is free , but you
|
|
cannot distribute it , if you want others have it , let them know
|
|
to come to my web site : http://digilander.iol.it/gensavas/francosava/
|
|
If you put this algorithm in your free or commercial software i'd like my name in your thanx list .
|
|
also check out my photoretouch program at : http://web.tiscalinet.it/new_world_software/ }
|
|
|
|
{Description :unit to implement the famous magic wand algorithm : an other secret is revealed !
|
|
the use of this unit is shown in the attached delphi sample program }
|
|
unit magwand;
|
|
|
|
|
|
|
|
interface
|
|
|
|
|
|
uses
|
|
Windows,SysUtils, Classes, Graphics,math;
|
|
|
|
type
|
|
tbool2darray=array of array of boolean;
|
|
TPointArray= array of TPoint;
|
|
procedure magicwand(var bitmap1:tbitmap;a,b:integer;oldcolor:tcolor;tolerance:real;var mask:tbool2darray);
|
|
procedure exec(var bitmap1:tbitmap;xf,yf:integer;var nf:integer;oldcolor:tcolor;tolerance:real;var mask:tbool2darray);
|
|
procedure showmagicwand(var bitmap1:tbitmap;var mask:tbool2darray);
|
|
Procedure MakePath(var mask:tbool2darray;var Points:TPointArray;var closed:Boolean);
|
|
Procedure BoundMask(var mask:tbool2darray;var maskX:tbool2darray);
|
|
|
|
|
|
implementation
|
|
type
|
|
trgbtriplerow=array[0..30000]of trgbtriple;
|
|
prgbtriplerow=^trgbtriplerow;
|
|
|
|
var
|
|
fillx:array[0..80000]of integer;
|
|
filly:array[0..80000]of integer;
|
|
|
|
|
|
{magic wand algorithm same as seed fill algorithm}
|
|
procedure magicwand;
|
|
var
|
|
nf:integer;
|
|
i,ir:integer;
|
|
xf,yf:integer;
|
|
begin
|
|
nf := 1;
|
|
ir := 1;
|
|
fillx[nf]:= a;
|
|
filly[nf]:= b;
|
|
exec(bitmap1,a,b,nf,oldcolor,tolerance,mask);
|
|
while nf>ir do
|
|
begin
|
|
ir := ir+1;
|
|
xf := fillx[ir];
|
|
yf := filly[ir];
|
|
exec(bitmap1,xf,yf,nf,oldcolor,tolerance,mask);
|
|
if (nf>75000) then
|
|
begin
|
|
for i := 1 to nf-ir do
|
|
begin
|
|
fillx[i] := fillx[ir+i];
|
|
filly[i] := filly[ir+i];
|
|
end;
|
|
nf := nf-ir ;
|
|
ir := 0;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure exec;
|
|
var
|
|
hh,ll,ss,h1,l1,s1,aa,bb,cc:real;
|
|
c1,c2,c3,pixr,pixg,pixb,oldr,oldg,oldb,newr,newg,newb:byte;
|
|
pix:tcolorref;
|
|
jj:byte;
|
|
xr,yr:longint;
|
|
gray:real;
|
|
pp:prgbtriplerow;
|
|
begin
|
|
oldr:=getrvalue(oldcolor);
|
|
oldg:=getgvalue(oldcolor);
|
|
oldb:=getbvalue(oldcolor);
|
|
|
|
for jj:=1 to 4 do
|
|
begin
|
|
if jj=1 then
|
|
begin
|
|
xr:=xf+1;
|
|
yr:=yf;
|
|
end;
|
|
if jj=2 then
|
|
begin
|
|
xr:=xf-1;
|
|
yr:=yf;
|
|
end;
|
|
if jj=3 then
|
|
begin
|
|
xr:=xf;
|
|
yr:=yf+1;
|
|
end;
|
|
if jj=4 then
|
|
begin
|
|
xr:=xf;
|
|
yr:=yf-1;
|
|
end;
|
|
if ((xr< bitmap1.width)and(jj=1))or((xr>=0)and(jj=2))
|
|
or ((yr< bitmap1.height)and(jj=3))or((yr>=0)and(jj=4)) then
|
|
begin
|
|
pp:=bitmap1.scanline[yr];
|
|
pix:=rgb(pp[xr].rgbtred,pp[xr].rgbtgreen,pp[xr].rgbtblue);
|
|
pixr:=getrvalue(pix);
|
|
pixg:=getgvalue(pix);
|
|
pixb:=getbvalue(pix);
|
|
if (not mask[xr,yr])and(abs(pixr-oldr)<=tolerance*150)and(abs(pixg-oldg)<=tolerance*150)and(abs(pixb-oldb)<=tolerance*150)then
|
|
begin
|
|
mask[xr,yr]:=true;
|
|
nf := nf+1;
|
|
fillx[nf]:= xr;
|
|
filly[nf]:= yr;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{This is only one of possible ways to show the result of the magic wand selection (stored in the array "mask" ) onto a bitmap ,
|
|
sorry but the selection will not be animated like you see in some photoretouch softwares ,
|
|
but i don't think this is very difficult to do !}
|
|
|
|
procedure showmagicwand;
|
|
var
|
|
i,j:integer;
|
|
test:boolean;
|
|
pp:prgbtriplerow;
|
|
begin
|
|
for j:=1 to bitmap1.height-2 do
|
|
begin
|
|
pp:=bitmap1.scanline[j];
|
|
for i:=1 to bitmap1.width-2 do
|
|
begin
|
|
if mask[i,j]then
|
|
begin
|
|
test:= mask[i-1,j] and mask[i+1,j] and mask[i,j-1] and mask[i,j+1] ;
|
|
if not test then
|
|
begin
|
|
{simply invert the colors of the boundary pixels }
|
|
with pp[i] do
|
|
begin
|
|
rgbtred:=255-rgbtred;
|
|
rgbtgreen:=255-rgbtgreen;
|
|
rgbtblue:=255-rgbtblue;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
Procedure BoundMask(var mask:tbool2darray;var maskX:tbool2darray);
|
|
var
|
|
i,j:integer;
|
|
lenH,lenW: Integer;
|
|
test: Boolean;
|
|
Si,sJ,ci,cj: Integer;
|
|
first:Boolean;
|
|
done: Boolean;
|
|
pCnt:Integer;
|
|
begin
|
|
lenW := Length(mask);
|
|
lenH := Length(mask[0]);
|
|
SetLength(maskX,LenW);
|
|
for i := 0 to LenW-1 do SetLength(maskX[i],LenH);
|
|
for j := 0 to Lenh-1 do
|
|
for i := 0 to LenW-1 do
|
|
maskX[i,j] := false;
|
|
first := True;
|
|
for j:=1 to lenH-2 do
|
|
begin
|
|
//pp:=bitmap1.scanline[j];
|
|
for i:=1 to lenW-2 do
|
|
begin
|
|
if mask[i,j]then
|
|
begin
|
|
test:= mask[i-1,j] and mask[i+1,j] and mask[i,j-1] and mask[i,j+1] ;
|
|
if not test then
|
|
begin
|
|
{simply invert the colors of the boundary pixels }
|
|
maskX[i,j] := True;
|
|
if first then begin
|
|
si := i;
|
|
sj := j;
|
|
first := false;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
Procedure MakePath(var mask:tbool2darray;var Points:TPointArray; var closed: Boolean);
|
|
var
|
|
i,j:integer;
|
|
lenH,lenW: Integer;
|
|
MaskX:tbool2darray;
|
|
test: Boolean;
|
|
Si,sJ,ci,cj: Integer;
|
|
first:Boolean;
|
|
done: Boolean;
|
|
pCnt:Integer;
|
|
begin
|
|
Closed := false;
|
|
si := -1;
|
|
sj := -1;
|
|
|
|
lenW := Length(mask);
|
|
lenH := Length(mask[0]);
|
|
SetLength(maskX,LenW);
|
|
SetLength(Points,0);
|
|
for i := 0 to LenW-1 do SetLength(maskX[i],LenH);
|
|
for j := 0 to Lenh-1 do
|
|
for i := 0 to LenW-1 do
|
|
maskX[i,j] := false;
|
|
first := True;
|
|
for j:=1 to lenH-2 do
|
|
begin
|
|
//pp:=bitmap1.scanline[j];
|
|
for i:=1 to lenW-2 do
|
|
begin
|
|
if mask[i,j]then
|
|
begin
|
|
test:= mask[i-1,j] and mask[i+1,j] and mask[i,j-1] and mask[i,j+1] ;
|
|
if not test then
|
|
begin
|
|
{simply invert the colors of the boundary pixels }
|
|
maskX[i,j] := True;
|
|
if first then begin
|
|
si := i;
|
|
sj := j;
|
|
first := false;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
if (si = -1) or (sj = -1) then exit;
|
|
ci := si;
|
|
cj := sj;
|
|
SetLength(Points,1);
|
|
Points[0] := Point(si,sj);
|
|
pCnt := 1;
|
|
done := false;
|
|
repeat
|
|
if (ci < LenW-1) and maskX[ci+1,cj] then begin
|
|
ci := ci+1;
|
|
end else if (cj > 0) and maskX[ci,cj-1] then begin
|
|
cj := cj-1;
|
|
end else if (cj < LenH-1) and maskX[ci,cj+1] then begin
|
|
cj := cj+1;
|
|
end else if (ci > 0) and maskX[ci-1,cj] then begin
|
|
ci := ci-1;
|
|
end else if (ci > 0) and (cj < LenH-1) and maskX[ci-1,cj+1] then begin
|
|
ci := ci-1;
|
|
cj := cj+1;
|
|
end else if (cj < LenH-1) and (ci < LenW-1) and maskX[ci+1,cj+1] then begin
|
|
ci := ci+1;
|
|
cj := cj+1;
|
|
end else if (ci > 0) and (cj > 0) and maskX[ci-1,cj-1] then begin
|
|
ci := ci-1;
|
|
cj := cj-1;
|
|
end else if (ci < LenW-1) and (cj >0) and maskX[ci+1,cj-1] then begin
|
|
ci := ci+1;
|
|
cj := cj-1;
|
|
end else begin
|
|
done := True;
|
|
end;
|
|
if not done then begin
|
|
pCnt := pCnt+1;
|
|
SetLength(Points,pCnt);
|
|
Points[pCnt-1] := Point(ci,cj);
|
|
maskx[ci,cj] := false;
|
|
end;
|
|
if done then begin
|
|
if (abs(ci-si) < 2) and (abs(cj-sj) < 2) then closed := True;
|
|
end;
|
|
until done;
|
|
|
|
end;
|
|
|
|
|
|
|
|
end.
|
|
|