coolor.pas

GREATIS Print Suite Pro for Delphi (3-7,2005,2006,2007) and C++ Builder (3-6) Set of components for

(*  GREATIS BONUS * TCoolorDialog             *)
(*  Copyright (C) 1998-2007 Greatis Software  *)
(*  http://www.greatis.com/delphibonus.htm    *)

unit Coolor;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, ExtCtrls, Colors, StdCtrls, Buttons, Clipbrd;

const
  UserColorCount = 32;

type

  TDialogPage = (pageVGA,pageInternet,pageHSB,pageRGB,pageCMY,pageCMYK,pageGray,pageWindows,pageInfo);
  TDialogPages = set of TDialogPage;

  TCoolorDialog = class;

  TfrmCoolorDialog = class(TForm)
    pgcSystems: TPageControl;
    tshHSB: TTabSheet;
    pnlHue: TPanel;
    pntHue: TPaintBox;
    trbHue: TTrackBar;
    pnlSaturation: TPanel;
    pntSaturation: TPaintBox;
    pnlBrightness: TPanel;
    pntBrightness: TPaintBox;
    trbSaturation: TTrackBar;
    trbBrightness: TTrackBar;
    tshVGA: TTabSheet;
    tshInternet: TTabSheet;
    lblHue: TLabel;
    edtHue: TEdit;
    udnHue: TUpDown;
    lblSaturation: TLabel;
    edtSaturation: TEdit;
    udnSaturation: TUpDown;
    lblBrightness: TLabel;
    edtBrightness: TEdit;
    udnBrightness: TUpDown;
    tshRGB: TTabSheet;
    tshGray: TTabSheet;
    tshCMY: TTabSheet;
    pnlCollection: TPanel;
    pnlCollectionBottom: TPanel;
    pnlCollectionTop: TPanel;
    pnl16: TPanel;
    pnl15: TPanel;
    pnl14: TPanel;
    pnl13: TPanel;
    pnl12: TPanel;
    pnl11: TPanel;
    pnl10: TPanel;
    pnl9: TPanel;
    pnl8: TPanel;
    pnl7: TPanel;
    pnl6: TPanel;
    pnl5: TPanel;
    pnl4: TPanel;
    pnl3: TPanel;
    pnl2: TPanel;
    pnl1: TPanel;
    pnl17: TPanel;
    pnl18: TPanel;
    pnl19: TPanel;
    pnl20: TPanel;
    pnl21: TPanel;
    pnl22: TPanel;
    pnl23: TPanel;
    pnl24: TPanel;
    pnl25: TPanel;
    pnl26: TPanel;
    pnl27: TPanel;
    pnl28: TPanel;
    pnl29: TPanel;
    pnl30: TPanel;
    pnl31: TPanel;
    pnl32: TPanel;
    btnOk: TButton;
    btnCancel: TButton;
    tshWindows: TTabSheet;
    pnlVGA: TPanel;
    pnlVGALight: TPanel;
    pnlVGAGray: TPanel;
    pnlVGARed: TPanel;
    pnlVGALime: TPanel;
    pnlVGAYellow: TPanel;
    pnlVGABlue: TPanel;
    pnlVGAFuchsia: TPanel;
    pnlVGAAqua: TPanel;
    pnlVGAWhite: TPanel;
    pnlVGADark: TPanel;
    pnlVGASilver: TPanel;
    pnlVGATeal: TPanel;
    pnlVGAPurple: TPanel;
    pnlVGANavy: TPanel;
    pnlVGAOlive: TPanel;
    pnlVGAGreen: TPanel;
    pnlVGAMaroon: TPanel;
    pnlVGABlack: TPanel;
    pnlColors: TPanel;
    pnlReferenceColor: TPanel;
    pnlColor: TPanel;
    tshInfo: TTabSheet;
    pnlInternet: TPanel;
    pntInternet: TPaintBox;
    lblRed: TLabel;
    lblGreen: TLabel;
    lblBlue: TLabel;
    pnlRed: TPanel;
    pntRed: TPaintBox;
    trbRed: TTrackBar;
    pnlGreen: TPanel;
    pntGreen: TPaintBox;
    pnlBlue: TPanel;
    pntBlue: TPaintBox;
    trbGreen: TTrackBar;
    trbBlue: TTrackBar;
    edtRed: TEdit;
    udnRed: TUpDown;
    edtGreen: TEdit;
    udnGreen: TUpDown;
    edtBlue: TEdit;
    udnBlue: TUpDown;
    lblCyan: TLabel;
    lblMagenta: TLabel;
    lblYellow: TLabel;
    pnlCyan: TPanel;
    pntCyan: TPaintBox;
    trbCyan: TTrackBar;
    pnlMagenta: TPanel;
    pntMagenta: TPaintBox;
    pnlYellow: TPanel;
    pntYellow: TPaintBox;
    trbMagenta: TTrackBar;
    trbYellow: TTrackBar;
    edtCyan: TEdit;
    udnCyan: TUpDown;
    edtMagenta: TEdit;
    udnMagenta: TUpDown;
    edtYellow: TEdit;
    udnYellow: TUpDown;
    lblGray: TLabel;
    pnlGray: TPanel;
    pntGray: TPaintBox;
    trbGray: TTrackBar;
    edtGray: TEdit;
    udnGray: TUpDown;
    lsbWindows: TListBox;
    rgrNumbers: TRadioGroup;
    lblHSB: TLabel;
    lblRGB: TLabel;
    lblCMY: TLabel;
    lblGrayTitle: TLabel;
    lblHSBValue: TLabel;
    lblRGBValue: TLabel;
    lblCMYValue: TLabel;
    lblGrayValue: TLabel;
    sbtHSB: TSpeedButton;
    sbtRGB: TSpeedButton;
    sbtCMY: TSpeedButton;
    sbtGray: TSpeedButton;
    grbFormat: TGroupBox;
    chbSpace: TCheckBox;
    chbComma: TCheckBox;
    chbNames: TCheckBox;
    btnHelp: TButton;
    sbtRound: TSpeedButton;
    sbtRoundGray: TSpeedButton;
    lblCMYK: TLabel;
    lblCMYKValue: TLabel;
    sbtCMYK: TSpeedButton;
    tshCMYK: TTabSheet;
    lblKCyan: TLabel;
    lblKMagenta: TLabel;
    lblKYellow: TLabel;
    pnlKCyan: TPanel;
    pntKCyan: TPaintBox;
    trbKCyan: TTrackBar;
    pnlKMagenta: TPanel;
    pntKMagenta: TPaintBox;
    pnlKYellow: TPanel;
    pntKYellow: TPaintBox;
    trbKMagenta: TTrackBar;
    trbKYellow: TTrackBar;
    edtKCyan: TEdit;
    udnKCyan: TUpDown;
    edtKMagenta: TEdit;
    udnKMagenta: TUpDown;
    edtKYellow: TEdit;
    udnKYellow: TUpDown;
    lblKBlack: TLabel;
    pnlKBlack: TPanel;
    pntKBlack: TPaintBox;
    trbKBlack: TTrackBar;
    edtKBlack: TEdit;
    udnKBlack: TUpDown;
    procedure pntHuePaint(Sender: TObject);
    procedure pntSaturationPaint(Sender: TObject);
    procedure pntBrightnessPaint(Sender: TObject);
    procedure trbHueChange(Sender: TObject);
    procedure trbSaturationChange(Sender: TObject);
    procedure trbBrightnessChange(Sender: TObject);
    procedure edtPress(Sender: TObject; var Key: Char);
    procedure udnHueChanging(Sender: TObject; var AllowChange: Boolean);
    procedure udnSaturationChanging(Sender: TObject;
      var AllowChange: Boolean);
    procedure udnBrightnessChanging(Sender: TObject;
      var AllowChange: Boolean);
    procedure edtHueChange(Sender: TObject);
    procedure udnClick(Sender: TObject; Button: TUDBtnType);
    procedure edtSaturationChange(Sender: TObject);
    procedure edtBrightnessChange(Sender: TObject);
    procedure edtHueExit(Sender: TObject);
    procedure edtSaturationExit(Sender: TObject);
    procedure edtBrightnessExit(Sender: TObject);
    procedure pnlDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure pnlDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure pntHueMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure pntSaturationMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure pntBrightnessMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure pnlVGAClick(Sender: TObject);
    procedure pnlCollectionClick(Sender: TObject);
    procedure pgcSystemsChange(Sender: TObject);
    procedure pntInternetPaint(Sender: TObject);
    procedure pntInternetMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure pntRGBPaint(Sender: TObject);
    procedure pntRGBMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure edtRedExit(Sender: TObject);
    procedure edtGreenExit(Sender: TObject);
    procedure edtBlueExit(Sender: TObject);
    procedure udnRedChanging(Sender: TObject; var AllowChange: Boolean);
    procedure udnGreenChanging(Sender: TObject; var AllowChange: Boolean);
    procedure udnBlueChanging(Sender: TObject; var AllowChange: Boolean);
    procedure trbRGBChange(Sender: TObject);
    procedure edtRedChange(Sender: TObject);
    procedure edtGreenChange(Sender: TObject);
    procedure edtBlueChange(Sender: TObject);
    procedure pntCyanPaint(Sender: TObject);
    procedure pntMagentaPaint(Sender: TObject);
    procedure pntYellowPaint(Sender: TObject);
    procedure trbCMYChange(Sender: TObject);
    procedure udnCyanChanging(Sender: TObject; var AllowChange: Boolean);
    procedure udnMagentaChanging(Sender: TObject;
      var AllowChange: Boolean);
    procedure udnYellowChanging(Sender: TObject; var AllowChange: Boolean);
    procedure edtCyanExit(Sender: TObject);
    procedure edtMagentaExit(Sender: TObject);
    procedure edtYellowExit(Sender: TObject);
    procedure edtCyanChange(Sender: TObject);
    procedure edtMagentaChange(Sender: TObject);
    procedure edtYellowChange(Sender: TObject);
    procedure pntCMYMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure pntGrayPaint(Sender: TObject);
    procedure trbGrayChange(Sender: TObject);
    procedure edtGrayExit(Sender: TObject);
    procedure udnGrayChanging(Sender: TObject; var AllowChange: Boolean);
    procedure pntGrayMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure edtGrayChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure lsbWindowsDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure lsbWindowsClick(Sender: TObject);
    procedure eveInfoClick(Sender: TObject);
    procedure sbtHSBClick(Sender: TObject);
    procedure sbtRGBClick(Sender: TObject);
    procedure sbtCMYClick(Sender: TObject);
    procedure sbtGrayClick(Sender: TObject);
    procedure chbNamesClick(Sender: TObject);
    procedure btnHelpClick(Sender: TObject);
    procedure sbtRoundClick(Sender: TObject);
    procedure sbtRoundGrayClick(Sender: TObject);
    procedure trbCMYKChange(Sender: TObject);
    procedure edtKCyanChange(Sender: TObject);
    procedure edtKMagentaChange(Sender: TObject);
    procedure edtKYellowChange(Sender: TObject);
    procedure edtKBlackChange(Sender: TObject);
    procedure edtKCyanExit(Sender: TObject);
    procedure edtKMagentaExit(Sender: TObject);
    procedure edtKYellowExit(Sender: TObject);
    procedure edtKBlackExit(Sender: TObject);
    procedure udnKCyanChanging(Sender: TObject; var AllowChange: Boolean);
    procedure udnKMagentaChanging(Sender: TObject;
      var AllowChange: Boolean);
    procedure udnKYellowChanging(Sender: TObject;
      var AllowChange: Boolean);
    procedure udnKBlackChanging(Sender: TObject; var AllowChange: Boolean);
    procedure pntCMYKMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure pntKBlackPaint(Sender: TObject);
    procedure pgcSystemsChanging(Sender: TObject;
      var AllowChange: Boolean);
  private
    { Private declarations }
    FCoolorDialog: TCoolorDialog;
    FResultRGB: TRGB;
    InternetColor: TPoint;
    FAutoHelpContext: Boolean;
    FLockRecurse: Boolean;
    function GetRGB: TRGB;
    procedure SetRGB(TheColor: TRGB);
    procedure UpdateColor;
    procedure UpdateSaturation;
    procedure UpdateBrightness;
    procedure UpdateHSBUpDown;
    function GetInternetColor(X,Y: Integer): TColor;
    procedure UpdateInternet;
    procedure UpdateRGBUpDown;
    procedure UpdateCMYUpDown;
    procedure UpdateCMYKUpDown;
    procedure UpdateGrayUpDown;
    procedure UpdateSysColors;
    function GetIndexColor(I: Integer): Integer;
    procedure WMSysColorChange(var Message: TMessage); message WM_SYSCOLORCHANGE;
    procedure UpdateInfo;
    procedure UpdateNamesCheckBox;
    function GetCollectedColor(Index: Integer): TColor;
    procedure SetCollectedColor(Index: Integer; Value: TColor);
    function GetResultColor: TColor;
    procedure SetResultColor(Value: TColor);
    function GetRefColor: TColor;
    procedure SetRefColor(Value: TColor);
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
  end;

  TUserColors = array[1..UserColorCount] of TColor;

  {$IFDEF DIRECTCMYK}
  TCMYKEvent = procedure(Sender: TObject; var CMYKColor: TCMYKColor) of object;
  {$ENDIF}

  TCoolorDialog = class(TComponent)
  private
    { Private declarations }
    FAutoApply: Boolean;
    FStayOnTop: Boolean;
    FVisiblePages: TDialogPages;
    FActivePage: TDialogPage;
    FColor: TColor;
    RColor: TColor;
    FReferenceColor: TColor;
    RReferenceColor: TColor;
    FUserColors: TUserColors;
    RUserColors: TUserColors;
    FCtl3D: Boolean;
    FHelpButton: Boolean;
    FAutoHelpContext: Boolean;
    FHelpContext: THelpContext;
    FCaption: string;
    FDialog: TfrmCoolorDialog;
    FOnShow: TNotifyEvent;
    FOnClose: TNotifyEvent;
    FOnApply: TNotifyEvent;
    {$IFDEF DIRECTCMYK}
    FOnSetCMYK: TCMYKEvent;
    FOnGetCMYK: TCMYKEvent;
    {$ENDIF}
    procedure OnDialogClose(Sender: TObject; var Action: TCloseAction);
    procedure OnApplyButton(Sender: TObject);
    procedure OnCloseButton(Sender: TObject);
    procedure SetColor(const Value: TColor);
    procedure SetReferenceColor(const Value: TColor);
    function GetRGBColor: TRGBColor;
    procedure SetRGBColor(const Value: TRGBColor);
    function GetRGBHex: TRGBHex;
    procedure SetRGBHex(const Value: TRGBHex);
    function GetCMYColor: TCMYColor;
    procedure SetCMYColor(const Value: TCMYColor);
    function GetCMYKColor: TCMYKColor;
    procedure SetCMYKColor(const Value: TCMYKColor);
    function GetHSBColor: THSBColor;
    procedure SetHSBColor(const Value: THSBColor);
    function GetHTMLColor: THTMLColor;
    procedure SetHTMLColor(const Value: THTMLColor);
    function GetUserColor(Index: Integer): TColor;
    procedure SetUserColor(Index: Integer; const Value: TColor);
    procedure SetAutoApply(const Value: Boolean);
    procedure SetStayOnTop(const Value: Boolean);
    procedure SetVisiblePages(const Value: TDialogPages);
    procedure SetActivePage(const Value: TDialogPage);
    procedure SetCtl3D(const Value: Boolean);
    procedure SetHelpButton(const Value: Boolean);
    procedure SetAutoHelpContext(const Value: Boolean);
    procedure SetHelpContext(const Value: THelpContext);
    procedure SetCaption(const Value: string);
    function GetDialog: TForm;
    function GetHandle: HWND;
    procedure SetProperties;
    procedure GetProperties;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    function Execute: Boolean;
    procedure Show;
    procedure DoApply(ForSure: Boolean); virtual;
    property HSBColor: THSBColor read GetHSBColor write SetHSBColor;
    property RGBColor: TRGBColor read GetRGBColor write SetRGBColor;
    property RGBHex: TRGBHex read GetRGBHex write SetRGBHex;
    property CMYColor: TCMYColor read GetCMYColor write SetCMYColor;
    property CMYKColor: TCMYKColor read GetCMYKColor write SetCMYKColor;
    property HTMLColor: THTMLColor read GetHTMLColor write SetHTMLColor;
    property UserColors[Index: Integer]: TColor read GetUserColor write SetUserColor;
    property Dialog: TForm read GetDialog;
    property Handle: HWND read GetHandle;
  published
    { Published declarations }
    property AutoApply: Boolean read FAutoApply write SetAutoApply;
    property StayOnTop: Boolean read FStayOnTop write SetStayOnTop;
    property VisiblePages: TDialogPages read FVisiblePages write SetVisiblePages;
    property ActivePage: TDialogPage read FActivePage write SetActivePage;
    property Color: TColor read FColor write SetColor;
    property ReferenceColor: TColor read FReferenceColor write SetReferenceColor;
    property Ctl3D: Boolean read FCtl3D write SetCtl3D;
    property HelpButton: Boolean read FHelpButton write SetHelpButton;
    property AutoHelpContext: Boolean read FAutoHelpContext write SetAutoHelpContext;
    property HelpContext: THelpContext read FHelpContext write SetHelpContext;
    property Caption: string read FCaption write SetCaption;
    property OnShow: TNotifyEvent read FOnShow write FOnShow;
    property OnClose: TNotifyEvent read FOnClose write FOnClose;
    property OnApply: TNotifyEvent read FOnApply write FOnApply;
    {$IFDEF DIRECTCMYK}
    property OnSetCMYK: TCMYKEvent read FOnSetCMYK write FOnSetCMYK;
    property OnGetCMYK: TCMYKEvent read FOnGetCMYK write FOnGetCMYK;
    {$ENDIF}
  end;

  ECoolorDialogException = class(Exception);

procedure Register;

implementation

{$R *.DFM}

procedure Register;
begin
  RegisterComponents('Greatis', [TCoolorDialog]);
end;

const
  chSelected = #159;
  LegalChars = ['0'..'9',Char(VK_BACK)];

procedure TfrmCoolorDialog.pntHuePaint(Sender: TObject);
var
  i: Integer;
begin
  with pntHue,Canvas do
    for i:=0 to 359 do
    begin
      Brush.Color:=HueToColor(i);
      FillRect(Rect(i*Width div 359,0,Succ(i)*Width div 359,Height));
    end;
end;

procedure TfrmCoolorDialog.pntSaturationPaint(Sender: TObject);
begin
  UpdateSaturation;
end;

procedure TfrmCoolorDialog.pntBrightnessPaint(Sender: TObject);
begin
  UpdateBrightness;
end;

procedure TfrmCoolorDialog.trbHueChange(Sender: TObject);
begin
  UpdateHSBUpDown;
  UpdateSaturation;
  UpdateBrightness;
  UpdateColor;
end;

procedure TfrmCoolorDialog.trbSaturationChange(Sender: TObject);
begin
  UpdateHSBUpDown;
  UpdateBrightness;
  UpdateColor;
end;

procedure TfrmCoolorDialog.trbBrightnessChange(Sender: TObject);
begin
  UpdateHSBUpDown;
  UpdateColor;
end;

function TfrmCoolorDialog.GetRGB: TRGB;
var
  i: Integer;
  HSB: THSB;
begin
  Result:=FResultRGB;
  case TDialogPage(pgcSystems.ActivePage.Tag) of
    pageVGA:
    begin
      with pnlVGADark do
        for i:=0 to Pred(ControlCount) do
          with Controls[i] as TPanel do
            if Caption<>'' then
            begin
              Result:=ColorToRGB(Color);
              Exit;
            end;
      with pnlVGALight do
        for i:=0 to Pred(ControlCount) do
          with Controls[i] as TPanel do
            if Caption<>'' then
            begin
              Result:=ColorToRGB(Color);
              Exit;
            end;
    end;
    pageInternet:
      with InternetColor do
        if (X<>-1) and (Y<>-1) then
          Result:=ColorToRGB(GetInternetColor(X,Y));
    pageHSB:
    begin
      with HSB do
      begin
        Hue:=trbHue.Position;
        Saturation:=trbSaturation.Position;
        Brightness:=trbBrightness.Position;
      end;