//---------------------------------------------------------------------------
//Akcent koloru
//www.algorytm.org
//(c) 2010 by Tomasz Lubinski

unit color_accent;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, StdCtrls, ExtCtrls, Math;

type
  TForm1 = class(TForm)
    Src: TImage;
    Dst: TImage;
    Label1: TLabel;
    Label2: TLabel;
    Range: TEdit;
    UpDown1: TUpDown;
    procedure SrcMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  PPixelRec = ^TPixelRec;
  TPixelRec = packed record
    B: Byte;
    G: Byte;
    R: Byte;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

function fmod(x: double; y: double): double;
begin
        Result := x - Int(x / y) * y;
end;

procedure rgb2hsv(var hue: double; var sat: double; var val: double; red: double;grn: double; blu:double);
var
        x, f, i: double;
begin
        x := MIN(MIN(red, grn), blu);
        val := MAX(MAX(red, grn), blu);
        if x = val then
                begin
                        hue := 0;
                        sat := 0;
                end
        else
                begin
                        if red = x then
                                f := grn-blu
                        else
                                if grn = x then
                                        f := blu-red
                                else
                                        f := red-grn;
                        if red = x then
                                i := 3
                        else
                                if grn = x then
                                        i := 5
                                else
                                        i := 1;
                        hue := fmod((i-f/(val-x))*60, 360);
                        sat := ((val-x)/val);
                end;
end;

procedure TForm1.SrcMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  color: TColor;
  Psrc, Pdst: PPixelRec;
  hsrc, ssrc, vsrc, hdst, sdst, vdst, hfrom, hto : double;
  range, i, j: Integer;
begin

   Dst.Canvas.Brush.Color := clWhite;
   Dst.Canvas.Rectangle(0, 0, Src.Picture.Bitmap.Width, Src.Picture.Bitmap.Height);
   Dst.Picture.Bitmap.PixelFormat := pf24bit;

   color := Src.Canvas.Pixels[X, Y];
   RGB2HSV(hsrc, ssrc, vsrc, (color and $FF) / 255.0, ((color and $FF00) shr 8) / 255.0, ((color and $FF0000) shr 16) / 255.0);
   range := StrToInt(Form1.Range.Text);
   hfrom := fmod((hsrc - (range / 2)) + 360, 360);
   hto := fmod(hsrc + (range / 2), 360);

   for i:=0 to Src.Picture.Bitmap.Height-1 do
   begin
      Psrc := Src.Picture.Bitmap.ScanLine[i];
      Pdst := Dst.Picture.Bitmap.ScanLine[i];
      for j:=0 to Src.Picture.Bitmap.Width-1 do
      begin
         RGB2HSV(hdst, sdst, vdst, Psrc.r/255.0, Psrc.g/255.0, Psrc.b/255.0);

         if (( (hfrom <= hto) and
               (hfrom <= hdst) and
               (hto >= hdst) ) or
             ( (hfrom > hto) and
               ( (hfrom <= hdst) or
                 (hto >= hdst) ))) then
            Pdst^ := Psrc^
         else
         begin
            Pdst.r := Round(0.299 * Psrc.r + 0.587 * Psrc.g + 0.114 * Psrc.b);
            Pdst.g := Round(0.299 * Psrc.r + 0.587 * Psrc.g + 0.114 * Psrc.b);
            Pdst.b := Round(0.299 * Psrc.r + 0.587 * Psrc.g + 0.114 * Psrc.b);
         end;

         Inc(Psrc);
         Inc(Pdst);
      end;
   end;
end;

end.