Как сделать "волшебную палочку"?

Всем привет!
Прошу помогите как сделать в Delphi "волшебную палочку", например подобно в Photoshopе?
Т.е. выделит похожие точки и скопировать?
Заранее спасибо!

Когда тыкнешь курсором по нужному цвету запомни его код цвета и начинай искать похожие цвета, когда найдешь похожий цвет скопируй его туда куда тебе надо и так делай пока не проверишь все изображение.

) здесь нужно не один цвет пикселя брать а диапазон...в фотошопе именно так работает...потом по алгаритму начинаешь все вокруг сканировать и выделять если в падает в диапазон.
пример прикреплен надеюсь он прояснит суть.

//MagicWand.pas

unit MagicWand;
 
interface
 
uses Windows, SysUtils, Classes, Graphics, Types;
 
type
  // Прототип функции сравнения цветов
  // Функция должна сравнить цвет исходной точки "a" c цветом проверяемой
  // точки "b" и вернуть true, если цвета достаточно близки.
  TMagicWandCmpFunc = function(a,b: TColor): Boolean;
 
  // Исключение, возникающее при попытке извлечения значения из пустого стека
  EStackEmpty = class(Exception);
 
  // Класс-стек
  TPointStack = class
  private
    FList: array of TPoint;
    FSize, FCount: Integer;
  public
    procedure Push(Point: TPoint);
    function Pop: TPoint;
    procedure StackEmpty;
    function Empty: Boolean;
    property Count: Integer read FCount;
  end;
 
// Функция для выделения части изображения по принципу "волшебной палочки".
// Возвращает регион, содержащий область выделения.
function MagicWandSelect(Graphic: TGraphic; StartPoint: TPoint;
  CmpFunc: TMagicWandCmpFunc): HRGN;
 
implementation
 
function MagicWandSelect(Graphic: TGraphic; StartPoint: TPoint;
  CmpFunc: TMagicWandCmpFunc): HRGN;
