pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

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).

Browse Source 
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
2017-01-05 18:49:22 +00:00
parent 212a9470c7
commit b24e7d5d2c
46 changed files with 2759 additions and 1868 deletions
Download Patch File Download Diff File Expand all files Collapse all files

7
components/mbColorLib/BColorPicker.pas
View File

@ -20,24 +20,25 @@ type
FRed, FGreen, FBlue: integer;
function ArrowPosFromBlue(b: integer): integer;
function BlueFromArrowPos(p: integer): integer;
function GetSelectedColor: TColor;
procedure SetBlue(b: integer);
procedure SetGreen(g: integer);
procedure SetRed(r: integer);
procedure SetSelectedColor(c: TColor);
protected
procedure Execute(tbaAction: integer); override;
function GetArrowPos: integer; override;
function GetGradientColor(AValue: Integer): TColor; override;
function GetSelectedColor: TColor; override;
function GetSelectedValue: integer; override;
procedure SetSelectedColor(c: TColor); override;
public
constructor Create(AOwner: TComponent); override;
published
property Blue: integer read FBlue write SetBlue default 255;
property Green: integer read FGreen write SetGreen default 128;
property Red: integer read FRed write SetRed default 128;
property SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed;
property SelectedColor default clRed;
property Layout default lyVertical;
property HintFormat;
end;

7
components/mbColorLib/CColorPicker.pas
View File

@ -17,17 +17,17 @@ type
FCyan, FMagenta, FYellow, FBlack: integer;
function ArrowPosFromCyan(c: integer): integer;
function CyanFromArrowPos(p: integer): integer;
function GetSelectedColor: TColor;
procedure SetBlack(k: integer);
procedure SetCyan(c: integer);
procedure SetMagenta(m: integer);
procedure SetSelectedColor(clr: TColor);
procedure SetYellow(y: integer);
protected
procedure Execute(tbaAction: integer); override;
function GetArrowPos: integer; override;
function GetGradientColor(AValue: Integer): TColor; override;
function GetSelectedColor: TColor; override;
function GetSelectedValue: integer; override;
procedure SetSelectedColor(clr: TColor); override;
public
constructor Create(AOwner: TComponent); override;
published
@ -35,8 +35,9 @@ type
property Cyan: integer read FCyan write SetCyan default 255;
property Magenta: integer read FMagenta write SetMagenta default 0;
property Yellow: integer read FYellow write SetYellow default 0;
property SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed;
property SelectedColor default clRed;
property Layout default lyVertical;
property HintFormat;
end;

3
components/mbColorLib/CIEAColorPicker.pas
View File

@ -7,8 +7,7 @@ unit CIEAColorPicker;
interface
uses
LCLIntf, LCLType, LMessages,
SysUtils, Classes, Controls, Graphics, Forms,
LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Forms,
HTMLColors, RGBCIEUtils, mbColorPickerControl;
type

3
components/mbColorLib/CIEBColorPicker.pas
View File

@ -7,8 +7,7 @@ unit CIEBColorPicker;
interface
uses
LCLIntf, LCLType, LMessages,
SysUtils, Classes, Controls, Graphics, Forms,
LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Forms,
HTMLColors, RGBCIEUtils, mbColorPickerControl;
type

4
components/mbColorLib/CIELColorPicker.pas
View File

@ -7,8 +7,7 @@ unit CIELColorPicker;
interface
uses
LCLIntf, LCLType, LMessages,
SysUtils, Classes, Controls, Graphics, Math, Forms,
LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Math, Forms,
HTMLColors, RGBCIEUtils, mbColorPickerControl;
type
@ -171,7 +170,6 @@ end;
procedure TCIELColorPicker.Resize;
begin
FManual := false;
mx := Round((FA + 128) * Width / 255);
my := Round((255 - (FB + 128)) * Height / 255);
inherited;

2
components/mbColorLib/GAxisColorPicker.pas
View File

@ -61,7 +61,6 @@ begin
FB := 0;
FR := 0;
FSelected := clLime;
FManual := false;
MarkerStyle := msCircle;
end;
@ -159,7 +158,6 @@ end;
procedure TGAxisColorPicker.Resize;
begin
FManual := false;
mx := Round(FB * Width / 255);
my := Round((255 - FR) * Height / 255);
inherited;

9
components/mbColorLib/GColorPicker.pas
View File

@ -7,7 +7,7 @@ unit GColorPicker;
interface
uses
LCLIntf, LCLType, LMessages, SysUtils, Classes, Controls, Graphics, Forms,
LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Forms,
HTMLColors, mbTrackBarPicker;
type
@ -15,25 +15,26 @@ type
private
FRed, FGreen, FBlue: integer;
function ArrowPosFromGreen(g: integer): integer;
function GetSelectedColor: TColor;
function GreenFromArrowPos(p: integer): integer;
procedure SetBlue(b: integer);
procedure SetGreen(g: integer);
procedure SetRed(r: integer);
procedure SetSelectedColor(c: TColor);
protected
procedure Execute(tbaAction: integer); override;
function GetArrowPos: integer; override;
function GetGradientColor(AValue: Integer): TColor; override;
function GetSelectedColor: TColor; override;
function GetSelectedValue: integer; override;
procedure SetSelectedColor(c: TColor); override;
public
constructor Create(AOwner: TComponent); override;
published
property Red: integer read FRed write SetRed default 128;
property Green: integer read FGreen write SetGreen default 255;
property Blue: integer read FBlue write SetBlue default 128;
property SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed;
property SelectedColor default clRed;
property Layout default lyVertical;
property HintFormat;
end;

210
components/mbColorLib/HColorPicker.pas
View File

@ -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.

280
components/mbColorLib/HRingPicker.pas
View File

@ -8,60 +8,44 @@ interface
uses
LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Math, Forms,
RGBHSVUtils, HTMLColors, mbColorPickerControl;
HTMLColors, mbColorConv, mbColorPickerControl;
type
THRingPicker = class(TmbColorPickerControl)
THRingPicker = class(TmbHSLVColorPickerControl)
private
FHue, FSat, FVal: Double;
FMaxHue, FMaxSat, FMaxVal: Integer;
FHueLineColor: TColor;
FSelectedColor: TColor;
mx, my, mdx, mdy: integer;
//FChange: boolean;
FHueLineColor: TColor;
FRadius: integer;
FDragging: Boolean;
function GetHue: Integer;
function GetSat: Integer;
function GetValue: Integer;
function RadHue(New: integer): integer;
procedure SetMaxHue(h: Integer);
procedure SetMaxSat(s: Integer);
procedure SetMaxValue(v: Integer);
procedure SetRadius(r: integer);
procedure SetHue(h: integer);
procedure SetSat(s: integer);
procedure SetValue(v: integer);
procedure SetHueLineColor(c: TColor);
procedure SelectionChanged(x, y: integer);
procedure UpdateCoords;
protected
procedure CreateGradient; override;
procedure DrawHueLine;
function GetGradientColor2D(X, Y: Integer): TColor; override;
function GetSelectedColor: 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;
function MouseOnPicker(X, Y: Integer): Boolean;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
// function MouseOnPicker(X, Y: Integer): Boolean;
procedure Paint; override;
procedure Resize; override;
procedure SelectColor(x, y: integer); override;
procedure SetRelHue(H: Double); override;
procedure SetSelectedColor(c: TColor); override;
procedure UpdateCoords;
public
constructor Create(AOwner: TComponent); override;
function GetColorAtPoint(x, y: integer): TColor; override;
property ColorUnderCursor;
published
property Hue: integer read GetHue write SetHue;
property Saturation: integer read GetSat write SetSat;
property Value: integer read GetValue write SetValue;
property MaxHue: Integer read FMaxHue write SetMaxHue default 359;
property MaxSaturation: Integer read FMaxSat write SetMaxSat default 255;
property MaxValue: Integer read FMaxVal write SetMaxValue default 255;
property Hue default 0;
property Luminance default 127;
property Saturation default 255;
property Value default 255;
property MaxHue default 360;
property MaxLuminance default 255;
property MaxSaturation default 255;
property MaxValue default 255;
property HueLineColor: TColor read FHueLineColor write SetHueLineColor default clGray;
property Radius: integer read FRadius write SetRadius default 40;
property SelectedColor default clNone;
property SelectedColor default clRed; //clNone;
property OnChange;
end;
@ -77,17 +61,13 @@ constructor THRingPicker.Create(AOwner: TComponent);
begin
inherited;
SetInitialBounds(0, 0, 204, 204);
FMaxHue := 359;
FMaxSat := 255;
FMaxVal := 255;
FHue := 0.0;
FVal := 1.0;
// FHue := 0.0;
FLum := 0.5;
FSat := 1.0;
FHueLineColor := clGray;
SetSelectedColor(clRed);
// FSelectedColor := clRed; clNone;
FManual := false;
FRadius := 40;
FHueLineColor := clGray;
HintFormat := 'Hue: %h (selected)';
TabStop := true;
end;
@ -108,7 +88,7 @@ begin
radius := Min(Width, Height) div 2;
if (FHue >= 0) and (FHue <= 1.0) then
begin
angle := -FHue * 2 * pi;
angle := -FHue * TWO_PI;
SinCos(angle, sinAngle, cosAngle);
Canvas.Pen.Color := FHueLineColor;
Canvas.MoveTo(radius, radius);
@ -134,9 +114,7 @@ begin
else if angle > 360 then
angle := angle - 360;
h := angle / 360;
Result := HSVtoColor(h, FSat, FVal);
if WebSafe then
Result := GetWebSafe(Result);
Result := HSLVtoColor(h, FSat, FLum, FVal);
end
else
Result := clNone;
@ -149,7 +127,6 @@ var
dSq, rSq: Integer;
radius, size: Integer;
H: Double;
q: TRGBQuad;
begin
size := FGradientWidth; // or Height, they are the same...
radius := size div 2;
@ -162,79 +139,21 @@ begin
H := 180 * (1 + arctan2(dx, dy) / pi); // wp: order (x,y) is correct!
H := H + 90;
if H > 360 then H := H - 360;
Result := HSVtoColor(H/360, FSat, FVal);
Result := HSLVtoColor(H/360, FSat, FLum, FVal);
if WebSafe then
Result := GetWebSafe(Result);
end else
Result := GetDefaultColor(dctBrush);
end;
function THRingPicker.GetHue: Integer;
begin
Result := round(FHue * FMaxHue);
end;
function THRingPicker.GetSat: Integer;
begin
Result := round(FSat * FMaxSat);
end;
function THRingPicker.GetSelectedColor: TColor;
begin
if FSelectedColor <> clNone then
begin
Result := HSVtoColor(FHue, FSat, FVal);
if WebSafe then
Result := GetWebSafe(Result);
end
Result := HSLVtoColor(FHue, FSat, FLum, FVal)
else
Result := clNone;
end;
function THRingPicker.GetValue: Integer;
begin
Result := round(FVal * FMaxVal);
end;
procedure THRingPicker.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 : SetHue(RadHue(GetHue() + delta));
VK_RIGHT : SetHue(RadHue(GetHue() - delta));
else erasekey := false;
end;
if eraseKey then
Key := 0;
inherited;
end;
procedure THRingPicker.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited;
if csDesigning in ComponentState then
Exit;
if (Button = mbLeft) and MouseOnPicker(X, Y)
then begin
mdx := x;
mdy := y;
SelectionChanged(X, Y);
FDragging := true;
end;
SetFocus;
end;
{
function THRingPicker.MouseOnPicker(X, Y: Integer): Boolean;
var
diameter, r: Integer;
@ -245,33 +164,7 @@ begin
P := Point(x, y);
ctr := Point(r, r);
Result := PtInCircle(P, ctr, r) and not PtInCircle(P, ctr, Radius);
end;
procedure THRingPicker.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
inherited;
if csDesigning in ComponentState then Exit;
if (ssLeft in Shift) and FDragging then
begin
mdx := x;
mdy := y;
SelectionChanged(X, Y);
end;
end;
procedure THRingPicker.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited;
if csDesigning in ComponentState then Exit;
if (Button = mbLeft) and FDragging then
begin
mdx := x;
mdy := y;
SelectionChanged(X, Y);
FDragging := false;
end;
end;
end; }
procedure THRingPicker.Paint;
var
@ -302,45 +195,26 @@ begin
DoChange;
end;
function THRingPicker.RadHue(New: integer): integer;
begin
if New < 0 then New := New + (FMaxHue + 1);
if New > (FMaxHue + 1) then New := New - (FMaxHue + 1);
Result := New;
end;
procedure THRingPicker.Resize;
begin
inherited;
CreateGradient;
if Min(Width, Height) <> FGradientWidth then
CreateGradient;
UpdateCoords;
end;
procedure THRingPicker.SelectionChanged(x, y: integer);
procedure THRingPicker.SelectColor(x, y: integer);
var
angle, dx, dy, Radius: integer;
begin
mx := y;
my := y;
FSelectedColor := clWhite;
radius := Min(Width, Height) div 2;
dx := x - radius;
dy := y - radius;
angle := round(360 + 180*arctan2(-dy, dx) / pi);
if angle < 0 then
inc(angle, 360)
else if angle > 360 then
dec(angle, 360);
SetHue(MulDiv(angle, FMaxHue + 1, 360));
end;
procedure THRingPicker.SetHue(h: integer);
begin
h := RadHue(h);
if GetHue() <> h then
begin
FHue := h / FMaxHue;
Invalidate;
DoChange;
end;
SetRelHue(angle/360);
end;
procedure THRingPicker.SetHueLineColor(c: TColor);
@ -352,36 +226,6 @@ begin
end;
end;
procedure THRingPicker.SetMaxHue(h: Integer);
begin
if h = FMaxHue then
exit;
FMaxHue := h;
CreateGradient;
Invalidate;
// if FChange and Assigned(OnChange) then OnChange(Self);
end;
procedure THRingPicker.SetMaxSat(s: Integer);
begin
if s = FMaxSat then
exit;
FMaxSat := s;
CreateGradient;
Invalidate;
// if FChange and Assigned(OnChange) then OnChange(Self);
end;
procedure THRingPicker.SetMaxValue(v: Integer);
begin
if v = FMaxVal then
exit;
FMaxVal := v;
CreateGradient;
Invalidate;
// if FChange and Assigned(OnChange) then OnChange(Self);
end;
procedure THRingPicker.SetRadius(r: integer);
begin
if FRadius <> r then
@ -391,20 +235,38 @@ begin
end;
end;
procedure THRingPicker.SetSat(s: integer);
procedure THRingPicker.SetRelHue(H: Double);
begin
Clamp(s, 0, FMaxSat);
if GetSat() <> s then
if H > 1 then H := H - 1;
if H < 0 then H := H + 1;
if FHue <> h then
begin
FSat := s / FMaxSat;
FHue := h;
UpdateCoords;
Invalidate;
DoChange;
end;
end;
(*
procedure THRingPicker.SetSat(s: integer);
begin
Clamp(s, 0, FMaxSat);
if Saturation <> s then
begin
FSat := s / FMaxSat;
UpdateCoords;
Invalidate;
DoChange;
end;
end;
*)
procedure THRingPicker.SetSelectedColor(c: TColor);
var
h, s, v: Double;
H: Double = 0;
S: Double = 0;
L: Double = 0;
V: Double = 0;
needNewGradient: Boolean;
begin
if WebSafe then
@ -412,11 +274,21 @@ begin
if c = GetSelectedColor then
Exit;
RGBToHSV(GetRValue(c), GetGValue(c), GetBValue(c), h, s, v);
needNewGradient := (s <> FSat) or (v <> FVal);
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;
FVal := v;
UpdateCoords;
if needNewGradient then
CreateGradient;
@ -424,18 +296,22 @@ begin
DoChange;
end;
procedure THRingPicker.SetValue(v: integer);
(*
procedure THRingPicker.SetVal(v: integer);
begin
Clamp(v, 0, FMaxVal);
if GetValue() <> V then
if Value <> V then
begin
FVal := V / FMaxVal;
CreateGradient;
Invalidate;
if BrightnessMode = bmValue then
begin
CreateGradient;
Invalidate;
end;
DoChange;
end;
end;
*)
procedure THRingPicker.UpdateCoords;
var
r, angle: double;
@ -446,8 +322,8 @@ begin
r := -radius * FSat;
angle := -(FHue * 2 + 1) * pi;
SinCos(angle, sinAngle, cosAngle);
mdx := round(cosAngle * r) + radius;
mdy := round(sinAngle * r) + radius;
mx := round(cosAngle * r) + radius;
my := round(sinAngle * r) + radius;
end;
end.

363
components/mbColorLib/HSColorPicker.pas
View File

@ -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);

459
components/mbColorLib/HSLColorPicker.pas
View File

