266 lines
6.8 KiB
ObjectPascal
266 lines
6.8 KiB
ObjectPascal
|
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.
|