unit UnitfrmSelectColor; // adapted from OfficeMoreColorsDialog

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  ComCtrls, HexaColorPicker, HSLColorPicker, StdCtrls, ExtCtrls, RGBHSLUtils,
  mbXPSpinEdit, mbColorPreview, mbXPSizeGrip, StrUtils, HTMLColors;

type
  TfrmSelectColor = class(TForm)
    Pages: TPageControl;
    Standard: TTabSheet;
    Custom: TTabSheet;
    Hexa: THexaColorPicker;
    HSL: THSLColorPicker;
    lblColor2: TLabel;
    lblColor1: TLabel;
    lblColorModel: TLabel;
    ColorModel: TComboBox;
    LRed: TLabel;
    LGreen: TLabel;
    LBlue: TLabel;
    lblNew: TLabel;
    lblCurrent: TLabel;
    cmdOK: TButton;
    cmdCancel: TButton;
    ERed: TmbXPSpinEdit;
    EGreen: TmbXPSpinEdit;
    EBlue: TmbXPSpinEdit;
    NewSwatch: TmbColorPreview;
    OldSwatch: TmbColorPreview;
    chkDefault1: TCheckBox;
    bvlSpace1: TBevel;
    bvlSpace2: TBevel;
    chkDefault2: TCheckBox;
    procedure ColorModelChange(Sender: TObject);
    procedure HSLChange(Sender: TObject);
    procedure ERedChange(Sender: TObject);
    procedure EGreenChange(Sender: TObject);
    procedure EBlueChange(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure HexaChange(Sender: TObject);
    procedure NewSwatchColorChange(Sender: TObject);
    procedure OldSwatchColorChange(Sender: TObject);
    function GetHint(c: TColor): string;
    procedure SetAllToSel(c: TColor);
    procedure PagesChange(Sender: TObject);
    procedure chkDefault2Click(Sender: TObject);
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
  end;

var
  frmSelectColor: TfrmSelectColor;
  h, s, l: integer;

implementation

{$R *.dfm}

procedure TfrmSelectColor.CreateParams(var Params: TCreateParams);
begin 
  inherited CreateParams(Params); 
  Params.Style := WS_CAPTION or WS_SYSMENU;
  Params.ExStyle := WS_EX_DLGMODALFRAME or WS_EX_WINDOWEDGE; 
end; 

procedure TfrmSelectColor.CreateWnd;
begin 
  inherited CreateWnd; 
  SendMessage(Self.Handle, WM_SETICON, 1, 0); 
end; 

procedure TfrmSelectColor.ColorModelChange(Sender: TObject);
begin
 case ColorModel.ItemIndex of
  0:
   begin
    LRed.Caption := '&Red:';
    LGreen.Caption := '&Green:';
    LBlue.Caption := '&Blue:';
    ERed.MaxValue := 255;
    EGreen.MaxValue := 255;
    EBlue.MaxValue := 255;
    ERed.Value := GetRValue(NewSwatch.Color);
    EGreen.Value := GetGValue(NewSwatch.Color);
    EBlue.Value := GetBValue(NewSwatch.Color);
   end;
  1:
   begin
    LRed.Caption := 'H&ue:';
    LGreen.Caption := '&Sat:';
    LBlue.Caption := '&Lum:';
    ERed.MaxValue := 238;
    EGreen.MaxValue := 240;
    EBlue.MaxValue := 240;
    RGBtoHSLRange(NewSwatch.Color, h, s, l);
    ERed.Value := h;
    EGreen.Value := s;
    EBlue.Value := l;
   end;
 end;
end;

procedure TfrmSelectColor.HSLChange(Sender: TObject);
begin
 if HSL.Manual then
  case ColorModel.ItemIndex of
   0:
    begin
      ERed.Value := HSL.RValue;
      EGreen.Value := HSL.GValue;
      EBlue.Value := HSL.BValue;
      NewSwatch.Color := HSL.SelectedColor;
    end;
   1:
    begin
      ERed.Value := HSL.HValue;
      EGreen.Value := HSL.SValue;
      EBlue.Value := HSL.LValue;
      NewSwatch.Color := HSL.SelectedColor;
    end;
  end;
end;

procedure TfrmSelectColor.ERedChange(Sender: TObject);
begin
if (ERed.Text <> '') and ERed.Focused then
 case ColorModel.ItemIndex of
  0:
   begin
    HSL.RValue := ERed.Value;
    NewSwatch.Color := RGB(ERed.Value, EGreen.Value, EBlue.Value);
   end;
  1:
   begin
    HSL.HValue := ERed.Value;
    NewSwatch.Color := HSLRangeToRGB(ERed.Value, EGreen.Value, EBlue.Value);
   end;
 end;
end;

procedure TfrmSelectColor.EGreenChange(Sender: TObject);
begin
if (EGreen.Text <> '') and EGreen.Focused then
 case ColorModel.ItemIndex of
  0:
   begin
    HSL.GValue := EGreen.Value;
    NewSwatch.Color := RGB(ERed.Value, EGreen.Value, EBlue.Value);
   end;
  1:
   begin
    HSL.SValue := EGreen.Value;
    NewSwatch.Color := HSLRangeToRGB(ERed.Value, EGreen.Value, EBlue.Value);
   end;
 end;
end;

procedure TfrmSelectColor.EBlueChange(Sender: TObject);
begin
if (EBlue.Text <> '') and EBlue.Focused then
 case ColorModel.ItemIndex of
  0:
   begin
    HSL.BValue := EBlue.Value;
    NewSwatch.Color := RGB(ERed.Value, EGreen.Value, EBlue.Value);
   end;
  1:
   begin
    HSL.LValue := EBlue.Value;
    NewSwatch.Color := HSLRangeToRGB(ERed.Value, EGreen.Value, EBlue.Value);
   end;
 end;
end;

procedure TfrmSelectColor.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
 case Key of
  VK_RETURN: ModalResult := mrOK;
  VK_ESCAPE: ModalResult := mrCancel;
 end;
end;

procedure TfrmSelectColor.HexaChange(Sender: TObject);
begin
 NewSwatch.Color := Hexa.SelectedColor;
end;

function TfrmSelectColor.GetHint(c: TColor): string;
begin
 Result := Format('RGB(%u, %u, %u)'#13'Hex: %s', [GetRValue(c), GetGValue(c), GetBValue(c), ColorToHex(c)]);
end;

procedure TfrmSelectColor.NewSwatchColorChange(Sender: TObject);
begin
 NewSwatch.Hint := GetHint(NewSwatch.Color);
end;

procedure TfrmSelectColor.OldSwatchColorChange(Sender: TObject);
begin
 OldSwatch.Hint := GetHint(OldSwatch.Color);
 SetAllToSel(OldSwatch.Color);
end;

procedure TfrmSelectColor.SetAllToSel(c: TColor);
begin
 case Pages.ActivePageIndex of
  // Standard Page
  0: Hexa.SelectedColor := c;
  // Custom Page
  1:
   begin
    HSL.SelectedColor := c;
    case ColorModel.ItemIndex of
     0:
      begin
       ERed.Value := GetRValue(c);
       EGreen.Value := GetGValue(c);
       EBlue.Value := GetBValue(c);
      end;
     1:
      begin
       RGBtoHSLRange(c, h, s, l);
       ERed.Value := h;
       EGreen.Value := s;
       EBlue.Value := l;
      end;
    end;
   end;
 end;
 NewSwatch.Color := c;
end;

procedure TfrmSelectColor.PagesChange(Sender: TObject);
begin
 SetAllToSel(NewSwatch.Color);
end;

procedure TfrmSelectColor.chkDefault2Click(Sender: TObject);
begin
  chkDefault1.Checked := (Sender As TCheckBox).Checked;
  chkDefault2.Checked := (Sender As TCheckBox).Checked;

  lblColor1.Enabled := not (Sender As TCheckBox).Checked;
  bvlSpace1.Enabled := not (Sender As TCheckBox).Checked;
  Hexa.Enabled := not (Sender As TCheckBox).Checked;
  lblColor2.Enabled := not (Sender As TCheckBox).Checked;
  lblColorModel.Enabled := not (Sender As TCheckBox).Checked;
  LRed.Enabled := not (Sender As TCheckBox).Checked;
  LGreen.Enabled := not (Sender As TCheckBox).Checked;
  LBlue.Enabled := not (Sender As TCheckBox).Checked;
  bvlSpace2.Enabled := not (Sender As TCheckBox).Checked;
  HSL.Enabled := not (Sender As TCheckBox).Checked;
  ColorModel.Enabled := not (Sender As TCheckBox).Checked;
  ERed.Enabled := not (Sender As TCheckBox).Checked;
  EGreen.Enabled := not (Sender As TCheckBox).Checked;
  EBlue.Enabled := not (Sender As TCheckBox).Checked;
end;

end.