unit HSLColorPicker;

{$IFDEF FPC}
  {$MODE DELPHI}
{$ENDIF}

interface

{$I mxs.inc}

uses
  {$IFDEF FPC}
  LCLIntf, LCLType, LMessages,
  {$ELSE}
  Windows, Messages,
  {$ENDIF}
  SysUtils, Classes, Controls, Graphics, Forms, Menus,
  {$IFDEF DELPHI_7_UP} Themes, {$ENDIF}
  RGBHSLUtils, HSColorPicker, LColorPicker, HTMLColors, mbBasicPicker;

type
  THSLColorPicker = class(TmbBasicPicker)
  private
    FOnChange: TNotifyEvent;
    FHSPicker: THSColorPicker;
    FLPicker: TLColorPicker;
    FSelectedColor: TColor;
    FHValue, FSValue, FLValue: integer;
    FRValue, FGValue, FBValue: integer;
    FHSHint, FLHint: string;
    FLMenu, FHSMenu: TPopupMenu;
    FLumIncrement: integer;
    FHSCursor, FLCursor: TCursor;
    PBack: TBitmap;
    function GetManual: boolean;
    procedure SetLumIncrement(i: integer);
    procedure SelectColor(c: TColor);
    procedure SetH(v: integer);
    procedure SetS(v: integer);
    procedure SetL(v: integer);
    procedure SetR(v: integer);
    procedure SetG(v: integer);
    procedure SetB(v: integer);
    procedure SetHSHint(h: string);
    procedure SetLHint(h: string);
    procedure SetLMenu(m: TPopupMenu);
    procedure SetHSMenu(m: TPopupMenu);
    procedure SetHSCursor(c: TCursor);
    procedure SetLCursor(c: TCursor);
    procedure SetSelectedColor(Value: TColor);
  protected
    procedure CreateWnd; override;
    procedure DoChange;
    procedure DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    function GetColorUnderCursor: TColor; override;
    procedure Resize; override;
    procedure Paint; override;
//    procedure PaintParentBack; override;
    procedure WMSetFocus(var Message: {$IFDEF FPC}TLMSetFocus{$ELSE}TWMSetFocus{$ENDIF});
      message {$IFDEF FPC}LM_SETFOCUS{$ELSE}WM_SETFOCUS{$ENDIF};
    procedure HSPickerChange(Sender: TObject);
    procedure LPickerChange(Sender: TObject);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function GetHexColorUnderCursor: string; override;
    function GetSelectedHexColor: string;
    property ColorUnderCursor;
    property HValue: integer read FHValue write SetH default 0;
    property SValue: integer read FSValue write SetS default 240;
    property LValue: integer read FLValue write SetL default 120;
    property RValue: integer read FRValue write SetR default 255;
    property GValue: integer read FGValue write SetG default 0;
    property BValue: integer read FBValue write SetB default 0;
    property Manual: boolean read GetManual;
  published
    property LuminanceIncrement: integer read FLumIncrement write SetLumIncrement default 1;
    property SelectedColor: TColor read FSelectedColor write SetSelectedColor default clRed;
    property HSPickerPopupMenu: TPopupMenu read FHSMenu write SetHSMenu;
    property LPickerPopupMenu: TPopupMenu read FLMenu write SetLMenu;
    property HSPickerHintFormat: string read FHSHint write SetHSHint;
    property LPickerHintFormat: string read FLHint write SetLHint;
    property HSPickerCursor: TCursor read FHSCursor write SetHSCursor default crDefault;
    property LPickerCursor: TCursor read FLCursor write SetLCursor default crDefault;
    property TabStop default true;
    property ShowHint;
    property ParentShowHint;
    property Anchors;
    property Align;
    property Visible;
    property Enabled;
    property TabOrder;
    property Color;
    property ParentColor default true;
    {$IFDEF DELPHI_7_UP}{$IFDEF DELPHI}
    property ParentBackground default true;
    {$ENDIF}{$ENDIF}
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnMouseMove;
  end;