@ -7,54 +7,76 @@ unit HSLColorPicker;
interface
uses
LCLIntf, LCLType, LMessages,
SysUtils, Classes, Controls, Graphics, Forms, Menus, Themes,
HTMLColors, RGBHSLUtils, HSColorPicker, LColorPicker, mbBasicPicker;
LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Forms, Menus, Themes,
HTMLColors, mbColorConv, HSColorPicker, LVColorPicker, mbBasicPicker;
type
THSLColorPicker = class(TmbBasicPicker)
private
FHSPicker: THSColorPicker;
FLPicker: TLColorPicker;
FSelectedColor: TColor;
FRValue, FGValue, FBValue: integer;
FHSHint, FLHint: string;
FLMenu, FHSMenu: TPopupMenu;
FLumIncrement: integer;
FHSCursor, FLCursor: TCursor;
FLVPicker: TLVColorPicker;
FRed, FGreen, FBlue: integer;
FHSHint: string;
FLVMenu, FHSMenu: TPopupMenu;
FLVIncrement: integer;
FHSCursor, FLVCursor: TCursor;
PBack: TBitmap;
function GetH: Integer;
function GetS: Integer;
function GetL: Integer;
function GetMaxH: Integer;
function GetMaxS: Integer;
function GetMaxL: Integer;
procedure SetH(H: integer);
procedure SetS(S: integer);
procedure SetL(L: integer);
procedure SetLumIncrement(i: integer);
procedure SetMaxH(H: Integer);
procedure SetMaxS(S: Integer);
procedure SetMaxL(L: Integer);
procedure SetR(R: integer);
procedure SetG(G: integer);
procedure SetB(B: integer);
procedure SetHSHint(h: string);
procedure SetLHint(h: string);
procedure SetLMenu(m: TPopupMenu);
procedure SetHSMenu(m: TPopupMenu);
function GetBrightnessMode: TBrightnessMode;
function GetHue: Integer;
function GetSat: Integer;
function GetLum: Integer;
function GetVal: Integer;
function GetMaxHue: Integer;
function GetMaxSat: Integer;
function GetMaxLum: Integer;
function GetMaxVal: Integer;
function GetRelHue: Double;
function GetRelSat: Double;
function GetRelLum: Double;
function GetRelVal: Double;
function GetLVHint(AMode: TBrightnessMode): String;
procedure SetBrightnessMode(AMode: TBrightnessMode);
procedure SetHue(H: integer);
procedure SetSat(S: integer);
procedure SetLum(L: integer);
procedure SetVal(V: Integer);
procedure SetMaxHue(H: Integer);
procedure SetMaxLum(L: Integer);
procedure SetMaxSat(S: Integer);
procedure SetMaxVal(V: Integer);
procedure SetRed(R: integer);
procedure SetGreen(G: integer);
procedure SetBlue(B: integer);
procedure SetRelHue(H: Double);
procedure SetRelLum(L: Double);
procedure SetRelSat(S: Double);
procedure SetRelVal(V: Double);
procedure SetHSCursor(c: TCursor);
procedure SetLCursor(c: TCursor);
procedure SetSelectedColor(Value: TColor);
procedure SetHSHint(h: string);
procedure SetHSMenu(m: TPopupMenu);
procedure SetLVCursor(c: TCursor);
procedure SetLVHint(AMode: TBrightnessMode; AText: string);
procedure SetLVMenu(m: TPopupMenu);
procedure SetLVIncrement(i: integer);
protected
procedure DoChange; override;
procedure DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
function GetColorUnderCursor: TColor; override;
function GetSelectedColor: TColor; override;
procedure HSPickerChange(Sender: TObject);
procedure LPickerChange(Sender: TObject);
procedure LVPickerChange(Sender: TObject);
procedure Paint; override;
procedure Resize; override;
procedure SelectColor(c: TColor);
procedure SetSelectedColor(Value: TColor); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
@ -62,24 +84,33 @@ type
function GetSelectedHexColor: string;
procedure SetFocus; override;
property ColorUnderCursor;
property Red: integer read FRValue write SetR;
property Green: integer read FGValue write SetG;
property Blue: integer read FBValue write SetB;
property Red: integer read FRed write SetRed;
property Green: integer read FGreen write SetGreen;
property Blue: integer read FBlue write SetBlue;
property RelHue: Double read GetRelHue write SetRelHue;
property RelSaturation: Double read GetRelSat write SetRelSat;
property RelLuminance: Double read GetRelLum write SetRelLum;
property RelValue: Double read GetRelVal write SetRelVal;
published
property Hue: integer read GetH write SetH default 0;
property Saturation: integer read GetS write SetS default 240;
property Luminance: integer read GetL write SetL default 120;
property LuminanceIncrement: integer read FLumIncrement write SetLumIncrement default 1;
property SelectedColor: TColor read FSelectedColor write SetSelectedColor default clRed;
property BrightnessMode: TBrightnessMode read GetBrightnessMode
write SetBrightnessMode default bmLuminance;
property Hue: integer read GetHue write SetHue default 0;
property Saturation: integer read GetSat write SetSat default 255;
property Luminance: integer read GetLum write SetLum default 127;
property LVIncrement: integer read FLVIncrement write SetLVIncrement default 1;
property Value: Integer read GetVal write SetVal default 255;
property SelectedColor default clRed;
property HSPickerPopupMenu: TPopupMenu read FHSMenu write SetHSMenu;
property LPickerPopupMenu: TPopupMenu read FLMenu write SetLMenu;
property LVPickerPopupMenu: TPopupMenu read FLVMenu write SetLVMenu;
property HSPickerHintFormat: string read FHSHint write SetHSHint;
property LPickerHintFormat: string read FLHint write SetLHint;
property LPickerHintFormat: string index bmLuminance read GetLVHint write SetLVHint;
property VPickerHintFormat: string index bmValue read GetLVHint write SetLVHint;
property HSPickerCursor: TCursor read FHSCursor write SetHSCursor default crDefault;
property LPickerCursor: TCursor read FLCursor write SetLCursor default crDefault;
property MaxHue: Integer read GetMaxH write SetMaxH default 359;
property MaxSaturation: Integer read GetMaxS write SetMaxS default 240;
property MaxLuminance: Integer read GetMaxL write SetMaxL default 240;
property LVPickerCursor: TCursor read FLVCursor write SetLVCursor default crDefault;
property MaxHue: Integer read GetMaxHue write SetMaxHue default 360;
property MaxSaturation: Integer read GetMaxSat write SetMaxSat default 255;
property MaxLuminance: Integer read GetMaxLum write SetMaxLum default 127;
property MaxValue: Integer read GetMaxVal write SetMaxVal default 255;
property TabStop default true;
property ShowHint;
property ParentShowHint;
@ -98,7 +129,7 @@ type
implementation
{THSLColorPicker}
{ THSLColorPicker }
uses
mbTrackbarPicker;
@ -112,9 +143,10 @@ begin
// PBack.PixelFormat := pf32bit;
SetInitialBounds(0, 0, 206, 146);
TabStop := true;
FLumIncrement := 1;
FLVIncrement := 1;
FHSCursor := crDefault;
FLCursor := crDefault;
FLVCursor := crDefault;
FHSPicker := THSColorPicker.Create(Self);
InsertControl(FHSPicker);
@ -122,36 +154,45 @@ begin
begin
SetInitialBounds(0, 6, 174, 134);
Anchors := [akLeft, akTop, akRight, akBottom];
Visible := true;
MaxHue := 359;
MaxSaturation := 240;
MaxLuminance := 240;
// Visible := true;
BrightnessMode := bmLuminance;
MaxHue := 360;
MaxSaturation := 255;
MaxLuminance := 255;
MaxValue := 255;
OnChange := HSPickerChange;
OnMouseMove := DoMouseMove;
end;
FLPicker := TLColorPicker.Create(Self);
InsertControl(FLPicker);
with FLPicker do
FLVPicker := TLVColorPicker.Create(Self);
InsertControl(FLVPicker);
with FLVPicker do
begin
Layout := lyVertical;
SetInitialBounds(184, 0, 25, 146);
Anchors := [akRight, akTop, akBottom];
Visible := true;
// Visible := true;
BrightnessMode := bmLuminance;
MaxHue := FHSPicker.MaxHue;
MaxSaturation := FHSPicker.MaxSaturation;
MaxLuminance := FHSPicker.MaxLuminance;
MaxValue := FHSPicker.MaxValue;
Luminance := MaxLuminance div 2;
OnChange := LPickerChange;
Value := MaxValue;
OnChange := LVPickerChange;
OnMouseMove := DoMouseMove;
end;
Hue := 0;
Saturation := FHSPicker.MaxLuminance;
Luminance := FHSPicker.MaxLuminance div 2;
Value := FHSPicker.MaxValue;
FHSHint := 'H: %h S: %hslS'#13'Hex: %hex';
FLHint := 'Luminance: %l';
HSPickerHintFormat := 'H: %h S: %hslS'#13'Hex: %hex';
{
FLVHint[bmLuminance] := 'Luminance: %l';
FLVHint[bmValue] := 'Value: %v';
}
end;
destructor THSLColorPicker.Destroy;
@ -161,27 +202,35 @@ begin
end;
procedure THSLColorPicker.DoChange;
var
c: TColor;
begin
FSelectedColor := FLPicker.SelectedColor;
FRValue := GetRValue(FSelectedColor);
FGValue := GetGValue(FSelectedColor);
FBValue := GetBValue(FSelectedColor);
c := FLVPicker.SelectedColor;
FRed := GetRValue(c);
FGreen := GetGValue(c);
FBlue := GetBValue(c);
inherited;
end;
procedure THSLColorPicker.DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure THSLColorPicker.DoMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
if Assigned(OnMouseMove) then
OnMouseMove(Self, Shift, x, y);
inherited;
end;
function THSLColorPicker.GetBrightnessMode: TBrightnessMode;
begin
Result := FHSPicker.BrightnessMode;
end;
function THSLColorPicker.GetColorUnderCursor: TColor;
begin
Result := FHSPicker.ColorUnderCursor;
end;
function THSLColorPicker.GetH: Integer;
function THSLColorPicker.GetHue: Integer;
begin
Result := FHSPicker.Hue;
end;
@ -191,46 +240,89 @@ begin
Result := FHSPicker.GetHexColorUnderCursor;
end;
function THSLColorPicker.GetS: Integer;
function THSLColorPicker.GetSat: Integer;
begin
Result := FHSPicker.Saturation;
end;
function THSLColorPicker.GetL: integer;
function THSLColorPicker.GetLum: integer;
begin
Result := FLPicker.Luminance;
Result := FLVPicker.Luminance;
end;
function THSLColorPicker.GetMaxH: Integer;
function THSLColorPicker.GetVal: Integer;
begin
Result := FLVPicker.Value;
end;
function THSLColorPicker.GetMaxHue: Integer;
begin
Result := FHSPicker.MaxHue;
end;
function THSLColorPicker.GetMaxS: Integer;
function THSLColorPicker.GetMaxSat: Integer;
begin
Result := FHSPicker.MaxSaturation;
end;
function THSLColorPicker.GetMaxL: Integer;
function THSLColorPicker.GetMaxLum: Integer;
begin
Result := FLPicker.MaxLuminance;
Result := FLVPicker.MaxLuminance;
end;
function THSLColorPicker.GetMaxVal: Integer;
begin
Result := FLVPicker.MaxValue;
end;
function THSLColorPicker.GetRelHue: Double;
begin
Result := FHSPicker.RelHue;
end;
function THSLColorPicker.GetRelLum: Double;
begin
Result := FLVPicker.RelLuminance;
end;
function THSLColorPicker.GetRelSat: Double;
begin
Result := FHSPicker.RelSaturation;
end;
function THSLColorPicker.GetRelVal: Double;
begin
Result := FLVPicker.RelValue;
end;
function THSLColorPicker.GetLVHint(AMode: TBrightnessMode): String;
begin
case AMode of
bmLuminance: Result := FLVPicker.LHintFormat;
bmValue : Result := FLVPicker.VHintFormat;
end;
end;
function THSLColorPicker.GetSelectedColor: TColor;
begin
Result := FLVPicker.SelectedColor;
end;
function THSLColorPicker.GetSelectedHexColor: string;
begin
Result := ColorToHex(FSelectedColor);
Result := ColorToHex(GetSelectedColor);
end;
procedure THSLColorPicker.HSPickerChange(Sender: TObject);
begin
if FHSPicker.Hue <> FLPicker.Hue then
FLPicker.Hue := FHSPicker.Hue;
if FHSPicker.Saturation <> FLPicker.Saturation then
FLPicker.Saturation := FHSPicker.Saturation;
if FHSPicker.Hue <> FLVPicker.Hue then
FLVPicker.Hue := FHSPicker.Hue;
if FHSPicker.Saturation <> FLVPicker.Saturation then
FLVPicker.Saturation := FHSPicker.Saturation;
DoChange;
end;
procedure THSLColorPicker.LPickerChange(Sender: TObject);
procedure THSLColorPicker.LVPickerChange(Sender: TObject);
begin
DoChange;
end;
@ -239,14 +331,14 @@ procedure THSLColorPicker.Resize;
begin
inherited;
if (FHSPicker = nil) or (FLPicker = nil) then
if (FHSPicker = nil) or (FLVPicker = nil) then
exit;
FHSPicker.Width := Width - FLPicker.Width - 15;
FHSPicker.Width := Width - FLVPicker.Width - 15;
FHSPicker.Height := Height - 12;
FLPicker.Left := Width - FLPicker.Width - 2;
FLPicker.Height := Height; // - 12;
FLVPicker.Left := Width - FLVPicker.Width - 2;
FLVPicker.Height := Height; // - 12;
end;
procedure THSLColorPicker.Paint;
@ -255,17 +347,16 @@ begin
Canvas.Draw(0, 0, PBack);
end;
procedure THSLColorPicker.SelectColor(c: TColor);
procedure THSLColorPicker.SetBlue(B: integer);
begin
FSelectedColor := c;
FHSPicker.SelectedColor := c;
FLPicker.SelectedColor := c;
FBlue := B;
SetSelectedColor(RGBtoColor(FRed, FGreen, FBlue));
end;
procedure THSLColorPicker.SetB(B: integer);
procedure THSLColorPicker.SetBrightnessMode(AMode: TBrightnessMode);
begin
FBValue := B;
SetSelectedColor(RGB(FRValue, FGValue, FBValue));
FHSPicker.BrightnessMode := AMode;
FLVPicker.BrightnessMode := AMode;
end;
procedure THSLColorPicker.SetFocus;
@ -274,16 +365,16 @@ begin
FHSPicker.SetFocus;
end;
procedure THSLColorPicker.SetG(G: integer);
procedure THSLColorPicker.SetGreen(G: integer);
begin
FGValue := G;
SetSelectedColor(RGB(FRValue, FGValue, FBValue));
FGreen := G;
SetSelectedColor(RGBtoColor(FRed, FGreen, FBlue));
end;
procedure THSLColorPicker.SetH(H: integer);
procedure THSLColorPicker.SetHue(H: integer);
begin
FHSPicker.Hue := H;
FLPicker.Hue := H;
FLVPicker.Hue := H;
end;
procedure THSLColorPicker.SetHSCursor(c: TCursor);
@ -304,84 +395,124 @@ begin
FHSPicker.PopupMenu := m;
end;
procedure THSLColorPicker.SetL(L: integer);
procedure THSLColorPicker.SetLum(L: integer);
begin
FLPicker.Luminance := L;
FLVPicker.Luminance := L;
end;
procedure THSLColorPicker.SetLHint(h: string);
procedure THSLColorPicker.SetLVCursor(c: TCursor);
begin
FLHint := h;
FLPicker.HintFormat := h;
FLVCursor := c;
FLVPicker.Cursor := c;
end;
procedure THSLColorPicker.SetLMenu(m: TPopupMenu);
procedure THSLColorPicker.SetLVHint(AMode: TBrightnessMode; AText: string);
begin
FLMenu := m;
FLPicker.PopupMenu := m;
end;
procedure THSLColorPicker.SetLumIncrement(i: integer);
begin
FLumIncrement := i;
FLPicker.Increment := i;
end;
procedure THSLColorPicker.SetLCursor(c: TCursor);
begin
FLCursor := c;
FLPicker.Cursor := c;
end;
procedure THSLColorPicker.SetMaxH(H: Integer);
begin
FHSPicker.MaxHue := H;
FLPicker.MaxHue := H;
end;
procedure THSLColorPicker.SetMaxL(L: Integer);
begin
FHSPicker.MaxLuminance := L;
FLPicker.MaxLuminance := L;
end;
procedure THSLColorPicker.SetMaxS(S: Integer);
begin
FHSPicker.MaxSaturation := S;
FLPicker.MaxSaturation := S;
end;
procedure THSLColorPicker.SetR(R: integer);
begin
FRValue := R;
SetSelectedColor(RGB(FRValue, FGValue, FBValue));
end;
procedure THSLColorPicker.SetS(S: integer);
begin
if S <> FHSPicker.Saturation then
FHSPicker.Saturation := S;
if S <> FLPicker.Saturation then
FLPicker.Saturation := S;
end;
procedure THSLColorPicker.SetSelectedColor(Value: TColor);
begin
if FSelectedColor <> Value then
begin
SelectColor(Value);
//FLPicker.Hue := FHSPicker.HueValue;
//FLPicker.Saturation := FHSPicker.SaturationValue;
case AMode of
bmLuminance: FLVPicker.LHintFormat := AText;
bmValue : FLVPicker.VHintFormat := AText;
end;
end;
(*
procedure THSLColorPicker.WMSetFocus(
var Message: {$IFDEF FPC}TLMSetFocus{$ELSE}TWMSetFocus{$ENDIF} );
procedure THSLColorPicker.SetLVIncrement(i: integer);
begin
FHSPicker.SetFocus;
Message.Result := 1;
FLVIncrement := i;
FLVPicker.Increment := i;
end;
*)
procedure THSLColorPicker.SetLVMenu(m: TPopupMenu);
begin
FLVMenu := m;
FLVPicker.PopupMenu := m;
end;
procedure THSLColorPicker.SetMaxHue(H: Integer);
begin
FHSPicker.MaxHue := H;
FLVPicker.MaxHue := H;
end;
procedure THSLColorPicker.SetMaxLum(L: Integer);
begin
FHSPicker.MaxLuminance := L;
FLVPicker.MaxLuminance := L;
end;
procedure THSLColorPicker.SetMaxSat(S: Integer);
begin
FHSPicker.MaxSaturation := S;
FLVPicker.MaxSaturation := S;
end;
procedure THSLColorPicker.SetMaxVal(V: Integer);
begin
FLVPicker.MaxValue := V;
end;
procedure THSLColorPicker.SetRed(R: integer);
begin
FRed := R;
SetSelectedColor(RGBtoColor(FRed, FGreen, FBlue));
end;
procedure THSLColorPicker.SetRelHue(H: Double);
begin
FHSPicker.RelHue := H;
FLVPicker.RelHue := H;
end;
procedure THSLCOlorPicker.SetRelSat(S: Double);
begin
FHSPicker.RelSaturation := S;
FLVPicker.RelSaturation := S;
end;
procedure THSLColorPicker.SetRelLum(L: Double);
begin
FHSPicker.RelLuminance := L;
FLVPicker.RelLuminance := L;
end;
procedure THSLColorPicker.SetRelVal(V: Double);
begin
FHSPicker.RelValue := V;
FLVPicker.RelValue := V;
end;
procedure THSLColorPicker.SetSat(S: integer);
begin
if S <> FHSPicker.Saturation then
FHSPicker.Saturation := S;
if S <> FLVPicker.Saturation then
FLVPicker.Saturation := S;
end;
procedure THSLColorPicker.SetSelectedColor(Value: TColor);
var
c: TColor;
H: Double = 0;
S: Double = 0;
LV: Double = 0;
begin
c := GetSelectedColor;
if c <> Value then
begin
case GetBrightnessMode of
bmLuminance: ColorToHSL(c, H, S, LV);
bmValue : ColorToHSV(c, H, S, LV);
end;
// FSelectedColor := c;
FHSPicker.RelHue := H;
FHSPicker.RelSaturation := S;
// FHSPicker.SelectedColor := c;
FLVPicker.SelectedColor := c;
end;
end;
procedure THSLColorPicker.SetVal(V: Integer);
begin
FLVPicker.Value := V;
end;
end.

200
components/mbColorLib/HSLRingPicker.pas
View File

@ -9,7 +9,7 @@ interface
uses
LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics,
Forms, Menus, Math, Themes,
RGBHSLUtils, HRingPicker, SLColorPicker, HTMLColors, mbBasicPicker;
mbColorConv, HRingPicker, SLColorPicker, HTMLColors, mbBasicPicker;
type
THSLRingPicker = class(TmbBasicPicker)
@ -17,41 +17,50 @@ type
FRingPicker: THRingPicker;
FSLPicker: TSLColorPicker;
FSelectedColor: TColor;
FRValue, FGValue, FBValue: integer;
// FRValue, FGValue, FBValue: integer;
FRingHint, FSLHint: string;
FSLMenu, FRingMenu: TPopupMenu;
FSLCursor, FRingCursor: TCursor;
PBack: TBitmap;
function GetBrightnessMode: TBrightnessMode;
function GetHue: Integer;
function GetLum: Integer;
function GetSat: Integer;
function GetVal: Integer;
function GetMaxHue: Integer;
function GetMaxLum: Integer;
function GetMaxSat: Integer;
function GetRed: Integer;
function GetGreen: Integer;
function GetBlue: Integer;
function GetLVHint(AMode: TBrightnessMode): String;
procedure SetBrightnessMode(AMode: TBrightnessMode);
procedure SetHue(H: integer);
procedure SetSat(S: integer);
procedure SetLum(L: integer);
procedure SetVal(V: Integer);
procedure SetMaxHue(H: Integer);
procedure SetMaxLum(L: Integer);
procedure SetMaxSat(S: Integer);
procedure SetR(v: integer);
procedure SetG(v: integer);
procedure SetB(v: integer);
procedure SetRed(R: integer);
procedure SetGreen(G: integer);
procedure SetBlue(B: integer);
procedure SetRingHint(h: string);
procedure SetSLHint(h: string);
procedure SetSLMenu(m: TPopupMenu);
procedure SetRingMenu(m: TPopupMenu);
procedure SetRingCursor(c: TCursor);
procedure SetSLCursor(c: TCursor);
procedure SetLVHint(AMode: TBrightnessMode; AText: String);
protected
procedure CreateWnd; override;
// procedure CreateWnd; override;
procedure DoChange; override;
procedure DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
function GetColorUnderCursor: TColor; override;
function GetSelectedColor: TColor; override;
procedure Paint; override;
procedure Resize; override;
procedure RingPickerChange(Sender: TObject);
procedure SelectColor(c: TColor);
procedure SetSelectedColor(c: TColor); override;
procedure SLPickerChange(Sender: TObject);
public
constructor Create(AOwner: TComponent); override;
@ -60,21 +69,25 @@ type
function GetSelectedHexColor: string;
procedure SetFocus; override;
property ColorUnderCursor;
property Red: integer read FRValue write SetR;
property Green: integer read FGValue write SetG;
property Blue: integer read FBValue write SetB;
property Red: integer read GetRed write SetRed;
property Green: integer read GetGreen write SetGreen;
property Blue: integer read GetBlue write SetBlue;
published
property BrightnessMode: TBrightnessMode read GetBrightnessMode
write SetBrightnessMode default bmValue;
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 SelectedColor: TColor read FSelectedColor write SelectColor default clRed;
property Saturation: integer read GetSat write SetSat default 255;
property Luminance: integer read GetLum write SetLum default 127;
property Value: Integer read GetVal write SetVal default 255;
property SelectedColor default clRed;
property RingPickerPopupMenu: TPopupMenu read FRingMenu write SetRingMenu;
property SLPickerPopupMenu: TPopupMenu read FSLMenu write SetSLMenu;
property RingPickerHintFormat: string read FRingHint write SetRingHint;
property SLPickerHintFormat: string read FSLHint write SetSLHint;
property SLPickerHintFormat: string index bmLuminance read GetLVHint write SetLVHint;
property SVPickerHintFormat: String index bmValue read GetLVHint write SetLVHint;
property RingPickerCursor: TCursor read FRingCursor write SetRingCursor default crDefault;
property SLPickerCursor: TCursor read FSLCursor write SetSLCursor default crDefault;
property MaxHue: Integer read GetMaxHue write SetMaxHue default 359;
property MaxHue: Integer read GetMaxHue write SetMaxHue default 360;
property MaxLuminance: Integer read GetMaxLum write SetMaxLum default 240;
property MaxSaturation: Integer read GetMaxSat write SetMaxSat default 240;
property TabStop default true;
@ -100,30 +113,20 @@ begin
inherited;
// ControlStyle := ControlStyle - [csAcceptsControls] + [csOpaque{$IFDEF DELPHI_7_UP}, csParentBackground{$ENDIF}];
FRValue := 255;
FGValue := 0;
FBValue := 0;
PBack := TBitmap.Create;
// PBack.PixelFormat := pf32bit;
SetInitialBounds(0, 0, 245, 245);
TabStop := true;
FSelectedColor := clRed;
FRingCursor := crDefault;
FSLCursor := crDefault;
FRingHint := 'Hue: %h';
FSLHint := 'S: %hslS L: %l'#13'Hex: %hex';
FRingPicker := THRingPicker.Create(Self);
InsertControl(FRingPicker);
with FRingPicker do
begin
SetInitialBounds(0, 0, 246, 246);
//Radius := 40;
BrightnessMode := bmValue;
Align := alClient;
Visible := true;
Saturation := FRingPicker.MaxSaturation;
Value := FRingPicker.MaxValue;
Hue := 0;
OnChange := RingPickerChange;
OnMouseMove := DoMouseMove;
end;
@ -133,14 +136,14 @@ begin
with FSLPicker do
begin
SetInitialBounds(63, 63, 120, 120);
MaxSaturation := 240;
MaxLuminance := 240;
Saturation := 240;
Luminance := 240;
Visible := true;
BrightnessMode := bmValue;
SLHintFormat := 'S: %hslS L: %l'#13'Hex: %hex';
SVHintFormat := 'S: %hslS V: %v'#13'Hex: %hex';
OnChange := SLPickerChange;
OnMouseMove := DoMouseMove;
end;
SetSelectedColor(clRed);
end;
destructor THSLRingPicker.Destroy;
@ -148,22 +151,16 @@ begin
PBack.Free;
inherited Destroy;
end;
(*
procedure THSLRingPicker.CreateWnd;
begin
inherited;
PaintParentBack(PBack);
end;
//PaintParentBack(PBack);
end; *)
procedure THSLRingPicker.DoChange;
begin
if (FRingPicker = nil) or (FSLPicker = nil) then
exit;
FRValue := GetRValue(FSLPicker.SelectedColor);
FGValue := GetGValue(FSLPicker.SelectedColor);
FBValue := GetBValue(FSLPicker.SelectedColor);
FSelectedColor := FSLPicker.SelectedColor;
inherited;
end;
@ -174,11 +171,26 @@ begin
inherited;
end;
function THSLRingPicker.GetBlue: Integer;
begin
Result := GetRValue(FSelectedColor);
end;
function THSLRingPicker.GetBrightnessMode: TBrightnessMode;
begin
Result := FSLPicker.BrightnessMode;
end;
function THSLRingPicker.GetColorUnderCursor: TColor;
begin
Result := FSLPicker.ColorUnderCursor;
end;
function THSLRingPicker.GetGreen: Integer;
begin
Result := GetGValue(FSelectedColor);
end;
function THSLRingPicker.GetHexColorUnderCursor: string;
begin
Result := FSLPicker.GetHexColorUnderCursor;
@ -194,6 +206,14 @@ begin
Result := FSLPicker.Luminance;
end;
function THSLRingPicker.GetLVHint(AMode: TBrightnessMode): String;
begin
case BrightnessMode of
bmLuminance: Result := FSLPicker.SLHintFormat;
bmValue : Result := FSLPicker.SVHintFormat;
end;
end;
function THSLRingPicker.GetMaxHue: Integer;
begin
Result := FRingPicker.MaxHue;
@ -209,16 +229,31 @@ begin
Result := FSLPicker.MaxLuminance;
end;
function THSLRingPicker.GetRed: Integer;
begin
Result := GetRValue(FSelectedColor);
end;
function THSLRingPicker.GetSat: Integer;
begin
Result := FSLPicker.Saturation;
end;
function THSLRingPicker.GetSelectedColor: TColor;
begin
Result := FSelectedColor;
end;
function THSLRingPicker.GetSelectedHexColor: string;
begin
Result := ColorToHex(FSelectedColor);
end;
function THSLRingPicker.GetVal: Integer;
begin
Result := FSLPicker.Value;
end;
procedure THSLRingPicker.Paint;
begin
PaintParentBack(PBack);
@ -250,8 +285,6 @@ end;
procedure THSLRingPicker.RingPickerChange(Sender: TObject);
begin
if (FRingPicker = nil) or (FSLPicker = nil) then
exit;
if FSLPicker.Hue <> FRingPicker.Hue then
begin
FSLPicker.Hue := FRingPicker.Hue;
@ -259,23 +292,15 @@ begin
end;
end;
procedure THSLRingPicker.SelectColor(c: TColor);
procedure THSLRingPicker.SetBlue(B: integer);
begin
if (FRingPicker = nil) or (FSLPicker = nil) then
exit;
FRingPicker.Hue := GetHValue(c);
//FRingPicker.Saturation := FRingPicker.MaxSaturation;
//FRingPicker.Value := FRingPicker.MaxValue;
FSLPicker.SelectedColor := c;
FSelectedColor := c;
SetSelectedColor(RgbToColor(Red, Green, B));
end;
procedure THSLRingPicker.SetB(v: integer);
procedure THSLRingPicker.SetBrightnessMode(AMode: TBrightnessMode);
begin
FBValue := v;
SelectColor(RGB(FRValue, FGValue, FBValue));
FRingPicker.BrightnessMode := AMode;
FSLPicker.BrightnessMode := AMode;
end;
procedure THSLRingPicker.SetFocus;
@ -284,47 +309,51 @@ begin
FRingPicker.SetFocus;
end;
procedure THSLRingPicker.SetG(v: integer);
procedure THSLRingPicker.SetGreen(G: integer);
begin
FGValue := v;
SelectColor(RGB(FRValue, FGValue, FBValue));
SetSelectedColor(RgbToColor(Red, G, Blue));
end;
procedure THSLRingPicker.SetHue(H: integer);
begin
if (FRingPicker = nil) or (FSLPicker = nil) then
exit;
FRingPicker.Hue := H;
FSLPicker.Hue := H;
end;
procedure THSLRingPicker.SetLum(L: integer);
begin
if (FSLPicker = nil) then
exit;
FSLPicker.Luminance := L;
end;
procedure THSLRingPicker.SetLVHint(AMode: TBrightnessMode; AText: string);
begin
case AMode of
bmLuminance: FSLPicker.SLHintFormat := AText;
bmValue : FSLPicker.SVHintFormat := AText;
end;
end;
procedure THSLRingPicker.SetMaxHue(H: Integer);
begin
FRingPicker.MaxHue := H;
FSLPicker.MaxHue := H;
end;
procedure THSLRingPicker.SetMaxLum(L: Integer);
begin
FRingPicker.MaxLuminance := L;
FSLPicker.MaxLuminance := L;
end;
procedure THSLRingPicker.SetMaxSat(S: Integer);
begin
FRingPicker.MaxSaturation := S;
FSLPicker.MaxSaturation := S;
end;
procedure THSLRingPicker.SetR(v: integer);
procedure THSLRingPicker.SetRed(R: integer);
begin
FRValue := v;
SelectColor(RGB(FRValue, FGValue, FBValue));
SetSelectedColor(RgbToColor(R, Green, Blue));
end;
procedure THSLRingPicker.SetRingCursor(c: TCursor);
@ -347,36 +376,45 @@ end;
procedure THSLRingPicker.SetSat(S: integer);
begin
if (FSLPicker = nil) then
exit;
FSLPicker.Saturation := S;
end;
procedure THSLRingPicker.SetSelectedColor(c: TColor);
var
H, S, LV: Double;
begin
case BrightnessMode of
bmLuminance: ColorToHSL(c, H, S, LV);
bmValue : ColorToHSV(c, H, S, LV);
end;
FRingPicker.RelHue := H;
FSLPicker.SelectedColor := c;
FSelectedColor := FSLPicker.SelectedColor;
end;
procedure THSLRingPicker.SetSLCursor(c: TCursor);
begin
FSLCursor := c;
FSLPicker.Cursor := c;
end;
procedure THSLRingPicker.SetSLHint(h: string);
begin
FSLHint := h;
FSLPicker.HintFormat := h;
end;
procedure THSLRingPicker.SetSLMenu(m: TPopupMenu);
begin
FSLMenu := m;
FSLPicker.PopupMenu := m;
end;
procedure THSLRingPicker.SetVal(V: integer);
begin
FSLPicker.Value := V;
end;
procedure THSLRingPicker.SLPickerChange(Sender: TObject);
begin
if (FSLPicker <> nil) and (FSelectedColor <> FSLPicker.SelectedColor) then
begin
FSelectedColor := FSLPicker.SelectedColor;
DoChange;
end;
if FSelectedColor = FSLPicker.SelectedColor then
exit;
FSelectedColor := FSLPicker.SelectedColor;
DoChange;
end;
end.

298
components/mbColorLib/HSVColorPicker.pas
View File