var
  TempBitmap: TBitmap;           // Временный битмап
  Color: TColor;                 // Цвет стартовой точки
  This,Next: TPointStack;        // Стеки для волнового алгоритма
  Mask: array of array of Byte;  // Маска для волнового алгоритма
  CurPoint: TPoint;              
  Width, Height, i: Integer;
 
  // Процедура меняет местами стеки Next и This
  procedure XchgStacks;
  var
    Temp: TPointStack;
  begin
    Temp:=Next;
    Next:=This;
    This:=Temp;
  end;
 
  // Функция распространения волны от точки APoint по 4-м направлениям.
  // Изначально всем элементам маски присваивается значение 0, что означает, что
  // соответствующая точка еще не проверялась на необходимость войти в область
  // выделения.
  // Если точка, соседняя APoint должна войти в выделение, то соответсвующему ей
  // элементу маски присваивается значение 2 и точка заносится в стек следующих
  // источников волны. Если соседняя точка не должна войти в область выделения,
  // то то соответсвующему ей элементу маски присваивается значение 1.
  procedure Wave(APoint: TPoint);
  var
    CurColor: TColor;
 
    // Возвращает цвет пиксела с координатой (APoint.X+offsx; APoint.Y+offsy)
    function GetPixelColor(offsx,offsy: Integer): TColor;
    var
      R,G,B: Byte;
      Pixel: Longint;
      PPixel: PLongint;
    begin
      PPixel:=PLongint(TempBitmap.ScanLine[APoint.Y + offsy]);
      Inc(PByte(PPixel),3*(APoint.X + offsx));
      Pixel:=PPixel^;
      B:=GetRValue(Pixel);
      G:=GetGValue(Pixel);
      R:=GetBValue(Pixel);
      Result:=RGB(R,G,B);
    end;
 
  begin
    // Проверяем соседнюю сверху точку
    // Проверяем, не выходит ли точка за область рисунки и не проверялась ли она
    // ранее.
    if (APoint.Y <> 0) and (Mask[APoint.X,APoint.Y - 1] = 0) then
    begin
      CurColor:=GetPixelColor(0,-1);
      // Проверяем, должна ли точка войти в область выделения
      if CmpFunc(Color,CurColor) then begin
        Mask[APoint.X,APoint.Y - 1]:=2;
        Next.Push(Point(APoint.X,APoint.Y - 1));
      end
      else
        Mask[APoint.X,APoint.Y - 1]:=1;
    end;
    // Проверяем соседнюю справа точку
    // Проверяем, не выходит ли точка за область рисунки и не проверялась ли она
    // ранее.
    if (APoint.X <> (Width - 1)) and (Mask[APoint.X + 1,APoint.Y] = 0) then
    begin
      CurColor:=GetPixelColor(1,0);
      // Проверяем, должна ли точка войти в область выделения
      if CmpFunc(Color,CurColor) then begin
        Mask[APoint.X + 1,APoint.Y]:=2;
        Next.Push(Point(APoint.X + 1,APoint.Y));
      end
      else
        Mask[APoint.X + 1,APoint.Y]:=1;
    end;
    // Проверяем соседнюю снизу точку
    // Проверяем, не выходит ли точка за область рисунки и не проверялась ли она
    // ранее.
    if (APoint.Y <> (Height - 1)) and (Mask[APoint.X,APoint.Y + 1] = 0) then
    begin
      CurColor:=GetPixelColor(0,1);
      // Проверяем, должна ли точка войти в область выделения
      if CmpFunc(Color,CurColor) then begin
        Mask[APoint.X,APoint.Y + 1]:=2;
        Next.Push(Point(APoint.X,APoint.Y + 1));
      end
      else
        Mask[APoint.X,APoint.Y + 1]:=1;
    end;
    // Проверяем соседнюю слева точку
    // Проверяем, не выходит ли точка за область рисунки и не проверялась ли она
    // ранее.
    if (APoint.X <> 0) and (Mask[APoint.X - 1,APoint.Y] = 0) then
    begin
      CurColor:=GetPixelColor(-1,0);
      // Проверяем, должна ли точка войти в область выделения
      if CmpFunc(Color,CurColor) then begin
        Mask[APoint.X - 1,APoint.Y]:=2;
        Next.Push(Point(APoint.X - 1,APoint.Y));
      end
      else
        Mask[APoint.X - 1,APoint.Y]:=1;
    end;
  end;
 
  // Функция строит регион по маске Mask. В регион войдут только те точки,
  // значение в маске которых равно 2.
  function CreateRgnFromMask: HRGN;
  const
    dCount = 1024;
  var
    H: THandle;
    MaxRects: DWORD;
    DataMem: PRgnData;
    X,StartX,FinishX,Y: Integer;
 
    // Процедура добавляет прямоугольник (StartX, Y, FinishX, Y+1) к региону
    procedure AddRect;
    var
      Rect: PRect;
    begin
      Rect:=@DataMem^.Buffer[DataMem^.rdh.nCount*SizeOf(TRect)];
      SetRect(Rect^,StartX,Y,FinishX,Y+1);
      Inc(DataMem^.rdh.nCount);
    end;
 
  begin
    MaxRects:=dCount;       // Начальное значение MaxRects
    // Выделяем память на данные для региона и получаем указатель на нее
    H:=GlobalAlloc(GMEM_MOVEABLE,SizeOf(TRgnDataHeader)+SizeOf(TRect)*MaxRects);
    DataMem:=GlobalLock(H);
    // Заполняем заголовок
    // Обнуляем все поля в заголовке
    ZeroMemory(@DataMem^.rdh,SizeOf(TRgnDataHeader));
    DataMem^.rdh.dwSize:=SizeOf(TRgnDataHeader);
    DataMem^.rdh.iType:=RDH_RECTANGLES;
    // Начинаем цикл обхода рисунка по точкам. Будем двигаться слева-направо,
    // сверху-вниз. В переменных X и Y будем хранить текущее значение координат.
    // В переменной StartX - начало нового прямоугольника, FinishX -
    // соответственно конец прямоугольника.
    for Y:=0 to Height-1 do begin   // Цикл по строкам
      X:=0; StartX:=0; FinishX:=0;  // Обнуляем X, StartX, FinishX
      while X<Width do begin        // Цикл по столбцам
        // Если Mask[X,Y] = 2,
        // то надо включить ее в новый прямоугольник
        if Mask[X,Y] = 2 then FinishX:=X+1
        else begin
          // Mask[X,Y] <> 2. Значит нужно завершить формирование прямоугольника,
          // если он не пустой, то добавить его к региону и начать формирование
          // нового прямоугольника. Если количество прямоугольников в регионе
          // достигло MaxRects, то увеличиваем MaxRects на dCount, и выделяем
          // память под данные о регионе заново
          if DataMem^.rdh.nCount>=MaxRects then
          begin
            Inc(MaxRects,dCount);
            GlobalUnlock(H);
            H:=GlobalReAlloc(H,SizeOf(TRgnDataHeader)+SizeOf(TRect)*MaxRects,
                GMEM_MOVEABLE);
            DataMem:=GlobalLock(H);
          end;
          // Если прямоугольник не пустой, добавляем его к региону
          if FinishX>StartX then AddRect;
          // Устанавливаем значения StartX, FinishX для формирования нового
          // прямоугольника
          StartX:=X+1;
          FinishX:=X+1;
        end;
        Inc(X);      // Увеличиваем текущее значение координаты X
      end;
      // Возможен следующий случай: если значение последней точки в строке равно
      // 2, то FinishX будет больше, чем StartX, однако прямоугольник не будет
      // добавлен к региону, так так добавление нового прямоугольника происходит
      // только если встретилось значение, отличное от 2. Это нужно учесть.
      if FinishX>StartX then AddRect;
    end;
    // Формируем регион по данным из DataMem^
    Result:=ExtCreateRegion(nil,SizeOf(TRgnDataHeader)+
      SizeOf(TRect)*DataMem^.rdh.nCount,DataMem^);
    GlobalFree(H); // Освобождаем выделенную память
  end;
 