implementation

{THSLColorPicker}

uses
  mbTrackbarPicker;

constructor THSLColorPicker.Create(AOwner: TComponent);
begin
  inherited;
//  ControlStyle := ControlStyle - [csAcceptsControls] + [csOpaque];
  //DoubleBuffered := true;
  PBack := TBitmap.Create;
  PBack.PixelFormat := pf32bit;
  {$IFDEF DELPHI_7_UP} {$IFDEF DELPHI}
  ParentBackground := true;
  {$ENDIF} {$ENDIF}
  SetInitialBounds(0, 0, 206, 146);
  //Width := 206;
  //Height := 146;
  TabStop := true;
  FSelectedColor := clRed;
  FHSPicker := THSColorPicker.Create(Self);
  InsertControl(FHSPicker);
  FLumIncrement := 1;
  FHSCursor := crDefault;
  FLCursor := crDefault;
  with FHSPicker do
  begin
    {$IFDEF DELPHI}
    Left := 0;
    Top := 6;
    Width := 174;
    Height := 134;
    {$ELSE}
    SetInitialBounds(0, 6, 174, 134);
    {$ENDIF}
    Anchors := [akLeft, akTop, akRight, akBottom];
    Visible := true;
    OnChange := HSPickerChange;
    OnMouseMove := DoMouseMove;
  end;
  FLPicker := TLColorPicker.Create(Self);
  InsertControl(FLPicker);
  with FLPicker do
  begin
    Layout := lyVertical;
    {$IFDEF DELPHI}
    Left := 184;
    Top := 0;
    Width := 25;
    Height := 146;
    {$ELSE}
    SetInitialBounds(184, 0, 25, 146);
    {$ENDIF}
    Anchors := [akRight, akTop, akBottom];
    Visible := true;
    OnChange := LPickerChange;
    OnMouseMove := DoMouseMove;
  end;
  FHValue := 0;
  FSValue := 240;
  FLValue := 120;
  FRValue := 255;
  FGValue := 0;
  FBValue := 0;
  FHSHint := 'H: %h S: %hslS'#13'Hex: %hex';
  FLHint := 'Luminance: %l';
end;

destructor THSLColorPicker.Destroy;
begin
  PBack.Free;
  FHSPicker.Free;
  FLPicker.Free;
  inherited Destroy;
end;

procedure THSLColorPicker.HSPickerChange(Sender: TObject);
begin
  FLPicker.Hue := FHSPicker.HueValue;
  FLPicker.Saturation := FHSPicker.SaturationValue;
  DoChange;
end;

procedure THSLColorPicker.LPickerChange(Sender: TObject);
begin
  FHSPicker.Lum := FLPicker.Luminance;
  FSelectedColor := FLPicker.SelectedColor;
  DoChange;
end;

procedure THSLColorPicker.DoChange;
begin
  FHValue := FLPicker.Hue;
  FSValue := FLPicker.Saturation;
  FLValue := FLPicker.Luminance;
  FRValue := GetRValue(FLPicker.SelectedColor);
  FGValue := GetGValue(FLPicker.SelectedColor);
  FBValue := GetBValue(FLPicker.SelectedColor);
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

procedure THSLColorPicker.SelectColor(c: TColor);
begin
  FSelectedColor := c;
  FHSPicker.SelectedColor := c;
  FLPicker.SelectedColor := c;
end;

procedure THSLColorPicker.SetH(v: integer);
begin
  FHValue := v;
  FHSPicker.HueValue := v;
  FLPicker.Hue := v;
end;

procedure THSLColorPicker.SetS(v: integer);
begin
  FSValue := v;
  FHSPicker.SaturationValue := v;
  FLPicker.Saturation := v;
end;

procedure THSLColorPicker.SetL(v: integer);
begin
  FLValue := v;
  FLPicker.Luminance := v;
end;

procedure THSLColorPicker.SetR(v: integer);
begin
  FRValue := v;
  SetSelectedColor(RGB(FRValue, FGValue, FBValue));