@ -8,34 +8,17 @@ interface
uses
LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Math, Forms, Themes,
RGBHSVUtils, Scanlines, HTMLColors, mbColorPickerControl;
HTMLColors, mbColorConv, mbColorPickerControl;
type
THSVColorPicker = class(TmbColorPickerControl)
THSVColorPicker = class(TmbHSLVColorPickerControl)
private
FHue, FSat, FValue: Double;
FMaxHue, FMaxSat, FMaxValue: Integer;
FSatCircColor, FHueLineColor: TColor;
FSelectedColor: TColor;
FShowSatCirc: boolean;
FShowHueLine: boolean;
FShowSelCirc: boolean;
function RadHue(New: integer): integer;
function GetHue: Integer;
function GetSat: Integer;
function GetValue: Integer;
function GetRed: Integer;
function GetGreen: Integer;
function GetBlue: Integer;
procedure SetMaxHue(h: Integer);
procedure SetMaxSat(s: Integer);
procedure SetMaxValue(v: Integer);
procedure SetHue(h: integer);
procedure SetSat(s: integer);
procedure SetValue(V: integer);
procedure SetRed(r: Integer);
procedure SetGreen(g: Integer);
procedure SetBlue(b: Integer);
procedure SetRelHue(H: Double);
procedure SetRelSat(S: Double);
procedure SetSatCircColor(c: TColor);
procedure SetHueLineColor(c: TColor);
procedure DrawSatCirc;
@ -47,31 +30,26 @@ type
procedure UpdateCoords;
protected
procedure CreateGradient; override;
procedure CreateWnd; override;
// procedure CreateWnd; override;
function GetGradientColor2D(X, Y: Integer): TColor; override;
function GetSelectedColor: TColor; override;
procedure Paint; override;
procedure Resize; 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 SelectColor(x, y: integer);
procedure SelectColor(x, y: integer); override;
procedure SetSelectedColor(c: TColor); override;
public
constructor Create(AOwner: TComponent); override;
function GetColorAtPoint(x, y: integer): TColor; override;
property Red: Integer read GetRed write SetRed;
property Green: Integer read GetGreen write SetGreen;
property Blue: Integer read GetBlue write SetBlue;
published
property BrightnessMode default bmValue;
property SelectedColor default clRed;
property Hue: integer read GetHue write SetHue default 0;
property Saturation: integer read GetSat write SetSat default 255;
property Value: integer read GetValue write SetValue default 255;
property MaxHue: Integer read FMaxHue write SetMaxHue default 359;
property MaxSaturation: Integer read FMaxSat write SetMaxSat default 255;
property MaxValue: Integer read FMaxValue write SetMaxValue default 255;
property Hue default 0;
property Luminance default 127;
property Saturation default 255;
property Value default 255;
property MaxHue default 360;
property MaxLuminance default 255;
property MaxSaturation default 255;
property MaxValue default 255;
property SaturationCircleColor: TColor read FSatCircColor write SetSatCircColor default clSilver;
property HueLineColor: TColor read FHueLineColor write SetHueLineColor default clGray;
property ShowSaturationCircle: boolean read FShowSatCirc write SetShowSatCirc default true;
@ -92,16 +70,14 @@ constructor THSVColorPicker.Create(AOwner: TComponent);
begin
inherited;
SetInitialBounds(0, 0, 204, 204);
FMaxHue := 359;
FMaxSat := 255;
FMaxValue := 255;
FHue := 0;
FSat := 1.0;
FValue := 1.0;
FLum := 0.5;
FVal := 1.0;
SetSelectedColor(clRed);
BrightnessMode := bmValue;
FSatCircColor := clSilver;
FHueLineColor := clGray;
FSelectedColor := clRed;
FManual := false;
FShowSatCirc := true;
FShowHueLine := true;
FShowSelCirc := true;
@ -114,13 +90,13 @@ begin
FGradientHeight := FGradientWidth;
inherited;
end;
(*
procedure THSVColorPicker.CreateWnd;
begin
inherited;
CreateGradient;
UpdateCoords;
end;
end; *)
procedure THSVColorPicker.DrawSatCirc;
var
@ -171,11 +147,6 @@ begin
InternalDrawMarker(x, y, c);
end;
function THSVColorPicker.GetBlue: Integer;
begin
Result := GetBValue(FSelectedColor);
end;
function THSVColorPicker.GetColorAtPoint(x, y: integer): TColor;
var
angle: Double;
@ -196,7 +167,7 @@ begin
angle := angle - 360;
h := angle / 360;
s := r / radius;
Result := HSVtoColor(h, s, FValue);
Result := HSLVtoColor(h, s, FLum, FVal);
if WebSafe then
Result := GetWebSafe(Result);
end else
@ -209,8 +180,7 @@ var
dx, dy: Integer;
dSq, radiusSq: Integer;
radius, size: Integer;
S, H, V: Double;
q: TRGBQuad;
S, H: Double;
begin
size := FGradientWidth; // or Height, they are the same...
radius := size div 2;
@ -227,102 +197,13 @@ begin
H := 180 * (1 + arctan2(dx, dy) / pi); // wp: order (x,y) is correct!
H := H + 90;
if H > 360 then H := H - 360;
Result := HSVtoColor(H/360, S, FValue);
Result := HSLVtoColor(H/360, S, FLum, FVal);
if WebSafe then
Result := GetWebSafe(Result);
end else
Result := GetDefaultColor(dctBrush);
end;
function THSVColorPicker.GetGreen: Integer;
begin
Result := GetGValue(FSelectedColor);
end;
function THSVColorPicker.GetHue: Integer;
begin
Result := round(FHue * FMaxHue);
end;
function THSVColorPicker.GetRed: Integer;
begin
Result := GetRValue(FSelectedColor);
end;
function THSVColorPicker.GetSat: Integer;
begin
Result := round(FSat * FMaxSat);
end;
function THSVColorPicker.GetSelectedColor: TColor;
begin
if FSelectedColor <> clNone then
begin
Result := HSVtoColor(FHue, FSat, FValue);
if WebSafe then
Result := GetWebSafe(Result);
end
else
Result := clNone;
end;
function THSVColorPicker.GetValue: Integer;
begin
Result := round(FValue * FMaxValue);
end;
procedure THSVColorPicker.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 : SetHue(RadHue(GetHue() + delta));
VK_RIGHT : SetHue(RadHue(GetHue() - delta));
VK_UP : SetSat(GetSat() + delta);
VK_DOWN : SetSat(GetSat() - delta);
else eraseKey := false;
end;
if eraseKey then
Key := 0;
inherited;
end;
procedure THSVColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited;
if csDesigning in ComponentState then
exit;
if (Button = mbLeft) and PointInCircle(Point(x, y), Min(Width, Height)) then
SelectColor(X, Y);
SetFocus;
end;
procedure THSVColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
inherited;
if csDesigning in ComponentState then
exit;
if (ssLeft in Shift) and PointInCircle(Point(x, y), Min(Width, Height)) then
SelectColor(X, Y);
end;
procedure THSVColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited;
if csDesigning in ComponentState then
exit;
if (Button = mbLeft) and PointInCircle(Point(x, y), Min(Width, Height)) then
SelectColor(X, Y);
end;
procedure THSVColorPicker.Paint;
var
rgn: HRGN;
@ -342,13 +223,6 @@ begin
DrawMarker(mx, my);
end;
function THSVColorPicker.RadHue(New: integer): integer;
begin
if New < 0 then New := New + (FMaxHue + 1);
if New > (FMaxHue + 1) then New := New - (FMaxHue + 1);
Result := New;
end;
procedure THSVColorPicker.Resize;
begin
inherited;
@ -393,48 +267,12 @@ begin
FHue := H;
FSat := S;
FSelectedColor := HSVToColor(FHue, FSat, FValue);
FSelected := HSLVToColor(FHue, FSat, FLum, FVal);
UpdateCoords;
Invalidate;
DoChange;
end;
procedure THSVColorPicker.SetBlue(b: Integer);
var
c: TColor;
begin
Clamp(b, 0, 255);
if b = GetBValue(FSelectedColor) then
exit;
c := RgbToColor(GetRValue(FSelectedColor), GetGValue(FSelectedColor), b);
SetSelectedColor(c);
end;
procedure THSVColorPicker.SetGreen(g: Integer);
var
c: TColor;
begin
Clamp(g, 0, 255);
if g = GetGValue(FSelectedColor) then
exit;
c := RgbToColor(GetRValue(FSelectedColor), g, GetBValue(FSelectedColor));
SetSelectedColor(c);
end;
procedure THSVColorPicker.SetHue(h: integer);
begin
if h > FMaxHue then h := h - (FMaxHue + 1);
if h < 0 then h := h + (FMaxHue + 1);
if GetHue() <> h then
begin
FHue := h / FMaxHue;
FSelectedColor := HSVToColor(FHue, FSat, FValue);
UpdateCoords;
Invalidate;
DoChange;
end;
end;
procedure THSVColorPicker.SetHueLineColor(c: TColor);
begin
if FHueLineColor <> c then
@ -444,54 +282,27 @@ begin
end;
end;
procedure THSVColorPicker.SetMaxHue(h: Integer);
procedure THSVColorPicker.SetRelHue(H: Double);
begin
if h = FMaxHue then
exit;
FMaxHue := h;
CreateGradient;
//if FChange and Assigned(OnChange) then OnChange(Self);
Invalidate;
end;
procedure THSVColorPicker.SetMaxSat(s: Integer);
begin
if s = FMaxSat then
exit;
FMaxSat := s;
CreateGradient;
//if FChange and Assigned(OnChange) then OnChange(Self);
Invalidate;
end;
procedure THSVColorPicker.SetMaxValue(v: Integer);
begin
if v = FMaxValue then
exit;
FMaxValue := v;
CreateGradient;
//if FChange and Assigned(OnChange) then OnChange(Self);
Invalidate;
end;
procedure THSVColorPicker.SetRed(r: Integer);
var
c: TColor;
begin
Clamp(r, 0, 255);
if r = GetRValue(FSelectedColor) then
exit;
c := RgbToColor(r, GetGValue(FSelectedColor), GetBValue(FSelectedColor));
SetSelectedColor(c);
end;
procedure THSVColorPicker.SetSat(s: integer);
begin
Clamp(s, 0, FMaxSat);
if GetSat() <> s then
if H > 1 then H := H - 1;
if H < 0 then H := H + 1;
if FHue <> h then
begin
FSat := s / FMaxSat;
FSelectedColor := HSVToColor(FHue, FSat, FValue);
FHue := h;
FSelected := HSLVtoColor(FHue, FSat, FLum, FVal);
UpdateCoords;
Invalidate;
DoChange;
end;
end;
procedure THSVColorPicker.SetRelSat(S: Double);
begin
Clamp(S, 0.0, 1.0);
if FSat <> S then
begin
FSat := s;
FSelected := HSLVToColor(FHue, FSat, FLum, FVal);
UpdateCoords;
Invalidate;
DoChange;
@ -508,15 +319,13 @@ begin
end;
procedure THSVColorPicker.SetSelectedColor(c: TColor);
var
h, s, v: Double;
begin
if WebSafe then
c := GetWebSafe(c);
if c = FSelectedColor then
if c = FSelected then
exit;
RGBtoHSV(GetRValue(c), GetGValue(c), GetBValue(c), FHue, FSat, FValue);
FSelectedColor := c;
ColorToHSLV(c, FHue, FSat, FLum, FVal);
FSelected := c;
UpdateCoords;
Invalidate;
DoChange;
@ -549,19 +358,6 @@ begin
end;
end;
procedure THSVColorPicker.SetValue(V: integer);
begin
Clamp(V, 0, FMaxValue);
if GetValue() <> V then
begin
FValue := V / FMaxValue;
FSelectedColor := HSVToColor(FHue, FSat, FValue);
CreateGradient;
Invalidate;
DoChange;
end;
end;
procedure THSVColorPicker.UpdateCoords;
var
r, angle: double;

9
components/mbColorLib/HexaColorPicker.pas
View File

@ -11,8 +11,7 @@ interface
uses
LCLIntf, LCLType, LMessages, SysUtils, Classes, Controls, Graphics, StdCtrls,
Forms, Themes, Math,
HTMLColors, RGBHSLUtils, RGBHSVUtils, RGBCMYKUtils, RGBCIEUtils,
mbBasicPicker;
HTMLColors, mbBasicPicker;
const
CustomCell = -2;
@ -90,7 +89,6 @@ type
procedure SetNewArrowStyle(Value: boolean);
procedure SetMarker(Value: TMarker);
procedure SetRadius(r: integer);
procedure SetSelectedColor(const Value: TColor);
procedure SetSliderVisible(Value: boolean);
procedure SetSliderWidth(w: integer);
function SelectAvailableColor(Color: TColor): boolean;
@ -100,6 +98,7 @@ type
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure Paint; override;
procedure Resize; override;
procedure SetSelectedColor(Value: TColor); override;
procedure CMHintShow(var Message: TLMessage); message CM_HINTSHOW;
procedure WMLButtonDown(var Message: TLMLButtonDown); message LM_LBUTTONDOWN;
procedure WMLButtonUp(var Message: TLMLButtonUp); message LM_LBUTTONUP;
@ -705,7 +704,7 @@ begin
FBWCombRect := Rect(
FColorCombRect.Left,
FColorCombRect.Bottom - 4,
Round(17 * FCombSize * cos(Pi / 6) / 2) + 6 * FCombSize,
Round(17 * FCombSize * cos(Pi / 6) / 2) {%H-}+ 6 * FCombSize,
FColorCombRect.Bottom + 2 * FCombSize
);
if FSliderVisible then
@ -977,7 +976,7 @@ begin
end;
end;
procedure THexaColorPicker.SetSelectedColor(const Value: TColor);
procedure THexaColorPicker.SetSelectedColor(Value: TColor);
begin
FCurrentColor := Value;
SelectColor(Value);

7
components/mbColorLib/KColorPicker.pas
View File

@ -17,17 +17,17 @@ type
FCyan, FMagenta, FYellow, FBlack: integer;
function ArrowPosFromBlack(k: integer): integer;
function BlackFromArrowPos(p: integer): integer;
function GetSelectedColor: TColor;
procedure SetBlack(k: integer);
procedure SetCyan(c: integer);
procedure SetMagenta(m: integer);
procedure SetSelectedColor(clr: TColor);
procedure SetYellow(y: integer);
protected
procedure Execute(tbaAction: integer); override;
function GetArrowPos: integer; override;
function GetGradientColor(AValue: Integer): TColor; override;
function GetSelectedColor: TColor; override;
function GetSelectedValue: integer; override;
procedure SetSelectedColor(clr: TColor); override;
public
constructor Create(AOwner: TComponent); override;
published
@ -35,8 +35,9 @@ type
property Magenta: integer read FMagenta write SetMagenta default 0;
property Yellow: integer read FYellow write SetYellow default 0;
property Black: integer read FBlack write SetBlack default 0;
property SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed;
property SelectedColor default clRed;
property Layout default lyVertical;
property HintFormat;
end;
implementation

36
components/mbColorLib/LColorPicker.pas
View File

@ -8,7 +8,7 @@ interface
uses
LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Forms,
HTMLColors, RGBHSLUtils, mbTrackBarPicker;
HTMLColors, {RGBHSLUtils, }mbTrackBarPicker;
type
TLColorPicker = class(TmbTrackBarPicker)
@ -19,7 +19,6 @@ type
function GetHue: Integer;
function GetLuminance: Integer;
function GetSat: Integer;
function GetSelectedColor: TColor;
function LumFromArrowPos(p: integer): integer;
procedure SetHue(H: integer);
procedure SetLuminance(L: integer);
@ -27,37 +26,39 @@ type
procedure SetMaxLum(L: Integer);
procedure SetMaxSat(S: Integer);
procedure SetSat(S: integer);
procedure SetSelectedColor(c: TColor);
protected
procedure Execute(tbaAction: integer); override;
function GetArrowPos: integer; override;
function GetGradientColor(AValue: Integer): TColor; override;
function GetSelectedColor: TColor; override;
function GetSelectedValue: integer; 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 Luminance: integer read GetLuminance write SetLuminance;
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 SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed;
property MaxHue: Integer read FMaxHue write SetmaxHue default 360;
property MaxSaturation: Integer read FMaxSat write SetMaxSat default 255;
property MaxLuminance: Integer read FMaxLum write SetMaxLum default 255;
property SelectedColor default clRed;
property HintFormat;
end;
implementation
uses
mbUtils;
mbUtils, mbColorConv;
{TLColorPicker}
constructor TLColorPicker.Create(AOwner: TComponent);
begin
inherited;
FMaxHue := 359;
FMaxSat := 240;
FMaxLum := 240;
FMaxHue := 360;
FMaxSat := 255;
FMaxLum := 255;
FGradientWidth := FMaxLum + 1;
FGradientHeight := 1;
FHue := 0;
@ -130,7 +131,7 @@ end;
function TLColorPicker.GetGradientColor(AValue: Integer): TColor;
begin
Result := HSLToRGB(FHue, FSat, AValue/FMaxLum);
Result := HSLToColor(FHue, FSat, AValue/FMaxLum);
end;
function TLColorPicker.GetHue: Integer;
@ -150,7 +151,7 @@ end;
function TLColorPicker.GetSelectedColor: TColor;
begin
Result := HSLToRGB(FHue, FSat, FLuminance);
Result := HSLToColor(FHue, FSat, FLuminance);
if WebSafe then
Result := GetWebSafe(Result);
end;
@ -165,8 +166,8 @@ var
L: integer;
begin
case Layout of
lyHorizontal : L := Round(p / (Width - 12) * FMaxLum);
lyVertical : L := Round(MaxLum - p /(Height - 12) * FMaxLum);
lyHorizontal : L := Round( p / (Width - 12) * FMaxLum);
lyVertical : L := Round((1.0 - p /(Height - 12)) * FMaxLum);
end;
Clamp(L, 0, FMaxLum);
Result := L;
@ -193,7 +194,6 @@ begin
FArrowPos := ArrowPosFromLum(L);
Invalidate;
DoChange;
// if FChange and Assigned(OnChange) then OnChange(Self);
end;
end;
@ -250,8 +250,8 @@ begin
if c = GetSelectedColor then
exit;
// ColortoHSL(c, FHue, FSat, FLuminance); // not working in HSLPicker
RGBtoHSL(c, H, S, L);
// ColortoHSL(c, H, S, L); // not working in HSLPicker
ColorToHSL(c, H, S, L);
needNewGradient := (H <> FHue) or (S <> FSat);
FHue := H;
FSat := S;

335
components/mbColorLib/LVColorPicker.pas Normal file
View File

@ -0,0 +1,335 @@
{ A trackbar picker for Luminance or Value parameters from the HSL or HSV
color models (depending on setting for BrightnessMode) }
unit LVColorPicker;
interface
{$IFDEF FPC}
{$MODE DELPHI}
{$ENDIF}
uses
LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Forms,
HTMLColors, mbColorConv, mbTrackBarPicker;
type
TLVColorPicker = class(TmbHSLVTrackBarPicker)
private
FHint: array[TBrightnessMode] of string;
function ArrowPosFromLum(L: Double): integer;
function ArrowPosFromVal(V: Double): integer;
function LumFromArrowPos(p: integer): Double;
function ValFromArrowPos(p: Integer): Double;
function GetHint(AMode: TBrightnessMode): String;
procedure SetHint(AMode: TBrightnessMode; AText: String);
protected
procedure Execute(tbaAction: integer); override;
function GetArrowPos: integer; override;
function GetGradientColor(AValue: Integer): TColor; override;
function GetSelectedValue: integer; override;
procedure SetBrightnessMode(AMode: TBrightnessMode); override;
procedure SetMaxLum(L: Integer); override;
procedure SetMaxVal(V: Integer); override;
procedure SetRelLum(L: Double); override;
procedure SetRelVal(V: Double); override;
procedure SetSelectedColor(c: TColor); override;
public
constructor Create(AOwner: TComponent); override;
published
property Hue default 0;
property Saturation default 0;
property Luminance default 255;
property Value default 255;
property SelectedColor default clWhite;
property LHintFormat: String index bmLuminance read GetHint write SetHint;
property VHintFormat: String index bmValue read GetHint write SetHint;
end;
implementation
uses
mbUtils;
{ TLVColorPicker }
constructor TLVColorPicker.Create(AOwner: TComponent);
begin
inherited;
case BrightnessMode of
bmLuminance : FGradientWidth := FMaxLum + 1;
bmValue : FGradientWidth := FMaxVal + 1;
end;
FGradientHeight := 1;
FHue := 0;
FSat := 0;
FLum := 1;
FVal := 1;
FHint[bmLuminance] := 'Luminance: %lum (selected)';
FHint[bmValue] := 'Value: %value (selected)';
end;
function TLVColorPicker.ArrowPosFromLum(L: Double): integer;
var
a: integer;
begin
if Layout = lyHorizontal then
begin
a := Round((Width - 12) * L);
if a > Width - FLimit then a := Width - FLimit;
end
else
begin
a := Round((Height - 12) * (1.0 - L));
if a > Height - FLimit then a := Height - FLimit;
end;
if a < 0 then a := 0;
Result := a;
end;
function TLVColorPicker.ArrowPosFromVal(V: Double): integer;
var
a: integer;
begin
if Layout = lyHorizontal then
begin
a := Round((Width - 12) * V);
if a > Width - FLimit then a := Width - FLimit;
end
else
begin
a := Round((Height - 12) * (1.0 - V));
if a > Height - FLimit then a := Height - FLimit;
end;
if a < 0 then a := 0;
Result := a;
end;
procedure TLVColorPicker.Execute(tbaAction: integer);
var
dLum, dVal: Double;
begin
case BrightnessMode of
bmLuminance:
begin
if FMaxLum = 0 then dLum := 0 else dLum := Increment / FMaxLum;
case tbaAction of
TBA_Resize:
SetRelLum(FLum);
TBA_MouseMove:
SetRelLum(LumFromArrowPos(FArrowPos));
TBA_MouseDown:
SetRelLum(LumFromArrowPos(FArrowPos));
TBA_MouseUp:
SetRelLum(LumFromArrowPos(FArrowPos));
TBA_WheelUp:
SetRelLum(FLum + dLum);
TBA_WheelDown:
SetRelLum(FLum - dLum);
TBA_VKRight:
SetRelLum(FLum + dLum);
TBA_VKCtrlRight:
SetRelLum(1.0);
TBA_VKLeft:
SetRelLum(FLum - dLum);
TBA_VKCtrlLeft:
SetRelLum(0.0);
TBA_VKUp:
SetRelLum(FLum + dLum);
TBA_VKCtrlUp:
SetRelLum(1.0);
TBA_VKDown:
SetRelLum(FLum - dLum);
TBA_VKCtrlDown:
SetRelLum(0);
else
inherited;
end;
end;
bmValue:
begin
if FMaxVal = 0 then dVal := 0 else dVal := Increment / FMaxVal;
case tbaAction of
TBA_Resize:
SetRelVal(FVal);
TBA_MouseMove:
SetRelVal(ValFromArrowPos(FArrowPos));
TBA_MouseDown:
SetRelVal(ValFromArrowPos(FArrowPos));
TBA_MouseUp:
SetRelVal(ValFromArrowPos(FArrowPos));
TBA_WheelUp:
SetRelVal(FVal + dVal);
TBA_WheelDown:
SetRelVal(FVal - dVal);
TBA_VKRight:
SetRelval(FVal + dVal);
TBA_VKCtrlRight:
SetRelVal(1.0);
TBA_VKLeft:
SetRelval(FVal - dVal);
TBA_VKCtrlLeft:
SetRelVal(0.0);
TBA_VKUp:
SetRelVal(FVal + dVal);
TBA_VKCtrlUp:
SetRelVal(1.0);
TBA_VKDown:
SetRelval(FVal - dVal);
TBA_VKCtrlDown:
SetRelVal(0.0);
else
inherited;
end;
end;
end;
end;
function TLVColorPicker.GetArrowPos: integer;
begin
case BrightnessMode of
bmLuminance:
if FMaxLum = 0 then
Result := inherited GetArrowPos
else
Result := ArrowPosFromLum(FLum);
bmValue:
if FMaxVal = 0 then
Result := inherited GetArrowPos
else
Result := ArrowPosFromVal(FVal);
end;
end;
function TLVColorPicker.GetGradientColor(AValue: Integer): TColor;
begin
Result := HSLVtoColor(FHue, FSat, AValue/FMaxLum, AValue/FMaxVal);
end;
function TLVColorPicker.GetHint(AMode: TBrightnessMode): String;
begin
Result := FHint[AMode];
end;
function TLVColorPicker.GetSelectedValue: integer;
begin
case BrightnessMode of
bmLuminance : Result := Luminance;
bmValue : Result := Value;
end;
end;
function TLVColorPicker.LumFromArrowPos(p: integer): Double;
var
L: Double;
begin
case Layout of
lyHorizontal : L := p / (Width - 12);
lyVertical : L := 1.0 - p /(Height - 12);
end;
Clamp(L, 0, 1.0);
Result := L;
end;
procedure TLVColorPicker.SetBrightnessMode(AMode: TBrightnessMode);
begin
inherited;
HintFormat := FHint[AMode];
end;
procedure TLVColorPicker.SetHint(AMode: TBrightnessMode; AText: String);
begin
FHint[AMode] := AText;
end;
procedure TLVColorPicker.SetMaxLum(L: Integer);
begin
if L = FMaxLum then
exit;
FMaxLum := L;
if BrightnessMode = bmLuminance then begin
FGradientWidth := FMaxLum + 1;
CreateGradient;
Invalidate;
DoChange;
end;
end;
procedure TLVColorPicker.SetMaxVal(V: Integer);
begin
if V = FMaxVal then
exit;
FMaxVal := V;
if BrightnessMode = bmValue then begin
FGradientWidth := FMaxVal + 1;
CreateGradient;
Invalidate;
DoChange;
end;
end;
procedure TLVColorPicker.SetRelLum(L: Double);
begin
Clamp(L, 0, 1.0);
if FLum <> L then
begin
FLum := L;
FArrowPos := ArrowPosFromLum(L);
Invalidate;
DoChange;
end;
end;
procedure TLVColorPicker.SetRelVal(V: Double);
begin
Clamp(V, 0, 1.0);
if FVal <> V then
begin
FVal := V;
FArrowPos := ArrowPosFromVal(V);
Invalidate;
DoChange;
end;
end;
procedure TLVColorPicker.SetSelectedColor(c: TColor);
var
H: Double = 0;
S: Double = 0;
L: Double = 0;
V: Double = 0;
needNewGradient: Boolean;
begin
if WebSafe then
c := GetWebSafe(c);
if c = GetSelectedColor then
exit;
ColorToHSLV(c, H, S, L, V);
needNewGradient := (H <> FHue) or (S <> FSat);
FHue := H;
FSat := S;
case BrightnessMode of
bmLuminance : FLum := L;
bmValue : FVal := V;
end;
if needNewGradient then
CreateGradient;
Invalidate;
DoChange;
end;
function TLVColorPicker.ValFromArrowPos(p: integer): Double;
var
V: Double;
begin
case Layout of
lyHorizontal : V := p / (Width - 12);
lyVertical : V := 1.0 - p /(Height - 12);
end;
Clamp(V, 0, 1.0);
Result := V;
end;
end.