begin
  // Создаем в памяти временный битмап, с которым будем работать
  TempBitmap:=TBitmap.Create;
  try
    TempBitmap.Assign(Graphic);
    TempBitmap.PixelFormat:=pf24bit;
    Width:=TempBitmap.Width;
    Height:=TempBitmap.Height;
    // Получаем цвет начальной точки
    Color:=TempBitmap.Canvas.Pixels[StartPoint.X,StartPoint.Y];
    // Создаем маску. Значение 0 соответствует тому, что данная точка не
    // проверялась на необходимость войти в регион. Значение 1 означает, что
    // точка проверялась, но не должна войти в регион. Значение 2 - проверялась
    // и должна войти в регион.
    SetLength(Mask,Width,Height);
    // Создаем стеки для волнового алгоритма
    // This - содержит источники волны текущей итерации
    // Next - содержит источники волны для следующей итерации
    This:=TPointStack.Create;
    Next:=TPointStack.Create;
    // Задаем начальные условия для распространения волны
    Mask[StartPoint.X,StartPoint.Y]:=2;
    Next.Push(StartPoint);
    // Цикл "пока есть источники волны".
    // В цикле извлекаются из стека все точки, которые должны стать новым
    // источником волны и для них вызывается волновая функция.
    while not Next.Empty do begin
      XchgStacks;
      for i:=1 to This.Count do begin
        CurPoint:=This.Pop;
        Wave(CurPoint);
      end;
    end;
    // Строим регион по маске Mask.
    Result:=CreateRgnFromMask;
  finally
    Next.Free;
    This.Free;
    TempBitmap.Free;
  end;
end;
 
{ TPointStack }
 
function TPointStack.Empty: Boolean;
begin
  Result:=FCount = 0;
end;
 
// Извлечь значение из стека
function TPointStack.Pop: TPoint;
begin
  // Проверяем, не пустой ли стек
  if FCount<>0 then begin
    Result:=FList[FCount - 1];
    Dec(FCount);
  end
  else begin
    StackEmpty;
  end;
end;
 
// Поместить значение в стек
procedure TPointStack.Push(Point: TPoint);
begin
  Inc(FCount);
  // При необходимости, выделяем дополнительную память для стека. Выделяем
  // блоками по 1024 элемента, чтобы исключить частое выделение памяти.
  // Частое обращение к функции SetLength снизит быстродействие.
  if FCount>FSize then begin
    Inc(FSize,1024);
    SetLength(FList,FSize);
  end;
  FList[FCount - 1]:=Point;
end;
 
procedure TPointStack.StackEmpty;
begin
  raise EStackEmpty.Create('Stack is Empty');
end;
 
end.

// Unit1.dfm

