unit CIEAColorPicker; {$IFDEF FPC} {$MODE DELPHI} {$ENDIF} interface uses LCLIntf, LCLType, LMessages, SysUtils, Classes, Controls, Graphics, Math, Forms, HTMLColors, RGBCIEUtils, mbColorPickerControl; type TCIEAColorPicker = class(TmbColorPickerControl) private FL, FA, FB: integer; dx, dy, mxx, myy: integer; procedure SetLValue(l: integer); procedure SetAValue(a: integer); procedure SetBValue(b: integer); protected procedure CorrectCoords(var x, y: integer); procedure CreateWnd; override; procedure DrawMarker(x, y: integer); function GetGradientColor2D(x, y: Integer): TColor; override; procedure KeyDown(var Key: Word; Shift: TShiftState); override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure Paint; override; procedure Resize; override; procedure SetSelectedColor(c: TColor); override; public constructor Create(AOwner: TComponent); override; function GetColorAtPoint(x, y: Integer): TColor; override; published property SelectedColor default clFuchsia; property LValue: integer read FL write SetLValue default 100; property AValue: integer read FA write SetAValue default 127; property BValue: integer read FB write SetBValue default -128; property MarkerStyle default msCircle; property OnChange; end; implementation uses mbUtils; {TCIEAColorPicker} constructor TCIEAColorPicker.Create(AOwner: TComponent); begin inherited; FGradientWidth := 256; FGradientHeight := 256; SetInitialBounds(0, 0, 256, 256); HintFormat := 'L: %cieL B: %cieB'#13'Hex: %hex'; FSelected := clFuchsia; FL := 100; FA := 127; FB := -128; FManual := false; dx := 0; dy := 0; mxx := 0; myy := 0; MarkerStyle := msCircle; end; procedure TCIEAColorPicker.CorrectCoords(var x, y: integer); begin Clamp(x, 0, Width - 1); Clamp(y, 0, Height - 1); end; procedure TCIEAColorPicker.CreateWnd; begin inherited; CreateGradient; end; procedure TCIEAColorPicker.DrawMarker(x, y: integer); var c: TColor; begin CorrectCoords(x, y); FL := Round(GetCIELValue(FSelected)); FA := Round(GetCIEAValue(FSelected)); FB := Round(GetCIEBValue(FSelected)); dx := x; dy := y; if Focused or (csDesigning in ComponentState) then c := clBlack else c := clWhite; InternalDrawMarker(x, y, c); end; { function TCIEAColorPicker.GetColorAtPoint(x, y: Integer): TColor; var l, a, b: Integer; begin l := round(100 * (1 - y / (Height-1))); a := FA; b := round(255 * (x / (Width - 1))) - 128; Result := LabToRGB(l, a, b); end; } function TCIEAColorPicker.GetColorAtPoint(x, y: Integer): TColor; var l, b: Integer; //Double; begin l := round((1 - y / (Height - 1)) * 100); b := round((x / (Width - 1) - 0.5) * 255); Result := LabToRGB(l, FA, b); end; // In the original code: for L ... for B ... LabToRGB(Round(100-L*100/255), FA, B-128); // --> x is B, y is L function TCIEAColorPicker.GetGradientColor2D(x, y: Integer): TColor; begin Result := LabToRGB(Round(100 - y*100/255), FA, x - 128); end; procedure TCIEAColorPicker.KeyDown(var Key: Word; Shift: TShiftState); var eraseKey: Boolean; delta: Integer; begin eraseKey := true; if (ssCtrl in Shift) then delta := 10 else delta := 1; case Key of VK_LEFT: begin mxx := dx - delta; myy := dy; if mxx < 0 then mxx := 0; FSelected := GetColorAtPoint(mxx, myy); FManual := true; Invalidate; if Assigned(FOnChange) then FOnChange(Self); end; VK_RIGHT: begin mxx := dx + delta; myy := dy; if mxx >= Width then mxx := Width - 1; FSelected := GetColorAtPoint(mxx, myy); FManual := true; Invalidate; if Assigned(FOnChange) then FOnChange(Self); end; VK_UP: begin mxx := dx; myy := dy - delta; if myy < 0 then myy := 0; FSelected := GetColorAtPoint(mxx, myy); FManual := true; Invalidate; if Assigned(FOnChange) then FOnChange(Self); end; VK_DOWN: begin mxx := dx; myy := dy + delta; if myy >= Height then myy := Height - 1; FSelected := GetColorAtPoint(mxx, myy); FManual := true; Invalidate; if Assigned(FOnChange) then FOnChange(Self); end; else eraseKey := false; end; if eraseKey then Key := 0; inherited; end; procedure TCIEAColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited; if Button = mbLeft then begin mxx := x; myy := y; CorrectCoords(mxx, myy); FSelected := GetColorAtPoint(mxx, myy); FSelected := GetColorAtPoint(x, y); FManual := true; Invalidate; if Assigned(FOnChange) then FOnChange(Self); end; SetFocus; end; procedure TCIEAColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer); begin inherited; if ssLeft in Shift then begin mxx := x; myy := y; CorrectCoords(mxx, myy); FSelected := GetColorAtPoint(mxx, myy); FManual := true; Invalidate; if Assigned(FOnChange) then FOnChange(Self); end; end; procedure TCIEAColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited; if ssLeft in Shift then begin mxx := x; myy := y; CorrectCoords(mxx, myy); FSelected := GetColorAtPoint(mxx, myy); FManual := true; Invalidate; if Assigned(FOnChange) then FOnChange(Self); end; end; procedure TCIEAColorPicker.Paint; begin Canvas.StretchDraw(ClientRect, FBufferBmp); DrawMarker(mxx, myy); end; procedure TCIEAColorPicker.Resize; begin FManual := false; mxx := Round((FB + 128) * Width / 255); myy := Round(((100 - FL) * 255 / 100) * Height / 255); inherited; end; procedure TCIEAColorPicker.SetAValue(a: integer); begin Clamp(a, -128, 127); FA := a; SetSelectedColor(LabToRGB(FL, FA, FB)); end; procedure TCIEAColorPicker.SetBValue(b: integer); begin Clamp(b, -128, 127); FB := b; SetSelectedColor(LabToRGB(FL, FA, FB)); end; procedure TCIEAColorPicker.SetLValue(l: integer); begin Clamp(L, 0, 100); FL := L; SetSelectedColor(LabToRGB(FL, FA, FB)); end; procedure TCIEAColorPicker.SetSelectedColor(c: TColor); begin if WebSafe then c := GetWebSafe(c); FL := Round(GetCIELValue(c)); FA := Round(GetCIEAValue(c)); FB := Round(GetCIEBValue(c)); FSelected := c; FManual := false; mxx := Round((FB + 128) * Width / 255); myy := Round((100 - FL) * 255 / 100 * Height / 255); Invalidate; if Assigned(FOnChange) then FOnChange(Self); end; end.