// Model YUV
// 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;
    Button1: TButton;
    WidthVal: TEdit;
    GroupBox2: TGroupBox;
    ProbeLarge: TImage;
    ProbeSmall: TImage;
    Probe: TImage;
    YVal: TEdit;
    UVal: TEdit;
    VVal: TEdit;
    YButton: TRadioButton;
    UButton: TRadioButton;
    VButton: TRadioButton;
    GroupBox3: TGroupBox;
    AllLayers: TImage;
    LayerY: TImage;
    LayerU: TImage;
    LayerV: TImage;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    white: TRadioButton;
    black: TRadioButton;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure ReDrawProbe(Sender: TObject);
    procedure ReDrawRectangle(Sender: TObject);
    procedure YButtonClick(Sender: TObject);
    procedure UButtonClick(Sender: TObject);
    procedure VButtonClick(Sender: TObject);
    procedure YValChange(Sender: TObject);
    procedure UValChange(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;

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

var
  Form1: TForm1;

implementation

{$R *.DFM}



procedure yuv2rgb(y: double; u: double; v: double; var r: double; var g: double; var b: double);
begin
   r := 1*y + 0*u + 1.13983*v;
   g := 1*y -0.39465*u + -0.58060*v;
   b := 1*y + 2.03211*u + 0*v;
   if (r>1) then r := 1;
   if (g>1) then g := 1;
   if (b>1) then b := 1;
   if (r<0) then r := 0;
   if (g<0) then g := 0;
   if (b<0) then b := 0;
end;

procedure rgb2yuv(var y: double; var u: double; var v: double; r: double; g: double; b: double);
begin
   y := 0.299*r + 0.587*g + 0.114*b;
   u := 0.493*(b - y);
   v := 0.877*(r - y);
end;


procedure TForm1.Button1Click(Sender: TObject);
var
   r, g, b, y, u, v : double;
   width, shift_x, shift_y, side, side_sign, i, j: Integer;

begin

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

   width := StrToInt(WidthVal.Text);

   shift_x := Model.Width div 2 - Round(width / 1.5);
   shift_y := Round(width * 1.5 + 50);

   if (black.Checked) then
   begin
      side := 0;
      side_sign := -1;
   end
   else
   begin
      side := 1;
      side_sign := 1;
   end;

   for i:=0 to width-1 do
      for j:=0 to width-1 do
      begin
         y := side;
         u := (0.436 - (0.872/width)*i)*side_sign;
         v := (0.615 - (1.23/width)*j)*side_sign;
         YUV2RGB(y, u, v, r, g, b);
         if (i=0) or (j=0) or (j = width -1) then
         begin
           g := 0;
           b := 0;
           r := 0;
         end;
         Model.Canvas.Pixels[i+shift_x, shift_y-j] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
      end;

   for i:=0 to width-1 do
      for j:=0 to (width div 2)-1 do
      begin
         y := (side - j/(width/2.0))*side_sign;
         u := (0.436 - (0.872/width)*i)*side_sign;
         v := (-0.615)*side_sign;
         YUV2RGB(y, u, v, r, g, b);
         if (i=0) or (i = width -1) or (j = (width div 2)-1) then
         begin
           g := 0;
           b := 0;
           r := 0;
         end;
         Model.Canvas.Pixels[i+j+shift_x, shift_y-j-width] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
      end;

   for i:=0 to (width div 2)-1 do
      for j:=0 to width-1 do
      begin
         y := (side - i/(width/2.0))*side_sign;
         u := (-0.436)*side_sign;
         v := (0.615 - (1.23/width)*j)*side_sign;
         YUV2RGB(y, u, v, r, g, b);
         if (i=0) or (j=0) or (i = (width div 2)-1) then
         begin
           g := 0;
           b := 0;
           r := 0;
         end;
         Model.Canvas.Pixels[i+shift_x+width, shift_y-j-i-1] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
      end;

   Model.Canvas.MoveTo(shift_x, shift_y + 20);
   Model.Canvas.LineTo(shift_x + width, shift_y + 20);
   Model.Canvas.LineTo(shift_x + width - 5, shift_y + 15);
   Model.Canvas.MoveTo(shift_x + width, shift_y + 20);
   Model.Canvas.LineTo(shift_x + width - 5, shift_y + 25);
   Model.Canvas.TextOut(shift_x + 10, shift_y + 7, 'V');

   Model.Canvas.MoveTo(shift_x - 20, shift_y);
   Model.Canvas.LineTo(shift_x - 20, shift_y - width);
   Model.Canvas.LineTo(shift_x - 25, shift_y - width + 5);
   Model.Canvas.MoveTo(shift_x - 20, shift_y - width);
   Model.Canvas.LineTo(shift_x - 15, shift_y - width + 5);
   Model.Canvas.TextOut(shift_x - 15, shift_y - 20, 'Y');

   Model.Canvas.MoveTo(shift_x + width + 2, shift_y + 18);
   Model.Canvas.LineTo(Round(shift_x + width * 1.5 + 2), shift_y + 18 - width div 2);
   Model.Canvas.LineTo(Round(shift_x + width * 1.5 - 5), shift_y + 18 - width div 2);
   Model.Canvas.MoveTo(Round(shift_x + width * 1.5 + 2), shift_y + 18 - width div 2);
   Model.Canvas.LineTo(Round(shift_x + width * 1.5 + 2), shift_y + 25 - width div 2);
   Model.Canvas.TextOut(shift_x + width + 10, shift_y - 10, 'U');
end;

procedure TForm1.ReDrawProbe(Sender: TObject);
var
   r, g, b, y, u, v: double;
   i, j: Integer;
   P: PPixelRec;
begin
   y := StrToFloat(YVal.Text);
   u := StrToFloat(UVal.Text);
   v := StrToFloat(VVal.Text);
   YUV2RGB(y, u, v, r, g, b);
   ProbeSmall.Canvas.Brush.Color := clWhite;
   ProbeSmall.Canvas.Rectangle(0, 0, ProbeSmall.Width, ProbeSmall.Height);
   ProbeSmall.Picture.Bitmap.PixelFormat := pf32Bit;

   if (YButton.Checked) then
   begin
      for i:=0 to 255 do
      begin
         y := 1 - i/255.0;
         YUV2RGB(y, u, v, r, g, b);
         P := ProbeSmall.Picture.Bitmap.ScanLine[i];
         for j:=1 to ProbeSmall.Picture.Bitmap.Width do
         begin
            P.R := Round(r*255);
            P.G := Round(g*255);
            P.B := Round(b*255);
            Inc(P);
         end;
      end
   end
   else if (UButton.Checked) then
   begin
      for i:=0 to 255 do
      begin
         u := 0.436 - i/292.43;
         YUV2RGB(y, u, v, r, g, b);
         P := ProbeSmall.Picture.Bitmap.ScanLine[i];
         for j:=1 to ProbeSmall.Picture.Bitmap.Width do
         begin
            P.R := Round(r*255);
            P.G := Round(g*255);
            P.B := Round(b*255);
            Inc(P);
         end;
      end
   end
   else if (VButton.Checked) then
   begin
      for i:=0 to 255 do
      begin
         v := 0.615 - i/207.31;
         YUV2RGB(y, u, v, r, g, b);
         P := ProbeSmall.Picture.Bitmap.ScanLine[i];
         for j:=1 to ProbeSmall.Picture.Bitmap.Width do
         begin
            P.R := Round(r*255);
            P.G := Round(g*255);
            P.B := Round(b*255);
            Inc(P);
         end;
      end
   end;

   y := StrToFloat(YVal.Text);
   u := StrToFloat(UVal.Text);
   v := StrToFloat(VVal.Text);

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

   ProbeLarge.Picture.Bitmap.PixelFormat := pf32Bit;
   if (YButton.Checked) then
   begin
      for j:=0 to 255 do
      begin
         P := ProbeLarge.Picture.Bitmap.ScanLine[255-j];
         for i:=0 to 255 do
         begin
            u := i/292.43 - 0.436;
            v := j/207.31 - 0.615;
            YUV2RGB(y, u, v, r, g, b);
            P.R := Round(r*255);
            P.G := Round(g*255);
            P.B := Round(b*255);
            Inc(P);
         end;
      end;
   end
   else if (UButton.Checked) then
   begin
      for j:=0 to 255 do
      begin
         P := ProbeLarge.Picture.Bitmap.ScanLine[255-j];
         for i:=0 to 255 do
         begin
            y := i/255.0;
            v := j/207.31 - 0.615;
            YUV2RGB(y, u, v, r, g, b);
            P.R := Round(r*255);
            P.G := Round(g*255);
            P.B := Round(b*255);
            Inc(P);
         end;
      end;
   end
   else if (VButton.Checked) then
   begin
      for j:=0 to 255 do
      begin
         P := ProbeLarge.Picture.Bitmap.ScanLine[255-j];
         for i:=0 to 255 do
         begin
            y := i/255.0;
            u := j/292.43 - 0.436;
            YUV2RGB(y, u, v, r, g, b);
            P.R := Round(r*255);
            P.G := Round(g*255);
            P.B := Round(b*255);
            Inc(P);
         end;
      end;
   end;

   ReDrawRectangle(Sender);
end;

procedure TForm1.ReDrawRectangle(Sender: TObject);
var
   r, g, b, y, u, v: double;
begin
   y := StrToFloat(YVal.Text);
   u := StrToFloat(UVal.Text);
   v := StrToFloat(VVal.Text);
   YUV2RGB(y, u, 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 (YButton.Checked) then
   begin
      ProbeSmall.Canvas.Ellipse(5, Round((1-y)*255-3), 13, Round((1-y)*255+3));
      ProbeLarge.Canvas.Ellipse(Round((u+0.436)*292.43-3), Round((0.615-v)*207.31-3),
       Round((u+0.436)*292.43+3), Round((0.615-v)*207.31+3));
   end
   else if (UButton.Checked) then
   begin
      ProbeSmall.Canvas.Ellipse(5, Round((0.436-u)*292.43-3), 13, Round((0.436-u)*292.43+3));
      ProbeLarge.Canvas.Ellipse(Round(y*255-3), Round((0.615-v)*207.31-3), Round(y*255+3), Round((0.615-v)*207.31+3));
   end
   else if (VButton.Checked) then
   begin
      ProbeSmall.Canvas.Ellipse(5, Round((0.615-v)*207.31-3), 13, Round((0.615-v)*207.31+3));
      ProbeLarge.Canvas.Ellipse(Round(y*255-3), Round((0.436-u)*292.43-3), Round(y*255+3), Round((0.436-u)*292.43+3));
   end;
end;

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

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

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

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

procedure TForm1.UValChange(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 (YButton.Checked) then
   begin
      UVal.Text := FloatToStr(X/292.43 - 0.436);
      VVal.Text := FloatToStr(0.615 - Y/207.31);
   end
   else if (UButton.Checked) then
   begin
      YVal.Text := FloatToStr(X/255.0);
      VVal.Text := FloatToStr(0.615 - Y/207.31);
   end
   else if (VButton.Checked) then
   begin
      YVal.Text := FloatToStr(X/255.0);
      UVal.Text := FloatToStr(0.436 - Y/292.43);
   end;
end;

procedure TForm1.ProbeSmallMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   if (YButton.Checked) then
   begin
      YVal.Text := FloatToStr(1 - Y/255.0);
   end
   else if (UButton.Checked) then
   begin
      UVal.Text := FloatToStr(0.436 - Y/292.43);
   end
   else if (VButton.Checked) then
   begin
      VVal.Text := FloatToStr(0.615 - Y/207.31);
   end;
end;

procedure TForm1.DrawLayers();
var
   color: TColor;
   r, g, b, y, u, v: double;
   i, j: Integer;
begin
   for j:=0 to AllLayers.Height-1 do
   begin
      for i:=0 to AllLayers.Width-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;
          RGB2YUV(y, u, v, r, g, b);
          YUV2RGB(y, 0, 0, r, g, b);
          LayerY.Canvas.Pixels[i, j] := Round((r*255) + (Round(g*255) shl 8) + (Round(b*255) shl 16));
          YUV2RGB(0, u, 0, r, g, b);
          LayerU.Canvas.Pixels[i, j] := (Round(255 - (u+0.416)*306) shl 8) + (Round((u+0.416)*306) shl 16);
          YUV2RGB(0, 0, v, r, g, b);
          LayerV.Canvas.Pixels[i, j] := Round(((v+0.615)*207) + (Round(255 - (v+0.615)*207) shl 8));
      end;
   end;
end;

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

end.