unit colorWin;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ValueSelector, SaturationSelector, ComCtrls,
  HSColorMap, SVColorMap, HueSelector, ColorContainer, RColors, ImgList, ActnList,
  System.Actions, System.ImageList, UITypes;

type
  TcolorDlg = class(TForm)
    pcControls: TPageControl;
    pcSummary: TPageControl;
    tsSVMap: TTabSheet;
    HueSelector1: THueSelector;
    SVColorMap1: TSVColorMap;
    tsHSMap: TTabSheet;
    HSColorMap1: THSColorMap;
    tbHSMap: TTrackBar;
    tsHSVSliders: TTabSheet;
    HueSelector2: THueSelector;
    SaturationSelector1: TSaturationSelector;
    ValueSelector1: TValueSelector;
    tsCoords: TTabSheet;
    StaticText1: TStaticText;
    eHue: TLabeledEdit;
    eSat: TLabeledEdit;
    eValue: TLabeledEdit;
    StaticText2: TStaticText;
    eRed: TLabeledEdit;
    eGreen: TLabeledEdit;
    eBlue: TLabeledEdit;
    eHex: TLabeledEdit;
    tsColorData: TTabSheet;
    ColorContainer: TColorContainer;
    StaticText3: TStaticText;
    stHue: TStaticText;
    stSaturation: TStaticText;
    stValue: TStaticText;
    StaticText4: TStaticText;
    stRed: TStaticText;
    stGreen: TStaticText;
    stBlue: TStaticText;
    stConfirmEnter: TStaticText;
    tsNamedColors: TTabSheet;
    lvNamedColors: TListView;
    ilSmall: TImageList;
    eNamedColorListFilter: TEdit;
    tsEyedropper: TTabSheet;
    btnEyedropper: TButton;
    stEyedropper: TStaticText;
    EyedropperAnimTimer: TTimer;
    EyedropperTimer: TTimer;
    ActionList1: TActionList;
    aEndEyedropper: TAction;
    btnOk: TButton;
    btnCancel: TButton;
    procedure pcControlsChange(Sender: TObject);
    procedure HueSelector1Change(Sender: TObject);
    procedure SVColorMap1Change(Sender: TObject);
    procedure HSColorMap1Change(Sender: TObject);
    procedure tbHSMapChange(Sender: TObject);
    procedure HueSelector2Change(Sender: TObject);
    procedure SaturationSelector1Change(Sender: TObject);
    procedure ValueSelector1Change(Sender: TObject);
    procedure eHSVChange(Sender: TObject);
    procedure eRGBChange(Sender: TObject);
    procedure eHexChange(Sender: TObject);
    procedure eHSVKeyPress(Sender: TObject; var Key: Char);
    procedure eRGBKeyPress(Sender: TObject; var Key: Char);
    procedure eHexKeyPress(Sender: TObject; var Key: Char);
    procedure eCoordsEnter(Sender: TObject);
    procedure eCoordsExit(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure lvNamedColorsSelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
    procedure eNamedColorListFilterChange(Sender: TObject);
    procedure btnEyedropperClick(Sender: TObject);
    procedure EyedropperAnimTimerTimer(Sender: TObject);
    procedure EyedropperTimerTimer(Sender: TObject);
    procedure aEndEyedropperUpdate(Sender: TObject);
    procedure aEndEyedropperExecute(Sender: TObject);
    procedure tsEyedropperResize(Sender: TObject);
    procedure tsNamedColorsShow(Sender: TObject);
  private
    FColor: THSV;
    procedure UpdateColorData;
    procedure SetColorLowres(const Value: TColor);
    function GetColorLowres: TColor;
    procedure SetColor(const AValue: TRGB); overload;
    procedure SetColor(const AValue: THSV); overload;
    procedure PopulateNamedColorsListView;
  public
    { Public declarations }
    property Color: TColor read GetColorLowres write SetColorLowres;
  end;

var
  colorDlg: TcolorDlg;

implementation

{$R *.dfm}

{ TcolorDlg }

procedure TcolorDlg.eHexChange(Sender: TObject);

  function TryStrToInt(const S: string; out i: byte): boolean;
  var
    int: integer;
  begin
    result := SysUtils.TryStrToInt(S, int);
    if result then
      i := int;
  end;

var
  rgbi: TRGBTriple;
begin
  if TryStrToInt('$' + Copy(eHex.Text, 1, 2), rgbi.rgbtRed) and
    TryStrToInt('$' + Copy(eHex.Text, 3, 2), rgbi.rgbtGreen) and
    TryStrToInt('$' + Copy(eHex.Text, 5, 2), rgbi.rgbtBlue) then
    SetColor(RGBTripleToRGB(rgbi));
end;

procedure TcolorDlg.eHexKeyPress(Sender: TObject; var Key: Char);
begin
  if Key = chr(VK_RETURN) then
  begin
    Key := #0;
    eHexChange(Sender);
    if Sender is TLabeledEdit then
      TLabeledEdit(Sender).SelectAll;
  end;
end;

procedure TcolorDlg.eHSVChange(Sender: TObject);
var
  hsv: THSV;
begin
  if TryStrToFloat(eHue.Text, hsv.hsvHue) and
    TryStrToFloat(eSat.Text, hsv.hsvSaturation) and
    TryStrToFloat(eValue.Text, hsv.hsvValue) then
    SetColor(hsv);
end;

procedure TcolorDlg.eHSVKeyPress(Sender: TObject; var Key: Char);
begin
  if Key = chr(VK_RETURN) then
  begin
    eHSVChange(Sender);
    Key := #0;
    if Sender is TLabeledEdit then
      TLabeledEdit(Sender).SelectAll;
  end;
end;

procedure TcolorDlg.eNamedColorListFilterChange(Sender: TObject);
begin
  PopulateNamedColorsListView;
end;

procedure TcolorDlg.aEndEyedropperExecute(Sender: TObject);
begin
  EyedropperTimer.Enabled := false;
  EyedropperAnimTimer.Enabled := false;
  stEyedropper.Hide;
  btnEyedropper.Show;
end;

procedure TcolorDlg.aEndEyedropperUpdate(Sender: TObject);
begin
  aEndEyedropper.Enabled := EyedropperTimer.Enabled;
end;

procedure TcolorDlg.btnEyedropperClick(Sender: TObject);
begin
  btnEyedropper.Hide;
  stEyedropper.Show;
  EyedropperTimer.Enabled := true;
  EyedropperAnimTimer.Enabled := true;
end;

procedure TcolorDlg.eCoordsEnter(Sender: TObject);
begin
  btnOk.Default := false;
  stConfirmEnter.Show;
end;

procedure TcolorDlg.eCoordsExit(Sender: TObject);
begin
  stConfirmEnter.Hide;
  btnOk.Default := true;
end;

procedure TcolorDlg.eRGBChange(Sender: TObject);
var
  rgb: TRGB;
begin
  if TryStrToFloat(eRed.Text, rgb.rgbRed) and
    TryStrToFloat(eGreen.Text, rgb.rgbGreen) and
    TryStrToFloat(eBlue.Text, rgb.rgbBlue) then
    SetColor(rgb);
end;

procedure TcolorDlg.eRGBKeyPress(Sender: TObject; var Key: Char);
begin
  if Key = chr(VK_RETURN) then
  begin
    eRGBChange(Sender);
    Key := #0;
    if Sender is TLabeledEdit then
      TLabeledEdit(Sender).SelectAll;
  end;
end;

procedure TcolorDlg.EyedropperAnimTimerTimer(Sender: TObject);
begin
  stEyedropper.Visible := not stEyedropper.Visible;
end;

procedure TcolorDlg.EyedropperTimerTimer(Sender: TObject);
var
  P: TPoint;
begin
  if GetCursorPos(P) then
    with P do
      SetColor(PascalColorToRGB(GetPixel(GetDC(GetDesktopWindow), X, Y)));
end;

procedure TcolorDlg.FormCreate(Sender: TObject);
const
  padding = 4;
var
  i: integer;
  R: TRect;
  bms, msk: TBitmap;
begin

  msk := TBitmap.Create;
  try
    msk.SetSize(ilSmall.Width, ilSmall.Height);
    R := Rect(0, 0, msk.Width, msk.Height);
    msk.PixelFormat := pf1bit;
    msk.Canvas.Brush.Color := clWhite;
    msk.Canvas.FillRect(R);
    InflateRect(R, -padding, -padding);
    msk.Canvas.Brush.Color := clBlack;
    msk.Canvas.FillRect(R);

    bms := TBitmap.Create;
    try
      bms.SetSize(ilSmall.Width, ilSmall.Height);
      R := Rect(0, 0, bms.Width, bms.Height);
      InflateRect(R, -padding, -padding);
      for i := 0 to high(CSSColorNames) do
      begin
        bms.Canvas.Brush.Color := CSSColorParse(CSSColorNames[i][1]);
        bms.Canvas.FillRect(R);
        bms.Canvas.Pen.Color := clBlack;
        bms.Canvas.Rectangle(R);
        ilSmall.Add(bms, msk);
      end;
    finally
      bms.Free;
    end;
  finally
    msk.Free;
  end;

  PopulateNamedColorsListView;
  UpdateColorData;
end;

function TcolorDlg.GetColorLowres: TColor;
begin
  result := GetPascalColor(FColor);
end;

procedure TcolorDlg.HSColorMap1Change(Sender: TObject);
begin
  SetColor(HSV(HSColorMap1.Hue, HSColorMap1.Saturation, HSColorMap1.Value));
end;

procedure TcolorDlg.HueSelector1Change(Sender: TObject);
begin
  SetColor(HSV(HueSelector1.Hue, HueSelector1.Saturation, HueSelector1.Value));
  SVColorMap1.Update;
end;

procedure TcolorDlg.HueSelector2Change(Sender: TObject);
begin
  SetColor(HSV(HueSelector2.Hue, HueSelector2.Saturation, HueSelector2.Value));
end;

procedure TcolorDlg.lvNamedColorsSelectItem(Sender: TObject; Item: TListItem;
  Selected: Boolean);
begin
  SetColor(PascalColorToRGB(CSSColorParse(Item.Caption)));
end;

procedure TcolorDlg.pcControlsChange(Sender: TObject);
begin
  UpdateColorData;
  eNamedColorListFilter.Visible := pcControls.ActivePage = tsNamedColors;
end;

procedure TcolorDlg.SaturationSelector1Change(Sender: TObject);
begin
  SetColor(HSV(SaturationSelector1.Hue, SaturationSelector1.Saturation, SaturationSelector1.Value));
end;

procedure TcolorDlg.SetColor(const AValue: TRGB);
begin
  SetColor(RGBToHSV(AValue));
end;

procedure TcolorDlg.SetColor(const AValue: THSV);
begin
  if not SameHSV(FColor, AValue) then
  begin
    FColor := AValue;
    UpdateColorData;
  end;
end;

procedure TcolorDlg.PopulateNamedColorsListView;
var
  i: integer;
begin
  lvNamedColors.Items.BeginUpdate;
  lvNamedColors.Items.Clear;
  for i := 0 to high(CSSColorNames) do
    if (eNamedColorListFilter.Text = '') or (Pos(eNamedColorListFilter.Text, CSSColorNames[i][0]) > 0) then
      with lvNamedColors.Items.Add do
      begin
        Caption := CSSColorNames[i][0];
        ImageIndex := i;
      end;
  lvNamedColors.Items.EndUpdate;
end;

procedure TcolorDlg.SetColorLowres(const Value: TColor);
begin
  if GetPascalColor(FColor) <> Value then
  begin
    FColor := RGBToHSV(PascalColorToRGB(Value));
    UpdateColorData;
  end;
end;

procedure TcolorDlg.SVColorMap1Change(Sender: TObject);
begin
  SetColor(HSV(SVColorMap1.Hue, SVColorMap1.Saturation, SVColorMap1.Value));
end;

procedure TcolorDlg.tsEyedropperResize(Sender: TObject);
begin
  btnEyedropper.Left := (tsEyedropper.ClientWidth - btnEyedropper.ClientWidth) div 2;
  btnEyedropper.Top := (tsEyedropper.ClientHeight - btnEyedropper.ClientHeight) div 2;

  stEyedropper.Left := (tsEyedropper.ClientWidth - stEyedropper.ClientWidth) div 2;
  stEyedropper.Top := (tsEyedropper.ClientHeight - stEyedropper.ClientHeight) div 2;
end;

procedure TcolorDlg.tsNamedColorsShow(Sender: TObject);
var
  i: Integer;
begin
  for i := 0 to lvNamedColors.Items.Count - 1 do
    if CSSColorParse(lvNamedColors.Items[i].Caption) = Color then
    begin
      lvNamedColors.ItemIndex := i;
      lvNamedColors.Items[i].MakeVisible(false);
      Exit;
    end;
  lvNamedColors.ItemIndex := -1;
end;

procedure TcolorDlg.tbHSMapChange(Sender: TObject);
begin
  SetColor(HSV(HSColorMap1.Hue, HSColorMap1.Saturation, (100 - tbHSMap.Position) / 100));
  HSColorMap1.Update;
end;

procedure TcolorDlg.UpdateColorData;
var
  hsv: THSV;
  rgb: TRGB;
begin
  hsv := FColor;
  rgb := HSVToRGB(hsv);

  ColorContainer.Color := GetPascalColor(FColor);
  ColorContainer.Update;

  stHue.Caption := FormatFloat('0.0', hsv.hsvHue);
  stSaturation.Caption := FormatFloat('0.000', hsv.hsvSaturation);
  stValue.Caption := FormatFloat('0.000', hsv.hsvValue);

  stRed.Caption := FormatFloat('0.000', rgb.rgbRed);
  stGreen.Caption := FormatFloat('0.000', rgb.rgbGreen);
  stBlue.Caption := FormatFloat('0.000', rgb.rgbBlue);

  if tsSVMap.Visible then
  begin
    HueSelector1.Color := hsv;
    SVColorMap1.Color := hsv;
  end;

  if tsHSMap.Visible then
  begin
    HSColorMap1.Color := hsv;
    tbHSMap.Position := round(100*(1 - hsv.hsvValue));
  end;

  if tsHSVSliders.Visible then
  begin
    HueSelector2.Color := hsv;
    SaturationSelector1.Color := hsv;
    ValueSelector1.Color := hsv;
  end;

  if tsCoords.Visible then
  begin
    eHue.Text := stHue.Caption;
    eSat.Text := stSaturation.Caption;
    eValue.Text := stValue.Caption;
    eRed.Text := stRed.Caption;
    eGreen.Text := stGreen.Caption;
    eBlue.Text := stBlue.Caption;

    eHex.Text := IntToHex(round(255*rgb.rgbRed), 2) +
      IntToHex(round(255*rgb.rgbGreen), 2) +
      IntToHex(round(255*rgb.rgbBlue), 2);
  end;
end;

procedure TcolorDlg.ValueSelector1Change(Sender: TObject);
begin
  SetColor(HSV(ValueSelector1.Hue, ValueSelector1.Saturation, ValueSelector1.Value));
end;

end.
