[Alegun]

Сообщение от TeRomani

...Гугул перегулил весь, нашел много интересного но...

Тогда вам возможно уже и попадался такой вариант "волшебной палки", он возвращает регион со схожими пикселями.

Код:

type
 TFillItem = class(TObject) // Untested coordinates that will be added to a list.
  Xfill, Yfill : Word;
 end;
function CreateHRGN(Bitmap : TBitmap; X, Y : Word; RGN : HRGN) : HRGN;
var
 FillList : TList; // The untested list of coordinates.

function TColorToRGBTriple(Color : TColor) : TRGBTriple;
 type
  TRGBQuad = packed record
    case integer of
     0 : (Color : TColor);
     1 : (r, g, b, a : byte);
    end;
var
 RGBQuad : TRGBQuad;
begin
 RGBQuad.Color:= Color;
 Result.rgbtRed:= RGBQuad.r;
 Result.rgbtGreen:= RGBQuad.g;
 Result.rgbtBlue:= RGBQuad.b;
end; {TColorToRGBTriple}

function RGBTripleToTColor(RGBTriple : TRGBTriple) : TColor;
begin
 Result:= RGBTriple.rgbtBlue shl 16 + RGBTriple.rgbtGreen shl 8 +
 RGBTriple.rgbtRed;
end; {RGBTripleToTColor}

procedure FillBitmap(Bitmap : TBitmap; X, Y : integer; Depth : Word);
type
 TRGBArray = array[0..0] of TRGBTriple;
 pRGBArray = ^TRGBArray;
var
 pc: pRGBArray;
 RGNTemp : HRGN;
 FillItem : TFillItem;
begin
 {$ifopt R+} {$define RangeCheck} {$endif} {$R-}
  if (X>= 0) and (X < Bitmap.Width) and (Y>= 0) and (Y < Bitmap.Height)         then begin
 pc:= Bitmap.Scanline[Y];
 if (RGBTripleToTColor(pc[X]) <>clBlack) and (RGBTripleToTColor(pc[X])  <>clNavy) then begin
 if (Depth>10000) then begin // Recursive depth exceeded ... so pack up
  FillItem:= TFillItem.Create; // all our pending test coordinates and
  FillItem.Xfill:= X; // leave.
  FillItem.Yfill:= Y;
  FillList.Add(FillItem);
end else begin
  if (RGN = 0) then // No region - must be new ...
   RGN:= CreateRectRgn(X, Y, X+1, Y+1) // so make one ...
   else begin // otherwise combine it with
    RGNTemp:= CreateRectRgn(X, Y, X+1, Y+1); // this new selection.
    CombineRgn(RGN, RGN, RGNTemp, RGN_XOR);
    DeleteObject(RGNTemp); // Must remember to
   get rid of unwanted regions.
  end; {if}
 pc[X]:= TColorToRGBTriple(clNavy); // Leave a marker to say we've been here.
 FillBitmap(Bitmap, X-1, Y, Depth+1); // Left ...
 FillBitmap(Bitmap, X+1, Y, Depth+1); // Right ...
 FillBitmap(Bitmap, X, Y-1, Depth+1); // Up ...
 FillBitmap(Bitmap, X, Y+1, Depth+1); // Down ...
end; {if}
 end; {if}
 end; {if}
{$ifdef RangeCheck} {$R+} {$undef RangeCheck} {$endif}
end; {FillBitmap}

var
 Depth : Word;
begin
 Bitmap.PixelFormat:= pf24bit; // Need 24 bit...
 Depth:= 0; // Not started tree search ... so zero depth.
 FillList:= TList.Create; // Create our fill list.
 FillBitmap(Bitmap, X, Y, Depth); // Go and fill...

  while (FillList.Count>0) do begin // Hmm ... too many recursive levels ...
with TFillItem(FillList[pred(FillList.Count)]) do begin // ... step through all the pending
 X:= Xfill; // coordinates.
 Y:= Yfill;
 Free; // Delete these coordinates, we're about to do them.
end; {with}
 FillList.Delete(pred(FillList.Count)); // Delete this entry from the list too.
 Depth:= 0;
 FillBitmap(Bitmap, X, Y, Depth); // Go and fill again ...
end; {while} // Keep on until the list's empty.
FillList.Free; // Free the list ... we're done.
Result:= RGN; // Return the region.
end;