You've already forked lazarus-ccr
mbColorLib: Add property BrightnessMode (Luminance or Value) to most pickers to get consistent usage of luminance of value parameters. Add new LVColorPicker (switchable between Luminance and Value). Office dialog working again (still buggy).
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5596 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
@ -4,94 +4,77 @@ unit HSColorPicker;
|
||||
{$MODE DELPHI}
|
||||
{$ENDIF}
|
||||
|
||||
{$DEFINE USE COLOR_TO_RGB}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Forms,
|
||||
RGBHSLUtils, HTMLColors, mbColorPickerControl;
|
||||
HTMLColors, mbColorConv, mbColorPickerControl;
|
||||
|
||||
type
|
||||
|
||||
{ THSColorPicker }
|
||||
|
||||
THSColorPicker = class(TmbColorPickerControl)
|
||||
THSColorPicker = class(TmbHSLVColorPickerControl)
|
||||
private
|
||||
FHue, FSat, FLum, FLumSel: Double;
|
||||
FMaxHue, FMaxSat, FMaxLum: 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);
|
||||
FLumDisp, FValDisp: Double; // Lum and Value used for display
|
||||
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 MouseMove(Shift: TShiftState; X, Y: Integer); override;
|
||||
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
|
||||
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
|
||||
function GetSelectedColor: TColor; override;
|
||||
procedure Paint; override;
|
||||
function PredictColor: TColor;
|
||||
procedure Resize; override;
|
||||
procedure SelectColor(x, y: Integer);
|
||||
procedure SelectColor(x, y: Integer); override;
|
||||
procedure SetMaxHue(H: Integer); override;
|
||||
procedure SetMaxSat(S: Integer); override;
|
||||
procedure SetRelHue(H: Double); override;
|
||||
procedure SetRelSat(S: Double); override;
|
||||
procedure SetSelectedColor(c: TColor); override;
|
||||
procedure UpdateCoords;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
function GetColorAtPoint(x, y: Integer): TColor; override;
|
||||
function GetSelectedColor: TColor; override;
|
||||
published
|
||||
property SelectedColor default clRed;
|
||||
property Hue: integer read GetHue write SetHue default 0;
|
||||
property Saturation: integer read GetSat write SetSat default 240;
|
||||
property Luminance: Integer read GetLum write SetLum default 120;
|
||||
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 Hue default 0;
|
||||
property Saturation default 255;
|
||||
property Luminance default 127;
|
||||
property Value default 255;
|
||||
property MaxHue default 360;
|
||||
property MaxSaturation default 255;
|
||||
property MaxLuminance default 255;
|
||||
property MaxValue default 255;
|
||||
property MarkerStyle default msCross;
|
||||
property OnChange;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
math, mbUtils;
|
||||
Math, mbUtils;
|
||||
|
||||
{THSColorPicker}
|
||||
{ THSColorPicker }
|
||||
|
||||
constructor THSColorPicker.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited;
|
||||
FMaxHue := 359;
|
||||
FMaxSat := 240;
|
||||
FMaxLum := 240;
|
||||
FGradientWidth := FMaxHue + 1;
|
||||
FGradientWidth := FMaxHue; // We want to skip the point at 360° --> no +1
|
||||
FGradientHeight := FMaxSat + 1;
|
||||
SetInitialBounds(0, 0, FGradientWidth, FGradientHeight);
|
||||
FHue := 0;
|
||||
FSat := 1.0;
|
||||
FLum := 0.5;
|
||||
FLumSel := 0.5;
|
||||
FLumDisp := 0.5;
|
||||
FVal := 1.0;
|
||||
FValDisp := 1.0;
|
||||
FSelected := clRed;
|
||||
CreateGradient;
|
||||
HintFormat := 'H: %h S: %hslS'#13'Hex: %hex';
|
||||
MarkerStyle := msCross;
|
||||
end;
|
||||
|
||||
procedure THSColorPicker.CorrectCoords(var x, y: integer);
|
||||
begin
|
||||
Clamp(x, 0, Width - 1);
|
||||
Clamp(y, 0, Height - 1);
|
||||
end;
|
||||
|
||||
procedure THSColorPicker.CreateWnd;
|
||||
begin
|
||||
inherited;
|
||||
@ -101,16 +84,10 @@ end;
|
||||
procedure THSColorPicker.DrawMarker(x, y: integer);
|
||||
var
|
||||
c: TColor;
|
||||
L: Double;
|
||||
dummy: Double = 0;
|
||||
begin
|
||||
CorrectCoords(x, y);
|
||||
|
||||
{$IFDEF USE_COLOR_TO_RGB}
|
||||
ColorToHSL(FSelected, FHue, FSat, L);
|
||||
{$ELSE}
|
||||
RGBToHSL(FSelected, FHue, FSat, L);
|
||||
{$ENDIF}
|
||||
|
||||
ColorToHSLV(FSelected, FHue, FSat, dummy, dummy);
|
||||
if Focused or (csDesigning in ComponentState) then
|
||||
c := clBlack
|
||||
else
|
||||
@ -124,13 +101,9 @@ var
|
||||
begin
|
||||
if InRange(x, 0, Width - 1) and InRange(y, 0, Height - 1) then
|
||||
begin
|
||||
H := x / (Width - 1);
|
||||
H := x / Width; // Width = FMaxHue
|
||||
S := 1 - y / (Height - 1);
|
||||
{$IFDEF USE_COLOR_TO_RGB}
|
||||
Result := HSLToColor(H, S, FLumSel);
|
||||
{$ELSE}
|
||||
Result := HSLToRGB(H, S, FLumSel);
|
||||
{$ENDIF}
|
||||
Result := HSLVtoColor(H, S, FLum, FVal);
|
||||
end else
|
||||
Result := clNone;
|
||||
end;
|
||||
@ -141,121 +114,12 @@ var
|
||||
begin
|
||||
H := x / FMaxHue;
|
||||
S := 1 - y / FMaxSat;
|
||||
{$IFDEF USE_COLOR_TO_RGB}
|
||||
Result := HSLToColor(H, S, FLum);
|
||||
{$ELSE}
|
||||
Result := HSLtoRGB(H, S, FLum);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
function THSColorPicker.GetHue: Integer;
|
||||
begin
|
||||
Result := Round(FHue * (FMaxHue + 1));
|
||||
end;
|
||||
|
||||
function THSColorPicker.GetLum: Integer;
|
||||
begin
|
||||
Result := Round(FLum * FMaxLum);
|
||||
end;
|
||||
|
||||
function THSColorPicker.GetSat: Integer;
|
||||
begin
|
||||
Result := Round(FSat * FMaxSat);
|
||||
Result := HSLVtoColor(H, S, FLumDisp, FValDisp);
|
||||
end;
|
||||
|
||||
function THSColorPicker.GetSelectedColor: TColor;
|
||||
begin
|
||||
{$IFDEF USE_COLOR_TO_RGB}
|
||||
Result := HSLToColor(FHue, FSat, FLumSel);
|
||||
{$ELSE}
|
||||
Result := HSLtoRGB(FHue, FSat, FLumSel);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
procedure THSColorPicker.KeyDown(var Key: Word; Shift: TShiftState);
|
||||
var
|
||||
eraseKey: Boolean;
|
||||
delta: Integer;
|
||||
begin
|
||||
eraseKey := true;
|
||||
delta := IfThen(ssCtrl in Shift, 10, 1);
|
||||
|
||||
case Key of
|
||||
VK_LEFT : SelectColor(mx - delta, my);
|
||||
VK_RIGHT : SelectColor(mx + delta, my);
|
||||
VK_UP : SelectColor(mx, my - delta);
|
||||
VK_DOWN : SelectColor(mx, my + delta);
|
||||
else eraseKey := false;
|
||||
end;
|
||||
{
|
||||
case Key of
|
||||
VK_LEFT:
|
||||
begin
|
||||
mxx := dx - delta;
|
||||
myy := dy;
|
||||
FSelected := GetColorAtPoint(mxx, myy);
|
||||
if Assigned(OnChange) then OnChange(Self);
|
||||
FManual := true;
|
||||
Invalidate;
|
||||
end;
|
||||
VK_RIGHT:
|
||||
begin
|
||||
mxx := dx + delta;
|
||||
myy := dy;
|
||||
FSelected := GetColorAtPoint(mxx, myy);
|
||||
if Assigned(OnChange) then OnChange(Self);
|
||||
FManual := true;
|
||||
Invalidate;
|
||||
end;
|
||||
VK_UP:
|
||||
begin
|
||||
mxx := dx;
|
||||
myy := dy - delta;
|
||||
FSelected := GetColorAtPoint(mxx, myy);
|
||||
if Assigned(OnChange) then OnChange(Self);
|
||||
FManual := true;
|
||||
Invalidate;
|
||||
end;
|
||||
VK_DOWN:
|
||||
begin
|
||||
mxx := dx;
|
||||
myy := dy + delta;
|
||||
FSelected := GetColorAtPoint(mxx, myy);
|
||||
if Assigned(OnChange) then OnChange(Self);
|
||||
FManual := true;
|
||||
Invalidate;
|
||||
end;
|
||||
else
|
||||
eraseKey := false;
|
||||
end;
|
||||
}
|
||||
|
||||
if eraseKey then
|
||||
Key := 0;
|
||||
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure THSColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
||||
begin
|
||||
inherited;
|
||||
if Button = mbLeft then
|
||||
SelectColor(x, y);
|
||||
SetFocus;
|
||||
end;
|
||||
|
||||
procedure THSColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer);
|
||||
begin
|
||||
inherited;
|
||||
if ssLeft in Shift then
|
||||
SelectColor(x, y);
|
||||
end;
|
||||
|
||||
procedure THSColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
||||
begin
|
||||
inherited;
|
||||
if Button = mbLeft then
|
||||
SelectColor(x, y);
|
||||
Result := HSLVtoColor(FHue, FSat, FLum, FVal);
|
||||
end;
|
||||
|
||||
procedure THSColorPicker.Paint;
|
||||
@ -265,15 +129,8 @@ begin
|
||||
end;
|
||||
|
||||
function THSColorPicker.PredictColor: TColor;
|
||||
var
|
||||
H, S, L: Double;
|
||||
begin
|
||||
{$IFDEF USE_COLOR_TO_RGB}
|
||||
ColorToHSL(GetColorUnderCursor, H, S, L);
|
||||
{$ELSE}
|
||||
RGBtoHSL(GetColorUnderCursor, H, S, L);
|
||||
{$ENDIF}
|
||||
Result := HSLToRGB(H, S, L);
|
||||
Result := GetColorUnderCursor;
|
||||
end;
|
||||
|
||||
procedure THSColorPicker.Resize;
|
||||
@ -284,7 +141,10 @@ end;
|
||||
|
||||
procedure THSColorPicker.SelectColor(x, y: Integer);
|
||||
var
|
||||
H, S, L: Double;
|
||||
H: Double = 0;
|
||||
S: Double = 0;
|
||||
L: Double = 0;
|
||||
V: Double = 0;
|
||||
c: TColor;
|
||||
begin
|
||||
CorrectCoords(x, y);
|
||||
@ -292,129 +152,59 @@ begin
|
||||
my := y;
|
||||
c := GetColorAtPoint(x, y);
|
||||
if WebSafe then c := GetWebSafe(c);
|
||||
{$IFDEF USE_COLOR_TO_RGB}
|
||||
ColorToHSL(c, H, S, L);
|
||||
{$ELSE}
|
||||
RGBtoHSL(c, H, S, L);
|
||||
{$ENDIF}
|
||||
|
||||
ColorToHSLV(c, H, S, L, V);
|
||||
if (H = FHue) and (S = FSat) then
|
||||
exit;
|
||||
|
||||
FHue := H;
|
||||
FSat := S;
|
||||
{$IFDEF USE_COLOR_TO_RGB}
|
||||
FSelected := ColorToHSL(FHue, FSat, FLumSel);
|
||||
{$ELSE}
|
||||
FSelected := HSLToRGB(FHue, FSat, FLumSel);
|
||||
{$ENDIF}
|
||||
FSelected := HSLVtoColor(FHue, FSat, FLum, FVal);
|
||||
|
||||
Invalidate;
|
||||
DoChange;
|
||||
end;
|
||||
|
||||
(*
|
||||
BeginUpdate;
|
||||
try
|
||||
mxx := x;
|
||||
myy := y;
|
||||
CorrectCoords(mxx, myy);
|
||||
c := GetColorAtPoint(mxx, myy);
|
||||
if WebSafe then c := GetWebSafe(c);
|
||||
{$IFDEF USE_COLOR_TO_RGB}
|
||||
ColorToHSL(c, FHue, FSat, L);
|
||||
{$ELSE}
|
||||
RGBtoHSL(c, FHue, FSat, L);
|
||||
{$ENDIF}
|
||||
FSelected := c;
|
||||
FManual := false;
|
||||
Invalidate;
|
||||
finally
|
||||
EndUpdate;
|
||||
end;
|
||||
end;
|
||||
*)
|
||||
|
||||
procedure THSColorPicker.SetHue(H: integer);
|
||||
begin
|
||||
Clamp(H, 0, FMaxHue);
|
||||
if H = GetHue then
|
||||
exit;
|
||||
|
||||
FHue := H / (FMaxHue + 1);
|
||||
{$IFDEF USE_COLOR_TO_RGB}
|
||||
FSelected := HSLtoColor(FHue, FSat, FLumSel);
|
||||
{$ELSE}
|
||||
FSelected := HSLToRGB(FHue, FSat, FLumSel);
|
||||
{$ENDIF}
|
||||
UpdateCoords;
|
||||
Invalidate;
|
||||
DoChange;
|
||||
(*
|
||||
{$IFDEF USE_COLOR_TO_RGB}
|
||||
SetSelectedColor(HSLtoColor(FHue, FSat, FLumSel));
|
||||
{$ELSE}
|
||||
SetSelectedColor(HSLToRGB(FHue, FSat, FLumSel));
|
||||
{$ENDIF}
|
||||
*)
|
||||
end;
|
||||
|
||||
// Sets the luminance value used for the display. It is not necessarily that
|
||||
// of the selected color.
|
||||
// The true luminance of the selected color is given by LumSel
|
||||
procedure THSColorPicker.SetLum(L: Integer);
|
||||
begin
|
||||
Clamp(L, 0, FMaxLum);
|
||||
if L = GetLum then
|
||||
exit;
|
||||
|
||||
FLum := L / FMaxLum;
|
||||
CreateGradient;
|
||||
Invalidate;
|
||||
DoChange;
|
||||
end;
|
||||
|
||||
procedure THSColorPicker.SetSat(S: integer);
|
||||
begin
|
||||
Clamp(S, 0, FMaxSat);
|
||||
if S = GetSat then
|
||||
exit;
|
||||
|
||||
FSat := S / FMaxSat;
|
||||
FSelected := HSLToRGB(FHue, FSat, FLumSel);
|
||||
UpdateCoords;
|
||||
Invalidate;
|
||||
DoChange;
|
||||
end;
|
||||
|
||||
procedure THSColorPicker.SetMaxHue(H: Integer);
|
||||
begin
|
||||
if H = FMaxHue then
|
||||
exit;
|
||||
FMaxHue := H;
|
||||
FGradientWidth := FMaxHue + 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);
|
||||
FGradientWidth := H + 1;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure THSColorPicker.SetMaxSat(S: Integer);
|
||||
begin
|
||||
if S = FMaxSat then
|
||||
exit;
|
||||
FMaxSat := S;
|
||||
FGradientHeight := FMaxSat + 1;
|
||||
CreateGradient;
|
||||
FGradientHeight := S + 1;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure THSColorPicker.SetRelHue(H: Double);
|
||||
begin
|
||||
Clamp(H, 0, 1 - 1/FMaxHue); // Don't use H=360°
|
||||
if H = FHue then
|
||||
exit;
|
||||
|
||||
FHue := H;
|
||||
FSelected := GetSelectedColor;
|
||||
UpdateCoords;
|
||||
Invalidate;
|
||||
DoChange;
|
||||
end;
|
||||
|
||||
procedure THSColorPicker.SetRelSat(S: Double);
|
||||
begin
|
||||
Clamp(S, 0.0, 1.0);
|
||||
if S = FSat then
|
||||
exit;
|
||||
|
||||
FSat := S;
|
||||
FSelected := GetSelectedColor;
|
||||
UpdateCoords;
|
||||
Invalidate;
|
||||
DoChange;
|
||||
end;
|
||||
|
||||
// NOTE: In the picker display only the hue and the saturation of the input
|
||||
@ -423,31 +213,32 @@ end;
|
||||
// input color.
|
||||
procedure THSColorPicker.SetSelectedColor(c: TColor);
|
||||
var
|
||||
H, S, L: Double;
|
||||
H: Double = 0;
|
||||
S: Double = 0;
|
||||
L: Double = 0;
|
||||
V: Double = 0;
|
||||
begin
|
||||
if WebSafe then
|
||||
c := GetWebSafe(c);
|
||||
|
||||
{$IFDEF USE_COLOR_TO_RGB}
|
||||
ColorToHSL(c, H, S, L);
|
||||
{$ELSE}
|
||||
RGBtoHSL(c, H, S, L);
|
||||
{$ENDIF}
|
||||
|
||||
FSelected := c;
|
||||
ColorToHSLV(c, H, S, L, V);
|
||||
if (H = FHue) and (S = FSat) then
|
||||
exit;
|
||||
|
||||
FSelected := c;
|
||||
FHue := H;
|
||||
FSat := S;
|
||||
FLumSel := L;
|
||||
case BrightnessMode of
|
||||
bmLuminance : FLum := L;
|
||||
bmValue : FVal := V;
|
||||
end;
|
||||
|
||||
UpdateCoords;
|
||||
Invalidate;
|
||||
DoChange;
|
||||
end;
|
||||
|
||||
procedure THSCOlorPicker.UpdateCoords;
|
||||
procedure THSColorPicker.UpdateCoords;
|
||||
begin
|
||||
mx := Round(FHue * Width);
|
||||
my := Round((1.0 - FSat) * Height);
|
||||
|
||||
Reference in New Issue
Block a user