7
components/mbColorLib/MColorPicker.pas
View File

@ -14,18 +14,18 @@ type
private
FCyan, FMagenta, FYellow, FBlack: integer;
function ArrowPosFromMagenta(m: integer): integer;
function GetSelectedColor: TColor;
function MagentaFromArrowPos(p: integer): integer;
procedure SetBlack(k: integer);
procedure SetCyan(c: integer);
procedure SetMagenta(m: integer);
procedure SetSelectedColor(clr: TColor);
procedure SetYellow(y: integer);
protected
procedure Execute(tbaAction: integer); override;
function GetArrowPos: integer; override;
function GetGradientColor(AValue: Integer): TColor; override;
function GetSelectedColor: TColor; override;
function GetSelectedValue: integer; override;
procedure SetSelectedColor(clr: TColor); override;
public
constructor Create(AOwner: TComponent); override;
published
@ -33,8 +33,9 @@ type
property Magenta: integer read FMagenta write SetMagenta default 255;
property Yellow: integer read FYellow write SetYellow default 0;
property Black: integer read FBlack write SetBlack default 0;
property SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed;
property SelectedColor default clRed;
property Layout default lyVertical;
property HintFormat;
end;

42
components/mbColorLib/OfficeMoreColorsDialog.lfm
View File

@ -56,9 +56,10 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin
TabIndex = 1
TabOrder = 0
OnChange = PagesChange
OnChanging = PagesChanging
object Standard: TTabSheet
Caption = 'Standard'
ClientHeight = 273
ClientHeight = 277
ClientWidth = 243
object Label2: TLabel
Left = 6
@ -73,11 +74,11 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin
AnchorSideTop.Control = Label2
AnchorSideTop.Side = asrBottom
Left = 0
Height = 246
Top = 26
Height = 254
Top = 22
Width = 240
Anchors = [akTop, akLeft, akRight, akBottom]
HintFormat = 'RGB(%r, %g, %b)'#13'Hex: %h'
HintFormat = 'RGB(%r, %g, %b)'#13'Hex: %hex'
IntensityText = 'Intensity'
TabOrder = 0
Constraints.MinHeight = 85
@ -173,7 +174,7 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin
Caption = '&Sat:'
ParentColor = False
end
object LLum: TLabel
object LLumVal: TLabel
Left = 120
Height = 15
Top = 249
@ -200,11 +201,12 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin
Height = 141
Top = 0
Width = 232
Hue = 180
Saturation = 227
SelectedColor = 16315911
SelectedColor = 460791
Saturation = 241
HSPickerHintFormat = 'H: %h S: %s'#13'Hex: %hex'
LPickerHintFormat = 'Luminance: %l'
VPickerHintFormat = 'Value: %value (selected)'
MaxLuminance = 255
Align = alClient
TabOrder = 0
OnChange = ColorPickerChange
@ -218,9 +220,14 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin
Height = 124
Top = 0
Width = 136
SelectedColor = 14803455
Saturation = 30
Luminance = 240
RingPickerHintFormat = 'Hue: %h'
SLPickerHintFormat = 'S: %hslS L: %l'#13'Hex: %hex'
SLPickerHintFormat = 'S: %hslS V: %v'#13'Hex: %hex'
SVPickerHintFormat = 'S: %hslS V: %v'#13'Hex: %hex'
MaxLuminance = 255
MaxSaturation = 255
ParentShowHint = False
Anchors = [akTop, akLeft, akBottom]
TabOrder = 0
@ -242,13 +249,16 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin
Top = 0
Width = 232
ParentColor = False
SelectedColor = clWhite
Saturation = 0
Luminance = 240
HPickerHintFormat = 'Hue: %h'
SLPickerHintFormat = 'S: %hslS L: %l'#13'Hex: %hex'
MaxSaturation = 255
MaxLuminance = 255
ParentShowHint = False
Align = alClient
TabOrder = 0
Color = clMenuHighlight
OnChange = ColorPickerChange
end
end
@ -260,7 +270,7 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin
Height = 32
Top = 0
Width = 218
HintFormat = 'Red: %value (selected)'
SelectedColor = 8026879
Layout = lyHorizontal
SelectionIndicator = siRect
Anchors = [akTop, akLeft, akRight]
@ -268,7 +278,7 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin
OnChange = ColorPickerChange
Green = 122
Blue = 122
SelectedColor = 8026879
HintFormat = 'Red: %value (selected)'
end
object GTrackbar: TGColorPicker
AnchorSideRight.Control = nbRGB
@ -277,9 +287,9 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin
Height = 32
Top = 40
Width = 216
SelectedColor = 8060794
BevelInner = bvLowered
BevelOuter = bvRaised
HintFormat = 'Green: %value (selected)'
Layout = lyHorizontal
SelectionIndicator = siRect
Anchors = [akTop, akLeft, akRight]
@ -287,7 +297,7 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin
OnChange = ColorPickerChange
Red = 122
Blue = 122
SelectedColor = 8060794
HintFormat = 'Green: %value (selected)'
end
object BTrackbar: TBColorPicker
AnchorSideRight.Control = nbRGB
@ -296,7 +306,7 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin
Height = 32
Top = 80
Width = 216
HintFormat = 'Blue: %value (selected)'
SelectedColor = 16743034
Layout = lyHorizontal
SelectionIndicator = siRect
Anchors = [akTop, akLeft, akRight]
@ -304,7 +314,7 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin
OnChange = ColorPickerChange
Green = 122
Red = 122
SelectedColor = 16743034
HintFormat = 'Blue: %value (selected)'
end
object Label6: TLabel
AnchorSideTop.Control = RTrackbar

262
components/mbColorLib/OfficeMoreColorsDialog.pas
View File

@ -5,7 +5,7 @@ interface
uses
LCLIntf, LCLType, SysUtils, Variants, Classes, Graphics, Controls, Forms,
StdCtrls, ExtCtrls, ComCtrls,
HexaColorPicker, HSLColorPicker, RGBHSLUtils, mbColorPreview,
HexaColorPicker, HSLColorPicker, mbColorConv, mbColorPreview,
{$IFDEF mbXP_Lib}mbXPSpinEdit, mbXPSizeGrip,{$ELSE} Spin,{$ENDIF}
HTMLColors, SLHColorPicker, HSLRingPicker, RColorPicker, GColorPicker,
BColorPicker;
@ -22,7 +22,7 @@ type
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
LLum: TLabel;
LLumVal: TLabel;
LSat: TLabel;
LHue: TLabel;
nbRGB: TPage;
@ -51,49 +51,66 @@ type
NewSwatch: TmbColorPreview;
OldSwatch: TmbColorPreview;
procedure cbColorDisplayChange(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure HSLChange(Sender: TObject);
procedure ERedChange(Sender: TObject);
procedure EGreenChange(Sender: TObject);
procedure ColorPickerChange(Sender: TObject);
procedure EBlueChange(Sender: TObject);
procedure EGreenChange(Sender: TObject);
procedure EHueChange(Sender: TObject);
procedure ELumValChange(Sender: TObject);
procedure ERedChange(Sender: TObject);
procedure ESatChange(Sender: TObject);
procedure ELumChange(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FormKeyDown(Sender: TObject; var Key: Word; {%H-}Shift: TShiftState);
procedure FormResize(Sender: TObject);
procedure FormShow(Sender: TObject);
function GetHint(c: TColor): string;
procedure HexaChange(Sender: TObject);
procedure HSLChange(Sender: TObject);
procedure HSLRingChange(Sender: TObject);
procedure NewSwatchColorChange(Sender: TObject);
procedure OldSwatchColorChange(Sender: TObject);
procedure PagesChange(Sender: TObject);
procedure ColorPickerChange(Sender: TObject);
procedure PagesChanging(Sender: TObject; var {%H-}AllowChange: Boolean);
procedure SLHChange(Sender: TObject);
private
{$IFDEF mbXP_Lib}
ERed, EGreen, EBlue: TmbXPSpinEdit;
EHue, ESat, ELum: TmbXPSpinEdit;
EHue, ESat, ELumVal: TmbXPSpinEdit;
grip: TmbXPSizeGrip;
{$ELSE}
ERed, EGreen, EBlue: TSpinEdit;
EHue, ESat, ELum: TSpinEdit;
EHue, ESat, ELumVal: TSpinEdit;
{$ENDIF}
FMaxHue: Integer;
FMaxSat: Integer;
FMaxLum: Integer;
FMaxVal: Integer;
FSelectedColor: TColor;
FBrightnessMode: TBrightnessMode;
FLockChange: Integer;
function GetPickerIndex: Integer;
function GetSelectedColor: TColor;
function GetShowHint: Boolean;
procedure SetAllCustom(c: TColor);
procedure SetAllToSel(c: TColor);
procedure SetBrightnessMode(AMode: TBrightnessMode);
procedure SetMaxHue(H: Integer);
procedure SetMaxLum(L: Integer);
procedure SetMaxSat(S: Integer);
procedure SetMaxVal(V: Integer);
procedure SetPickerIndex(AValue: Integer);
procedure SetSelectedColor(c: TColor);
procedure SetShowHint(AValue: boolean);
protected
procedure BeginUpdate;
procedure CreateParams(var Params: TCreateParams); override;
// procedure CreateWnd; override;
procedure EndUpdate;
public
property MaxHue: Integer read FMaxHue write FMaxHue;
property MaxSaturation: Integer read FMaxSat write FMaxSat;
property MaxLuminance: Integer read FMaxLum write FMaxLum;
property PickerIndex: Integer read GetPickerIndex write SetPickerIndex;
property SelectedColor: TColor read GetSelectedColor write SetSelectedColor;
property MaxHue: Integer read FMaxHue write SetMaxHue;
property MaxSaturation: Integer read FMaxSat write SetMaxSat;
property MaxLuminance: Integer read FMaxLum write SetMaxLum;
property MaxValue: Integer read FMaxVal write SetMaxVal;
published
property ShowHint: Boolean read GetShowHint write SetShowHint;
end;
@ -105,8 +122,16 @@ implementation
{$R *.lfm}
procedure TOfficeMoreColorsWin.BeginUpdate;
begin
inc(FLockChange);
end;
procedure TOfficeMoreColorsWin.ColorPickerChange(Sender: TObject);
begin
if FLockChange > 0 then
exit;
if Sender = HSL then
SetAllCustom(HSL.SelectedColor);
if Sender = HSLRing then
@ -183,27 +208,42 @@ begin
try
HSL.Hue := EHue.Value;
SLH.Hue := EHue.Value;
NewSwatch.Color := HSLToRGB(EHue.Value/FMaxHue, ESat.Value/FMaxSat, ELum.Value/FMaxLum);
case FBrightnessMode of
bmLuminance:
NewSwatch.Color := HSLToColor(EHue.Value/FMaxHue, ESat.Value/FMaxSat, ELumVal.Value/FMaxLum);
bmValue:
NewSwatch.Color := HSVtoColor(EHue.Value/FMaxHue, ESat.Value/FMaxSat, ELumVal.Value/FMaxVal);
end;
finally
dec(FLockChange);
end;
end;
end;
procedure TOfficeMoreColorsWin.ELumChange(Sender: TObject);
procedure TOfficeMoreColorsWin.ELumValChange(Sender: TObject);
begin
if (ELum.Text <> '') and ELum.Focused and (FLockChange = 0) then
if (ELumVal.Text <> '') and ELumVal.Focused and (FLockChange = 0) then
begin
inc(FLockChange);
try
HSL.Luminance := ELum.Value;
NewSwatch.Color := HSLToRGB(EHue.Value/FMaxHue, ESat.Value/FMaxSat, ELum.Value/FMaxLum);
HSL.Luminance := ELumVal.Value;
case FBrightnessMode of
bmLuminance:
NewSwatch.Color := HSLToColor(EHue.Value/FMaxHue, ESat.Value/FMaxSat, ELumVal.Value/FMaxLum);
bmValue:
NewSwatch.Color := HSVtoColor(EHue.Value/FMaxHue, ESat.Value/FMaxSat, ELumVal.Value/FMaxVal);
end;
finally
dec(FLockChange);
end;
end;
end;
procedure TOfficeMoreColorsWin.EndUpdate;
begin
dec(FLockChange);
end;
procedure TOfficeMoreColorsWin.ERedChange(Sender: TObject);
begin
if (ERed.Text <> '') and ERed.Focused and (FLockChange = 0) then
@ -227,7 +267,12 @@ begin
try
HSL.Saturation := ESat.Value;
SLH.Saturation := ESat.Value;
NewSwatch.Color := HSLToRGB(EHue.Value/FMaxHue, ESat.Value/FMaxSat, ELum.Value/FMaxLum);
case FBrightnessMode of
bmLuminance:
NewSwatch.Color := HSLToColor(EHue.Value/FMaxHue, ESat.Value/FMaxSat, ELumval.Value/FMaxLum);
bmValue:
NewSwatch.Color := HSVtoColor(EHue.Value/FMaxHue, ESat.Value/FMaxSat, ELumval.Value/FMaxVal);
end;
finally
dec(FLockChange);
end;
@ -236,21 +281,27 @@ end;
procedure TOfficeMoreColorsWin.FormCreate(Sender: TObject);
begin
FMaxHue := 359;
FMaxSat := 240;
FMaxLum := 240;
FBrightnessMode := bmLuminance;
FMaxHue := 360;
FMaxSat := 255;
FMaxLum := 255;
FMaxVal := 255;
HSL.MaxHue := FMaxHue;
HSL.MaxSaturation := FMaxSat;
HSL.MaxLuminance := FMaxLum;
HSL.BrightnessMode := FBrightnessMode;
HSLRing.MaxHue := FMaxHue;
HSLRing.MaxSaturation := FMaxSat;
HSLRing.MaxLuminance := FMaxLum;
HSLRing.BrightnessMode := FBrightnessMode;
SLH.MaxHue := FMaxHue;
SLH.MaxSaturation := FMaxSat;
SLH.MaxLuminance := FMaxLum;
SLH.BrightnessMode := FBrightnessMode;
{$IFDEF mbXP_Lib}
ERed := TmbXPSpinEdit.CreateParented(Custom.Handle);
@ -263,7 +314,7 @@ begin
EBlue := TSpinEdit.CreateParented(Custom.Handle);
EHue := TSpinEdit.CreateParented(Custom.Handle);
ESat := TSpinEdit.CreateParented(Custom.Handle);
ELum := TSpinEdit.CreateParented(Custom.Handle);
ELumVal := TSpinEdit.CreateParented(Custom.Handle);
{$ENDIF}
with ERed do
begin
@ -340,9 +391,9 @@ begin
OnChange := @ESatChange;
// TabOrder := EHue.TabOrder + 1;
end;
with ELum do
with ELumVal do
begin
Name := 'ELum';
Name := 'ELumVal';
Width := 47;
Height := 22;
Left := cbColorDisplay.Left + cbColorDisplay.Width - Width;
@ -352,7 +403,7 @@ begin
MaxValue := FMaxLum;
MinValue := 0;
Value := 0;
OnChange := @ELumChange;
OnChange := @ELumValChange;
// TabOrder := ESat.TabOrder + 1;
end;
Custom.InsertControl(ERed);
@ -360,7 +411,7 @@ begin
Custom.InsertControl(EBlue);
Custom.InsertControl(EHue);
Custom.InsertControl(ESat);
Custom.InsertControl(ELum);
Custom.InsertControl(ELumVal);
{$IFDEF mbXP_Lib}
with grip do
@ -375,7 +426,7 @@ begin
InsertControl(grip);
{$ENDIF}
OKBtn.TabOrder := ELum.TabOrder + 1;
OKBtn.TabOrder := ELumVal.TabOrder + 1;
CancelBtn.TabOrder := OKBtn.TabOrder + 1;
end;
@ -415,6 +466,32 @@ begin
]);
end;
function TOfficeMoreColorsWin.GetPickerIndex: Integer;
begin
Result := PickerNotebook.PageIndex + 1;
if Pages.PageIndex = 0 then
Result := -Result;
end;
procedure TOfficeMoreColorsWin.SetPickerIndex(AValue: Integer);
begin
if AValue = 0 then begin
Pages.PageIndex := 0;
PickerNotebook.PageIndex := 0;
end else
begin
PickerNotebook.PageIndex := abs(AValue) - 1;
if AValue > 0 then
Pages.PageIndex := 1 else
Pages.PageIndex := 0;
end;
end;
function TOfficeMoreColorsWin.GetSelectedColor: TColor;
begin
Result := NewSwatch.Color;
end;
function TOfficeMoreColorsWin.GetShowHint: Boolean;
begin
Result := inherited ShowHint;
@ -436,13 +513,14 @@ begin
end;
procedure TOfficeMoreColorsWin.NewSwatchColorChange(Sender: TObject);
var
r,g,b: Integer;
h,s,l: Integer;
begin
NewSwatch.Hint := GetHint(NewSwatch.Color);
exit;
if (ERed = nil) or (EBlue = nil) or (EGreen = nil) or
(EHue = nil) or (ESat = nil) or (ELum = nil)
(EHue = nil) or (ESat = nil) or (ELumVal = nil)
then
exit;
@ -452,33 +530,57 @@ end;
procedure TOfficeMoreColorsWin.OldSwatchColorChange(Sender: TObject);
begin
OldSwatch.Hint := GetHint(OldSwatch.Color);
SetAllToSel(OldSwatch.Color);
//SetAllToSel(OldSwatch.Color);
end;
procedure TOfficeMoreColorsWin.PagesChange(Sender: TObject);
begin
SetAllToSel(NewSwatch.Color);
SetAllToSel(FSelectedColor); //NewSwatch.Color);
end;
procedure TOfficeMoreColorsWin.PagesChanging(Sender: TObject;
var AllowChange: Boolean);
begin
FSelectedColor := NewSwatch.Color;
{
case Pages.PageIndex of
0: FSelectedColor := Hexa.SelectedColor;
1: case PickerNotebook.PageIndex of
0: FSelectedColor := HSL.SelectedColor;
1: FSelectedColor := HSLRing.SelectedColor;
2: FSelectedColor := SLH.SelectedColor;
3: FSelectedColor := RgbToColor(RTrackbar.Red, GTrackbar.Green, BTrackbar.Blue);
end;
end;
}
end;
procedure TOfficeMoreColorsWin.SetAllCustom(c: TColor);
var
r, g, b: Integer;
H, S, L: Double;
// h, s, l: Integer;
H, S, L, V: Double;
begin
if (ERed = nil) or (EGreen = nil) or (EBlue = nil) or
(EHue = nil) or (ESat = nil) or (ELum = nil) or
(EHue = nil) or (ESat = nil) or (ELumVal = nil) or
(PickerNotebook = nil) or (HSL = nil) or (HSLRing = nil) or (SLH = nil)
or (FLockChange > 0)
then
exit;
BeginUpdate;
NewSwatch.Color := c;
r := GetRValue(c);
g := GetGValue(c);
b := GetBValue(c);
RGBToHSL(c, H, S, L);
// RGBtoHSLRange(c, h, s, l);
case FBrightnessMode of
bmLuminance : ColorToHSL(c, H, S, L);
bmValue : ColortoHSV(c, H, S, V);
end;
if PickerNotebook.ActivePage = nbHSL.Name then
HSL.SelectedColor := c
@ -503,13 +605,17 @@ begin
EBlue.Value := b;
EHue.Value := H * HSL.MaxHue;
ESat.Value := S * HSL.MaxSaturation;
ELum.Value := L * HSL.MaxLuminance;
case FBrightnessMode of
bmLuminance: ELumVal.Value := L * HSL.MaxLuminance;
bmValue : ELumVal.Value := V * HSL.MaxValue;
end;
EndUpdate;
end;
procedure TOfficeMoreColorsWin.SetAllToSel(c: TColor);
var
h, s, l: Integer;
begin
//inc(FLockChange);
case Pages.ActivePageIndex of
// Standard Page
0: Hexa.SelectedColor := c;
@ -517,6 +623,71 @@ begin
1: SetAllCustom(c);
end;
NewSwatch.Color := c;
//dec(FLockChange);
end;
procedure TOfficeMoreColorsWin.SetBrightnessMode(AMode: TBrightnessMode);
begin
FBrightnessMode := AMode;
case AMode of
bmLuminance: LLumVal.Caption := 'Lum:';
bmValue : LLumval.Caption := 'Val:';
end;
end;
procedure TOfficeMoreColorsWin.SetMaxHue(H: Integer);
var
hh: Double;
begin
inc(FLockChange);
hh := EHue.Value / FMaxHue;
FMaxHue := H;
EHue.MaxValue := H;
EHue.Value := round(hh * FMaxHue);
dec(FLockChange);
end;
procedure TOfficeMoreColorsWin.SetMaxLum(L: Integer);
var
ll: Double;
begin
inc(FLockChange);
ll := ELumVal.Value / FMaxLum;
FMaxLum := L;
ELumVal.MaxValue := L;
ELumVal.Value := round(ll * FMaxLum);
dec(FLockChange);
end;
procedure TOfficeMoreColorsWin.SetMaxSat(S: Integer);
var
ss: Double;
begin
inc(FLockChange);
ss := ESat.Value / FMaxSat;
FMaxSat := S;
ESat.MaxValue := S;
ESat.Value := round(ss * FMaxSat);
dec(FLockChange);
end;
procedure TOfficeMoreColorsWin.SetMaxVal(V: Integer);
var
vv: Double;
begin
inc(FLockChange);
vv := ELumVal.Value / FMaxVal;
FMaxVal := V;
ELumVal.MaxValue := V;
ELumVal.Value := round(vv * FMaxVal);
dec(FLockChange);
end;
procedure TOfficeMoreColorsWin.SetSelectedColor(c: TColor);
begin
FSelectedColor := c;
OldSwatch.Color := c;
SetAllToSel(FSelectedColor);
end;
procedure TOfficeMoreColorsWin.SetShowHint(AValue: Boolean);
@ -526,6 +697,9 @@ begin
HSL.ShowHint := AValue;
HSLRing.ShowHint := AValue;
SLH.ShowHint := AValue;
RTrackbar.ShowHint := AValue;
GTrackbar.ShowHint := AValue;
BTrackbar.ShowHint := AValue;
end;
procedure TOfficeMoreColorsWin.SLHChange(Sender: TObject);

10
components/mbColorLib/PalUtils.pas
View File

@ -50,13 +50,13 @@ function ReadJASCPal(PalFile: TFileName): string;
//saves a string list to a JASC .pal file
procedure SaveJASCPal(pal: TStrings; FileName: TFileName);
(*
//reads Photoshop .aco file into an Aco record
function ReadPhotoshopAco(PalFile: TFileName): AcoColors;
//reads Photoshop .act file
function ReadPhotoshopAct(PalFile: TFileName): string;
*)
implementation
@ -87,7 +87,7 @@ function FormatHint(fmt: string; c: TColor): string;
var
h: string;
begin
h := AnsiReplaceText(fmt, '%hex', ColorToHex(c));
h := AnsiReplaceText(fmt, '%hex', '#' + ColorToHex(c));
h := AnsiReplaceText(h, '%cieL', IntToStr(Round(GetCIElValue(c))));
h := AnsiReplaceText(h, '%cieA', IntToStr(Round(GetCIEaValue(c))));
h := AnsiReplaceText(h, '%cieB', IntToStr(Round(GetCIEbValue(c))));
@ -579,7 +579,7 @@ begin
s[i] := WideChar(w);
end;
end;
(*
function GetAcoColor(space,w,x,y,z: word): TColor;
begin
case space of
@ -711,5 +711,5 @@ begin
end;
CloseFile(f);
end;
*)
end.

2
components/mbColorLib/RAxisColorPicker.pas
View File