end;

procedure THSLColorPicker.SetG(v: integer);
begin
  FGValue := v;
  SetSelectedColor(RGB(FRValue, FGValue, FBValue));
end;

procedure THSLColorPicker.SetB(v: integer);
begin
  FBValue := v;
  SetSelectedColor(RGB(FRValue, FGValue, FBValue));
end;

function THSLColorPicker.GetSelectedHexColor: string;
begin
  Result := ColorToHex(FSelectedColor);
end;

procedure THSLColorPicker.SetHSHint(h: string);
begin
  FHSHint := h;
  FHSPicker.HintFormat := h;
end;

procedure THSLColorPicker.SetLHint(h: string);
begin
  FLHint := h;
  FLPicker.HintFormat := h;
end;

procedure THSLColorPicker.SetLMenu(m: TPopupMenu);
begin
  FLMenu := m;
  FLPicker.PopupMenu := m;
end;

procedure THSLColorPicker.SetHSMenu(m: TPopupMenu);
begin
  FHSMenu := m;
  FHSPicker.PopupMenu := m;
end;

procedure THSLColorPicker.SetLumIncrement(i: integer);
begin
  FLumIncrement := i;
  FLPicker.Increment := i;
end;

procedure THSLColorPicker.DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  if Assigned(OnMouseMove) then
    OnMouseMove(Self, Shift, x, y);
  inherited;
end;

function THSLColorPicker.GetColorUnderCursor: TColor;
begin
  Result := FHSPicker.ColorUnderCursor;
end;

function THSLColorPicker.GetHexColorUnderCursor: string;
begin
  Result := FHSPicker.GetHexColorUnderCursor;
end;

procedure THSLColorPicker.SetHSCursor(c: TCursor);
begin
  FHSCursor := c;
  FHSPicker.Cursor := c;
end;

procedure THSLColorPicker.SetLCursor(c: TCursor);
begin
  FLCursor := c;
  FLPicker.Cursor := c;
end;

procedure THSLColorPicker.WMSetFocus(
  var Message: {$IFDEF FPC}TLMSetFocus{$ELSE}TWMSetFocus{$ENDIF} );
begin
  FHSPicker.SetFocus;
  Message.Result := 1;
end;

function THSLColorPicker.GetManual:boolean;
begin
  Result := FHSPicker.Manual or FLPicker.Manual;
end;

                                         (*
procedure THSLColorPicker.PaintParentBack;
begin
  if PBack = nil then
  begin
    PBack := TBitmap.Create;
    PBack.PixelFormat := pf32bit;
  end;
  PBack.Width := Width;
  PBack.Height := Height;
  if Color = clDefault then begin
    PBack.Transparent := true;
    PBack.TransparentColor := clForm;
    PBack.Canvas.Brush.Color := clForm;
  end else
    PBack.Canvas.Brush.Color := Color;
  PBack.Canvas.FillRect(0, 0, Width, Height);
//  PaintParentBack(PBack);
end;
                                           *)
procedure THSLColorPicker.Resize;
begin
  inherited;

  if (FHSPicker = nil) or (FLPicker = nil) then
    exit;

  FHSPicker.Width := Width - FLPicker.Width - 15;
  FHSPicker.Height := Height - 12;

  FLPicker.Left := Width - FLPicker.Width - 2;
  FLPicker.Height := Height; // - 12;
end;

procedure THSLColorPicker.CreateWnd;
begin
  inherited;
 // PaintParentBack;
end;

procedure THSLColorPicker.Paint;
begin
  PaintParentBack(Canvas);
  Canvas.Draw(0, 0, PBack);
end;

procedure THSLColorPicker.SetSelectedColor(Value: TColor);
begin
  if FSelectedColor <> Value then
  begin
    SelectColor(Value);
    //FLPicker.Hue := FHSPicker.HueValue;
    //FLPicker.Saturation := FHSPicker.SaturationValue;
  end;
end;

end.