object fmMain: TfmMain
  Left = 247
  Top = 157
  Width = 696
  Height = 461
  Caption = 'fmMain'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnClose = FormClose
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object pbPaint: TPaintBox
    Left = 0
    Top = 0
    Width = 688
    Height = 369
    Align = alTop
    OnMouseDown = pbPaintMouseDown
    OnPaint = pbPaintPaint
  end
  object lbHint: TLabel
    Left = 200
    Top = 392
    Width = 196
    Height = 13
    Caption = #1058#1077#1087#1077#1088#1100' '#1082#1083#1080#1082#1085#1080#1090#1077' '#1074' '#1087#1088#1077#1076#1077#1083#1072#1093' '#1082#1072#1088#1090#1080#1085#1082#1080
    Visible = False
  end
  object btOpen: TButton
    Left = 48
    Top = 384
    Width = 129
    Height = 25
    Caption = #1054#1090#1082#1088#1099#1090#1100' '#1092#1072#1081#1083
    TabOrder = 0
    OnClick = btOpenClick
  end
  object dlgPicture: TOpenPictureDialog
    Filter =
      'All (*.jpg;*.jpeg;*.bmp;*.ico;*.emf;*.wmf)|*.jpg;*.jpeg;*.bmp;*.' +
      'ico;*.emf;*.wmf|JPEG Image File (*.jpg)|*.jpg|JPEG Image File (*' +
      '.jpeg)|*.jpeg|Bitmaps (*.bmp)|*.bmp|Icons (*.ico)|*.ico|Enhanced' +
      ' Metafiles (*.emf)|*.emf|Metafiles (*.wmf)|*.wmf'
    Left = 40
    Top = 32
  end
  object tmBlink: TTimer
    Enabled = False
    Interval = 500
    OnTimer = tmBlinkTimer
    Left = 80
    Top = 32
  end
end

//Proect1.dpr

program Project1;
 
uses
  Forms,
  Unit1 in 'Unit1.pas' {fmMain},
  MagicWand in 'MagicWand.pas';
 
{$R *.res}
 
begin
  Application.Initialize;
  Application.CreateForm(TfmMain, fmMain);
  Application.Run;
end.

//Unit1.pas

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, jpeg, ExtCtrls, ExtDlgs, StdCtrls;
 
type
  TfmMain = class(TForm)
    dlgPicture: TOpenPictureDialog;
    pbPaint: TPaintBox;
    btOpen: TButton;
    lbHint: TLabel;
    tmBlink: TTimer;
    procedure btOpenClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure pbPaintPaint(Sender: TObject);
    procedure pbPaintMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure tmBlinkTimer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  fmMain: TfmMain;
  Picture: TPicture;
  Rgn: HRGN;
 
implementation
 
uses MagicWand;
 
{$R *.dfm}
 
function cmp(a,b: TColor): Boolean;
var
  ar,ag,ab,br,bg,bb,dr,dg,db: Byte;
begin
  ar:=GetRValue(a);
  ag:=GetGValue(a);
  ab:=GetBValue(a);
  br:=GetRValue(b);
  bg:=GetGValue(b);
  bb:=GetBValue(b);
  dr:=Abs(ar - br);
  dg:=Abs(ag - bg);
  db:=Abs(ab - bb);
  if (dr + dg + db) < 75 then Result:=true else Result:=false;
end;
 
procedure TfmMain.btOpenClick(Sender: TObject);
begin
  if dlgPicture.Execute then begin
    if Rgn<>0 then DeleteObject(Rgn);
    Picture.LoadFromFile(dlgPicture.FileName);
    tmBlink.Enabled:=true;
    pbPaint.Repaint;
  end;
end;
 
procedure TfmMain.FormCreate(Sender: TObject);
begin
  Picture:=TPicture.Create;
  Rgn:=0;
end;
 
procedure TfmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if Rgn<>0 then DeleteObject(Rgn);
  Picture.Free;
end;
 
procedure TfmMain.pbPaintPaint(Sender: TObject);
var
  Brush: TBrush;
begin
  pbPaint.Canvas.Draw(0,0,Picture.Graphic);
  Brush:=TBrush.Create;
  try
    Brush.Color:=clBlack;
    FrameRgn(pbPaint.Canvas.Handle,Rgn,Brush.Handle,1,1);
  finally
    Brush.Free;
  end;
end;
 
procedure TfmMain.pbPaintMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if (X<=Picture.Width) and (Y<=Picture.Height) then begin
    if Rgn<>0 then DeleteObject(Rgn);
    Screen.Cursor:=crHourGlass;
    try
      Rgn:=MagicWandSelect(Picture.Graphic,Point(X,Y),cmp);
    finally
      Screen.Cursor:=crDefault;
      pbPaint.Repaint;
    end;
  end;
end;
 
procedure TfmMain.tmBlinkTimer(Sender: TObject);
begin
  lbHint.Visible:=not lbHint.Visible;
end;
 
end.

Надеюсь этого хватит