@ -157,7 +157,6 @@ end;
procedure TRAxisColorPicker.Resize;
begin
FManual := false;
mx := Round(FB * Width / 255);
my := Round((255 - FG) * Height / 255);
inherited;
@ -231,7 +230,6 @@ begin
FG := g;
FB := b;
FSelected := c;
FManual := false;
mx := Round(FB * Width / 255); // BLUE on x
my := Round((255 - FG) * Height / 255); // GREEN on y
if needNewGradient then

9
components/mbColorLib/RColorPicker.pas
View File

@ -6,7 +6,7 @@ interface
uses
LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Forms,
HTMLColors, Scanlines, mbTrackBarPicker;
HTMLColors, mbTrackBarPicker;
type
@ -16,25 +16,26 @@ type
private
FRed, FGreen, FBlue: integer;
function ArrowPosFromRed(r: integer): integer;
function GetSelectedColor: TColor;
function RedFromArrowPos(p: integer): integer;
procedure SetBlue(b: integer);
procedure SetGreen(g: integer);
procedure SetRed(r: integer);
procedure SetSelectedColor(c: TColor);
protected
procedure Execute(tbaAction: integer); override;
function GetArrowPos: integer; override;
function GetGradientColor(AValue: Integer): TColor; override;
function GetSelectedColor: TColor; override;
function GetSelectedValue: integer; override;
procedure SetSelectedColor(c: TColor); override;
public
constructor Create(AOwner: TComponent); override;
published
property Red: integer read FRed write SetRed default 255;
property Green: integer read FGreen write SetGreen default 128;
property Blue: integer read FBlue write SetBlue default 128;
property SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed;
property SelectedColor default clRed;
property Layout default lyVertical;
property HintFormat;
end;

25
components/mbColorLib/RGBCIEUtils.pas
View File

@ -243,7 +243,8 @@ end;
procedure RGBToLCH(clr: TColor; var l, c, h: double);
var
a, b: double;
a: Double = 0;
b: Double = 0;
begin
RGBToLab(clr, l, a, b);
LabToLCH(l, a, b, l, c, h);
@ -251,7 +252,9 @@ end;
function LCHToRGB(l, c, h: double): TColor;
var
lum, a, b: double;
lum: Double = 0;
a: Double = 0;
b: double = 0;
begin
LCHToLab(l, c, h, lum, a, b);
Result := LabToRGB(lum, a, b);
@ -283,36 +286,38 @@ end;
function GetCIELValue(c: TColor): double;
var
d: real;
d: Double = 0;
begin
XYZToLab(RGBToXYZ(c), Result, d, d);
XYZToLab(RGBToXYZ(c), Result{%H-}, d, d);
end;
function GetCIEAValue(c: TColor): double;
var
d: double;
d: double = 0;
begin
XYZToLab(RGBToXYZ(c), d, Result, d);
XYZToLab(RGBToXYZ(c), d, Result{%H-}, d);
end;
function GetCIEBValue(c: TColor): double;
var
d: double;
d: double = 0;
begin
XYZToLab(RGBToXYZ(c), d, d, Result);
XYZToLab(RGBToXYZ(c), d, d, Result{%H-});
end;
function GetCIECValue(c: TColor): double;
var
d: double;
d: double = 0;
begin
Result := 0.0;
RGBToLCH(c, d, Result, d);
end;
function GetCIEHValue(c: TColor): double;
var
d: double;
d: double = 0;
begin
Result := 0.0;
RGBToLCH(c, d, d, Result);
end;

16
components/mbColorLib/RGBHSLUtils.pas
View File

@ -14,13 +14,13 @@ var //set these variables to your needs, e.g. 360, 255, 255
MaxSat: integer = 240;
MaxLum: integer = 240;
function HSLtoRGB(H, S, L: double): TColor;
{function HSLtoRGB(H, S, L: double): TColor;}
function HSLRangeToRGB(H, S, L: integer): TColor;
procedure ColorToHSL(AColor: TColor; var H, S, L: Double);
{procedure ColorToHSL(AColor: TColor; var H, S, L: Double);}
function HSLtoColor(H, S, L: Double): TColor;
procedure RGBtoHSL(RGB: TColor; out H, S, L: Double);
{procedure RGBtoHSL(RGB: TColor; out H, S, L: Double); }
procedure RGBtoHSLRange(RGB: TColor; out H1, S1, L1: integer);
function GetHValue(AColor: TColor): integer;
@ -36,7 +36,7 @@ implementation
uses
mbUtils;
(*
procedure ColorToHSL(AColor: TColor; var H, S, L: Double);
function RGBMaxValue(r, g, b: Double): Double;
@ -81,7 +81,7 @@ begin
if H < 0 then H := H + 360;
H := H / 360;
end;
end;
end; *)
function HSLtoColor(H, S, L: Double): TColor;
const
@ -133,9 +133,6 @@ var
begin
if Hue > 10 then
Hue := Hue + 1;
if Hue < 0 then
Hue := Hue + 1
else if Hue > 1 then
@ -224,9 +221,6 @@ procedure RGBtoHSLRange(RGB: TColor; out H1, S1, L1: integer);
var
R, G, B, D, Cmax, Cmin, h, s, l: double;
begin
H := h1;
S := s1;
L := l1;
R := GetRValue(RGB) / 255;
G := GetGValue(RGB) / 255;
B := GetBValue(RGB) / 255;

10
components/mbColorLib/RGBHSVUtils.pas
View File

@ -11,11 +11,11 @@ uses
Scanlines;
{ The next four procedures assume H, S, V to be in the range 0..1 }
procedure ColorToHSV(c: TColor; out H, S, V: Double);
procedure RGBtoHSV(R, G, B: Integer; out H, S, V: Double);
//procedure ColorToHSV(c: TColor; out H, S, V: Double);
//procedure RGBtoHSV(R, G, B: Integer; out H, S, V: Double);
function HSVtoColor(H, S, V: Double): TColor;
procedure HSVtoRGB(H, S, V: Double; out R, G, B: Integer);
//function HSVtoColor(H, S, V: Double): TColor;
//procedure HSVtoRGB(H, S, V: Double; out R, G, B: Integer);
{ These next procedure assume H to be in the range 0..360
and S, V in the range 0..255 }
@ -117,8 +117,6 @@ procedure RGBToHSVRange(R, G, B: integer; out H, S, V: integer);
var
Delta, Min, H1, S1: double;
begin
h1 := h;
s1 := s;
Min := MinIntValue([R, G, B]);
V := MaxIntValue([R, G, B]);
Delta := V - Min;

208
components/mbColorLib/SColorPicker.pas
View File

@ -7,43 +7,31 @@ unit SColorPicker;
interface
uses
LCLIntf, LCLType, LMessages,
SysUtils, Classes, Controls, Graphics, Forms,
RGBHSVUtils, mbTrackBarPicker, HTMLColors, Scanlines;
LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Forms,
mbColorConv, mbTrackBarPicker, HTMLColors;
type
TSColorPicker = class(TmbTrackBarPicker)
TSColorPicker = class(TmbHSLVTrackBarPicker)
private
FVal, FHue, FSat: Double;
FMaxVal, FMaxHue, FMaxSat: Integer;
function ArrowPosFromSat(s: integer): integer;
function GetHue: Integer;
function GetSat: Integer;
function GetSelectedColor: TColor;
function GetVal: Integer;
function SatFromArrowPos(p: integer): integer;
procedure SetHue(h: integer);
procedure SetMaxHue(h: Integer);
procedure SetMaxSat(s: Integer);
procedure SetMaxVal(v: Integer);
procedure SetSat(s: integer);
procedure SetValue(v: integer);
procedure SetSelectedColor(c: TColor);
function ArrowPosFromSat(s: Double): integer;
function SatFromArrowPos(p: integer): Double;
protected
procedure Execute(tbaAction: integer); override;
function GetArrowPos: integer; override;
function GetGradientColor(AValue: Integer): TColor; override;
function GetSelectedValue: integer; override;
procedure SetMaxSat(S: Integer); override;
procedure SetRelSat(S: 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 SetValue;
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;
@ -57,29 +45,27 @@ uses
constructor TSColorPicker.Create(AOwner: TComponent);
begin
inherited;
FMaxHue := 359;
FMaxSat := 255;
FMaxVal := 255;
FGradientWidth := FMaxSat + 1;
FGradientHeight := 1;
FHue := 0;
FLum := 0.5;
FVal := 1.0;
SetSat(FMaxSat);
Saturation := 255;
HintFormat := 'Saturation: %value (selected)';
end;
function TSColorPicker.ArrowPosFromSat(s: integer): integer;
function TSColorPicker.ArrowPosFromSat(s: Double): integer;
var
a: integer;
begin
if Layout = lyHorizontal then
begin
a := Round(s / FMaxSat * (Width - 12));
a := Round(s * (Width - 12));
if a > Width - FLimit then a := Width - FLimit;
end
else
begin
a := Round((FMaxSat - s) / FMaxSat * (Height - 12));
a := Round((1.0 - s) * (Height - 12));
if a > Height - FLimit then a := Height - FLimit;
end;
if a < 0 then a := 0;
@ -87,36 +73,39 @@ begin
end;
procedure TSColorPicker.Execute(tbaAction: integer);
var
dSat: Double;
begin
if FMaxSat = 0 then dSat := 0 else dSat := Increment / FMaxSat;
case tbaAction of
TBA_Resize:
SetSat(GetSat());
SetRelSat(FSat);
TBA_MouseMove:
SetSat(SatFromArrowPos(FArrowPos));
SetRelSat(SatFromArrowPos(FArrowPos));
TBA_MouseDown:
SetSat(SatFromArrowPos(FArrowPos));
SetRelSat(SatFromArrowPos(FArrowPos));
TBA_MouseUp:
SetSat(SatFromArrowPos(FArrowPos));
SetRelSat(SatFromArrowPos(FArrowPos));
TBA_WheelUp:
SetSat(GetSat() + Increment);
SetRelSat(FSat + dSat);
TBA_WheelDown:
SetSat(GetSat() - Increment);
SetRelSat(FSat - dSat);
TBA_VKLeft:
SetSat(GetSat() - Increment);
SetRelSat(FSat - dSat);
TBA_VKCtrlLeft:
SetSat(0);
SetRelSat(0.0);
TBA_VKRight:
SetSat(GetSat() + Increment);
SetRelSat(FSat + dSat);
TBA_VKCtrlRight:
SetSat(FMaxSat);
SetRelSat(1.0);
TBA_VKUp:
SetSat(GetSat() + Increment);
SetRelSat(FSat + dSat);
TBA_VKCtrlUp:
SetSat(FMaxSat);
SetRelSat(1.0);
TBA_VKDown:
SetSat(GetSat() - Increment);
SetRelSat(FSat - dSat);
TBA_VKCtrlDown:
SetSat(0);
SetRelSat(0.0);
else
inherited;
end;
@ -127,103 +116,49 @@ begin
if FMaxSat = 0 then
Result := inherited GetArrowPos
else
Result := ArrowPosFromSat(GetSat());
Result := ArrowPosFromSat(FSat);
end;
function TSColorPicker.GetGradientColor(AValue: Integer): TColor;
begin
Result := HSVtoColor(FHue, AValue/FMaxSat, FVal);
end;
function TSColorPicker.GetHue: Integer;
begin
Result := round(FHue * FMaxHue);
end;
function TSColorPicker.GetSat: Integer;
begin
Result := round(FSat * FMaxSat);
end;
function TSColorPicker.GetSelectedColor: TColor;
begin
Result := HSVToColor(FHue, FSat, FVal);
if WebSafe then
Result := GetWebSafe(Result);
Result := HSLVtoColor(FHue, AValue/FMaxSat, FLum, FVal);
end;
function TSColorPicker.GetSelectedValue: integer;
begin
Result := GetSat();
Result := Saturation;
end;
function TSColorPicker.GetVal: Integer;
begin
Result := round(FVal * FMaxVal);
end;
function TSColorPicker.SatFromArrowPos(p: integer): integer;
function TSColorPicker.SatFromArrowPos(p: integer): Double;
var
s: integer;
s: Double;
begin
case Layout of
lyHorizontal: s := Round(p / (Width - 12) * FMaxSat);
lyVertical : s := Round(FMaxSat - p / (Height - 12) * FMaxSat);
lyHorizontal: s := p / (Width - 12);
lyVertical : s := 1.0 - p / (Height - 12);
end;
Clamp(s, 0, FMaxSat);
Clamp(s, 0, 1.0);
Result := s;
end;
procedure TSColorPicker.SetMaxHue(h: Integer);
procedure TSColorPicker.SetMaxSat(S: Integer);
begin
if h = FMaxHue then
if S = FMaxSat then
exit;
FMaxHue := h;
CreateGradient;
//if FChange and Assigned(OnChange) then OnChange(Self);
Invalidate;
end;
procedure TSColorPicker.SetMaxSat(s: Integer);
begin
if s = FMaxSat then
exit;
FMaxSat := s;
FMaxSat := S;
FGradientWidth := FMaxSat + 1;
CreateGradient;
//if FChange and Assigned(OnChange) then OnChange(Self);
Invalidate;
DoChange;
end;
procedure TSColorPicker.SetMaxVal(v: Integer);
procedure TSColorPicker.SetRelSat(S: Double);
begin
if v = FMaxVal then
exit;
FMaxVal := v;
CreateGradient;
//if FChange and Assigned(OnChange) then OnChange(Self);
Invalidate;
end;
procedure TSColorPicker.SetHue(h: integer);
begin
Clamp(h, 0, FMaxHue);
if GetHue() <> h then
Clamp(S, 0, 1.0);
if FSat <> S then
begin
FHue := h / FMaxHue;
CreateGradient;
Invalidate;
DoChange;
end;
end;
procedure TSColorPicker.SetSat(s: integer);
begin
Clamp(s, 0, FMaxSat);
if GetSat() <> s then
begin
FSat := s / FMaxSat;
FArrowPos := ArrowPosFromSat(s);
FSat := S;
FArrowPos := ArrowPosFromSat(S);
Invalidate;
DoChange;
end;
@ -231,7 +166,10 @@ end;
procedure TSColorPicker.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
@ -239,27 +177,25 @@ begin
if c = GetSelectedColor then
exit;
RGBToHSVRange(GetRValue(c), GetGValue(c), GetBValue(c), h, s, v);
needNewGradient := (h <> FHue) or (v <> FVal);
FHue := h;
FSat := s;
FVal := v;
ColorToHSLV(c, H,S,L,V);
case BrightnessMode of
bmLuminance:
begin
needNewGradient := (H <> FHue) or (L <> FLum);
FLum := L;
end;
bmValue:
begin
needNewGradient := (H <> FHue) or (V <> FVal);
FVal := V;
end;
end;
FHue := H;
FSat := S;
if needNewGradient then
CreateGradient;
Invalidate;
DoChange;
end;
procedure TSColorPicker.SetValue(v: integer);
begin
Clamp(v, 0, FMaxVal);
if GetVal() <> v then
begin
FVal := v / FMaxVal;
CreateGradient;
Invalidate;
DoChange;
end;
end;
end.

343
components/mbColorLib/SLColorPicker.pas
View File

@ -5,74 +5,74 @@ unit SLColorPicker;
interface
uses
LCLIntf, LCLType, LMessages,
SysUtils, Classes, Controls, Graphics, Forms,
mbColorPickerControl;
LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Forms,
mbColorConv, mbColorPickerControl;
type
TSLColorPicker = class(TmbColorPickerControl)
TSLColorPicker = class(TmbHSLVColorPickerControl)
private
FHue, FSat, FLum: Double;
FMaxHue, FMaxSat, FMaxLum: integer;
procedure DrawMarker(x, y: 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);
procedure UpdateCoords;
FHint: array[TBrightnessMode] of string;
function GetHint(AMode: TBrightnessMode): String;
procedure SetHint(AMode: TBrightnessMode; AText: String);
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;
procedure Resize; override;
procedure Paint; override;
procedure SelectColor(x, y: integer);
procedure SelectColor(x, y: integer); override;
procedure SetBrightnessMode(AMode: TBrightnessMode); override;
procedure SetMaxLum(L: Integer); override;
procedure SetMaxSat(S: Integer); override;
procedure SetMaxVal(V: Integer); override;
procedure SetRelLum(L: Double); override;
procedure SetRelSat(S: Double); override;
procedure SetRelVal(V: Double); override;
procedure SetSelectedColor(c: TColor); override;
procedure UpdateCoords;
public
constructor Create(AOwner: TComponent); override;
function GetColorAtPoint(x, y: integer): TColor; override;
property ColorUnderCursor;
published
property Hue: integer read GetHue write SetHue default 0;
property Saturation: integer read GetSat write SetSat default 0;
property Luminance: integer read GetLum write SetLum default 240;
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 0;
property Luminance default 255;
property Value default 255;
property MaxHue default 360;
property MaxSaturation default 255;
property MaxLuminance default 255;
property MaxValue default 255;
property SelectedColor default clWhite;
property MarkerStyle default msCircle;
property SLHintFormat: String index bmLuminance read GetHint write SetHint;
property SVHintFormat: String index bmValue read GetHint write SetHint;
property OnChange;
end;
implementation
uses
Math,
ScanLines, RGBHSLUtils, HTMLColors, mbUtils;
HTMLColors, mbUtils;
{ TSLColorPicker }
constructor TSLColorPicker.Create(AOwner: TComponent);
begin
inherited;
FMaxHue := 359;
FMaxSat := 240;
FMaxLum := 240;
FGradientWidth := FMaxSat + 1; // x --> Saturation
FGradientHeight := FMaxLum + 1; // y --> Luminance
FGradientWidth := FMaxSat + 1; // x --> Saturation
case BrightnessMode of
bmLuminance : FGradientHeight := FMaxLum + 1; // y --> Luminance
bmValue : FGradientHeight := FMaxVal + 1; // y --> value
end;
SetInitialBounds(0, 0, FGradientWidth, FGradientHeight);
FSelected := clWhite;
RGBToHSL(FSelected, FHue, FSat, FLum);
HintFormat := 'S: %hslS L: %l'#13'Hex: %hex';
FHue := 0;
FSat := 1.0;
FLum := 1.0;
FVal := 1.0;
SLHintFormat := 'S: %hslS L: %l' + LineEnding + 'Hex: %hex';
SVHintFormat := 'S: %hslS V: %v' + LineEnding + 'Hex: %hex';
MarkerStyle := msCircle;
end;
@ -99,135 +99,28 @@ end;
function TSLColorPicker.GetColorAtPoint(x, y: integer): TColor;
var
S, L: Double;
S, LV: Double;
begin
S := x / (Width - 1);
L := 1.0 - y / (Height - 1);
Result := HSLToRGB(FHue, S, L);
// Result := HSLToRGB(FHue, x/(Width - 1), (Height - 1 - y) / (Height - 1));
if WebSafe then
Result := GetWebSafe(Result);
LV := 1.0 - y / (Height - 1);
Result := HSLVtoColor(FHue, S, LV, LV);
end;
{ This picker has Saturation along the X and Luminance along the Y axis.
NOTE: The HSL conversion (HSLtoColor) seems to be wrong
but it produces the display seen elsewhere }
{ This picker has Saturation along the X and Luminance or Value on the Y axis. }
function TSLColorPicker.GetGradientColor2D(X, Y: Integer): TColor;
begin
// Result := HSLtoColor(FHue, x / FMaxSat, (FMaxLum - y) / FMaxLum); // wrong formula
Result := HSLtoRGB(FHue, x / FMaxSat, (FMaxLum - y) / FMaxLum); // correct, but looks wrong...
Result := HSLVtoColor(FHue, x/FMaxSat, 1.0 - y/FMaxLum, 1.0 - y/FMaxVal);
end;
function TSLColorPicker.GetHue: Integer;
function TSLColorPicker.GetHint(AMode: TBrightnessMode): String;
begin
Result := round(FHue * FMaxHue);
end;
function TSLColorPicker.GetLum: Integer;
begin
Result := round(FLum * FMaxLum);
end;
function TSLColorPicker.GetSat: Integer;
begin
Result := round(FSat * FMaxSat);
end;
procedure TSLColorPicker.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:
if (mdx - delta >= 0) then
begin
Dec(mdx, delta);
SelectionChanged(mdx, mdy);
FManual := true;
DoChange;
end;
VK_RIGHT:
if (mdx + delta < Width) then
begin
Inc(mdx, delta);
SelectionChanged(mdx, mdy);
FManual := true;
DoChange;
end;
VK_UP:
if (mdy - delta >= 0) then
begin
Dec(mdy, delta);
SelectionChanged(mdx, mdy);
FManual := true;
DoChange;
end;
VK_DOWN:
if (mdy + delta < Height) then
begin
Inc(mdy, delta);
SelectionChanged(mdx, mdy);
FManual := true;
DoChange;
end;
else
eraseKey := false;
end;
}
if eraseKey then
Key := 0;
inherited;
end;
procedure TSLColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited;
if csDesigning in ComponentState then
Exit;
if (Button = mbLeft) then
SelectColor(X, Y);
SetFocus;
end;
procedure TSLColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
inherited;
if csDesigning in ComponentState then
Exit;
if (ssLeft in Shift) then
SelectColor(X, Y);
end;
procedure TSLColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited;
if csDesigning in ComponentState then
Exit;
if (Button = mbLeft)then
SelectColor(X, Y);
Result := FHint[AMode];
end;
procedure TSLColorPicker.Paint;
begin
Canvas.StretchDraw(ClientRect, FBufferBMP);
UpdateCoords;
// UpdateCoords;
DrawMarker(mx, my);
end;
@ -239,88 +132,94 @@ end;
procedure TSLColorPicker.SelectColor(x, y: integer);
var
S, L: Double;
S, LV: Double;
begin
CorrectCoords(x, y);
S := x / (Width - 1);
L := 1 - y / (Height - 1);
if (S = FSat) and (L = FLum) then
exit;
LV := 1 - y / (Height - 1);
case BrightnessMode of
bmLuminance:
begin
if (S = FSat) and (LV = FLum) then
exit;
FLum := LV;
end;
bmValue:
begin
if (S = FSat) and (LV = FVal) then
exit;
FVal := LV;
end;
end;
FSat := S;
FLum := L;
FSelected := HSLtoRGB(FHue, FSat, FLum);
FSelected := HSLVtoColor(FHue, FSat, FLum, FVal);
Invalidate;
UpdateCoords;
DoChange;
end;
procedure TSLColorPicker.SetHue(H: integer);
procedure TSLColorPicker.SetBrightnessMode(AMode: TBrightnessMode);
begin
Clamp(H, 0, FMaxHue);
if GetHue() <> H then
begin
FHue := h / FMaxHue;
FSelected := HSLtoRGB(FHue, FSat, FLum);
CreateGradient;
UpdateCoords;
Invalidate;
DoChange;
end;
inherited;
HintFormat := FHint[AMode];
end;
procedure TSLColorPicker.SetLum(L: integer);
procedure TSLColorPicker.SetHint(AMode: TBrightnessMode; AText: String);
begin
Clamp(L, 0, FMaxLum);
if GetLum() <> L then
begin
FLum := L / FMaxLum;
FSelected := HSLtoRGB(FHue, FSat, FLum);
UpdateCoords;
Invalidate;
DoChange;
end;
end;
procedure TSLColorPicker.SetMaxHue(H: Integer);
begin
if H = FMaxHue then
exit;
FMaxHue := H;
CreateGradient;
//if FChange and Assigned(OnChange) then OnChange(Self);
Invalidate;
FHint[AMode] := AText;
end;
procedure TSLColorPicker.SetMaxLum(L: Integer);
begin
if L = FMaxLum then
exit;
FMaxLum := L;
FGradientHeight := FMaxLum + 1;
CreateGradient;
//if FChange and Assigned(OnChange) then OnChange(Self);
Invalidate;
if BrightnessMode = bmLuminance then
FGradientHeight := L + 1;
inherited;
end;
procedure TSLColorPicker.SetMaxSat(S: Integer);
begin
if S = FMaxSat then
exit;
FMaxSat := S;
FGradientWidth := FMaxSat + 1;
CreateGradient;
//if FChange and Assigned(OnChange) then OnChange(Self);
Invalidate;
FGradientWidth := S + 1; // inherited will re-create the gradient
inherited;
end;
procedure TSLColorPicker.SetSat(S: integer);
procedure TSLColorPicker.SetMaxVal(V: Integer);
begin
Clamp(S, 0, FMaxSat);
if GetSat() <> S then
if V = FMaxVal then
exit;
if BrightnessMode = bmValue then
FGradientHeight := V + 1;
inherited;
end;
procedure TSLColorPicker.SetRelLum(L: Double);
begin
Clamp(L, 0.0, 1.0);
if FLum <> L then
begin
FSat := S / FMaxSat;
FSelected := HSLtoRGB(FHue, FSat, FLum);
FLum := L;
if BrightnessMode = bmLuminance then
begin
FSelected := HSLtoColor(FHue, FSat, FLum);
UpdateCoords;
Invalidate;
end;
DoChange;
end;
end;
procedure TSLColorPicker.SetRelSat(S: Double);
begin
Clamp(S, 0.0, 1.0);
if FSat <> S then
begin
FSat := S;
FSelected := HSLVtoColor(FHue, FSat, FLum, FVal);
UpdateCoords;
Invalidate;
DoChange;
@ -329,7 +228,10 @@ end;
procedure TSLColorPicker.SetSelectedColor(c: TColor);
var
H, S, L: Double;
H: Double = 0;
S: Double = 0;
L: Double = 0;
V: Double = 0;
needNewGradient: Boolean;
begin
if WebSafe then
@ -337,12 +239,14 @@ begin
if c = GetSelectedColor then
exit;
RGBToHSL(c, H, S, L);
// ColorToHSL(c, H, S, L);
ColorToHSLV(c, H, S, L, V);
needNewGradient := (FHue <> H);
FHue := H;
FSat := S;
FLum := L;
case BrightnessMode of
bmLuminance : FLum := L;
bmValue : FVal := V;
end;
FSelected := c;
UpdateCoords;
if needNewGradient then
@ -351,10 +255,29 @@ begin
DoChange;
end;
procedure TSLColorPicker.SetRelVal(V: Double);
begin
Clamp(V, 0.0, 1.0);
if FVal <> V then
begin
FVal := V;
if BrightnessMode = bmValue then
begin
FSelected := HSVtoColor(FHue, FSat, FVal);
UpdateCoords;
Invalidate;
end;
DoChange;
end;
end;
procedure TSLColorPicker.UpdateCoords;
begin
mx := round(FSat * (Width - 1));
my := round((1.0 - FLum) * (Height - 1));
case BrightnessMode of
bmLuminance : my := round((1.0 - FLum) * (Height - 1));
bmValue : my := round((1.0 - FVal) * (Height - 1));
end;
end;

