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
@ -7,27 +7,14 @@ unit HColorPicker;
|
||||
interface
|
||||
|
||||
uses
|
||||
LCLIntf, LCLType, LMessages, SysUtils, Classes, Controls, Graphics, Forms,
|
||||
RGBHSVUtils, HTMLColors, mbTrackBarPicker;
|
||||
LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Forms,
|
||||
HTMLColors, mbColorConv, mbTrackBarPicker;
|
||||
|
||||
type
|
||||
THColorPicker = class(TmbTrackBarPicker)
|
||||
THColorPicker = class(TmbHSLVTrackBarPicker)
|
||||
private
|
||||
FHue, FSat, FVal: Double;
|
||||
FMaxHue, FMaxSat, FMaxVal: Integer;
|
||||
function ArrowPosFromHue(h: integer): integer;
|
||||
function HueFromArrowPos(p: integer): integer;
|
||||
function GetHue: Integer;
|
||||
function GetSat: Integer;
|
||||
function GetSelectedColor: TColor;
|
||||
function GetVal: Integer;
|
||||
procedure SetHue(h: integer);
|
||||
procedure SetMaxHue(h: Integer);
|
||||
procedure SetMaxSat(s: Integer);
|
||||
procedure SetMaxVal(v: Integer);
|
||||
procedure SetSat(s: integer);
|
||||
procedure SetSelectedColor(c: TColor);
|
||||
procedure SetVal(v: integer);
|
||||
function ArrowPosFromHue(h: Double): integer;
|
||||
function HueFromArrowPos(p: integer): Double;
|
||||
protected
|
||||
function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
|
||||
MousePos: TPoint): Boolean; override;
|
||||
@ -35,17 +22,19 @@ type
|
||||
function GetArrowPos: integer; override;
|
||||
function GetGradientColor(AValue: Integer): TColor; override;
|
||||
function GetSelectedValue: integer; override;
|
||||
procedure SetMaxHue(H: Integer); override;
|
||||
procedure SetRelHue(H: Double); override;
|
||||
procedure SetSelectedColor(c: TColor); override;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
published
|
||||
property Hue: integer read GetHue write SetHue;
|
||||
property Saturation: integer read GetSat write SetSat;
|
||||
property Value: integer read GetVal write SetVal;
|
||||
property Layout default lyHorizontal;
|
||||
property MaxHue: Integer read FMaxHue write SetMaxHue default 359;
|
||||
property MaxSaturation: Integer read FMaxSat write SetMaxSat default 255;
|
||||
property MaxValue: Integer read FMaxVal write SetMaxVal default 255;
|
||||
property SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed;
|
||||
property Hue default 0;
|
||||
property Saturation default 255;
|
||||
property Luminance default 127;
|
||||
property Value default 255;
|
||||
property SelectedColor default clRed;
|
||||
property HintFormat;
|
||||
end;
|
||||
|
||||
|
||||
@ -59,29 +48,27 @@ uses
|
||||
constructor THColorPicker.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited;
|
||||
FMaxHue := 359;
|
||||
FMaxSat := 255;
|
||||
FMaxVal := 255;
|
||||
FGradientWidth := FMaxHue;
|
||||
FGradientHeight := 1;
|
||||
FSat := 1.0;
|
||||
FVal := 1.0;
|
||||
SetHue(0);
|
||||
FLum := 0.5;
|
||||
Hue := 0;
|
||||
HintFormat := 'Hue: %value (selected)';
|
||||
end;
|
||||
|
||||
function THColorPicker.ArrowPosFromHue(h: integer): integer;
|
||||
function THColorPicker.ArrowPosFromHue(H: Double): integer;
|
||||
var
|
||||
a: integer;
|
||||
begin
|
||||
if Layout = lyHorizontal then
|
||||
begin
|
||||
a := Round((Width - 12) * h / FMaxHue);
|
||||
a := Round((Width - 12) * H);
|
||||
if a > Width - FLimit then a := Width - FLimit;
|
||||
end
|
||||
else
|
||||
begin
|
||||
a := Round((Height - 12) * h / FMaxHue);
|
||||
a := Round((Height - 12) * H);
|
||||
if a > Height - FLimit then a := Height - FLimit;
|
||||
end;
|
||||
if a < 0 then a := 0;
|
||||
@ -92,40 +79,44 @@ function THColorPicker.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
|
||||
MousePos: TPoint): Boolean;
|
||||
begin
|
||||
if Layout = lyVertical then WheelDelta := -WheelDelta;
|
||||
inherited;
|
||||
WheelDelta := WheelDelta * 3; // use larger steps
|
||||
Result := inherited;
|
||||
end;
|
||||
|
||||
procedure THColorPicker.Execute(tbaAction: integer);
|
||||
var
|
||||
dHue: Double;
|
||||
begin
|
||||
if FMaxHue = 0 then dHue := 0 else dHue := Increment / FMaxHue;
|
||||
case tbaAction of
|
||||
TBA_Resize:
|
||||
SetHue(GetHue);
|
||||
SetRelHue(FHue); // wp: Is this working?
|
||||
TBA_MouseMove:
|
||||
SetHue(HueFromArrowPos(FArrowPos));
|
||||
SetRelHue(HueFromArrowPos(FArrowPos));
|
||||
TBA_MouseDown:
|
||||
SetHue(HueFromArrowPos(FArrowPos));
|
||||
SetRelHue(HueFromArrowPos(FArrowPos));
|
||||
TBA_MouseUp:
|
||||
SetHue(HueFromArrowPos(FArrowPos));
|
||||
SetRelHue(HueFromArrowPos(FArrowPos));
|
||||
TBA_WheelUp:
|
||||
SetHue(GetHue() + Increment);
|
||||
SetRelHue(FHue + dHue);
|
||||
TBA_WheelDown:
|
||||
SetHue(GetHue() - Increment);
|
||||
SetRelHue(FHue - dHue);
|
||||
TBA_VKLeft:
|
||||
SetHue(GetHue() - Increment);
|
||||
SetRelHue(FHue - dHue);
|
||||
TBA_VKCtrlLeft:
|
||||
SetHue(0);
|
||||
SetRelHue(0);
|
||||
TBA_VKRight:
|
||||
SetHue(GetHue() + Increment);
|
||||
SetRelHue(FHue + dHue);
|
||||
TBA_VKCtrlRight:
|
||||
SetHue(FMaxHue);
|
||||
SetRelHue(1 - dHue); // go one step below 360, or the hue will flip back to 0
|
||||
TBA_VKUp:
|
||||
SetHue(GetHue() - Increment);
|
||||
SetRelHue(FHue - dHue);
|
||||
TBA_VKCtrlUp:
|
||||
SetHue(0);
|
||||
SetRelHue(0);
|
||||
TBA_VKDown:
|
||||
SetHue(GetHue() + Increment);
|
||||
SetRelHue(FHue + dHue);
|
||||
TBA_VKCtrlDown:
|
||||
SetHue(FMaxHue);
|
||||
SetRelHue(1 - dHue);
|
||||
else
|
||||
inherited;
|
||||
end;
|
||||
@ -136,109 +127,55 @@ begin
|
||||
if FMaxHue = 0 then
|
||||
Result := inherited GetArrowPos
|
||||
else
|
||||
Result := ArrowPosFromHue(GetHue());
|
||||
Result := ArrowPosFromHue(FHue);
|
||||
end;
|
||||
|
||||
function THColorPicker.GetGradientColor(AValue: Integer): TColor;
|
||||
var
|
||||
h: Double;
|
||||
begin
|
||||
if Layout = lyVertical then AValue := (FMaxHue + 1) - AValue;
|
||||
if Layout = lyVertical then AValue := FMaxHue - 1 - AValue;
|
||||
// Width is FMaxHue --> last index is FMaxHue - 1
|
||||
h := AValue / FMaxHue;
|
||||
Result := HSVtoColor(h, FSat, FVal);
|
||||
end;
|
||||
|
||||
function THColorPicker.GetHue: Integer;
|
||||
begin
|
||||
Result := round(FHue * FMaxHue);
|
||||
end;
|
||||
|
||||
function THColorPicker.GetSat: Integer;
|
||||
begin
|
||||
Result := round(FSat * FMaxSat);
|
||||
end;
|
||||
|
||||
function THColorPicker.GetSelectedColor: TColor;
|
||||
begin
|
||||
Result := HSVtoColor(FHue, FSat, FVal);
|
||||
if WebSafe then
|
||||
Result := GetWebSafe(Result);
|
||||
Result := HSLVtoColor(h, FSat, FLum, FVal);
|
||||
end;
|
||||
|
||||
function THColorPicker.GetSelectedValue: integer;
|
||||
begin
|
||||
Result := GetHue();
|
||||
Result := Hue;
|
||||
end;
|
||||
|
||||
function THColorPicker.GetVal: Integer;
|
||||
begin
|
||||
Result := round(FVal * FMaxVal);
|
||||
end;
|
||||
|
||||
function THColorPicker.HueFromArrowPos(p: integer): integer;
|
||||
function THColorPicker.HueFromArrowPos(p: integer): Double;
|
||||
var
|
||||
h: integer;
|
||||
h: Double;
|
||||
begin
|
||||
case Layout of
|
||||
lyHorizontal:
|
||||
h := Round(p / (Width - 12) * FMaxHue);
|
||||
lyVertical:
|
||||
h := Round(p / (Height - 12) * MaxHue);
|
||||
lyHorizontal : h := p / (Width - 12);
|
||||
lyVertical : h := p / (Height - 12)
|
||||
end;
|
||||
Clamp(h, 0, FMaxHue);
|
||||
Clamp(h, 0, 1.0 - 1/FMaxHue);
|
||||
Result := h;
|
||||
end;
|
||||
|
||||
procedure THColorPicker.SetHue(h: integer);
|
||||
begin
|
||||
Clamp(h, 0, FMaxHue);
|
||||
if GetHue <> h then
|
||||
begin
|
||||
FHue := h / FMaxHue;
|
||||
FArrowPos := ArrowPosFromHue(h);
|
||||
Invalidate;
|
||||
DoChange;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure THColorPicker.SetMaxHue(h: Integer);
|
||||
begin
|
||||
if h = FMaxHue then
|
||||
exit;
|
||||
FMaxHue := h;
|
||||
FGradientWidth := FMaxHue + 1; // 0 .. FMaxHue --> FMaxHue + 1 pixels
|
||||
FGradientWidth := FMaxHue; // we don't want to access H=360, i.e. don't use FMaxHue+1
|
||||
CreateGradient;
|
||||
Invalidate;
|
||||
//if FChange and Assigned(OnChange) then OnChange(Self);
|
||||
end;
|
||||
|
||||
procedure THColorPicker.SetMaxSat(s: Integer);
|
||||
procedure THColorPicker.SetRelHue(H: Double);
|
||||
begin
|
||||
if s = FMaxSat then
|
||||
if FMaxHue = 0 then
|
||||
exit;
|
||||
FMaxSat := s;
|
||||
CreateGradient;
|
||||
Invalidate;
|
||||
//if FChange and Assigned(OnChange) then OnChange(Self);
|
||||
end;
|
||||
|
||||
procedure THColorPicker.SetMaxVal(v: Integer);
|
||||
begin
|
||||
if v = FMaxVal then
|
||||
exit;
|
||||
FMaxVal := v;
|
||||
CreateGradient;
|
||||
Invalidate;
|
||||
// if FChange and Assigned(OnChange) then OnChange(Self);
|
||||
end;
|
||||
|
||||
procedure THColorPicker.SetSat(s: integer);
|
||||
begin
|
||||
Clamp(s, 0, FMaxSat);
|
||||
if GetSat() <> s then
|
||||
Clamp(H, 0, 1 - 1/FMaxHue); // don't go up to 360 because this will flip back to the start
|
||||
if (FHue <> H) then
|
||||
begin
|
||||
FSat := s / FMaxSat;
|
||||
CreateGradient;
|
||||
FHue := H;
|
||||
FArrowPos := ArrowPosFromHue(H);
|
||||
Invalidate;
|
||||
DoChange;
|
||||
end;
|
||||
@ -246,7 +183,10 @@ end;
|
||||
|
||||
procedure THColorPicker.SetSelectedColor(c: TColor);
|
||||
var
|
||||
h, s, v: integer;
|
||||
H: Double = 0;
|
||||
S: Double = 0;
|
||||
L: Double = 0;
|
||||
V: Double = 0;
|
||||
needNewGradient: Boolean;
|
||||
begin
|
||||
if WebSafe then
|
||||
@ -254,27 +194,25 @@ begin
|
||||
if c = GetSelectedColor then
|
||||
exit;
|
||||
|
||||
RGBToHSVRange(GetRValue(c), GetGValue(c), GetBValue(c), h, s, v);
|
||||
needNewGradient := (s <> FSat) or (v <> FVal);
|
||||
FHue := h;
|
||||
FSat := s;
|
||||
FVal := v;
|
||||
ColorToHSLV(c, H, S, L, V);
|
||||
case BrightnessMode of
|
||||
bmLuminance:
|
||||
begin
|
||||
needNewGradient := (S <> FSat) or (L <> FLum);
|
||||
FLum := L;
|
||||
end;
|
||||
bmValue:
|
||||
begin
|
||||
needNewGradient := (S <> FSat) or (V <> FVal);
|
||||
FVal := V;
|
||||
end;
|
||||
end;
|
||||
FHue := H;
|
||||
FSat := S;
|
||||
if needNewGradient then
|
||||
CreateGradient;
|
||||
Invalidate;
|
||||
DoChange;
|
||||
end;
|
||||
|
||||
procedure THColorPicker.SetVal(v: integer);
|
||||
begin
|
||||
Clamp(v, 0, FMaxVal);
|
||||
if GetVal() <> v then
|
||||
begin
|
||||
FVal := v / FMaxVal;
|
||||
CreateGradient;
|
||||
Invalidate;
|
||||
DoChange;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Reference in New Issue
Block a user