// Model HSV
// www.algorytm.org
// (c)2007 by Tomasz Lubinski

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    Model: TImage;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Button1: TButton;
    WidthVal: TEdit;
    HeightVal: TEdit;
    ShiftVal: TEdit;
    Button2: TButton;
    GroupBox2: TGroupBox;
    ProbeLarge: TImage;
    ProbeSmall: TImage;
    Probe: TImage;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    HVal: TEdit;
    SVal: TEdit;
    VVal: TEdit;
    HButton: TRadioButton;
    SButton: TRadioButton;
    VButton: TRadioButton;
    GroupBox3: TGroupBox;
    AllLayers: TImage;
    LayerH: TImage;
    LayerS: TImage;
    LayerV: TImage;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure DrawArc(x: Real; y: Real; r1: Real; s: Real; v: Real; shift: Integer);
    procedure FillCircle(x: Real; y: Real; maxr: Integer; shift: Integer);
    procedure Button2Click(Sender: TObject);
    procedure ReDrawProbe(Sender: TObject);
    procedure ReDrawRectangle(Sender: TObject);
    procedure HButtonClick(Sender: TObject);
    procedure SButtonClick(Sender: TObject);
    procedure VButtonClick(Sender: TObject);
    procedure HValChange(Sender: TObject);
    procedure SValChange(Sender: TObject);
    procedure VValChange(Sender: TObject);
    procedure ProbeLargeMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ProbeSmallMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormActivate(Sender: TObject);
    procedure DrawLayers();
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

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

procedure hsv2rgb(hue: double; sat: double; val: double; var red: double; var grn: double; var blu: double);
var
        i, f, p, q, t: double;
begin
        red := 0;
        grn := 0;
        blu := 0;
        if val=0 then
                begin
                        red := 0;
                        grn := 0;
                        blu := 0;
                end
        else
                begin
                        hue := hue/60;
                        i := floor(hue);
                        f := hue-i;
                        p := val*(1-sat);
                        q := val*(1-(sat*f));
                        t := val*(1-(sat*(1-f)));
                        if i=0 then begin red:=val; grn:=t; blu:=p; end
                        else if i=1 then begin red:=q; grn:=val; blu:=p; end
                        else if i=2 then begin red:=p; grn:=val; blu:=t; end
                        else if i=3 then begin red:=p; grn:=q; blu:=val; end
                        else if i=4 then begin red:=t; grn:=p; blu:=val; end
                        else if i=5 then begin red:=val; grn:=p; blu:=q; end;
                end;
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.DrawArc(x: Real; y: Real; r1: Real; s: Real; v: Real; shift: Integer);
var
        h, r, g, b, r2, incr, i: double;
begin
        incr := 45 / r1;
        r2 := r1 / 3.0;
        i := 180;
        while (i<360) do
        begin
                h := fmod(i + shift, 360);
                HSV2RGB(h, s, v, r, g, b);
                Model.Canvas.Pixels[Round(r1*cos(i*Pi/180)+x), Round(-r2*sin(i*Pi/180)+y)] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
                i := i+incr;
        end;
end;

procedure TForm1.FillCircle(x: Real; y: Real; maxr: Integer; shift: Integer);
var
        h, s, v, r, g, b, r1, r2, incr, i: double;
        j: integer;
begin
        for j:=1 to maxr do
        begin
                r1 := j;
                r2 := r1 / 3.0;
                s := j / (maxr);
                v := 1;
                incr := 45 / r1;
                i := 0;
                while (i<360) do
                begin
                        h := fmod(i + shift, 360);
                        HSV2RGB(h, s, v, r, g, b);
                        Model.Canvas.Pixels[Round(r1*cos(i*Pi/180)+x), Round(-r2*sin(i*Pi/180)+y)] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
                        i := i+incr;
                end;
        end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
   s,v,step,r1,r2,incr,i: Real;
   width, height, shift, shift_x, shift_y, k: Integer;