276
components/mbColorLib/SLHColorPicker.pas
View File

@ -7,7 +7,7 @@ interface
uses
LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Forms, Menus, Themes,
RGBHSLUtils, mbTrackBarPicker, HTMLColors, SLColorPicker, HColorPicker,
mbBasicPicker;
mbColorConv, mbBasicPicker;
type
TSLHColorPicker = class(TmbBasicPicker)
@ -15,25 +15,36 @@ type
FSLPicker: TSLColorPicker;
FHPicker: THColorPicker;
FSelectedColor: TColor;
FHValue, FSValue, FLValue: Double;
FMaxH, FMaxS, FMaxL: Integer;
FRValue, FGValue, FBValue: integer;
// FHValue, FSValue, FLValue: Double;
// FRed, FGreen, FBlue: integer;
FSLHint, FHHint: string;
FSLMenu, FHMenu: TPopupMenu;
FSLCursor, FHCursor: TCursor;
PBack: TBitmap;
function GetH: Integer;
function GetS: Integer;
function GetL: Integer;
procedure SetH(H: integer);
procedure SetS(S: integer);
procedure SetL(L: integer);
procedure SetR(R: integer);
procedure SetG(G: integer);
procedure SetB(B: integer);
procedure SetMaxH(H: Integer);
procedure SetMaxS(S: Integer);
procedure SetMaxL(L: Integer);
function GetBrightnessMode: TBrightnessMode;
function GetHue: Integer;
function GetSat: Integer;
function GetLum: Integer;
function GetVal: Integer;
function GetMaxHue: Integer;
function GetMaxLum: Integer;
function GetMaxSat: Integer;
function GetMaxVal: Integer;
function GetRed: Integer;
function GetGreen: Integer;
function GetBlue: Integer;
procedure SetBlue(B: integer);
procedure SetBrightnessMode(bm: TBrightnessMode);
procedure SetGreen(G: integer);
procedure SetHue(H: integer);
procedure SetLum(L: integer);
procedure SetRed(R: integer);
procedure SetSat(S: integer);
procedure SetVal(V: Integer);
procedure SetMaxHue(H: Integer);
procedure SetMaxSat(S: Integer);
procedure SetMaxLum(L: Integer);
procedure SetMaxVal(V: Integer);
procedure SetHHint(h: string);
procedure SetSLHint(h: string);
procedure SetSLMenu(m: TPopupMenu);
@ -46,10 +57,11 @@ type
procedure DoChange; override;
procedure DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
function GetColorUnderCursor: TColor; override;
function GetSelectedColor: TColor; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure Paint; override;
procedure Resize; override;
procedure SelectColor(c: TColor);
procedure SetSelectedColor(c: TColor); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
@ -59,23 +71,26 @@ type
function GetSelectedHexColor: string;
procedure SetFocus; override;
property ColorUnderCursor;
property Red: integer read FRValue write SetR default 255;
property Green: integer read FGValue write SetG default 0;
property Blue: integer read FBValue write SetB default 0;
property Red: integer read GetRed write SetRed default 255;
property Green: integer read GetGreen write SetGreen default 0;
property Blue: integer read GetBlue write SetBlue default 0;
published
property Hue: integer read GetH write SetH default 0;
property Saturation: integer read GetS write SetS default 240;
property Luminance: integer read GetL write SetL default 120;
property SelectedColor: TColor read FSelectedColor write SelectColor default clRed;
property BrightnessMode: TBrightnessMode read GetBrightnessMode
write SetBrightnessMode default bmValue;
property SelectedColor default clRed;
property Hue: integer read GetHue write SetHue default 0;
property Saturation: integer read GetSat write SetSat default 255;
property Value: Integer read GetVal write SetVal default 255;
property Luminance: integer read GetLum write SetLum default 127;
property HPickerPopupMenu: TPopupMenu read FHMenu write SetHMenu;
property SLPickerPopupMenu: TPopupMenu read FSLMenu write SetSLMenu;
property HPickerHintFormat: string read FHHint write SetHHint;
property SLPickerHintFormat: string read FSLHint write SetSLHint;
property HPickerCursor: TCursor read FHCursor write SetHCursor default crDefault;
property SLPickerCursor: TCursor read FSLCursor write SetSLCursor default crDefault;
property MaxHue: Integer read FMaxH write SetMaxH default 359;
property MaxSaturation: Integer read FMaxS write SetMaxS default 240;
property MaxLuminance: Integer read FMaxL write SetMaxL default 240;
property MaxHue: Integer read GetMaxHue write SetMaxHue default 360;
property MaxSaturation: Integer read GetMaxSat write SetMaxSat default 240;
property MaxLuminance: Integer read GetMaxLum write SetMaxLum default 240;
property TabStop default true;
property ShowHint;
property ParentShowHint;
@ -107,19 +122,15 @@ begin
inherited;
//ControlStyle := ControlStyle - [csAcceptsControls] + [csOpaque];
FMaxH := 359;
FMaxS := 240;
FMaxL := 240;
PBack := TBitmap.Create;
// PBack.PixelFormat := pf32bit;
ParentColor := true;
SetInitialBounds(0, 0, WSL + DIST + WH, HSL + 2*VDELTA);
TabStop := true;
FSelectedColor := clRed;
FHPicker := THColorPicker.Create(Self);
InsertControl(FHPicker);
FHCursor := crDefault;
FSLCursor := crDefault;
FHHint := 'Hue: %h';
FSLHint := 'S: %hslS L: %l'#13'Hex: %hex';
// Saturation-Lightness picker
FSLPicker := TSLColorPicker.Create(Self);
@ -127,28 +138,21 @@ begin
with FSLPicker do
begin
SetInitialBounds(0, VDELTA, WSL, HSL);
Visible := true;
SelectedColor := clRed;
MaxHue := FMaxH;
MaxSaturation := FMaxS;
MaxLuminance := FMaxL;
//Saturation := FMaxS;
//Luminance := FMaxL;
Cursor := FSLCursor;
BrightnessMode := bmValue;
OnChange := SLPickerChange;
OnMouseMove := DoMouseMove;
end;
// Hue picker
FHPicker := THColorPicker.Create(Self);
InsertControl(FHPicker);
with FHPicker do
begin
Cursor := FHCursor;
Layout := lyVertical; // put before setting width and height
SetInitialBounds(WSL + DIST, 0, WH, HSL + 2*VDELTA);
MaxHue := self.FMaxH;
MaxSaturation := 255;
MaxValue := 255;
//Saturation := MaxSaturation;
Value := MaxValue;
Visible := true;
BrightnessMode := bmValue;
ArrowPlacement := spBoth;
NewArrowStyle := true;
OnChange := HPickerChange;
@ -156,14 +160,7 @@ begin
end;
// red
FHValue := 0;
FSValue := 1.0;
FLValue := 0.5;
FRValue := 255;
FGValue := 0;
FBValue := 0;
FHHint := 'Hue: %h';
FSLHint := 'S: %hslS L: %l'#13'Hex: %hex';
SelectedColor := clRed;
end;
destructor TSLHColorPicker.Destroy;
@ -175,12 +172,6 @@ end;
procedure TSLHColorPicker.DoChange;
begin
FSelectedColor := FSLPicker.SelectedColor;
FHValue := FHPicker.Hue / FHPicker.MaxHue;
FSValue := FSLPicker.Saturation / FSLPicker.MaxSaturation;
FLValue := FSLPicker.Luminance / FSLPicker.MaxLuminance;
FRValue := GetRValue(FSelectedColor);
FGValue := GetGValue(FSelectedColor);
FBValue := GetBValue(FSelectedColor);
inherited;
end;
@ -190,14 +181,29 @@ begin
OnMouseMove(Self, Shift, x, y);
end;
function TSLHColorPicker.GetBrightnessMode: TBrightnessMode;
begin
Result := FSLPicker.BrightnessMode;
end;
function TSLHColorPicker.GetColorUnderCursor: TColor;
begin
Result := FSLPicker.ColorUnderCursor;
end;
function TSLHColorPicker.GetH: Integer;
function TSLHColorPicker.GetBlue: Integer;
begin
Result := Round(FHValue * FMaxH);
Result := GetBValue(FSelectedColor);
end;
function TSLHColorPicker.GetGreen: Integer;
begin
Result := GetGValue(FSelectedColor);
end;
function TSLHColorPicker.GetHue: Integer;
begin
Result := FHPicker.Hue;
end;
function TSLHColorPicker.GetHexColorUnderCursor: string;
@ -205,14 +211,44 @@ begin
Result := FSLPicker.GetHexColorUnderCursor;
end;
function TSLHColorPicker.GetL: Integer;
function TSLHColorPicker.GetLum: Integer;
begin
Result := ROund(FLValue * FMaxL);
Result := FSLPicker.Luminance;
end;
function TSLHColorPicker.GetS: Integer;
function TSLHColorPicker.GetMaxHue: Integer;
begin
Result := Round(FSValue * FMaxS);
Result := FSLPicker.MaxHue;
end;
function TSLHColorPicker.GetMaxLum: Integer;
begin
Result := FSLPicker.MaxLuminance;
end;
function TSLHColorPicker.GetMaxSat: Integer;
begin
Result := FSLPicker.MaxSaturation;
end;
function TSLHColorPicker.GetMaxVal: Integer;
begin
Result := FSLPicker.MaxValue;
end;
function TSLHColorPicker.GetRed: Integer;
begin
Result := GetRValue(FSelectedColor);
end;
function TSLHColorPicker.GetSat: Integer;
begin
Result := FSLPicker.Saturation;
end;
function TSLHColorPicker.GetSelectedColor: TColor;
begin
Result := FSelectedColor;
end;
function TSLHColorPicker.GetSelectedHexColor: string;
@ -220,6 +256,11 @@ begin
Result := ColorToHex(FSelectedColor);
end;
function TSLHColorPicker.GetVal: Integer;
begin
REsult := FSLPicker.Value;
end;
procedure TSLHColorPicker.HPickerChange(Sender: TObject);
begin
if FSLPicker.Hue = FHPicker.Hue then
@ -243,7 +284,6 @@ end;
procedure TSLHColorPicker.Resize;
begin
inherited;
// PaintParentBack;
if (FSLPicker = nil) or (FHPicker = nil) then
exit;
@ -255,36 +295,32 @@ begin
FHPicker.Height := Height;
end;
procedure TSLHColorPicker.SelectColor(c: TColor);
begin
FSelectedColor := c;
FHPicker.Hue := GetHValue(c);
FSLPicker.SelectedColor := c;
end;
procedure TSLHColorPicker.SetB(B: integer);
begin
FBValue := B;
SelectColor(RGB(FRValue, FGValue, FBValue));
end;
procedure TSLHColorPicker.SetFocus;
begin
inherited;
FSLPicker.SetFocus;
end;
procedure TSLHColorPicker.SetH(H: integer);
procedure TSLHColorPicker.SetBlue(B: integer);
begin
FHValue := H / FMaxH;
FSLPicker.Hue := H;
FHPicker.Hue := H;
SetSelectedColor(RgbToColor(Red, Green, B));
end;
procedure TSLHColorPicker.SetG(G: integer);
procedure TSLHColorPicker.SetBrightnessMode(bm: TBrightnessMode);
begin
FGValue := G;
SelectColor(RGB(FRValue, FGValue, FBValue));
FSLPicker.BrightnessMode := bm;
FHPicker.BrightnessMode := bm;
end;
procedure TSLHColorPicker.SetGreen(G: integer);
begin
SetSelectedColor(RgbToColor(Red, G, Blue));
end;
procedure TSLHColorPicker.SetHCursor(c: TCursor);
begin
FHCursor := c;
FHPicker.Cursor := c;
end;
procedure TSLHColorPicker.SetHHint(h: string);
@ -299,70 +335,84 @@ begin
FHPicker.PopupMenu := m;
end;
procedure TSLHColorPicker.SetL(L: integer);
procedure TSLHColorPicker.SetHue(H: integer);
begin
FHPicker.Hue := H;
FSLPicker.Hue := H;
end;
procedure TSLHColorPicker.SetLum(L: integer);
begin
FLValue := L / FMaxL;
FSLPicker.Luminance := L;
end;
procedure TSLHColorPicker.SetMaxH(H: Integer);
procedure TSLHColorPicker.SetMaxHue(H: Integer);
begin
FMaxH := H;
FSLPicker.MaxHue := H;
FHPicker.MaxHue := H;
end;
procedure TSLHColorPicker.SetMaxL(L: Integer);
procedure TSLHColorPicker.SetMaxLum(L: Integer);
begin
FMaxL := L;
FSLPicker.MaxLuminance := L;
FHPicker.MaxLuminance := L;
end;
procedure TSLHColorPicker.SetMaxS(S: Integer);
procedure TSLHColorPicker.SetMaxSat(S: Integer);
begin
FMaxS := S;
FSLPicker.MaxSaturation := S;
FHPicker.MaxSaturation := S;
end;
procedure TSLHColorPicker.SetR(R: integer);
procedure TSLHColorPicker.SetMaxVal(V: Integer);
begin
FRValue := R;
SelectColor(RGB(FRValue, FGValue, FBValue));
FSLPicker.MaxValue := V;
FHPicker.MaxValue := V;
end;
procedure TSLHColorPicker.SetS(S: integer);
procedure TSLHColorPicker.SetRed(R: integer);
begin
SetSelectedColor(RgbToColor(R, Green, Blue));
end;
procedure TSLHColorPicker.SetSat(S: integer);
begin
FSValue := S / FMaxS;
FSLPicker.Saturation := S;
end;
procedure TSLHColorPicker.SetSelectedColor(c: TColor);
begin
FSelectedColor := c;
FHPicker.Hue := GetHValue(c);
FSLPicker.SelectedColor := c;
end;
procedure TSLHColorPicker.SetSLHint(h: string);
begin
FSLHint := h;
FSLPicker.HintFormat := h;
end;
procedure TSLHColorPicker.SetSLMenu(m: TPopupMenu);
begin
FSLMenu := m;
FSLPicker.PopupMenu := m;
end;
procedure TSLHColorPicker.SetHCursor(c: TCursor);
begin
FHCursor := c;
FHPicker.Cursor := c;
end;
procedure TSLHColorPicker.SetSLCursor(c: TCursor);
begin
FSLCursor := c;
FSLPicker.Cursor := c;
end;
procedure TSLHColorPicker.SetSLMenu(m: TPopupMenu);
begin
FSLMenu := m;
FSLPicker.PopupMenu := m;
end;
procedure TSLHColorPicker.SetVal(V: Integer);
begin
FSLPicker.Value := V;
end;
procedure TSLHColorPicker.SLPickerChange(Sender: TObject);
begin
if FSLPicker.SelectedColor = FSelectedColor then
if FSelectedColor = FSLPicker.SelectedColor then
exit;
FSelectedColor := FSLPicker.SelectedColor;
DoChange;

6
components/mbColorLib/ScreenWin.pas
View File

@ -21,9 +21,9 @@ type
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure FormMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
{%H-}Shift: TShiftState; X, Y: Integer);
procedure FormMouseUp(Sender: TObject; {%H-}Button: TMouseButton;
{%H-}Shift: TShiftState; X, Y: Integer);
procedure FormShow(Sender: TObject);
private

22
components/mbColorLib/VColorPicker.pas
View File

@ -7,13 +7,8 @@ interface
{$ENDIF}
uses
{$IFDEF FPC}
LCLIntf, LCLType, LMessages,
{$ELSE}
Windows, Messages,
{$ENDIF}
SysUtils, Classes, Controls, Forms, Graphics,
RGBHSVUtils, mbTrackBarPicker, HTMLColors, Scanlines;
LCLIntf, LCLType, SysUtils, Classes, Controls, Forms, Graphics,
{RGBHSVUtils,} mbTrackBarPicker, HTMLColors;
type
TVColorPicker = class(TmbTrackBarPicker)
@ -24,9 +19,7 @@ type
function ValFromArrowPos(p: integer): integer;
function GetHue: Integer;
function GetSat: Integer;
function GetSelectedColor: TColor;
function GetValue: Integer;
procedure SetSelectedColor(c: TColor);
procedure SetHue(h: integer);
procedure SetMaxHue(h: Integer);
procedure SetMaxSat(s: Integer);
@ -37,7 +30,9 @@ type
procedure Execute(tbaAction: integer); override;
function GetArrowPos: integer; override;
function GetGradientColor(AValue: Integer): TColor; override;
function GetSelectedColor: TColor; override;
function GetSelectedValue: integer; override;
procedure SetSelectedColor(c: TColor); override;
public
constructor Create(AOwner: TComponent); override;
published
@ -47,13 +42,14 @@ type
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 SelectedColor default clRed;
property HintFormat;
end;
implementation
uses
mbUtils;
mbUtils, mbColorConv;
{TVColorPicker}
@ -224,7 +220,7 @@ end;
procedure TVColorPicker.SetSelectedColor(c: TColor);
var
h, s, v: integer;
h, s, v: Double;
needNewGradient: Boolean;
begin
if WebSafe then
@ -232,7 +228,7 @@ begin
if c = GetSelectedColor then
exit;
RGBToHSVRange(GetRValue(c), GetGValue(c), GetBValue(c), h, s, v);
RGBToHSV(GetRValue(c), GetGValue(c), GetBValue(c), h, s, v);
needNewGradient := (h <> FHue) or (s <> FSat);
FHue := h;
FSat := s;

16
components/mbColorLib/YColorPicker.pas
View File

@ -7,13 +7,8 @@ interface
{$ENDIF}
uses
{$IFDEF FPC}
LCLIntf, LCLType, LMessages,
{$ELSE}
Windows, Messages,
{$ENDIF}
SysUtils, Classes, Controls, Graphics, Forms,
RGBCMYKUtils, mbTrackBarPicker, HTMLColors, Scanlines;
LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Forms,
RGBCMYKUtils, mbTrackBarPicker, HTMLColors;
type
TYColorPicker = class(TmbTrackBarPicker)
@ -21,8 +16,6 @@ type
FYellow, FMagenta, FCyan, FBlack: integer;
function ArrowPosFromYellow(y: integer): integer;
function YellowFromArrowPos(p: integer): integer;
function GetSelectedColor: TColor;
procedure SetSelectedColor(clr: TColor);
procedure SetYellow(y: integer);
procedure SetMagenta(m: integer);
procedure SetCyan(c: integer);
@ -31,7 +24,9 @@ type
procedure Execute(tbaAction: integer); override;
function GetArrowPos: integer; override;
function GetGradientColor(AValue: Integer): TColor; override;
function GetSelectedColor: TColor; override;
function GetSelectedValue: integer; override;
procedure SetSelectedColor(clr: TColor); override;
public
constructor Create(AOwner: TComponent); override;
published
@ -39,8 +34,9 @@ type
property Magenta: integer read FMagenta write SetMagenta default 0;
property Cyan: integer read FCyan write SetCyan default 0;
property Black: integer read FBlack write SetBlack default 0;
property SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed;
property SelectedColor default clRed;
property Layout default lyVertical;
property HintFormat;
end;
implementation

111
components/mbColorLib/examples/fulldemo/main.lfm
View File

