You've already forked lazarus-ccr
mbColorLib: All HSV/HSL controls have a property for MaxHue/MaxSaturation/MaxValue (MaxLuminance). Some refactoring avoiding duplicate storage of H, S, L (V) in the complex pickers.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5540 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
@ -4,6 +4,8 @@ unit HSColorPicker;
|
||||
{$MODE DELPHI}
|
||||
{$ENDIF}
|
||||
|
||||
{$DEFINE USE COLOR_TO_RGB}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
@ -21,11 +23,18 @@ type
|
||||
|
||||
THSColorPicker = class(TmbColorPickerControl)
|
||||
private
|
||||
FHue, FSaturation, FLuminance: integer;
|
||||
FLum: integer;
|
||||
FHue, FSat, FLum: Double;
|
||||
FMaxHue, FMaxSat, FMaxLum: Integer;
|
||||
dx, dy, mxx, myy: integer;
|
||||
procedure SetHValue(h: integer);
|
||||
procedure SetSValue(s: integer);
|
||||
function GetHue: Integer;
|
||||
function GetLum: Integer;
|
||||
function GetSat: Integer;
|
||||
procedure SetHue(H: integer);
|
||||
procedure SetLum(L: Integer);
|
||||
procedure SetSat(S: integer);
|
||||
procedure SetMaxHue(H: Integer);
|
||||
procedure SetMaxLum(L: Integer);
|
||||
procedure SetMaxSat(S: Integer);
|
||||
protected
|
||||
procedure CorrectCoords(var x, y: integer);
|
||||
function GetGradientColor2D(X, Y: Integer): TColor; override;
|
||||
@ -42,11 +51,15 @@ type
|
||||
function PredictColor: TColor;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
property Lum: integer read FLum write FLum default 120;
|
||||
property Hue: integer read GetHue write SetHue;
|
||||
property Saturation: integer read GetSat write SetSat;
|
||||
// property Lum: integer read GetLum write SetLum;
|
||||
published
|
||||
property SelectedColor default clRed;
|
||||
property HueValue: integer read FHue write SetHValue default 0;
|
||||
property SaturationValue: integer read FSaturation write SetSValue default 240;
|
||||
property Luminance: Integer read GetLum write SetLum;
|
||||
property MaxHue: Integer read FMaxHue write SetMaxHue default 359;
|
||||
property MaxSaturation: Integer read FMaxSat write SetMaxSat default 240;
|
||||
property MaxLuminance: Integer read FMaxLum write SetMaxLum default 240;
|
||||
property MarkerStyle default msCross;
|
||||
property OnChange;
|
||||
end;
|
||||
@ -61,20 +74,22 @@ uses
|
||||
constructor THSColorPicker.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited;
|
||||
FGradientWidth := 240;
|
||||
FGradientHeight := 241;
|
||||
FMaxHue := 359;
|
||||
FMaxSat := 240;
|
||||
FMaxLum := 240;
|
||||
FGradientWidth := FMaxHue + 1;
|
||||
FGradientHeight := FMaxSat + 1;
|
||||
{$IFDEF DELPHI}
|
||||
Width := 239;
|
||||
Height := 240;
|
||||
{$ELSE}
|
||||
SetInitialBounds(0, 0, 239, 240);
|
||||
SetInitialBounds(0, 0, FGradientWidth, FGradientHeight);
|
||||
{$ENDIF}
|
||||
HintFormat := 'H: %h S: %hslS'#13'Hex: %hex';
|
||||
FHue := 0;
|
||||
FSaturation := 240;
|
||||
FLuminance := 120;
|
||||
FSat := 1.0;
|
||||
FLum := 0.5;
|
||||
FSelected := clRed;
|
||||
FLum := 120;
|
||||
FManual := false;
|
||||
dx := 0;
|
||||
dy := 0;
|
||||
@ -91,7 +106,11 @@ end;
|
||||
|
||||
function THSColorPicker.GetGradientColor2D(X, Y: Integer): TColor;
|
||||
begin
|
||||
Result := HSLRangeToRGB(x, FBufferBmp.Height - 1 - y, 120);
|
||||
{$IFDEF USE_COLOR_TO_RGB}
|
||||
Result := HSLToColor(x / FMaxHue, (FBufferBmp.Height - 1 - y) / FMaxSat, FLum);
|
||||
{$ELSE}
|
||||
Result := HSLtoRGB(x / FMaxHue, (FMaxSat - y) / FMaxSat, FLum);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
procedure THSColorPicker.CorrectCoords(var x, y: integer);
|
||||
@ -103,11 +122,16 @@ end;
|
||||
procedure THSColorPicker.DrawMarker(x, y: integer);
|
||||
var
|
||||
c: TColor;
|
||||
L: Double;
|
||||
begin
|
||||
CorrectCoords(x, y);
|
||||
RGBtoHSLRange(FSelected, FHue, FSaturation, FLuminance);
|
||||
if Assigned(FOnChange) then
|
||||
FOnChange(Self);
|
||||
|
||||
{$IFDEF USE_COLOR_TO_RGB}
|
||||
ColorToHSL(FSelected, FHue, FSat, L);
|
||||
{$ELSE}
|
||||
RGBToHSL(FSelected, FHue, FSat, L);
|
||||
{$ENDIF}
|
||||
|
||||
dx := x;
|
||||
dy := y;
|
||||
if Focused or (csDesigning in ComponentState) then
|
||||
@ -117,15 +141,37 @@ begin
|
||||
InternalDrawMarker(x, y, c);
|
||||
end;
|
||||
|
||||
function THSColorPicker.GetHue: Integer;
|
||||
begin
|
||||
Result := Round(FHue * FMaxHue);
|
||||
end;
|
||||
|
||||
function THSColorPicker.GetLum: Integer;
|
||||
begin
|
||||
Result := Round(FLum * FMaxLum);
|
||||
end;
|
||||
|
||||
function THSColorPicker.GetSat: Integer;
|
||||
begin
|
||||
Result := Round(FSat * FMaxSat);
|
||||
end;
|
||||
|
||||
procedure THSColorPicker.SetSelectedColor(c: TColor);
|
||||
var
|
||||
L: Double;
|
||||
begin
|
||||
if WebSafe then c := GetWebSafe(c);
|
||||
RGBtoHSLRange(c, FHue, FSaturation, FLuminance);
|
||||
{$IFDEF USE_COLOR_TO_RGB}
|
||||
ColorToHSL(c, FHue, FSat, L);
|
||||
{$ELSE}
|
||||
RGBtoHSL(c, FHue, FSat, L);
|
||||
{$ENDIF}
|
||||
FSelected := c;
|
||||
FManual := false;
|
||||
mxx := Round(FHue*(Width/239));
|
||||
myy := Round((240-FSaturation)*(Height/240));
|
||||
mxx := Round(FHue * Width);
|
||||
myy := Round((1.0 - FSat) * Height);
|
||||
Invalidate;
|
||||
if Assigned(OnChange) then OnChange(Self);
|
||||
end;
|
||||
|
||||
procedure THSColorPicker.Paint;
|
||||
@ -142,21 +188,23 @@ begin
|
||||
end;
|
||||
|
||||
procedure THSColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
||||
{$IFDEF DELPHI}
|
||||
var
|
||||
R: TRect;
|
||||
{$ENDIF}
|
||||
begin
|
||||
inherited;
|
||||
mxx := x;
|
||||
myy := y;
|
||||
if Button = mbLeft then
|
||||
begin
|
||||
{$IFDEF DELPHI}
|
||||
R := ClientRect;
|
||||
R.TopLeft := ClientToScreen(R.TopLeft);
|
||||
R.BottomRight := ClientToScreen(R.BottomRight);
|
||||
{$IFDEF DELPHI}
|
||||
ClipCursor(@R);
|
||||
{$ENDIF}
|
||||
FSelected := GetColorAtPoint(x, y);
|
||||
SetSelectedColor(GetColorAtPoint(x, y));
|
||||
FManual := true;
|
||||
Invalidate;
|
||||
end;
|
||||
@ -171,7 +219,7 @@ begin
|
||||
{$ENDIF}
|
||||
mxx := x;
|
||||
myy := y;
|
||||
FSelected := GetColorAtPoint(x, y);
|
||||
SetSelectedColor(GetColorAtPoint(x, y));
|
||||
FManual := true;
|
||||
Invalidate;
|
||||
end;
|
||||
@ -183,7 +231,7 @@ begin
|
||||
begin
|
||||
mxx := x;
|
||||
myy := y;
|
||||
FSelected := GetColorAtPoint(x, y);
|
||||
SetSelectedColor(GetColorAtPoint(x, y));
|
||||
FManual := true;
|
||||
Invalidate;
|
||||
end;
|
||||
@ -191,121 +239,138 @@ end;
|
||||
|
||||
function THSColorPicker.PredictColor: TColor;
|
||||
var
|
||||
FTHue, FTSat, FTLum: integer;
|
||||
H, S, L: Double;
|
||||
begin
|
||||
RGBtoHSLRange(GetColorUnderCursor, FTHue, FTSat, FTLum);
|
||||
Result := HSLRangeToRGB(FTHue, FTSat, FLum);
|
||||
{$IFDEF USE_COLOR_TO_RGB}
|
||||
ColorToHSL(GetColorUnderCursor, H, S, L);
|
||||
{$ELSE}
|
||||
RGBtoHSL(GetColorUnderCursor, H, S, L);
|
||||
{$ENDIF}
|
||||
Result := HSLToRGB(H, S, L);
|
||||
end;
|
||||
|
||||
procedure THSColorPicker.CNKeyDown(
|
||||
var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF} );
|
||||
var
|
||||
Shift: TShiftState;
|
||||
FInherited: boolean;
|
||||
Shift: TShiftState;
|
||||
FInherited: boolean;
|
||||
delta: Integer;
|
||||
begin
|
||||
FInherited := false;
|
||||
Shift := KeyDataToShiftState(Message.KeyData);
|
||||
if not (ssCtrl in Shift) then
|
||||
case Message.CharCode of
|
||||
VK_LEFT:
|
||||
begin
|
||||
mxx := dx - 1;
|
||||
myy := dy;
|
||||
FSelected := GetColorAtPoint(mxx, myy);
|
||||
FManual := true;
|
||||
Invalidate;
|
||||
end;
|
||||
VK_RIGHT:
|
||||
begin
|
||||
mxx := dx + 1;
|
||||
myy := dy;
|
||||
FSelected := GetColorAtPoint(mxx, myy);
|
||||
FManual := true;
|
||||
Invalidate;
|
||||
end;
|
||||
VK_UP:
|
||||
begin
|
||||
mxx := dx;
|
||||
myy := dy - 1;
|
||||
FSelected := GetColorAtPoint(mxx, myy);
|
||||
FManual := true;
|
||||
Invalidate;
|
||||
end;
|
||||
VK_DOWN:
|
||||
begin
|
||||
mxx := dx;
|
||||
myy := dy + 1;
|
||||
FSelected := GetColorAtPoint(mxx, myy);
|
||||
FManual := true;
|
||||
Invalidate;
|
||||
end;
|
||||
FInherited := false;
|
||||
Shift := KeyDataToShiftState(Message.KeyData);
|
||||
if (ssCtrl in Shift) then
|
||||
delta := 10
|
||||
else
|
||||
begin
|
||||
FInherited := true;
|
||||
inherited;
|
||||
end;
|
||||
end
|
||||
else
|
||||
delta := 1;
|
||||
case Message.CharCode of
|
||||
VK_LEFT:
|
||||
VK_LEFT:
|
||||
begin
|
||||
mxx := dx - delta;
|
||||
myy := dy;
|
||||
FSelected := GetColorAtPoint(mxx, myy);
|
||||
FManual := true;
|
||||
Invalidate;
|
||||
end;
|
||||
VK_RIGHT:
|
||||
begin
|
||||
mxx := dx + delta;
|
||||
myy := dy;
|
||||
FSelected := GetColorAtPoint(mxx, myy);
|
||||
FManual := true;
|
||||
Invalidate;
|
||||
end;
|
||||
VK_UP:
|
||||
begin
|
||||
mxx := dx;
|
||||
myy := dy - delta;
|
||||
FSelected := GetColorAtPoint(mxx, myy);
|
||||
FManual := true;
|
||||
Invalidate;
|
||||
end;
|
||||
VK_DOWN:
|
||||
begin
|
||||
mxx := dx;
|
||||
myy := dy + delta;
|
||||
FSelected := GetColorAtPoint(mxx, myy);
|
||||
FManual := true;
|
||||
Invalidate;
|
||||
end;
|
||||
else
|
||||
begin
|
||||
mxx := dx - 10;
|
||||
myy := dy;
|
||||
Refresh;
|
||||
FSelected := GetColorAtPoint(mxx, myy);
|
||||
FManual := true;
|
||||
Invalidate;
|
||||
FInherited := true;
|
||||
inherited;
|
||||
end;
|
||||
VK_RIGHT:
|
||||
begin
|
||||
mxx := dx + 10;
|
||||
myy := dy;
|
||||
Refresh;
|
||||
FSelected := GetColorAtPoint(mxx, myy);
|
||||
FManual := true;
|
||||
Invalidate;
|
||||
end;
|
||||
VK_UP:
|
||||
begin
|
||||
mxx := dx;
|
||||
myy := dy - 10;
|
||||
Refresh;
|
||||
FSelected := GetColorAtPoint(mxx, myy);
|
||||
FManual := true;
|
||||
Invalidate;
|
||||
end;
|
||||
VK_DOWN:
|
||||
begin
|
||||
mxx := dx;
|
||||
myy := dy + 10;
|
||||
Refresh;
|
||||
FSelected := GetColorAtPoint(mxx, myy);
|
||||
FManual := true;
|
||||
Invalidate;
|
||||
end;
|
||||
else
|
||||
begin
|
||||
FInherited := true;
|
||||
inherited;
|
||||
end;
|
||||
end;
|
||||
if not FInherited then
|
||||
if Assigned(OnKeyDown) then
|
||||
OnKeyDown(Self, Message.CharCode, Shift);
|
||||
|
||||
if not FInherited then
|
||||
if Assigned(OnKeyDown) then
|
||||
OnKeyDown(Self, Message.CharCode, Shift);
|
||||
end;
|
||||
|
||||
procedure THSColorPicker.SetHValue(h: integer);
|
||||
procedure THSColorPicker.SetHue(H: integer);
|
||||
begin
|
||||
Clamp(h, 0, 239);
|
||||
FHue := h;
|
||||
SetSelectedColor(HSLRangeToRGB(FHue, FSaturation, 120)); // why hard-coded 120?
|
||||
Clamp(H, 0, FMaxHue);
|
||||
FHue := H / FMaxHue;
|
||||
{$IFDEF USE_COLOR_TO_RGB}
|
||||
SetSelectedColor(HSLtoColor(FHue, FSat, FLum));
|
||||
{$ELSE}
|
||||
SetSelectedColor(HSLToRGB(FHue, FSat, FLum));
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
procedure THSColorPicker.SetSValue(s: integer);
|
||||
// Sets the luminance value used for the display. It is not necessarily that
|
||||
// of the selected color.
|
||||
procedure THSColorPicker.SetLum(L: Integer);
|
||||
begin
|
||||
Clamp(s, 0, 240);
|
||||
FSaturation := s;
|
||||
SetSelectedColor(HSLRangeToRGB(FHue, FSaturation, 120));
|
||||
Clamp(L, 0, FMaxLum);
|
||||
FLum := L / FMaxLum;
|
||||
CreateGradient;
|
||||
{$IFDEF USE_COLOR_TO_RGB}
|
||||
SetSelectedColor(HSLtoColor(FHue, FSat, FLum));
|
||||
{$ELSE}
|
||||
SetSelectedColor(HSLToRGB(FHue, FSat, FLum));
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
procedure THSColorPicker.SetSat(S: integer);
|
||||
begin
|
||||
Clamp(S, 0, FMaxSat);
|
||||
FSat := S;
|
||||
{$IFDEF USE_COLOR_TO_RGB}
|
||||
SetSelectedColor(HSLtoColor(FHue, FSat, FLum));
|
||||
{$ELSE}
|
||||
SetSelectedColor(HSLToRGB(FHue, FSat, FLum));
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
procedure THSColorPicker.SetMaxHue(H: Integer);
|
||||
begin
|
||||
if H = FMaxHue then
|
||||
exit;
|
||||
FMaxHue := H;
|
||||
FGradientWidth := FMaxHue + 1;
|
||||
CreateGradient;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
procedure THSColorPicker.SetMaxSat(S: Integer);
|
||||
begin
|
||||
if S = FMaxSat then
|
||||
exit;
|
||||
FMaxSat := S;
|
||||
FGradientHeight := FMaxSat + 1;
|
||||
CreateGradient;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
procedure THSColorPicker.SetMaxLum(L: Integer);
|
||||
begin
|
||||
if L = FMaxLum then
|
||||
exit;
|
||||
FMaxLum := L;
|
||||
CreateGradient;
|
||||
Invalidate;
|
||||
if Assigned(OnChange) then OnChange(Self);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Reference in New Issue
Block a user