begin

   Model.Canvas.Brush.Color := clWhite;
   Model.Canvas.Rectangle(0, 0, Model.Width, Model.Height);

   width := StrToInt(WidthVal.Text);
   height := StrToInt(HeightVal.Text);
   shift := StrToInt(ShiftVal.Text);

   shift_x := Model.Width div 2;
   shift_y := 50;

   step := (width*1.0)/height;
   for k:=height-1 downto 0 do
   begin
        s := 1.0 - (1 / (width - (step*k)));
        v := 1 - (k / height);

        DrawArc(shift_x, shift_y + k, width - (step*k), s, v, shift);
   end;

   FillCircle(shift_x, shift_y,  width, shift);

   //draw H, S and V crosses
   r1 := width;
   r2 := r1 / 3.0;
   shift_y := shift_y - 10;
   incr := 45 / r1;
   i := 0;
   while (i<270) do
   begin
      Model.Canvas.Pixels[Round(r1*cos(i*Pi/180)+shift_x), Round(-r2*sin(i*Pi/180)+shift_y)] := 0;
      i := i + incr;
   end;
   Model.Canvas.MoveTo(Round(r1*cos(270*Pi/180)+shift_x),      Round(-r2*sin(270*Pi/180)+shift_y));
   Model.Canvas.LineTo(Round(r1*cos(270*Pi/180)+shift_x-5),    Round(-r2*sin(270*Pi/180)+shift_y-5));
   Model.Canvas.MoveTo(Round(r1*cos(270*Pi/180)+shift_x),      Round(-r2*sin(270*Pi/180)+shift_y));
   Model.Canvas.LineTo(Round(r1*cos(270*Pi/180)+shift_x-5),    Round(-r2*sin(270*Pi/180)+shift_y+5));
   Model.Canvas.TextOut(Round(r1*cos(140*Pi/180)+shift_x-30), Round(-r2*sin(140*Pi/180)+shift_y+5), 'H');

   Model.Canvas.MoveTo(Round(shift_x - r1 - 10),   Round(shift_y + r2/2 + height));
   Model.Canvas.LineTo(Round(shift_x - r1 - 10),   Round(shift_y + r2/2));
   Model.Canvas.LineTo(Round(shift_x - r1 - 15),   Round(shift_y + r2/2 + 5));
   Model.Canvas.MoveTo(Round(shift_x - r1 - 10),   Round(shift_y + r2/2));
   Model.Canvas.LineTo(Round(shift_x - r1 - 5),    Round(shift_y + r2/2 + 5));
   Model.Canvas.TextOut(Round(shift_x - r1 - 20), Round(shift_y + r2/2 + 15), 'V');

   Model.Canvas.MoveTo(Round(shift_x),             Round(shift_y + r2/2 + height));
   Model.Canvas.LineTo(Round(shift_x - r1),        Round(shift_y + r2/2 + height));
   Model.Canvas.LineTo(Round(shift_x - r1 + 5),    Round(shift_y + r2/2 + height - 5));
   Model.Canvas.MoveTo(Round(shift_x - r1),        Round(shift_y + r2/2 + height));
   Model.Canvas.LineTo(Round(shift_x - r1 + 5),    Round(shift_y + r2/2 + height + 5));
   Model.Canvas.TextOut(Round(shift_x - r1 + 15), Round(shift_y + r2/2 + height - 15), 'S');

   Model.Refresh();
end;

procedure TForm1.Button2Click(Sender: TObject);
var
   i: Integer;
begin
   for i:=0 to 36 do
   begin
      ShiftVal.Text := IntToStr(i * 10);
      Button1Click(Sender);
   end;
end;

procedure TForm1.ReDrawProbe(Sender: TObject);
var
   h, s, v, r, g, b: double;
   i, j: Integer;