@ -15,10 +15,10 @@ object Form1: TForm1
Height = 404
Top = 6
Width = 476
ActivePage = TabSheet7
ActivePage = TabSheet1
Align = alClient
BorderSpacing.Around = 6
TabIndex = 7
TabIndex = 0
TabOrder = 0
OnChange = PageControl1Change
OnMouseMove = PageControl1MouseMove
@ -31,10 +31,12 @@ object Form1: TForm1
Height = 360
Top = 8
Width = 454
Saturation = 146
SelectedColor = 3289805
SelectedColor = 3552968
Saturation = 147
HSPickerHintFormat = 'H: %h S: %s'#13'Hex: #%hex'
LPickerHintFormat = 'Luminance: %l'
VPickerHintFormat = 'Value: %value (selected)'
MaxLuminance = 255
Anchors = [akTop, akLeft, akRight, akBottom]
TabOrder = 0
OnChange = HSLColorPicker1Change
@ -611,7 +613,10 @@ object Form1: TForm1
Width = 322
Luminance = 240
RingPickerHintFormat = 'Hue: %h'
SLPickerHintFormat = 'S: %s L: %l'#13'Hex: %hex'
SLPickerHintFormat = 'S: %hslS V: %v'#13'Hex: %hex'
SVPickerHintFormat = 'S: %hslS V: %v'#13'Hex: %hex'
MaxLuminance = 255
MaxSaturation = 255
Anchors = [akTop, akLeft, akRight, akBottom]
TabOrder = 0
OnChange = HSLRingPicker1Change
@ -632,25 +637,22 @@ object Form1: TForm1
HintFormat = 'H: %h S: %s V: %v'#13'Hex: %hex'
Anchors = [akTop, akLeft, akRight, akBottom]
TabOrder = 0
OnMouseMove = HSVColorPicker1MouseMove
Saturation = 0
OnChange = HSVColorPicker1Change
end
object VColorPicker2: TVColorPicker
object LVColorPicker1: TLVColorPicker
Left = 437
Height = 375
Top = 2
Width = 22
HintFormat = 'Value: %v (selected)'
Layout = lyVertical
NewArrowStyle = True
Anchors = [akTop, akRight, akBottom]
TabOrder = 1
OnChange = VColorPicker2Change
Hue = 0
Saturation = 0
Value = 255
SelectedColor = clWhite
OnChange = LVColorPicker1Change
BrightnessMode = bmValue
LHintFormat = 'Luminance: %lum (selected)'
VHintFormat = 'Value: %value (selected)'
end
end
object TabSheet6: TTabSheet
@ -663,9 +665,13 @@ object Form1: TForm1
Height = 364
Top = 6
Width = 458
SelectedColor = 213
Value = 213
Luminance = 100
HPickerHintFormat = 'Hue: %h (selected)'
SLPickerHintFormat = 'S: %s L: %l'#13'Hex: %hex'
MaxSaturation = 255
MaxLuminance = 255
Anchors = [akTop, akLeft, akRight, akBottom]
TabOrder = 0
OnChange = SLHColorPicker1Change
@ -782,20 +788,20 @@ object Form1: TForm1
Height = 25
Top = 265
Width = 420
HintFormat = 'Luminance: %l (selected)'
SelectedColor = 460777
SelectionIndicator = siRect
Anchors = [akLeft, akRight, akBottom]
TabOrder = 2
Hue = 0
Saturation = 240
Luminance = 120
HintFormat = 'Luminance: %l (selected)'
end
object VColorPicker1: TVColorPicker
Left = 34
Height = 21
Top = 233
Width = 420
HintFormat = 'Value: %v (selected)'
ArrowPlacement = spBefore
NewArrowStyle = True
SelectionIndicator = siRect
@ -804,23 +810,22 @@ object Form1: TForm1
Hue = 0
Saturation = 255
Value = 255
HintFormat = 'Value: %v (selected)'
end
object HColorPicker1: THColorPicker
Left = 34
Height = 61
Top = 304
Width = 420
HintFormat = 'Hue: %h (under mouse)'
SelectedColor = 8882175
Increment = 5
ArrowPlacement = spBoth
SelectionIndicator = siRect
Anchors = [akLeft, akRight, akBottom]
TabOrder = 4
OnGetHintStr = HColorPicker1GetHintStr
Hue = 0
Saturation = 120
Value = 255
SelectedColor = 8882175
Luminance = 195
HintFormat = 'Hue: %h (under mouse)'
end
object SColorPicker1: TSColorPicker
AnchorSideTop.Control = OfficeColorDialogButton
@ -829,7 +834,7 @@ object Form1: TForm1
Height = 291
Top = 74
Width = 19
HintFormat = 'Saturation: %s (selected)'
SelectedColor = 11534335
Layout = lyVertical
ArrowPlacement = spBefore
NewArrowStyle = True
@ -838,9 +843,8 @@ object Form1: TForm1
BorderSpacing.Top = 8
TabOrder = 5
Hue = 60
Saturation = 80
Value = 255
SelectedColor = 11534335
Luminance = 215
HintFormat = 'Saturation: %s (selected)'
end
object Memo1: TMemo
AnchorSideLeft.Control = Label9
@ -903,12 +907,13 @@ object Form1: TForm1
Height = 155
Top = 6
Width = 211
SelectedColor = 15797774
SelectedColor = 15406357
HintFormat = 'H: %h S: %s'#13'Hex: %hex'
TabOrder = 0
OnMouseMove = HSColorPicker1MouseMove
Hue = 240
Saturation = 214
Luminance = 128
Saturation = 215
MarkerStyle = msSquare
OnChange = HSColorPicker1Change
end
@ -917,12 +922,14 @@ object Form1: TForm1
Height = 130
Top = 168
Width = 161
SelectedColor = 6974058
SelectedColor = 6579300
HintFormat = 'H: %h S: %s L: %l'#13'Hex: %hex'
TabOrder = 1
OnMouseMove = SLColorPicker1MouseMove
Luminance = 100
MarkerStyle = msCross
SLHintFormat = 'S: %hslS L: %l'#13#10'Hex: %hex'
SVHintFormat = 'S: %hslS V: %v'#13#10'Hex: %hex'
OnChange = SLColorPicker1Change
end
object HRingPicker1: THRingPicker
@ -930,13 +937,11 @@ object Form1: TForm1
Height = 130
Top = 168
Width = 133
SelectedColor = clRed
SelectedColor = 66047
HintFormat = 'Hue: %h (selected)'
TabOrder = 2
OnMouseMove = HRingPicker1MouseMove
Hue = 0
Saturation = 255
Value = 255
Luminance = 128
OnChange = HRingPicker1Change
end
end
@ -964,10 +969,10 @@ object Form1: TForm1
Height = 353
Top = 19
Width = 22
HintFormat = 'Cyan: %c (selected)'
SelectedColor = clAqua
Anchors = [akTop, akLeft, akBottom]
TabOrder = 0
SelectedColor = clAqua
HintFormat = 'Cyan: %c (selected)'
end
object MColorPicker1: TMColorPicker
AnchorSideTop.Control = CColorPicker1
@ -977,11 +982,11 @@ object Form1: TForm1
Height = 353
Top = 19
Width = 22
HintFormat = 'Magenta: %m (selected)'
SelectedColor = clFuchsia
ArrowPlacement = spBefore
Anchors = [akTop, akLeft, akBottom]
TabOrder = 1
SelectedColor = clFuchsia
HintFormat = 'Magenta: %m (selected)'
end
object YColorPicker1: TYColorPicker
AnchorSideTop.Control = CColorPicker1
@ -991,11 +996,11 @@ object Form1: TForm1
Height = 353
Top = 19
Width = 31
HintFormat = 'Yellow: %y (selected)'
SelectedColor = clYellow
ArrowPlacement = spBoth
Anchors = [akTop, akLeft, akBottom]
TabOrder = 2
SelectedColor = clYellow
HintFormat = 'Yellow: %y (selected)'
end
object KColorPicker1: TKColorPicker
AnchorSideTop.Control = CColorPicker1
@ -1005,13 +1010,13 @@ object Form1: TForm1
Height = 353
Top = 19
Width = 22
HintFormat = 'Black: %k (selected)'
SelectedColor = 16711422
NewArrowStyle = True
Anchors = [akTop, akLeft, akBottom]
TabOrder = 3
Cyan = 0
Black = 1
SelectedColor = 16711422
HintFormat = 'Black: %k (selected)'
end
object RColorPicker1: TRColorPicker
AnchorSideTop.Control = CColorPicker1
@ -1021,14 +1026,14 @@ object Form1: TForm1
Height = 353
Top = 19
Width = 22
HintFormat = 'Red: %r (selected)'
SelectedColor = 8026879
ArrowPlacement = spBefore
NewArrowStyle = True
Anchors = [akTop, akLeft, akBottom]
TabOrder = 4
Green = 122
Blue = 122
SelectedColor = 8026879
HintFormat = 'Red: %r (selected)'
end
object GColorPicker1: TGColorPicker
AnchorSideTop.Control = CColorPicker1
@ -1038,14 +1043,14 @@ object Form1: TForm1
Height = 353
Top = 19
Width = 34
HintFormat = 'Green: %g (selected)'
SelectedColor = 8060794
ArrowPlacement = spBoth
NewArrowStyle = True
Anchors = [akTop, akLeft, akBottom]
TabOrder = 5
Red = 122
Blue = 122
SelectedColor = 8060794
HintFormat = 'Green: %g (selected)'
end
object BColorPicker1: TBColorPicker
AnchorSideTop.Control = CColorPicker1
@ -1055,72 +1060,72 @@ object Form1: TForm1
Height = 353
Top = 19
Width = 22
HintFormat = 'Blue: %b (selected)'
SelectedColor = 16743034
SelectionIndicator = siRect
Anchors = [akTop, akLeft, akBottom]
TabOrder = 6
Green = 122
Red = 122
SelectedColor = 16743034
HintFormat = 'Blue: %b (selected)'
end
object KColorPicker2: TKColorPicker
Left = 322
Height = 79
Top = 27
Width = 69
SelectedColor = 16711422
BevelInner = bvRaised
BevelOuter = bvRaised
BorderStyle = bsSingle
HintFormat = 'Black: %k (selected)'
ArrowPlacement = spBoth
NewArrowStyle = True
TabOrder = 7
Cyan = 0
Black = 1
SelectedColor = 16711422
HintFormat = 'Black: %k (selected)'
end
object MColorPicker2: TMColorPicker
Left = 320
Height = 61
Top = 110
Width = 91
SelectedColor = clFuchsia
BevelInner = bvLowered
BevelOuter = bvRaised
BorderStyle = bsSingle
HintFormat = 'Magenta: %m (selected)'
Layout = lyHorizontal
ArrowPlacement = spBoth
NewArrowStyle = True
TabOrder = 8
SelectedColor = clFuchsia
HintFormat = 'Magenta: %m (selected)'
end
object CColorPicker2: TCColorPicker
Left = 322
Height = 74
Top = 172
Width = 61
SelectedColor = clAqua
BevelInner = bvRaised
BevelOuter = bvLowered
BorderStyle = bsSingle
HintFormat = 'Cyan: %c (selected)'
ArrowPlacement = spBoth
NewArrowStyle = True
TabOrder = 9
SelectedColor = clAqua
HintFormat = 'Cyan: %c (selected)'
end
object YColorPicker2: TYColorPicker
Left = 320
Height = 63
Top = 256
Width = 81
SelectedColor = clYellow
BevelInner = bvLowered
BevelOuter = bvLowered
BorderStyle = bsSingle
HintFormat = 'Yellow: %y (selected)'
ArrowPlacement = spBoth
NewArrowStyle = True
TabOrder = 10
SelectedColor = clYellow
HintFormat = 'Yellow: %y (selected)'
end
end
object TabSheet10: TTabSheet

51
components/mbColorLib/examples/fulldemo/main.pas
View File

@ -4,16 +4,18 @@ interface
uses
LCLIntf, LCLType, SysUtils, Variants,Classes, Graphics, Controls,
Forms, Dialogs, HSLColorPicker, ComCtrls, StdCtrls, ExtCtrls, mbColorPreview,
LCLIntf, LCLType, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, HSLColorPicker, ComCtrls, StdCtrls, ExtCtrls, mbColorPreview,
HexaColorPicker, mbColorPalette, HSLRingPicker, HSVColorPicker, PalUtils,
SLHColorPicker, mbDeskPickerButton, mbOfficeColorDialog, SColorPicker,
HColorPicker, VColorPicker, mbTrackBarPicker, LColorPicker, HRingPicker,
SLColorPicker, HSColorPicker, IniFiles, mbColorPickerControl,
BColorPicker, GColorPicker, RColorPicker, KColorPicker, YColorPicker,
MColorPicker, CColorPicker, CIEBColorPicker, CIEAColorPicker, Typinfo,
CIELColorPicker, BAxisColorPicker, GAxisColorPicker, RAxisColorPicker,
mbColorTree, mbColorList {for internet shortcuts}, mbBasicPicker;
HColorPicker, LVColorPicker, mbTrackBarPicker, LColorPicker, HRingPicker,
SLColorPicker, HSColorPicker, IniFiles, mbColorPickerControl, BColorPicker,
GColorPicker, RColorPicker, KColorPicker, YColorPicker, MColorPicker,
CColorPicker, CIEBColorPicker, CIEAColorPicker, Typinfo, CIELColorPicker,
BAxisColorPicker, GAxisColorPicker, RAxisColorPicker, mbColorTree,
mbColorList, mbBasicPicker,
VColorPicker;
type
@ -63,7 +65,6 @@ type
HSColorPicker1: THSColorPicker;
SLColorPicker1: TSLColorPicker;
HRingPicker1: THRingPicker;
VColorPicker2: TVColorPicker;
CheckBox1: TCheckBox;
CbMarker: TComboBox;
Label4: TLabel;
@ -82,6 +83,7 @@ type
TabSheet9: TTabSheet;
CColorPicker1: TCColorPicker;
MColorPicker1: TMColorPicker;
LVColorPicker1: TLVColorPicker;
YColorPicker1: TYColorPicker;
KColorPicker1: TKColorPicker;
Label8: TLabel;
@ -131,8 +133,6 @@ type
procedure HSLRingPicker1MouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
procedure HSVColorPicker1Change(Sender: TObject);
procedure HSVColorPicker1MouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
procedure SLHColorPicker1Change(Sender: TObject);
procedure SLHColorPicker1MouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
@ -149,7 +149,7 @@ type
Y: Integer);
procedure udSizeChangingEx(Sender: TObject; var AllowChange: Boolean;
NewValue: SmallInt; Direction: TUpDownDirection);
procedure VColorPicker2Change(Sender: TObject);
procedure LVColorPicker1Change(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
procedure CbMarkerChange(Sender: TObject);
@ -176,7 +176,8 @@ implementation
{$R mxico.res} //MXS icon resource file, for internet shortcut only
uses
RGBHSLUtils;
mbColorConv;
// RGBHSLUtils;
procedure TForm1.tb1Change(Sender: TObject);
begin
@ -244,15 +245,9 @@ end;
procedure TForm1.HSVColorPicker1Change(Sender: TObject);
begin
sc.color := HSVColorPicker1.SelectedColor;
VColorPicker2.Saturation := HSVColorPicker1.Saturation;
VColorPicker2.Hue := HSVColorPicker1.Hue;
end;
procedure TForm1.HSVColorPicker1MouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
begin
uc.Color := HSVColorPicker1.ColorUnderCursor;
LVColorPicker1.Saturation := HSVColorPicker1.Saturation;
LVColorPicker1.Hue := HSVColorPicker1.Hue;
sc.color := LVColorPicker1.SelectedColor;
end;
procedure TForm1.SLHColorPicker1Change(Sender: TObject);
@ -322,17 +317,19 @@ begin
uc.color := hringpicker1.ColorUnderCursor;
end;
procedure TForm1.VColorPicker2Change(Sender: TObject);
procedure TForm1.LVColorPicker1Change(Sender: TObject);
begin
HSVColorPicker1.Value := VColorPicker2.Value;
if (sc = nil) or (uc = nil) or (LVColorPicker1 = nil) or (HSVColorPicker1 = nil) then
exit;
LVColorPicker1.Saturation := HSVColorPicker1.Saturation;
LVColorPicker1.Hue := HSVColorPicker1.Hue;
sc.Color := LVColorPicker1.SelectedColor;
uc.Color := HSVtoColor(HSVColorPicker1.RelHue, HSVColorPicker1.RelSaturation, HSVColorPicker1.RelValue);
end;
// only for internet shortcuts
procedure TForm1.FormCreate(Sender: TObject);
begin
// MaxHue := 360;
// MaxSat := 240;
// MaxLum := 240;
with TIniFile.Create(ExtractFilePath(Application.ExeName) + '\MXS Website.url') do
try
WriteString('InternetShortcut','URL', 'http://mxs.bergsoft.net');

7
components/mbColorLib/mbBasicPicker.pas
View File

@ -25,14 +25,16 @@ type
procedure CreateGradient; virtual;
procedure DoChange; virtual;
function GetColorUnderCursor: TColor; virtual;
function GetGradientColor(AValue: Integer): TColor; virtual;
function GetGradientColor2D(X, Y: Integer): TColor; virtual;
function GetGradientColor({%H-}AValue: Integer): TColor; virtual;
function GetGradientColor2D({%H-}X, {%H-}Y: Integer): TColor; virtual;
function GetHintPos(X, Y: Integer): TPoint; virtual;
function GetHintStr(X, Y: Integer): String; virtual;
function GetSelectedColor: TColor; virtual; abstract;
procedure PaintParentBack; virtual; overload;
procedure PaintParentBack(ACanvas: TCanvas); overload;
procedure PaintParentBack(ACanvas: TCanvas; ARect: TRect); overload;
procedure PaintParentBack(ABitmap: TBitmap); overload;
procedure SetSelectedColor(c: TColor); virtual; abstract;
procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW;
procedure CMParentColorChanged(var Message: TLMessage); message CM_PARENTCOLORCHANGED;
property ColorUnderCursor: TColor read GetColorUnderCursor;
@ -46,6 +48,7 @@ type
function GetHexColorUnderCursor: string; virtual;
published
property ParentColor default true;
property SelectedColor: TColor read GetSelectedColor write SetSelectedColor;
end;
implementation

6
components/mbColorLib/mbColorPalette.pas
View File

@ -64,7 +64,7 @@ type
procedure DrawCell(ACanvas: TCanvas; AColor: string);
procedure DrawCellBack(ACanvas: TCanvas; R: TRect; AIndex: integer);
function GetColorUnderCursor: TColor; override;
function GetHintStr(X, Y: Integer): String; override;
function GetHintStr({%H-}X, {%H-}Y: Integer): String; override;
function GetIndexUnderCursor: integer;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
@ -146,8 +146,6 @@ type
implementation
uses
mbUtils;
{ TmbColorPalette }
@ -684,6 +682,7 @@ begin
FNames.Clear;
FColors.Text := ReadJASCPal(FileName);
end
(*
else if SameText(ExtractFileExt(FileName), '.aco') then
begin
supported := true;
@ -702,6 +701,7 @@ begin
FNames.Clear;
FColors.Text := ReadPhotoshopAct(FileName);
end
*)
else
raise Exception.Create('The file format you are trying to load is not supported in this version of the palette'#13'Please send a request to MXS along with the files of this format so'#13'loading support for this file can be added too');
if supported then

357
components/mbColorLib/mbColorPickerControl.pas
View File

@ -6,7 +6,7 @@ interface
uses
LCLIntf, LCLType, LMessages, SysUtils, Classes, Controls, Graphics, Forms, Themes,
RGBHSLUtils, RGBHSVUtils, RGBCMYKUtils, RGBCIEUtils, HTMLColors, mbBasicPicker;
HTMLColors, mbColorConv, mbBasicPicker;
type
TMarkerStyle = (msCircle, msSquare, msCross, msCrossCirc);
@ -21,24 +21,22 @@ type
procedure SetMarkerStyle(s: TMarkerStyle);
procedure SetWebSafe(s: boolean);
protected
FManual: Boolean;
FSelected: TColor;
mx, my: integer;
procedure CreateGradient; override;
function GetHintStr(X, Y: Integer): String; override;
function GetSelectedColor: TColor; virtual;
function GetHintStr({%H-}X, {%H-}Y: Integer): String; override;
function GetSelectedColor: TColor; override;
procedure InternalDrawMarker(X, Y: Integer; C: TColor);
procedure SetSelectedColor(C: TColor); virtual;
procedure SetSelectedColor(C: TColor); override;
procedure WebSafeChanged; dynamic;
procedure CMGotFocus(var Message: TLMessage); message CM_ENTER;
procedure CMLostFocus(var Message: TLMessage); message CM_EXIT;
procedure CMMouseLeave(var Message: TLMessage); message CM_MOUSELEAVE;
// procedure CMMouseLeave(var Message: TLMessage); message CM_MOUSELEAVE;
property MarkerStyle: TMarkerStyle read FMarkerStyle write SetMarkerStyle;
public
constructor Create(AOwner: TComponent); override;
property ColorUnderCursor;
published
property SelectedColor: TColor read GetSelectedColor write SetSelectedColor;
property HintFormat: string read FHintFormat write FHintFormat;
property WebSafe: boolean read FWebSafe write SetWebSafe default false;
end;
@ -78,11 +76,70 @@ type
property OnStartDrag;
end;
TmbHSLVColorPickerControl = class(TmbColorPickerControl)
private
FBrightnessMode: TBrightnessMode;
function GetHue: Integer;
function GetLum: Integer;
function GetSat: Integer;
function GetVal: Integer;
function GetRed: Integer;
function GetGreen: Integer;
function GetBlue: Integer;
procedure SetHue(h: integer);
procedure SetLum(L: Integer);
procedure SetSat(s: integer);
procedure SetVal(v: integer);
procedure SetRed(R: Integer);
procedure SetGreen(G: Integer);
procedure SetBlue(B: Integer);
protected
FHue, FSat, FLum, FVal: Double;
FMaxHue, FMaxSat, FMaxLum, FMaxVal: Integer;
procedure ColorToHSLV(c: TColor; var H, S, L, V: Double);
procedure CorrectCoords(var x, y: integer);
function HSLVtoColor(H, S, L, V: Double): TColor;
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 SelectColor({%H-}x, {%H-}y: Integer); virtual;
procedure SetBrightnessMode(AMode: TBrightnessMode); virtual;
procedure SetMaxHue(H: Integer); virtual;
procedure SetMaxLum(L: Integer); virtual;
procedure SetMaxSat(S: Integer); virtual;
procedure SetMaxVal(V: Integer); virtual;
procedure SetRelHue(H: Double); virtual;
procedure SetRelLum(L: Double); virtual;
procedure SetRelSat(S: Double); virtual;
procedure SetRelVal(V: Double); virtual;
public
constructor Create(AOwner: TComponent); override;
property RelHue: Double read FHue write SetRelHue;
property RelSaturation: Double read FSat write SetRelSat;
property RelLuminance: Double read FLum write SetRelLum;
property RelValue: Double read FVal write SetRelVal;
property Red: Integer read GetRed write SetRed;
property Green: Integer read GetGreen write SetGreen;
property Blue: Integer read GetBlue write SetBlue;
published
property BrightnessMode: TBrightnessMode
read FBrightnessMode write SetBrightnessMode default bmLuminance;
property Hue: integer read GetHue write SetHue;
property Luminance: Integer read GetLum write SetLum;
property Saturation: integer read GetSat write SetSat;
property Value: integer read GetVal write SetVal;
property MaxHue: Integer read FMaxHue write SetMaxHue default 360;
property MaxSaturation: Integer read FMaxSat write SetMaxSat default 255;
property MaxLuminance: Integer read FMaxLum write SetMaxLum default 255;
property MaxValue: Integer read FMaxVal write SetMaxVal default 255;
end;
implementation
uses
IntfGraphics, fpimage,
ScanLines, PalUtils, SelPropUtils;
Math, IntfGraphics, fpimage,
PalUtils, SelPropUtils, mbUtils;
constructor TmbCustomPicker.Create(AOwner: TComponent);
begin
@ -107,14 +164,14 @@ begin
inherited;
Invalidate;
end;
(*
procedure TmbCustomPicker.CMMouseLeave(var Message: TLMessage);
begin
mx := 0;
my := 0;
inherited;
end;
*)
procedure TmbCustomPicker.CreateGradient;
var
x, y: Integer;
@ -205,4 +262,282 @@ begin
Invalidate;
end;
{ TmbHSLVColorPickerControl }
constructor TmbHSLVColorPickerControl.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FBrightnessMode := bmLuminance;
FMaxHue := 360;
FMaxSat := 255;
FMaxVal := 255;
FMaxLum := 255;
end;
procedure TmbHSLVColorPickerControl.ColorToHSLV(c: TColor;
var H, S, L, V: Double);
begin
case FBrightnessMode of
bmLuminance : ColorToHSL(c, H, S, L);
bmValue : ColorToHSV(c, H, S, V);
end;
end;
procedure TmbHSLVColorPickerControl.CorrectCoords(var x, y: integer);
begin
Clamp(x, 0, Width - 1);
Clamp(y, 0, Height - 1);
end;
function TmbHSLVColorPickerControl.GetBlue: Integer;
begin
Result := GetBValue(GetSelectedColor);
end;
function TmbHSLVColorPickerControl.GetGreen: Integer;
begin
Result := GetGValue(GetSelectedColor);
end;
function TmbHSLVColorPickerControl.GetHue: Integer;
begin
Result := Round(FHue * FMaxHue);
end;
function TmbHSLVColorPickerControl.GetLum: Integer;
begin
Result := Round(FLum * FMaxLum);
end;
function TmbHSLVColorPickerControl.GetRed: Integer;
begin
Result := GetRValue(GetSelectedColor);
end;
function TmbHSLVColorPickerControl.GetSat: Integer;
begin
Result := Round(FSat * FMaxSat);
end;
function TmbHSLVColorPickerControl.GetVal: Integer;
begin
Result := Round(FVal * FMaxVal);
end;
function TmbHSLVColorPickerControl.HSLVtoColor(H, S, L, V: Double): TColor;
begin
case FBrightnessMode of
bmLuminance : Result := HSLToColor(H, S, L);
bmValue : Result := HSVtoColor(H, S, V);
end;
if WebSafe then
Result := GetWebSafe(Result);
end;
procedure TmbHSLVColorPickerControl.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;
if eraseKey then
Key := 0;
inherited;
end;
procedure TmbHSLVColorPickerControl.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited;
if csDesigning in ComponentState then
Exit;
if Button = mbLeft then
SelectColor(x, y);
SetFocus;
end;
procedure TmbHSLVColorPickerControl.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
inherited;
if csDesigning in ComponentState then
Exit;
if ssLeft in Shift then
SelectColor(x, y);
end;
procedure TmbHSLVColorPickerControl.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited;
if csDesigning in ComponentState then
Exit;
if Button = mbLeft then
SelectColor(x, y);
end;
procedure TmbHSLVColorPickerControl.SelectColor(x, y: Integer);
begin
end;
procedure TmbHSLVColorPickerControl.SetBlue(B: Integer);
begin
Clamp(B, 0, 255);
SetSelectedColor(RgbToColor(Red, Green, B));
end;
procedure TmbHSLVColorPickerControl.SetBrightnessMode(AMode: TBrightnessMode);
var
c: TColor;
begin
c := HSLVtoColor(FHue, FSat, FLum, FVal);
FBrightnessMode := AMode;
ColorToHSLV(c, FHue, FSat, FLum, FVal);
CreateGradient;
Invalidate;
DoChange;
end;
procedure TmbHSLVColorPickerControl.SetGreen(G: Integer);
begin
Clamp(G, 0, 255);
SetSelectedColor(RgbToColor(Red, G, Blue));
end;
procedure TmbHSLVColorPickerControl.SetHue(H: Integer);
begin
SetRelHue(H / FMaxHue);
end;
procedure TmbHSLVColorPickerControl.SetLum(L: Integer);
begin
SetRelLum(L / FMaxLum);
end;
procedure TmbHSLVColorPickerControl.SetMaxHue(h: Integer);
begin
if h = FMaxHue then
exit;
FMaxHue := h;
CreateGradient;
Invalidate;
end;
procedure TmbHSLVColorPickerControl.SetMaxLum(L: Integer);
begin
if L = FMaxLum then
exit;
FMaxLum := L;
if BrightnessMode = bmLuminance then begin
CreateGradient;
Invalidate;
end;
end;
procedure TmbHSLVColorPickerControl.SetMaxSat(S: Integer);
begin
if S = FMaxSat then
exit;
FMaxSat := S;
CreateGradient;
Invalidate;
end;
procedure TmbHSLVColorPickerControl.SetMaxVal(V: Integer);
begin
if V = FMaxVal then
exit;
FMaxVal := V;
if BrightnessMode = bmLuminance then
begin
CreateGradient;
Invalidate;
end;
end;
procedure TmbHSLVColorPickerControl.SetRed(R: Integer);
begin
Clamp(R, 0, 255);
SetSelectedColor(RgbToColor(R, Green, Blue));
end;
procedure TmbHSLVColorPickerControl.SetRelHue(H: Double);
begin
Clamp(H, 0, 1.0);
if FHue <> H then
begin
FHue := H;
FSelected := HSLVtoColor(FHue, FSat, FLum, FVal);
CreateGradient;
Invalidate;
DoChange;
end;
end;
procedure TmbHSLVColorPickerControl.SetRelLum(L: Double);
begin
Clamp(L, 0, 1.0);
if FLum <> L then
begin
FLum := L;
FSelected := HSLVtoColor(FHue, FSat, FLum, FVal);
if BrightnessMode = bmLuminance then begin
CreateGradient;
Invalidate;
end;
DoChange;
end;
end;
procedure TmbHSLVColorPickerControl.SetRelSat(S: Double);
begin
Clamp(S, 0, 1.0);
if FSat <> S then
begin
FSat := S;
FSelected := HSLVtoColor(FHue, FSat, FLum, FVal);
CreateGradient;
Invalidate;
DoChange;
end;
end;
procedure TmbHSLVColorPickerControl.SetRelVal(V: Double);
begin
Clamp(v, 0, 1.0);
if FVal <> V then
begin
FVal := V;
if BrightnessMode = bmValue then
begin
FSelected := HSLVtoColor(FHue, FSat, FLum, FVal);
CreateGradient;
Invalidate;
end;
DoChange;
end;
end;
procedure TmbHSLVColorPickerControl.SetSat(S: Integer);
begin
SetRelSat(S / FMaxSat);
end;
procedure TmbHSLVColorPickerControl.SetVal(V: Integer);
begin
SetRelVal(V / FMaxVal);
end;
end.

4
components/mbColorLib/mbColorTree.pas
View File

@ -35,12 +35,12 @@ type
protected
procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW;
function CustomDrawItem(Node: TTreeNode; State: TCustomDrawState;
Stage: TCustomDrawStage; var PaintImages: Boolean): Boolean; override;
{%H-}Stage: TCustomDrawStage; var {%H-}PaintImages: Boolean): Boolean; override;
procedure DoArrow(c: TCanvas; dir: TScrollDirection; p: TPoint; sel: boolean);
procedure DrawColorItem(R: TRect; Selected: boolean; AIndex: Integer;
AItemText: String; Expanded: boolean); dynamic;
procedure DrawInfoItem(R: TRect; Index: integer); dynamic;
function IsCustomDrawn(Target: TCustomDrawTarget; Stage: TCustomDrawStage): Boolean; override;
function IsCustomDrawn({%H-}Target: TCustomDrawTarget; {%H-}Stage: TCustomDrawStage): Boolean; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
public

4
components/mbColorLib/mbDeskPickerButton.pas
View File

@ -60,8 +60,8 @@ type
var Handled: Boolean);
public
constructor Create(AOwner: TComponent); override;
procedure ExecuteTarget(Target: TObject); override;
function HandlesTarget(Target: TObject): Boolean; override;
procedure ExecuteTarget({%H-}Target: TObject); override;
function HandlesTarget({%H-}Target: TObject): Boolean; override;
// procedure UpdateTarget(Target: TObject); override;
published
property Caption;

