unit ColorContainer;

interface

uses
  Windows, Messages, SysUtils, Types, Classes, Graphics, Controls, Menus,
  UITypes;

type
  TColorContainer = class(TCustomControl)
  private
    FColor: TColor;
    FInteractive: Boolean;
    FPopupMenu: TPopupMenu;
    FOnChange: TNotifyEvent;
    procedure SetColor(const Value: TColor);
    procedure SetInteractive(const Value: Boolean);
    procedure MenuItemClicked(Sender: TObject);
    function ColorToHex(AColor: TColor): string;
    procedure CopyToClipboard;
    procedure PasteFromClipboard;
  protected
    procedure Paint; override;
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure Click; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer;
      Y: Integer); override;
    procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
    procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure WMContextMenu(var Message: TWMContextMenu);
      message WM_CONTEXTMENU;
    procedure KeyPress(var Key: Char); override;
    procedure WndProc(var Message: TMessage); override;
  public
    procedure ShowDialog;
    constructor Create(AOwner: TComponent); override;
  published
    property Align;
    property AlignWithMargins;
    property Anchors;
    property Cursor;
    property Color: TColor read FColor write SetColor;
    property Enabled;
    property Interactive: Boolean read FInteractive write SetInteractive default false;
    property PopupMenu;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnClick;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnKeyPress;
    property OnKeyDown;
    property OnKeyUp;
  end;

procedure Register;

implementation

uses ASColors, ColorDialog, Clipbrd;

procedure Register;
begin
  RegisterComponents('Rejbrand 2015', [TColorContainer]);
end;

{ TColorContainer }

resourcestring
  SBlack = 'Black';
  SWhite = 'White';
  SCopy = 'Copy';
  SPaste = 'Paste';

const
  MENU_COPY = -1;
  MENU_PASTE = -2;

procedure TColorContainer.Click;
begin
  inherited;
  if FInteractive then
    ShowDialog;
end;

procedure TColorContainer.MenuItemClicked(Sender: TObject);
begin
  if Sender is TMenuItem then
    case TMenuItem(Sender).Tag of
      MENU_COPY:
        CopyToClipboard;
      MENU_PASTE:
        PasteFromClipboard;
    else
      begin
        if Color <> TMenuItem(Sender).Tag then
        begin
          Color := TMenuItem(Sender).Tag;
          if Assigned(FOnChange) then
            FOnChange(Self);
        end;
      end;
    end;
end;

constructor TColorContainer.Create(AOwner: TComponent);
var
  mi: TMenuItem;
begin

  inherited;

  FPopupMenu := TPopupMenu.Create(Self);
  FPopupMenu.AutoLineReduction := maAutomatic;

  mi := TMenuItem.Create(FPopupMenu);
  mi.Caption := SBlack;
  mi.Tag := clBlack;
  mi.OnClick := MenuItemClicked;
  FPopupMenu.Items.Add(mi);

  mi := TMenuItem.Create(FPopupMenu);
  mi.Caption := SWhite;
  mi.Tag := clWhite;
  mi.OnClick := MenuItemClicked;
  FPopupMenu.Items.Add(mi);

  FPopupMenu.Items.NewBottomLine;

  mi := TMenuItem.Create(FPopupMenu);
  mi.Caption := SCopy;
  mi.Tag := MENU_COPY;
  mi.OnClick := MenuItemClicked;
  FPopupMenu.Items.Add(mi);

  mi := TMenuItem.Create(FPopupMenu);
  mi.Caption := SPaste;
  mi.Tag := MENU_PASTE;
  mi.OnClick := MenuItemClicked;
  FPopupMenu.Items.Add(mi);

end;

procedure TColorContainer.ShowDialog;
begin
  with TColorDialog.Create(nil) do
    try
      Color := Self.Color;
      if Execute then
      begin
        Self.Color := Color;
        if Assigned(FOnChange) then
          FOnChange(Self);
      end;
    finally
      Free;
    end;
end;

procedure TColorContainer.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited;
  if FInteractive then
    if (Key = VK_SPACE) and not (ssAlt in Shift) then
      ShowDialog;
end;

procedure TColorContainer.KeyPress(var Key: Char);
begin
  inherited;
  if FInteractive then
    case Key of
      ^C:
        CopyToClipboard;
      ^V:
        PasteFromClipboard;
    end;
end;

procedure TColorContainer.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  inherited;
  if FInteractive and CanFocus then
    SetFocus;
end;

procedure TColorContainer.CMEnabledChanged(var Message: TMessage);
begin
  inherited;
  Invalidate;
end;

function TColorContainer.ColorToHex(AColor: TColor): string;
begin
  Result := Format('#%.2x%.2x%.2x', [GetRValue(AColor), GetGValue(AColor), GetBValue(AColor)]);
end;

procedure TColorContainer.Paint;
var
  R: TRect;
  S: string;
  LColor: TColor;
begin
  inherited;
  R := ClientRect;
  if Enabled then
    LColor := FColor
  else
    LColor := clBtnFace;
  Canvas.Brush.Color := LColor;
  Canvas.Brush.Style := bsSolid;
  Canvas.FillRect(R);
  InflateRect(R, -4, -4);
  Canvas.Font.Assign(Self.Font);
  if ColorIsDark(LColor) then
    Canvas.Pen.Color := clWhite
  else
    Canvas.Pen.Color := clBlack;
  Canvas.Font.Color := Canvas.Pen.Color;
  S := ColorToHex(FColor); // use the actual FColor
  if not Enabled then
    S := Format('(%s)', [S]);
  Canvas.TextRect(R, S, [tfSingleLine, tfVerticalCenter, tfCenter]);
  if Focused then
    Canvas.DrawFocusRect(R);
end;

procedure TColorContainer.SetColor(const Value: TColor);
begin
  if FColor <> Value then
  begin
    FColor := Value;
    Invalidate;
  end;
end;

procedure TColorContainer.SetInteractive(const Value: Boolean);
begin
  if FInteractive <> Value then
  begin
    FInteractive := Value;
    TabStop := FInteractive;
    Invalidate;
  end;
end;

procedure TColorContainer.WMContextMenu(var Message: TWMContextMenu);
begin
  if FInteractive and not Assigned(PopupMenu) then
    if (Message.XPos = -1) and (Message.YPos = -1) then
      with ClientToScreen(Point(0, ClientHeight)) do
        FPopupMenu.Popup(X, Y)
    else
      FPopupMenu.Popup(Message.XPos, Message.YPos)
  else
    inherited;
end;

procedure TColorContainer.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
  Message.Result := 1;
end;

procedure TColorContainer.WMKillFocus(var Message: TWMKillFocus);
begin
  Invalidate;
end;

procedure TColorContainer.WMSetFocus(var Message: TWMSetFocus);
begin
  Invalidate;
end;


procedure TColorContainer.WndProc(var Message: TMessage);
begin
  inherited;
  case Message.Msg of
    WM_COPY:
      CopyToClipboard;
    WM_PASTE:
      PasteFromClipboard;
  end;
end;

procedure TColorContainer.CopyToClipboard;
begin
  Clipboard.AsText := ColorToHex(Color);
end;

procedure TColorContainer.PasteFromClipboard;
var
  clr: TColor;
begin
  if TryStrToColor(Clipboard.AsText, clr) then
  begin
    Color := clr;
    if Assigned(FOnChange) then
      FOnChange(Self);
  end;
end;

end.