begin
   h := StrToInt(HVal.Text);
   s := StrToInt(SVal.Text) / 100.0;
   v := StrToInt(VVal.Text) / 100.0;

   ProbeSmall.Canvas.Brush.Color := clWhite;
   ProbeSmall.Canvas.Rectangle(0, 0, ProbeSmall.Width, ProbeSmall.Height);

   if (HButton.Checked) then
   begin
      s := 1;
      v := 1;
      for i:=0 to 255 do
      begin
         h := (i * 359.0) / 255;
         HSV2RGB(h, s, v, r, g, b);
         ProbeSmall.Canvas.Pixels[1, i] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
         ProbeSmall.Canvas.Pixels[2, i] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
         ProbeSmall.Canvas.Pixels[3, i] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
         ProbeSmall.Canvas.Pixels[4, i] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
         ProbeSmall.Canvas.Pixels[5, i] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
         ProbeSmall.Canvas.Pixels[6, i] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
         ProbeSmall.Canvas.Pixels[7, i] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
         ProbeSmall.Canvas.Pixels[8, i] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
         ProbeSmall.Canvas.Pixels[9, i] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
         ProbeSmall.Canvas.Pixels[10, i] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
         ProbeSmall.Canvas.Pixels[11, i] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
         ProbeSmall.Canvas.Pixels[12, i] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
         ProbeSmall.Canvas.Pixels[13, i] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
         ProbeSmall.Canvas.Pixels[14, i] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
         ProbeSmall.Canvas.Pixels[15, i] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
      end
   end
   else if (SButton.Checked) then
   begin
      for i:=0 to 255 do
      begin
         s := i / 255.0;
         HSV2RGB(h, s, v, r, g, b);
         ProbeSmall.Canvas.Pixels[1, i] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
         ProbeSmall.Canvas.Pixels[2, i] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
         ProbeSmall.Canvas.Pixels[3, i] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
         ProbeSmall.Canvas.Pixels[4, i] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
         ProbeSmall.Canvas.Pixels[5, i] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
         ProbeSmall.Canvas.Pixels[6, i] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
         ProbeSmall.Canvas.Pixels[7, i] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
         ProbeSmall.Canvas.Pixels[8, i] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
         ProbeSmall.Canvas.Pixels[9, i] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
         ProbeSmall.Canvas.Pixels[10, i] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
         ProbeSmall.Canvas.Pixels[11, i] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
         ProbeSmall.Canvas.Pixels[12, i] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
         ProbeSmall.Canvas.Pixels[13, i] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
         ProbeSmall.Canvas.Pixels[14, i] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
         ProbeSmall.Canvas.Pixels[15, i] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
      end
   end
   else if (VButton.Checked) then
   begin
      for i:=0 to 255 do
      begin
         v := i / 255.0;
         HSV2RGB(h, s, v, r, g, b);
         ProbeSmall.Canvas.Pixels[1, i] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
         ProbeSmall.Canvas.Pixels[2, i] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
         ProbeSmall.Canvas.Pixels[3, i] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
         ProbeSmall.Canvas.Pixels[4, i] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
         ProbeSmall.Canvas.Pixels[5, i] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
         ProbeSmall.Canvas.Pixels[6, i] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
         ProbeSmall.Canvas.Pixels[7, i] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
         ProbeSmall.Canvas.Pixels[8, i] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
         ProbeSmall.Canvas.Pixels[9, i] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
         ProbeSmall.Canvas.Pixels[10, i] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
         ProbeSmall.Canvas.Pixels[11, i] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
         ProbeSmall.Canvas.Pixels[12, i] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
         ProbeSmall.Canvas.Pixels[13, i] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
         ProbeSmall.Canvas.Pixels[14, i] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
         ProbeSmall.Canvas.Pixels[15, i] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
      end
   end;

   h := StrToInt(HVal.Text);
   s := StrToInt(SVal.Text) / 100.0;
   v := StrToInt(VVal.Text) / 100.0;

   ProbeLarge.Canvas.Brush.Color := clWhite;
   ProbeLarge.Canvas.Rectangle(0, 0, ProbeLarge.Width, ProbeLarge.Height);

   if (HButton.Checked) then
   begin
      for i:=0 to 255 do
      begin
         for j:=0 to 255 do
         begin
            s := i / 255.0;
            v := j / 255.0;
            HSV2RGB(h, s, v, r, g, b);
            ProbeLarge.Canvas.Pixels[i, 255-j] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
         end;
      end;
   end
   else if (SButton.Checked) then
   begin
      for i:=0 to 255 do
      begin
         for j:=0 to 255 do
         begin
            h := (i * 359.0) / 255;
            v := j / 255.0;
            HSV2RGB(h, s, v, r, g, b);
            ProbeLarge.Canvas.Pixels[i, 255-j] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
         end;
      end;
   end
   else if (VButton.Checked) then
   begin
      for i:=0 to 255 do
      begin
         for j:=0 to 255 do
         begin
            h := (i * 359.0) / 255;
            s := j / 255.0;
            HSV2RGB(h, s, v, r, g, b);
            ProbeLarge.Canvas.Pixels[i, 255-j] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
         end;
      end;
   end;

   ReDrawRectangle(Sender);