20
components/mbColorLib/mbOfficeColorDialog.pas
View File

@ -15,15 +15,16 @@ type
FSelColor: TColor;
FUseHint: boolean;
FMaxHue, FMaxSat, FMaxLum: Integer;
FPickerIndex: Integer;
public
constructor Create(AOwner: TComponent); override;
function Execute: boolean; overload;
function Execute(AColor: TColor): boolean; overload;
published
property SelectedColor: TColor read FSelColor write FSelColor default clWhite;
property MaxHue: Integer read FMaxHue write FMaxHue default 359;
property MaxSaturation: Integer read FMaxSat write FMaxSat default 240;
property MaxLuminance: Integer read FMaxLum write FMaxLum default 240;
property MaxHue: Integer read FMaxHue write FMaxHue default 360;
property MaxSaturation: Integer read FMaxSat write FMaxSat default 255;
property MaxLuminance: Integer read FMaxLum write FMaxLum default 255;
property UseHints: boolean read FUseHint write FUseHint default false;
end;
@ -36,9 +37,9 @@ begin
inherited;
FSelColor := clWhite;
FUseHint := false;
FMaxHue := 359;
FMaxSat := 240;
FMaxLum := 240;
FMaxHue := 360;
FMaxSat := 255;
FMaxLum := 255;
end;
function TmbOfficeColorDialog.Execute: boolean;
@ -50,16 +51,19 @@ function TmbOfficeColorDialog.Execute(AColor: TColor): boolean;
begin
FWin := TOfficeMoreColorsWin.Create(Application);
try
FWin.OldSwatch.Color := AColor;
FWin.ShowHint := FUseHint;
FWin.MaxHue := FMaxHue;
FWin.MaxSaturation := FMaxSat;
FWin.MaxLuminance := FMaxLum;
FWin.PickerIndex := FPickerIndex;
// FWin.OldSwatch.Color := AColor;
FWin.SelectedColor := AColor;
Result := (FWin.ShowModal = IdOK);
if Result then
FSelColor := FWin.NewSwatch.Color
FSelColor := FWin.SelectedColor //FWin.NewSwatch.Color
else
FSelColor := clNone;
FPickerIndex := FWin.PickerIndex;
finally
FWin.Free;
end;

12
components/mbColorLib/mbReg.lrs
View File

@ -646,3 +646,15 @@ LazarusResources.Add('TVColorPicker','PNG',[
+' '#12'H'#3#162#0'Y'#128',A%P'#23#160'F'#208'#'#168#145#238#208'._'#200#185
+#241#12'o'#213'fM'#147#161'f;'#0#0#0#0'IEND'#174'B`'#130
]);
LazarusResources.Add('TLVColorPicker','PNG',[
#137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#6#0#0#0#224'w='#248#0
+#0#0#9'pHYs'#0#0#11#19#0#0#11#19#1#0#154#156#24#0#0#0#163'IDATH'#199#237#149
+'1'#10#195'0'#12'E'#191'\'#155#128'e'#199#6#15#6#239#134#244'&9_.'#147'k'#197
+'''P'#183#210#165#161#164#205#208'`'#129#16#130'/'#189'E'#31#145#136#224#204
+#208'89:'#224#183#128#24#163#180#214#16'B@J'#9'9g'#148'RPJ'#193#178','#244'5'
+'`'#219'6'#138'1'#202'0'#12'0'#198'@k'#13#165'no'#151#3#0#29'9'#211#233'>'
+#201#232'G'#164#148#176#174'+'#237#138'E'#228'P'#206#243','#159#232#232':FSJ'
+#9'3'#131#153#225#156#131#181#22#206#185'g'#191'W_'#231#152#25#222'{'#169#181
+#170#238#228#14#248#19#0#245#151'y}'#192#3#148#140'h'#197#198'%'#238'5'#0#0#0
+#0'IEND'#174'B`'#130
]);

4
components/mbColorLib/mbReg.pas
View File

@ -19,7 +19,7 @@ uses
RAxisColorPicker, GAxisColorPicker, BAxisColorPicker,
CColorPicker, MColorPicker, YColorPicker, KColorPicker,
HRingPicker,
HColorPicker, SColorPicker, LColorPicker, VColorPicker,
HColorPicker, SColorPicker, LVColorPicker, LColorPicker, VColorPicker,
HSColorPicker, HSVColorPicker, HSLColorPicker, HSLRingPicker,
SLColorPicker, SLHColorPicker,
CIEAColorPicker, CIEBColorPicker, CIELColorPicker,
@ -34,7 +34,7 @@ begin
TRAxisColorPicker, TGAxisColorPicker, TBAxisColorPicker,
TCColorPicker, TMColorPicker, TYColorPicker, TKColorPicker,
THRingPicker,
THColorPicker, TSColorPicker, TLColorPicker, TVColorPicker,
THColorPicker, TSColorPicker, TLVColorPicker, TLColorPicker, TVColorPicker,
THSColorPicker, THSVColorPicker, THSLColorPicker, THSLRingPicker,
TSLColorPicker, TSLHColorPicker,
TCIEAColorPicker, TCIEBColorPicker, TCIELColorPicker,

238
components/mbColorLib/mbTrackBarPicker.pas
View File

@ -7,7 +7,7 @@ interface
uses
LCLIntf, LCLType, LMessages, SysUtils, Classes, Controls, Graphics, Forms,
Themes, ExtCtrls,
PalUtils, mbBasicPicker;
PalUtils, mbColorConv, mbBasicPicker;
const
TBA_Resize = 0;
@ -86,6 +86,7 @@ type
procedure SetBorderStyle(Value: TBorderStyle); override;
procedure CMGotFocus(var Message: TLMessage); message CM_ENTER;
procedure CMLostFocus(var Message: TLMessage); message CM_EXIT;
property HintFormat: string read FHintFormat write FHintFormat;
public
constructor Create(AOwner: TComponent); override;
@ -96,7 +97,6 @@ type
property BevelOuter: TPanelBevel read FBevelOuter write SetBevelOuter default bvNone;
property BevelWidth: TBevelWidth read FBevelWidth write SetBevelWidth default 1;
property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsNone;
property HintFormat: string read FHintFormat write FHintFormat;
property Increment: integer read FIncrement write FIncrement default 1;
property Layout: TTrackBarLayout read FLayout write SetLayout default lyHorizontal;
property ArrowPlacement: TSliderPlacement read FPlacement write SetPlacement default spAfter;
@ -140,11 +140,58 @@ type
property OnStartDrag;
end;
{ TmbHSLVTrackbarPicker }
TmbHSLVTrackbarPicker = class(TmbTrackbarPicker)
private
FBrightnessMode: TBrightnessMode;
function GetHue: Integer;
function GetLum: Integer;
function GetSat: Integer;
function GetVal: Integer;
procedure SetHue(h: integer);
procedure SetLum(L: Integer);
procedure SetSat(s: integer);
procedure SetVal(v: integer);
protected
FHue, FSat, FLum, FVal: Double;
FMaxHue, FMaxSat, FMaxLum, FMaxVal: Integer;
procedure ColorToHSLV(c: TColor; var H, S, L, V: Double);
function GetSelectedColor: TColor; override;
function HSLVtoColor(H, S, L, V: Double): TColor;
procedure SetBrightnessMode(AMode: TBrightnessMode); virtual;
procedure SetMaxHue(h: Integer); virtual;
procedure SetMaxLum(L: Integer); virtual;
procedure SetMaxSat(s: Integer); virtual;
procedure SetMaxVal(v: Integer); virtual;
procedure SetRelHue(H: Double); virtual;
procedure SetRelLum(L: Double); virtual;
procedure SetRelSat(S: Double); virtual;
procedure SetRelVal(V: Double); virtual;
public
constructor Create(AOwner: TComponent); override;
property RelHue: Double read FHue write SetRelHue;
property RelSaturation: Double read FSat write SetRelSat;
property RelLuminance: Double read FLum write SetRelLum;
property RelValue: Double read FVal write SetRelVal;
published
property BrightnessMode: TBrightnessMode
read FBrightnessMode write SetBrightnessMode default bmLuminance;
property Hue: integer read GetHue write SetHue;
property Luminance: Integer read GetLum write SetLum;
property Saturation: integer read GetSat write SetSat;
property Value: integer read GetVal write SetVal;
property MaxHue: Integer read FMaxHue write SetMaxHue default 360;
property MaxSaturation: Integer read FMaxSat write SetMaxSat default 255;
property MaxLuminance: Integer read FMaxLum write SetMaxLum default 255;
property MaxValue: Integer read FMaxVal write SetMaxVal default 255;
end;
implementation
uses
IntfGraphics, fpimage, Math,
ScanLines, HTMLColors;
mbUtils, HTMLColors;
const
{ 3D border styles }
@ -634,7 +681,6 @@ begin
my := Y;
FArrowPos := IfThen(FLayout = lyHorizontal, XToArrowPos(X), YToArrowPos(Y));
Execute(TBA_MouseDown);
//Invalidate;
end;
inherited;
end;
@ -653,7 +699,6 @@ begin
my := Y;
FArrowPos := IfThen(FLayout = lyHorizontal, XToArrowPos(X), YToArrowPos(Y));
Execute(TBA_MouseMove);
// Invalidate;
end;
inherited;
end;
@ -666,7 +711,6 @@ begin
my := Y;
FArrowPos := IfThen(FLayout = lyHorizontal, XToArrowPos(X), YToArrowPos(Y));
Execute(TBA_MouseUp);
// Invalidate;
end;
inherited;
@ -804,4 +848,186 @@ begin
Result := pos;
end;
{ TmbHSLVTrackbarPicker }
constructor TmbHSLVTrackbarPicker.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FBrightnessMode := bmLuminance;
FMaxHue := 360;
FMaxSat := 255;
FMaxVal := 255;
FMaxLum := 255;
end;
procedure TmbHSLVTrackbarPicker.ColorToHSLV(c: TColor; var H, S, L, V: Double);
begin
case FBrightnessMode of
bmLuminance : ColorToHSL(c, H, S, L);
bmValue : ColorToHSV(c, H, S, V);
end;
end;
function TmbHSLVTrackbarPicker.GetHue: Integer;
begin
Result := round(FHue * FMaxHue);
end;
function TmbHSLVTrackbarPicker.GetLum: Integer;
begin
Result := round(FLum * FMaxLum);
end;
function TmbHSLVTrackbarPicker.GetSat: Integer;
begin
Result := round(FSat * FMaxSat);
end;
function TmbHSLVTrackbarPicker.GetSelectedColor: TColor;
begin
Result := HSLVtoColor(FHue, FSat, FLum, FVal);
end;
function TmbHSLVTrackbarPicker.GetVal: Integer;
begin
Result := round(FVal * FMaxVal);
end;
function TmbHSLVTrackbarPicker.HSLVtoColor(H, S, L, V: Double): TColor;
begin
case FBrightnessMode of
bmLuminance : Result := HSLToColor(H, S, L);
bmValue : Result := HSVtoColor(H, S, V);
end;
if WebSafe then
Result := GetWebSafe(Result);
end;
procedure TmbHSLVTrackbarPicker.SetBrightnessMode(AMode: TBrightnessMode);
var
c: TColor;
begin
c := HSLVtoColor(FHue, FSat, FLum, FVal);
FBrightnessMode := AMode;
ColorToHSLV(c, FHue, FSat, FLum, FVal);
CreateGradient;
Invalidate;
DoChange;
end;
procedure TmbHSLVTrackbarPicker.SetHue(H: Integer);
begin
SetRelHue(H / FMaxHue);
end;
procedure TmbHSLVTrackbarPicker.SetLum(L: Integer);
begin
SetRelLum(L / FMaxLum);
end;
procedure TmbHSLVTrackbarPicker.SetMaxHue(h: Integer);
begin
if h = FMaxHue then
exit;
FMaxHue := h;
FGradientWidth := FMaxHue; // we don't want to access H=360, i.e. don't use FMaxHue+1
//CreateGradient;
Invalidate;
end;
procedure TmbHSLVTrackbarPicker.SetMaxLum(L: Integer);
begin
if L = FMaxLum then
exit;
FMaxLum := L;
if FBrightnessMode = bmLuminance then begin
//CreateGradient;
Invalidate;
end;
end;
procedure TmbHSLVTrackbarPicker.SetMaxSat(S: Integer);
begin
if S = FMaxSat then
exit;
FMaxSat := S;
//CreateGradient;
Invalidate;
end;
procedure TmbHSLVTrackbarPicker.SetMaxVal(V: Integer);
begin
if V = FMaxVal then
exit;
FMaxVal := V;
if FBrightnessMode = bmValue then begin
//CreateGradient;
Invalidate;
end;
end;
procedure TmbHSLVTrackbarPicker.SetRelHue(H: Double);
begin
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
FHue := H;
CreateGradient;
Invalidate;
DoChange;
end;
end;
procedure TmbHSLVTrackbarPicker.SetRelLum(L: Double);
begin
Clamp(L, 0, 1.0);
if (FLum <> L) then
begin
FLum := L;
if BrightnessMode = bmLuminance then begin
CreateGradient;
Invalidate;
end;
DoChange;
end;
end;
procedure TmbHSLVTrackbarPicker.SetRelSat(S: Double);
begin
Clamp(S, 0, 1.0);
if FSat <> S then
begin
FSat := S;
CreateGradient;
Invalidate;
DoChange;
end;
end;
procedure TmbHSLVTrackbarPicker.SetRelVal(V: Double);
begin
Clamp(V, 0, 1.0);
if FVal <> V then
begin
FVal := V;
if BrightnessMode = bmValue then
begin
CreateGradient;
Invalidate;
end;
DoChange;
end;
end;
procedure TmbHSLVTrackbarPicker.SetSat(S: Integer);
begin
SetRelSat(S / FMaxSat);
end;
procedure TmbHSLVTrackbarPicker.SetVal(V: Integer);
begin
SetRelVal(V / FMaxVal);
end;
end.

316
components/mbColorLib/mbcolorconv.pas Normal file
View File

@ -0,0 +1,316 @@
unit mbColorConv;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Graphics;
type
TBrightnessMode = (bmLuminance, bmValue);
{ HSL color model }
function HSLtoColor(H, S, L: double): TColor;
procedure HSLtoRGB(H, S, L: Double; out R, G, B: Integer);
procedure ColortoHSL(c: TColor; out H, S, L: Double);
procedure RGBtoHSL(R, G, B: Integer; out H, S, L: Double);
{ HSV color model }
procedure ColorToHSV(c: TColor; out H, S, V: Double);
procedure RGBtoHSV(R, G, B: Integer; out H, S, V: Double);
function HSVtoColor(H, S, V: Double): TColor;
procedure HSVtoRGB(H, S, V: Double; out R, G, B: Integer);
implementation
uses
Math, LclIntf;
function modulo(x, y: Double): Double;
begin
Result := x - floor(x / y) * y;
end;
//==============================================================================
// HSL color model
//==============================================================================
function HSLToColor(H, S, L: Double): TColor;
var
R, G, B: Integer;
begin
HSLtoRGB(H, S, L, R, G, B);
Result := RGBtoColor(R, G, B);
end;
(*
procedure HSLtoRGB(H, S, L: double; out R, G, B: Integer);
var
C, X, m: Double;
rr, gg, bb: Double;
begin
H := H * 360;
C := (1 - abs(2*L - 1)) * S;
X := C * (1 - abs(modulo(H / 60, 2) - 1));
m := L - C/2;
if H < 60 then
begin
R := round((C + m) * 255);
G := round((X + m) * 255);
B := round(m * 255);
end else
if H < 120 then
begin
R := round((X + m) * 255);
G := round((C + m) * 255);
B := round(m * 255);
end else
if H < 180 then
begin
R := round(m * 255);
G := round((C + m) * 255);
B := round((X + m) * 255);
end else
if H < 240 then
begin
R := round(m * 255);
G := round((X + m) * 255);
B := round((C + m) * 255);
end else
if H < 300 then
begin
R := round((X + m) * 255);
G := round(m * 255);
B := round((C + m) * 255);
end else
begin
R := round((C + m) * 255);
G := round(m * 255);
B := round((X + m) * 255);
end;
end; *)
procedure HSLtoRGB(H, S, L: double; out R, G, B: Integer);
var
M1, M2: double;
function HueToColorValue(Hue: double): byte;
var
V : double;
begin
if Hue > 10 then
Hue := Hue + 1;
if Hue < 0 then
Hue := Hue + 1
else if Hue > 1 then
Hue := Hue - 1;
if 6 * Hue < 1 then
V := M1 + (M2 - M1) * Hue * 6
else if 2 * Hue < 1 then
V := M2
else if 3 * Hue < 2 then
V := M1 + (M2 - M1) * (2/3 - Hue) * 6
else
V := M1;
Result := round(255 * V)
end;
begin
if S = 0 then
begin
R := round(255 * L);
G := R;
B := R
end
else
begin
if L <= 0.5 then
M2 := L * (1 + S)
else
M2 := L + S - L * S;
M1 := 2 * L - M2;
R := HueToColorValue(H + 1/3);
G := HueToColorValue(H);
B := HueToColorValue(H - 1/3)
end;
end;
procedure ColorToHSL(c: TColor; out H, S, L: Double);
begin
RGBtoHSL(GetRValue(c), GetGValue(c), GetBValue(c), H, S, L);
end;
// From: http://www.rapidtables.com/convert/color/rgb-to-hsl.htm
procedure RGBtoHSL(R, G, B: Integer; out H, S, L: Double);
var
rr, gg, bb, Cmax, Cmin, delta: double;
begin
rr := R / 255;
gg := G / 255;
bb := B / 255;
Cmax := MaxValue([rr, gg, bb]);
Cmin := MinValue([rr, gg, bb]);
delta := (Cmax - Cmin);
if delta = 0 then
begin
H := 0;
S := 0;
end else
begin
// Calculate L
L := (Cmax + Cmin) / 2;
// Calculate H
if Cmax = rr then
begin
H := modulo((gg - bb) / delta, 6);
{
H := ((gg - bb) / delta);
H := H - floor(H / 6);
}
H := H * 60;
end else
if Cmax = gg then
H := 60 * ((bb - rr) / delta + 2)
else
if Cmax = bb then
H := 60 * ((rr - gg) / delta + 4)
else
H := 0;
H := H / 360;
// Calculate S
S := delta / (1 - abs(2 * L - 1));
end;
end;
(*
procedure RGBtoHSL(R, G, B: Integer; out H, S, L: Double);
var
rr, gg, bb, D, Cmax, Cmin: double;
begin
rr := R / 255;
gg := G / 255;
bb := B / 255;
Cmax := MaxValue([rr, gg, bb]);
Cmin := MinValue([rr, gg, bb]);
L := (Cmax + Cmin) / 2;
if Cmax = Cmin then
begin
H := 0;
S := 0;
end
else
begin
D := Cmax - Cmin;
//calc S
if L < 0.5 then
S := D / (Cmax + Cmin)
else
S := D / (2 - Cmax - Cmin);
//calc H
if R = Cmax then
H := (gg - bb) / D
else if G = Cmax then
H := 2 + (bb - rr) /D
else
H := 4 + (rr - gg) / D;
H := H / 6;
if H < 0 then
H := H + 1;
end;
end;
*)
//==============================================================================
// HSV color model
//==============================================================================
{ Assumes H, S, V in the range 0..1 and calculates the R, G, B values which are
returned to be in the range 0..255.
From: http://axonflux.com/handy-rgb-to-hsl-and-rgb-to-hsv-color-model-c
}
procedure HSVtoRGB(H, S, V: Double; out R, G, B: Integer);
var
i: Integer;
f: Double;
p, q, t: Double;
procedure MakeRgb(rr, gg, bb: Double);
begin
R := Round(rr * 255);
G := Round(gg * 255);
B := Round(bb * 255);
end;
begin
i := floor(H * 6);
f := H * 6 - i;
p := V * (1 - S);
q := V * (1 - f*S);
t := V * (1 - (1 - f) * S);
case i mod 6 of
0: MakeRGB(V, t, p);
1: MakeRGB(q, V, p);
2: MakeRGB(p, V, t);
3: MakeRGB(p, q, V);
4: MakeRGB(t, p, V);
5: MakeRGB(V, p, q);
else MakeRGB(0, 0, 0);
end;
end;
function HSVToColor(H, S, V: Double): TColor;
var
r, g, b: Integer;
begin
HSVtoRGB(H, S, V, r, g, b);
Result := RgbToColor(r, g, b);
end;
{ Assumes R, G, B to be in range 0..255. Calculates H, S, V in range 0..1
From: http://axonflux.com/handy-rgb-to-hsl-and-rgb-to-hsv-color-model-c }
procedure ColorToHSV(c: TColor; out H, S, V: Double);
begin
RGBToHSV(GetRValue(c), GetGValue(c), GetBValue(c), H, S, V);
end;
procedure RGBToHSV(R, G, B: Integer; out H, S, V: Double);
var
rr, gg, bb: Double;
cmax, cmin, delta: Double;
begin
rr := R / 255;
gg := G / 255;
bb := B / 255;
cmax := MaxValue([rr, gg, bb]);
cmin := MinValue([rr, gg, bb]);
delta := cmax - cmin;
if delta = 0 then
begin
H := 0;
S := 0;
end else
begin
if cmax = rr then
H := (gg - bb) / delta + IfThen(gg < bb, 6, 0)
else if cmax = gg then
H := (bb - rr) / delta + 2
else if (cmax = bb) then
H := (rr -gg) / delta + 4;
H := H / 6;
S := delta / cmax;
end;
V := cmax;
end;
end.

10
components/mbColorLib/mbcolorliblaz.lpk
View File

@ -15,7 +15,7 @@
<Description Value="Comprehensive color selection library with more than 30 components"/>
<License Value="License is granted to use, modify and redistribute these units in your applications as you see fit. You are given COMPLETE FREEDOM with the sources found in this pack; you're free to use it in ANY kind of app without even mentioning my name, my site or any other stuff, that depends on your good will and nothing else. I will accept any modifications and incorporate them in this pack if they'll help make it better. You are under NO obligation to pay for these components to neither me nor anyone else trying to sell them in their current form. If you wish to support development of these components you can do so by contributing some source or making a donation, again this solely depends on your good will."/>
<Version Major="2" Minor="1"/>
<Files Count="46">
<Files Count="48">
<Item1>
<Filename Value="PalUtils.pas"/>
<UnitName Value="PalUtils"/>
@ -202,6 +202,14 @@
<AddToUsesPkgSection Value="False"/>
<UnitName Value="mbReg"/>
</Item46>
<Item47>
<Filename Value="mbcolorconv.pas"/>
<UnitName Value="mbcolorconv"/>
</Item47>
<Item48>
<Filename Value="LVColorPicker.pas"/>
<UnitName Value="LVColorPicker"/>
</Item48>
</Files>
<RequiredPkgs Count="3">
<Item1>

1
components/mbColorLib/mbutils.pas
View File

@ -21,6 +21,7 @@ function IsEmptyRect(R: TRect): Boolean;
const
EMPTY_RECT: TRect = (Left: -1; Top: -1; Right: -1; Bottom: -1);
TWO_PI = 2.0 * pi;
implementation