end;

procedure TForm1.ReDrawRectangle(Sender: TObject);
var
   h, s, v, r, g, b: double;
begin
   h := StrToInt(HVal.Text);
   s := StrToInt(SVal.Text) / 100.0;
   v := StrToInt(VVal.Text) / 100.0;
   HSV2RGB(h, s, v, r, g, b);
   Probe.Canvas.Brush.Color := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
   Probe.Canvas.Rectangle(0, 0, Probe.Width, Probe.Height);

   if (HButton.Checked) then
   begin
      ProbeSmall.Canvas.Ellipse(5, Round(h*255/359-3), 13, Round(h*255/359+3));
      ProbeLarge.Canvas.Ellipse(Round(s*255-3), Round(255-v*255-3), Round(s*255+3), Round(255-v*255+3));
   end
   else if (SButton.Checked) then
   begin
      ProbeSmall.Canvas.Ellipse(5, Round(s*255-3), 13, Round(s*255+3));
      ProbeLarge.Canvas.Ellipse(Round(h*255/359-3), Round(255-v*255-3), Round(h*255/359+3), Round(255-v*255+3));
   end
   else if (VButton.Checked) then
   begin
      ProbeSmall.Canvas.Ellipse(5, Round(v*255-3), 13, Round(v*255+3));
      ProbeLarge.Canvas.Ellipse(Round(h*255/359-3), Round(255-s*255-3), Round(h*255/359+3), Round(255-s*255+3));
   end;
end;

procedure TForm1.HButtonClick(Sender: TObject);
begin
     ReDrawProbe(Sender);
end;

procedure TForm1.SButtonClick(Sender: TObject);
begin
     ReDrawProbe(Sender);     
end;

procedure TForm1.VButtonClick(Sender: TObject);
begin
     ReDrawProbe(Sender);
end;

procedure TForm1.HValChange(Sender: TObject);
begin
     ReDrawProbe(Sender);
end;

procedure TForm1.SValChange(Sender: TObject);
begin
     ReDrawProbe(Sender);
end;

procedure TForm1.VValChange(Sender: TObject);
begin
     ReDrawProbe(Sender);
end;

procedure TForm1.ProbeLargeMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   if (HButton.Checked) then
   begin
      SVal.Text := IntToStr((X*100) div 255);
      VVal.Text := IntToStr(100-(Y*100) div 255);
   end
   else if (SButton.Checked) then
   begin
      HVal.Text := IntToStr((X*359) div 255);
      VVal.Text := IntToStr(100-(Y*100) div 255);
   end
   else if (VButton.Checked) then
   begin
      HVal.Text := IntToStr((X*359) div 255);
      SVal.Text := IntToStr(100-(Y*100) div 255);
   end;
end;

procedure TForm1.ProbeSmallMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   if (HButton.Checked) then
   begin
      HVal.Text := IntToStr((Y*359) div 255);
   end
   else if (SButton.Checked) then
   begin
      SVal.Text := IntToStr((Y*100) div 255);
   end
   else if (VButton.Checked) then
   begin
      VVal.Text := IntToStr((Y*100) div 255);
   end;
end;

procedure TForm1.DrawLayers();
var
   r, g, b, h, s, v: double;
   color: TColor;
   i, j: Integer;
begin
   for i:=0 to AllLayers.Width-1 do
      for j:=0 to AllLayers.Height-1 do
      begin
          color := AllLayers.Canvas.Pixels[i, j];
          r := (color and $FF) / 255.0;
          g := ((color and $FF00) shr 8) / 255.0;
          b := ((color and $FF0000) shr 16) / 255.0;
          RGB2HSV(h, s, v, r, g, b);
          HSV2RGB(h, 1, 1, r, g, b);
          LayerH.Canvas.Pixels[i, j] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
          HSV2RGB(0, s, 1, r, g, b);
          LayerS.Canvas.Pixels[i, j] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
          HSV2RGB(0, 0, v, r, g, b);
          LayerV.Canvas.Pixels[i, j] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
      end;
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
   ReDrawProbe(Sender);
   Button1Click(Sender);
   DrawLayers();
end;

end.