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; FRed, FGreen, FBlue: integer;
function ArrowPosFromBlue(b: integer): integer; function ArrowPosFromBlue(b: integer): integer;
function BlueFromArrowPos(p: integer): integer; function BlueFromArrowPos(p: integer): integer;
function GetSelectedColor: TColor;
procedure SetBlue(b: integer); procedure SetBlue(b: integer);
procedure SetGreen(g: integer); procedure SetGreen(g: integer);
procedure SetRed(r: integer); procedure SetRed(r: integer);
procedure SetSelectedColor(c: TColor);
protected protected
procedure Execute(tbaAction: integer); override; procedure Execute(tbaAction: integer); override;
function GetArrowPos: integer; override; function GetArrowPos: integer; override;
function GetGradientColor(AValue: Integer): TColor; override; function GetGradientColor(AValue: Integer): TColor; override;
function GetSelectedColor: TColor; override;
function GetSelectedValue: integer; override; function GetSelectedValue: integer; override;
procedure SetSelectedColor(c: TColor); override;
public public
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
published published
property Blue: integer read FBlue write SetBlue default 255; property Blue: integer read FBlue write SetBlue default 255;
property Green: integer read FGreen write SetGreen default 128; property Green: integer read FGreen write SetGreen default 128;
property Red: integer read FRed write SetRed 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 Layout default lyVertical;
property HintFormat;
end; end;

7
components/mbColorLib/CColorPicker.pas
View File

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

3
components/mbColorLib/CIEAColorPicker.pas
View File

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

3
components/mbColorLib/CIEBColorPicker.pas
View File

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

4
components/mbColorLib/CIELColorPicker.pas
View File

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

2
components/mbColorLib/GAxisColorPicker.pas
View File

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

9
components/mbColorLib/GColorPicker.pas
View File

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

210
components/mbColorLib/HColorPicker.pas
View File

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

280
components/mbColorLib/HRingPicker.pas
View File

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

363
components/mbColorLib/HSColorPicker.pas
View File

@ -4,94 +4,77 @@ unit HSColorPicker;
{$MODE DELPHI} {$MODE DELPHI}
{$ENDIF} {$ENDIF}
{$DEFINE USE COLOR_TO_RGB}
interface interface
uses uses
LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Forms, LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Forms,
RGBHSLUtils, HTMLColors, mbColorPickerControl; HTMLColors, mbColorConv, mbColorPickerControl;
type type
{ THSColorPicker } { THSColorPicker }
THSColorPicker = class(TmbColorPickerControl) THSColorPicker = class(TmbHSLVColorPickerControl)
private private
FHue, FSat, FLum, FLumSel: Double; FLumDisp, FValDisp: Double; // Lum and Value used for display
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);
protected protected
procedure CorrectCoords(var x, y: integer);
procedure CreateWnd; override; procedure CreateWnd; override;
procedure DrawMarker(x, y: integer); procedure DrawMarker(x, y: integer);
function GetGradientColor2D(x, y: Integer): TColor; override; function GetGradientColor2D(x, y: Integer): TColor; override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override; function GetSelectedColor: TColor; 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 Paint; override; procedure Paint; override;
function PredictColor: TColor; function PredictColor: TColor;
procedure Resize; override; 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 SetSelectedColor(c: TColor); override;
procedure UpdateCoords; procedure UpdateCoords;
public public
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
function GetColorAtPoint(x, y: Integer): TColor; override; function GetColorAtPoint(x, y: Integer): TColor; override;
function GetSelectedColor: TColor; override;
published published
property SelectedColor default clRed; property SelectedColor default clRed;
property Hue: integer read GetHue write SetHue default 0; property Hue default 0;
property Saturation: integer read GetSat write SetSat default 240; property Saturation default 255;
property Luminance: Integer read GetLum write SetLum default 120; property Luminance default 127;
property MaxHue: Integer read FMaxHue write SetMaxHue default 359; property Value default 255;
property MaxSaturation: Integer read FMaxSat write SetMaxSat default 240; property MaxHue default 360;
property MaxLuminance: Integer read FMaxLum write SetMaxLum default 240; property MaxSaturation default 255;
property MaxLuminance default 255;
property MaxValue default 255;
property MarkerStyle default msCross; property MarkerStyle default msCross;
property OnChange; property OnChange;
end; end;
implementation implementation
uses uses
math, mbUtils; Math, mbUtils;
{THSColorPicker} { THSColorPicker }
constructor THSColorPicker.Create(AOwner: TComponent); constructor THSColorPicker.Create(AOwner: TComponent);
begin begin
inherited; inherited;
FMaxHue := 359; FGradientWidth := FMaxHue; // We want to skip the point at 360° --> no +1
FMaxSat := 240;
FMaxLum := 240;
FGradientWidth := FMaxHue + 1;
FGradientHeight := FMaxSat + 1; FGradientHeight := FMaxSat + 1;
SetInitialBounds(0, 0, FGradientWidth, FGradientHeight); SetInitialBounds(0, 0, FGradientWidth, FGradientHeight);
FHue := 0; FHue := 0;
FSat := 1.0; FSat := 1.0;
FLum := 0.5; FLum := 0.5;
FLumSel := 0.5; FLumDisp := 0.5;
FVal := 1.0;
FValDisp := 1.0;
FSelected := clRed; FSelected := clRed;
CreateGradient; CreateGradient;
HintFormat := 'H: %h S: %hslS'#13'Hex: %hex'; HintFormat := 'H: %h S: %hslS'#13'Hex: %hex';
MarkerStyle := msCross; MarkerStyle := msCross;
end; end;
procedure THSColorPicker.CorrectCoords(var x, y: integer);
begin
Clamp(x, 0, Width - 1);
Clamp(y, 0, Height - 1);
end;
procedure THSColorPicker.CreateWnd; procedure THSColorPicker.CreateWnd;
begin begin
inherited; inherited;
@ -101,16 +84,10 @@ end;
procedure THSColorPicker.DrawMarker(x, y: integer); procedure THSColorPicker.DrawMarker(x, y: integer);
var var
c: TColor; c: TColor;
L: Double; dummy: Double = 0;
begin begin
CorrectCoords(x, y); CorrectCoords(x, y);
ColorToHSLV(FSelected, FHue, FSat, dummy, dummy);
{$IFDEF USE_COLOR_TO_RGB}
ColorToHSL(FSelected, FHue, FSat, L);
{$ELSE}
RGBToHSL(FSelected, FHue, FSat, L);
{$ENDIF}
if Focused or (csDesigning in ComponentState) then if Focused or (csDesigning in ComponentState) then
c := clBlack c := clBlack
else else
@ -124,13 +101,9 @@ var
begin begin
if InRange(x, 0, Width - 1) and InRange(y, 0, Height - 1) then if InRange(x, 0, Width - 1) and InRange(y, 0, Height - 1) then
begin begin
H := x / (Width - 1); H := x / Width; // Width = FMaxHue
S := 1 - y / (Height - 1); S := 1 - y / (Height - 1);
{$IFDEF USE_COLOR_TO_RGB} Result := HSLVtoColor(H, S, FLum, FVal);
Result := HSLToColor(H, S, FLumSel);
{$ELSE}
Result := HSLToRGB(H, S, FLumSel);
{$ENDIF}
end else end else
Result := clNone; Result := clNone;
end; end;
@ -141,121 +114,12 @@ var
begin begin
H := x / FMaxHue; H := x / FMaxHue;
S := 1 - y / FMaxSat; S := 1 - y / FMaxSat;
{$IFDEF USE_COLOR_TO_RGB} Result := HSLVtoColor(H, S, FLumDisp, FValDisp);
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);
end; end;
function THSColorPicker.GetSelectedColor: TColor; function THSColorPicker.GetSelectedColor: TColor;
begin begin
{$IFDEF USE_COLOR_TO_RGB} Result := HSLVtoColor(FHue, FSat, FLum, FVal);
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);
end; end;
procedure THSColorPicker.Paint; procedure THSColorPicker.Paint;
@ -265,15 +129,8 @@ begin
end; end;
function THSColorPicker.PredictColor: TColor; function THSColorPicker.PredictColor: TColor;
var
H, S, L: Double;
begin begin
{$IFDEF USE_COLOR_TO_RGB} Result := GetColorUnderCursor;
ColorToHSL(GetColorUnderCursor, H, S, L);
{$ELSE}
RGBtoHSL(GetColorUnderCursor, H, S, L);
{$ENDIF}
Result := HSLToRGB(H, S, L);
end; end;
procedure THSColorPicker.Resize; procedure THSColorPicker.Resize;
@ -284,7 +141,10 @@ end;
procedure THSColorPicker.SelectColor(x, y: Integer); procedure THSColorPicker.SelectColor(x, y: Integer);
var var
H, S, L: Double; H: Double = 0;
S: Double = 0;
L: Double = 0;
V: Double = 0;
c: TColor; c: TColor;
begin begin
CorrectCoords(x, y); CorrectCoords(x, y);
@ -292,129 +152,59 @@ begin
my := y; my := y;
c := GetColorAtPoint(x, y); c := GetColorAtPoint(x, y);
if WebSafe then c := GetWebSafe(c); 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 if (H = FHue) and (S = FSat) then
exit; exit;
FHue := H; FHue := H;
FSat := S; FSat := S;
{$IFDEF USE_COLOR_TO_RGB} FSelected := HSLVtoColor(FHue, FSat, FLum, FVal);
FSelected := ColorToHSL(FHue, FSat, FLumSel);
{$ELSE}
FSelected := HSLToRGB(FHue, FSat, FLumSel);
{$ENDIF}
Invalidate; Invalidate;
DoChange; DoChange;
end; 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); procedure THSColorPicker.SetMaxHue(H: Integer);
begin begin
if H = FMaxHue then if H = FMaxHue then
exit; exit;
FMaxHue := H; FGradientWidth := H + 1;
FGradientWidth := FMaxHue + 1; inherited;
CreateGradient;
Invalidate;
end;
procedure THSColorPicker.SetMaxLum(L: Integer);
begin
if L = FMaxLum then
exit;
FMaxLum := L;
CreateGradient;
Invalidate;
if Assigned(OnChange) then OnChange(Self);
end; end;
procedure THSColorPicker.SetMaxSat(S: Integer); procedure THSColorPicker.SetMaxSat(S: Integer);
begin begin
if S = FMaxSat then if S = FMaxSat then
exit; exit;
FMaxSat := S; FGradientHeight := S + 1;
FGradientHeight := FMaxSat + 1; inherited;
CreateGradient; 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; 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; end;
// NOTE: In the picker display only the hue and the saturation of the input // NOTE: In the picker display only the hue and the saturation of the input
@ -423,31 +213,32 @@ end;
// input color. // input color.
procedure THSColorPicker.SetSelectedColor(c: TColor); procedure THSColorPicker.SetSelectedColor(c: TColor);
var var
H, S, L: Double; H: Double = 0;
S: Double = 0;
L: Double = 0;
V: Double = 0;
begin begin
if WebSafe then if WebSafe then
c := GetWebSafe(c); c := GetWebSafe(c);
{$IFDEF USE_COLOR_TO_RGB} ColorToHSLV(c, H, S, L, V);
ColorToHSL(c, H, S, L);
{$ELSE}
RGBtoHSL(c, H, S, L);
{$ENDIF}
FSelected := c;
if (H = FHue) and (S = FSat) then if (H = FHue) and (S = FSat) then
exit; exit;
FSelected := c;
FHue := H; FHue := H;
FSat := S; FSat := S;
FLumSel := L; case BrightnessMode of
bmLuminance : FLum := L;
bmValue : FVal := V;
end;
UpdateCoords; UpdateCoords;
Invalidate; Invalidate;
DoChange; DoChange;
end; end;
procedure THSCOlorPicker.UpdateCoords; procedure THSColorPicker.UpdateCoords;
begin begin
mx := Round(FHue * Width); mx := Round(FHue * Width);
my := Round((1.0 - FSat) * Height); my := Round((1.0 - FSat) * Height);

459
components/mbColorLib/HSLColorPicker.pas
View File

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

200
components/mbColorLib/HSLRingPicker.pas
View File

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

298
components/mbColorLib/HSVColorPicker.pas
View File

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

9
components/mbColorLib/HexaColorPicker.pas
View File

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

7
components/mbColorLib/KColorPicker.pas
View File

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

36
components/mbColorLib/LColorPicker.pas
View File

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

42
components/mbColorLib/OfficeMoreColorsDialog.lfm
View File

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

262
components/mbColorLib/OfficeMoreColorsDialog.pas
View File

@ -5,7 +5,7 @@ interface
uses uses
LCLIntf, LCLType, SysUtils, Variants, Classes, Graphics, Controls, Forms, LCLIntf, LCLType, SysUtils, Variants, Classes, Graphics, Controls, Forms,
StdCtrls, ExtCtrls, ComCtrls, StdCtrls, ExtCtrls, ComCtrls,
HexaColorPicker, HSLColorPicker, RGBHSLUtils, mbColorPreview, HexaColorPicker, HSLColorPicker, mbColorConv, mbColorPreview,
{$IFDEF mbXP_Lib}mbXPSpinEdit, mbXPSizeGrip,{$ELSE} Spin,{$ENDIF} {$IFDEF mbXP_Lib}mbXPSpinEdit, mbXPSizeGrip,{$ELSE} Spin,{$ENDIF}
HTMLColors, SLHColorPicker, HSLRingPicker, RColorPicker, GColorPicker, HTMLColors, SLHColorPicker, HSLRingPicker, RColorPicker, GColorPicker,
BColorPicker; BColorPicker;
@ -22,7 +22,7 @@ type
Label6: TLabel; Label6: TLabel;
Label7: TLabel; Label7: TLabel;
Label8: TLabel; Label8: TLabel;
LLum: TLabel; LLumVal: TLabel;
LSat: TLabel; LSat: TLabel;
LHue: TLabel; LHue: TLabel;
nbRGB: TPage; nbRGB: TPage;
@ -51,49 +51,66 @@ type
NewSwatch: TmbColorPreview; NewSwatch: TmbColorPreview;
OldSwatch: TmbColorPreview; OldSwatch: TmbColorPreview;
procedure cbColorDisplayChange(Sender: TObject); procedure cbColorDisplayChange(Sender: TObject);
procedure FormShow(Sender: TObject); procedure ColorPickerChange(Sender: TObject);
procedure HSLChange(Sender: TObject);
procedure ERedChange(Sender: TObject);
procedure EGreenChange(Sender: TObject);
procedure EBlueChange(Sender: TObject); procedure EBlueChange(Sender: TObject);
procedure EGreenChange(Sender: TObject);
procedure EHueChange(Sender: TObject); procedure EHueChange(Sender: TObject);
procedure ELumValChange(Sender: TObject);
procedure ERedChange(Sender: TObject);
procedure ESatChange(Sender: TObject); procedure ESatChange(Sender: TObject);
procedure ELumChange(Sender: TObject);
procedure FormCreate(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 FormResize(Sender: TObject);
procedure FormShow(Sender: TObject);
function GetHint(c: TColor): string; function GetHint(c: TColor): string;
procedure HexaChange(Sender: TObject); procedure HexaChange(Sender: TObject);
procedure HSLChange(Sender: TObject);
procedure HSLRingChange(Sender: TObject); procedure HSLRingChange(Sender: TObject);
procedure NewSwatchColorChange(Sender: TObject); procedure NewSwatchColorChange(Sender: TObject);
procedure OldSwatchColorChange(Sender: TObject); procedure OldSwatchColorChange(Sender: TObject);
procedure PagesChange(Sender: TObject); procedure PagesChange(Sender: TObject);
procedure ColorPickerChange(Sender: TObject); procedure PagesChanging(Sender: TObject; var {%H-}AllowChange: Boolean);
procedure SLHChange(Sender: TObject); procedure SLHChange(Sender: TObject);
private private
{$IFDEF mbXP_Lib} {$IFDEF mbXP_Lib}
ERed, EGreen, EBlue: TmbXPSpinEdit; ERed, EGreen, EBlue: TmbXPSpinEdit;
EHue, ESat, ELum: TmbXPSpinEdit; EHue, ESat, ELumVal: TmbXPSpinEdit;
grip: TmbXPSizeGrip; grip: TmbXPSizeGrip;
{$ELSE} {$ELSE}
ERed, EGreen, EBlue: TSpinEdit; ERed, EGreen, EBlue: TSpinEdit;
EHue, ESat, ELum: TSpinEdit; EHue, ESat, ELumVal: TSpinEdit;
{$ENDIF} {$ENDIF}
FMaxHue: Integer; FMaxHue: Integer;
FMaxSat: Integer; FMaxSat: Integer;
FMaxLum: Integer; FMaxLum: Integer;
FMaxVal: Integer;
FSelectedColor: TColor;
FBrightnessMode: TBrightnessMode;
FLockChange: Integer; FLockChange: Integer;
function GetPickerIndex: Integer;
function GetSelectedColor: TColor;
function GetShowHint: Boolean; function GetShowHint: Boolean;
procedure SetAllCustom(c: TColor); procedure SetAllCustom(c: TColor);
procedure SetAllToSel(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); procedure SetShowHint(AValue: boolean);
protected protected
procedure BeginUpdate;
procedure CreateParams(var Params: TCreateParams); override; procedure CreateParams(var Params: TCreateParams); override;
// procedure CreateWnd; override; procedure EndUpdate;
public public
property MaxHue: Integer read FMaxHue write FMaxHue; property PickerIndex: Integer read GetPickerIndex write SetPickerIndex;
property MaxSaturation: Integer read FMaxSat write FMaxSat; property SelectedColor: TColor read GetSelectedColor write SetSelectedColor;
property MaxLuminance: Integer read FMaxLum write FMaxLum; 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 published
property ShowHint: Boolean read GetShowHint write SetShowHint; property ShowHint: Boolean read GetShowHint write SetShowHint;
end; end;
@ -105,8 +122,16 @@ implementation
{$R *.lfm} {$R *.lfm}
procedure TOfficeMoreColorsWin.BeginUpdate;
begin
inc(FLockChange);
end;
procedure TOfficeMoreColorsWin.ColorPickerChange(Sender: TObject); procedure TOfficeMoreColorsWin.ColorPickerChange(Sender: TObject);
begin begin
if FLockChange > 0 then
exit;
if Sender = HSL then if Sender = HSL then
SetAllCustom(HSL.SelectedColor); SetAllCustom(HSL.SelectedColor);
if Sender = HSLRing then if Sender = HSLRing then
@ -183,27 +208,42 @@ begin
try try
HSL.Hue := EHue.Value; HSL.Hue := EHue.Value;
SLH.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 finally
dec(FLockChange); dec(FLockChange);
end; end;
end; end;
end; end;
procedure TOfficeMoreColorsWin.ELumChange(Sender: TObject); procedure TOfficeMoreColorsWin.ELumValChange(Sender: TObject);
begin begin
if (ELum.Text <> '') and ELum.Focused and (FLockChange = 0) then if (ELumVal.Text <> '') and ELumVal.Focused and (FLockChange = 0) then
begin begin
inc(FLockChange); inc(FLockChange);
try try
HSL.Luminance := ELum.Value; HSL.Luminance := ELumVal.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 finally
dec(FLockChange); dec(FLockChange);
end; end;
end; end;
end; end;
procedure TOfficeMoreColorsWin.EndUpdate;
begin
dec(FLockChange);
end;
procedure TOfficeMoreColorsWin.ERedChange(Sender: TObject); procedure TOfficeMoreColorsWin.ERedChange(Sender: TObject);
begin begin
if (ERed.Text <> '') and ERed.Focused and (FLockChange = 0) then if (ERed.Text <> '') and ERed.Focused and (FLockChange = 0) then
@ -227,7 +267,12 @@ begin
try try
HSL.Saturation := ESat.Value; HSL.Saturation := ESat.Value;
SLH.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 finally
dec(FLockChange); dec(FLockChange);
end; end;
@ -236,21 +281,27 @@ end;
procedure TOfficeMoreColorsWin.FormCreate(Sender: TObject); procedure TOfficeMoreColorsWin.FormCreate(Sender: TObject);
begin begin
FMaxHue := 359; FBrightnessMode := bmLuminance;
FMaxSat := 240;
FMaxLum := 240; FMaxHue := 360;
FMaxSat := 255;
FMaxLum := 255;
FMaxVal := 255;
HSL.MaxHue := FMaxHue; HSL.MaxHue := FMaxHue;
HSL.MaxSaturation := FMaxSat; HSL.MaxSaturation := FMaxSat;
HSL.MaxLuminance := FMaxLum; HSL.MaxLuminance := FMaxLum;
HSL.BrightnessMode := FBrightnessMode;
HSLRing.MaxHue := FMaxHue; HSLRing.MaxHue := FMaxHue;
HSLRing.MaxSaturation := FMaxSat; HSLRing.MaxSaturation := FMaxSat;
HSLRing.MaxLuminance := FMaxLum; HSLRing.MaxLuminance := FMaxLum;
HSLRing.BrightnessMode := FBrightnessMode;
SLH.MaxHue := FMaxHue; SLH.MaxHue := FMaxHue;
SLH.MaxSaturation := FMaxSat; SLH.MaxSaturation := FMaxSat;
SLH.MaxLuminance := FMaxLum; SLH.MaxLuminance := FMaxLum;
SLH.BrightnessMode := FBrightnessMode;
{$IFDEF mbXP_Lib} {$IFDEF mbXP_Lib}
ERed := TmbXPSpinEdit.CreateParented(Custom.Handle); ERed := TmbXPSpinEdit.CreateParented(Custom.Handle);
@ -263,7 +314,7 @@ begin
EBlue := TSpinEdit.CreateParented(Custom.Handle); EBlue := TSpinEdit.CreateParented(Custom.Handle);
EHue := TSpinEdit.CreateParented(Custom.Handle); EHue := TSpinEdit.CreateParented(Custom.Handle);
ESat := TSpinEdit.CreateParented(Custom.Handle); ESat := TSpinEdit.CreateParented(Custom.Handle);
ELum := TSpinEdit.CreateParented(Custom.Handle); ELumVal := TSpinEdit.CreateParented(Custom.Handle);
{$ENDIF} {$ENDIF}
with ERed do with ERed do
begin begin
@ -340,9 +391,9 @@ begin
OnChange := @ESatChange; OnChange := @ESatChange;
// TabOrder := EHue.TabOrder + 1; // TabOrder := EHue.TabOrder + 1;
end; end;
with ELum do with ELumVal do
begin begin
Name := 'ELum'; Name := 'ELumVal';
Width := 47; Width := 47;
Height := 22; Height := 22;
Left := cbColorDisplay.Left + cbColorDisplay.Width - Width; Left := cbColorDisplay.Left + cbColorDisplay.Width - Width;
@ -352,7 +403,7 @@ begin
MaxValue := FMaxLum; MaxValue := FMaxLum;
MinValue := 0; MinValue := 0;
Value := 0; Value := 0;
OnChange := @ELumChange; OnChange := @ELumValChange;
// TabOrder := ESat.TabOrder + 1; // TabOrder := ESat.TabOrder + 1;
end; end;
Custom.InsertControl(ERed); Custom.InsertControl(ERed);
@ -360,7 +411,7 @@ begin
Custom.InsertControl(EBlue); Custom.InsertControl(EBlue);
Custom.InsertControl(EHue); Custom.InsertControl(EHue);
Custom.InsertControl(ESat); Custom.InsertControl(ESat);
Custom.InsertControl(ELum); Custom.InsertControl(ELumVal);
{$IFDEF mbXP_Lib} {$IFDEF mbXP_Lib}
with grip do with grip do
@ -375,7 +426,7 @@ begin
InsertControl(grip); InsertControl(grip);
{$ENDIF} {$ENDIF}
OKBtn.TabOrder := ELum.TabOrder + 1; OKBtn.TabOrder := ELumVal.TabOrder + 1;
CancelBtn.TabOrder := OKBtn.TabOrder + 1; CancelBtn.TabOrder := OKBtn.TabOrder + 1;
end; end;
@ -415,6 +466,32 @@ begin
]); ]);
end; 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; function TOfficeMoreColorsWin.GetShowHint: Boolean;
begin begin
Result := inherited ShowHint; Result := inherited ShowHint;
@ -436,13 +513,14 @@ begin
end; end;
procedure TOfficeMoreColorsWin.NewSwatchColorChange(Sender: TObject); procedure TOfficeMoreColorsWin.NewSwatchColorChange(Sender: TObject);
var
r,g,b: Integer;
h,s,l: Integer;
begin begin
NewSwatch.Hint := GetHint(NewSwatch.Color); NewSwatch.Hint := GetHint(NewSwatch.Color);
exit;
if (ERed = nil) or (EBlue = nil) or (EGreen = nil) or 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 then
exit; exit;
@ -452,33 +530,57 @@ end;
procedure TOfficeMoreColorsWin.OldSwatchColorChange(Sender: TObject); procedure TOfficeMoreColorsWin.OldSwatchColorChange(Sender: TObject);
begin begin
OldSwatch.Hint := GetHint(OldSwatch.Color); OldSwatch.Hint := GetHint(OldSwatch.Color);
SetAllToSel(OldSwatch.Color);
//SetAllToSel(OldSwatch.Color);
end; end;
procedure TOfficeMoreColorsWin.PagesChange(Sender: TObject); procedure TOfficeMoreColorsWin.PagesChange(Sender: TObject);
begin 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; end;
procedure TOfficeMoreColorsWin.SetAllCustom(c: TColor); procedure TOfficeMoreColorsWin.SetAllCustom(c: TColor);
var var
r, g, b: Integer; r, g, b: Integer;
H, S, L: Double; H, S, L, V: Double;
// h, s, l: Integer;
begin begin
if (ERed = nil) or (EGreen = nil) or (EBlue = nil) or 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) (PickerNotebook = nil) or (HSL = nil) or (HSLRing = nil) or (SLH = nil)
or (FLockChange > 0)
then then
exit; exit;
BeginUpdate;
NewSwatch.Color := c; NewSwatch.Color := c;
r := GetRValue(c); r := GetRValue(c);
g := GetGValue(c); g := GetGValue(c);
b := GetBValue(c); b := GetBValue(c);
RGBToHSL(c, H, S, L); case FBrightnessMode of
// RGBtoHSLRange(c, h, s, l); bmLuminance : ColorToHSL(c, H, S, L);
bmValue : ColortoHSV(c, H, S, V);
end;
if PickerNotebook.ActivePage = nbHSL.Name then if PickerNotebook.ActivePage = nbHSL.Name then
HSL.SelectedColor := c HSL.SelectedColor := c
@ -503,13 +605,17 @@ begin
EBlue.Value := b; EBlue.Value := b;
EHue.Value := H * HSL.MaxHue; EHue.Value := H * HSL.MaxHue;
ESat.Value := S * HSL.MaxSaturation; 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; end;
procedure TOfficeMoreColorsWin.SetAllToSel(c: TColor); procedure TOfficeMoreColorsWin.SetAllToSel(c: TColor);
var
h, s, l: Integer;
begin begin
//inc(FLockChange);
case Pages.ActivePageIndex of case Pages.ActivePageIndex of
// Standard Page // Standard Page
0: Hexa.SelectedColor := c; 0: Hexa.SelectedColor := c;
@ -517,6 +623,71 @@ begin
1: SetAllCustom(c); 1: SetAllCustom(c);
end; end;
NewSwatch.Color := c; 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; end;
procedure TOfficeMoreColorsWin.SetShowHint(AValue: Boolean); procedure TOfficeMoreColorsWin.SetShowHint(AValue: Boolean);
@ -526,6 +697,9 @@ begin
HSL.ShowHint := AValue; HSL.ShowHint := AValue;
HSLRing.ShowHint := AValue; HSLRing.ShowHint := AValue;
SLH.ShowHint := AValue; SLH.ShowHint := AValue;
RTrackbar.ShowHint := AValue;
GTrackbar.ShowHint := AValue;
BTrackbar.ShowHint := AValue;
end; end;
procedure TOfficeMoreColorsWin.SLHChange(Sender: TObject); 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 //saves a string list to a JASC .pal file
procedure SaveJASCPal(pal: TStrings; FileName: TFileName); procedure SaveJASCPal(pal: TStrings; FileName: TFileName);
(*
//reads Photoshop .aco file into an Aco record //reads Photoshop .aco file into an Aco record
function ReadPhotoshopAco(PalFile: TFileName): AcoColors; function ReadPhotoshopAco(PalFile: TFileName): AcoColors;
//reads Photoshop .act file //reads Photoshop .act file
function ReadPhotoshopAct(PalFile: TFileName): string; function ReadPhotoshopAct(PalFile: TFileName): string;
*)
implementation implementation
@ -87,7 +87,7 @@ function FormatHint(fmt: string; c: TColor): string;
var var
h: string; h: string;
begin begin
h := AnsiReplaceText(fmt, '%hex', ColorToHex(c)); h := AnsiReplaceText(fmt, '%hex', '#' + ColorToHex(c));
h := AnsiReplaceText(h, '%cieL', IntToStr(Round(GetCIElValue(c)))); h := AnsiReplaceText(h, '%cieL', IntToStr(Round(GetCIElValue(c))));
h := AnsiReplaceText(h, '%cieA', IntToStr(Round(GetCIEaValue(c)))); h := AnsiReplaceText(h, '%cieA', IntToStr(Round(GetCIEaValue(c))));
h := AnsiReplaceText(h, '%cieB', IntToStr(Round(GetCIEbValue(c)))); h := AnsiReplaceText(h, '%cieB', IntToStr(Round(GetCIEbValue(c))));
@ -579,7 +579,7 @@ begin
s[i] := WideChar(w); s[i] := WideChar(w);
end; end;
end; end;
(*
function GetAcoColor(space,w,x,y,z: word): TColor; function GetAcoColor(space,w,x,y,z: word): TColor;
begin begin
case space of case space of
@ -711,5 +711,5 @@ begin
end; end;
CloseFile(f); CloseFile(f);
end; end;
*)
end. end.

2
components/mbColorLib/RAxisColorPicker.pas
View File

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

9
components/mbColorLib/RColorPicker.pas
View File

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

25
components/mbColorLib/RGBCIEUtils.pas
View File

@ -243,7 +243,8 @@ end;
procedure RGBToLCH(clr: TColor; var l, c, h: double); procedure RGBToLCH(clr: TColor; var l, c, h: double);
var var
a, b: double; a: Double = 0;
b: Double = 0;
begin begin
RGBToLab(clr, l, a, b); RGBToLab(clr, l, a, b);
LabToLCH(l, a, b, l, c, h); LabToLCH(l, a, b, l, c, h);
@ -251,7 +252,9 @@ end;
function LCHToRGB(l, c, h: double): TColor; function LCHToRGB(l, c, h: double): TColor;
var var
lum, a, b: double; lum: Double = 0;
a: Double = 0;
b: double = 0;
begin begin
LCHToLab(l, c, h, lum, a, b); LCHToLab(l, c, h, lum, a, b);
Result := LabToRGB(lum, a, b); Result := LabToRGB(lum, a, b);
@ -283,36 +286,38 @@ end;
function GetCIELValue(c: TColor): double; function GetCIELValue(c: TColor): double;
var var
d: real; d: Double = 0;
begin begin
XYZToLab(RGBToXYZ(c), Result, d, d); XYZToLab(RGBToXYZ(c), Result{%H-}, d, d);
end; end;
function GetCIEAValue(c: TColor): double; function GetCIEAValue(c: TColor): double;
var var
d: double; d: double = 0;
begin begin
XYZToLab(RGBToXYZ(c), d, Result, d); XYZToLab(RGBToXYZ(c), d, Result{%H-}, d);
end; end;
function GetCIEBValue(c: TColor): double; function GetCIEBValue(c: TColor): double;
var var
d: double; d: double = 0;
begin begin
XYZToLab(RGBToXYZ(c), d, d, Result); XYZToLab(RGBToXYZ(c), d, d, Result{%H-});
end; end;
function GetCIECValue(c: TColor): double; function GetCIECValue(c: TColor): double;
var var
d: double; d: double = 0;
begin begin
Result := 0.0;
RGBToLCH(c, d, Result, d); RGBToLCH(c, d, Result, d);
end; end;
function GetCIEHValue(c: TColor): double; function GetCIEHValue(c: TColor): double;
var var
d: double; d: double = 0;
begin begin
Result := 0.0;
RGBToLCH(c, d, d, Result); RGBToLCH(c, d, d, Result);
end; 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; MaxSat: integer = 240;
MaxLum: 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; 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; 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); procedure RGBtoHSLRange(RGB: TColor; out H1, S1, L1: integer);
function GetHValue(AColor: TColor): integer; function GetHValue(AColor: TColor): integer;
@ -36,7 +36,7 @@ implementation
uses uses
mbUtils; mbUtils;
(*
procedure ColorToHSL(AColor: TColor; var H, S, L: Double); procedure ColorToHSL(AColor: TColor; var H, S, L: Double);
function RGBMaxValue(r, g, b: Double): Double; function RGBMaxValue(r, g, b: Double): Double;
@ -81,7 +81,7 @@ begin
if H < 0 then H := H + 360; if H < 0 then H := H + 360;
H := H / 360; H := H / 360;
end; end;
end; end; *)
function HSLtoColor(H, S, L: Double): TColor; function HSLtoColor(H, S, L: Double): TColor;
const const
@ -133,9 +133,6 @@ var
begin begin
if Hue > 10 then if Hue > 10 then
Hue := Hue + 1; Hue := Hue + 1;
if Hue < 0 then if Hue < 0 then
Hue := Hue + 1 Hue := Hue + 1
else if Hue > 1 then else if Hue > 1 then
@ -224,9 +221,6 @@ procedure RGBtoHSLRange(RGB: TColor; out H1, S1, L1: integer);
var var
R, G, B, D, Cmax, Cmin, h, s, l: double; R, G, B, D, Cmax, Cmin, h, s, l: double;
begin begin
H := h1;
S := s1;
L := l1;
R := GetRValue(RGB) / 255; R := GetRValue(RGB) / 255;
G := GetGValue(RGB) / 255; G := GetGValue(RGB) / 255;
B := GetBValue(RGB) / 255; B := GetBValue(RGB) / 255;

10
components/mbColorLib/RGBHSVUtils.pas
View File

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

208
components/mbColorLib/SColorPicker.pas
View File

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

343
components/mbColorLib/SLColorPicker.pas
View File

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

276
components/mbColorLib/SLHColorPicker.pas
View File

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

6
components/mbColorLib/ScreenWin.pas
View File

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

22
components/mbColorLib/VColorPicker.pas
View File

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

16
components/mbColorLib/YColorPicker.pas
View File

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

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

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

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

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

7
components/mbColorLib/mbBasicPicker.pas
View File

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

6
components/mbColorLib/mbColorPalette.pas
View File

@ -64,7 +64,7 @@ type
procedure DrawCell(ACanvas: TCanvas; AColor: string); procedure DrawCell(ACanvas: TCanvas; AColor: string);
procedure DrawCellBack(ACanvas: TCanvas; R: TRect; AIndex: integer); procedure DrawCellBack(ACanvas: TCanvas; R: TRect; AIndex: integer);
function GetColorUnderCursor: TColor; override; function GetColorUnderCursor: TColor; override;
function GetHintStr(X, Y: Integer): String; override; function GetHintStr({%H-}X, {%H-}Y: Integer): String; override;
function GetIndexUnderCursor: integer; function GetIndexUnderCursor: integer;
procedure KeyDown(var Key: Word; Shift: TShiftState); override; procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
@ -146,8 +146,6 @@ type
implementation implementation
uses
mbUtils;
{ TmbColorPalette } { TmbColorPalette }
@ -684,6 +682,7 @@ begin
FNames.Clear; FNames.Clear;
FColors.Text := ReadJASCPal(FileName); FColors.Text := ReadJASCPal(FileName);
end end
(*
else if SameText(ExtractFileExt(FileName), '.aco') then else if SameText(ExtractFileExt(FileName), '.aco') then
begin begin
supported := true; supported := true;
@ -702,6 +701,7 @@ begin
FNames.Clear; FNames.Clear;
FColors.Text := ReadPhotoshopAct(FileName); FColors.Text := ReadPhotoshopAct(FileName);
end end
*)
else 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'); 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 if supported then

357
components/mbColorLib/mbColorPickerControl.pas
View File

@ -6,7 +6,7 @@ interface
uses uses
LCLIntf, LCLType, LMessages, SysUtils, Classes, Controls, Graphics, Forms, Themes, LCLIntf, LCLType, LMessages, SysUtils, Classes, Controls, Graphics, Forms, Themes,
RGBHSLUtils, RGBHSVUtils, RGBCMYKUtils, RGBCIEUtils, HTMLColors, mbBasicPicker; HTMLColors, mbColorConv, mbBasicPicker;
type type
TMarkerStyle = (msCircle, msSquare, msCross, msCrossCirc); TMarkerStyle = (msCircle, msSquare, msCross, msCrossCirc);
@ -21,24 +21,22 @@ type
procedure SetMarkerStyle(s: TMarkerStyle); procedure SetMarkerStyle(s: TMarkerStyle);
procedure SetWebSafe(s: boolean); procedure SetWebSafe(s: boolean);
protected protected
FManual: Boolean;
FSelected: TColor; FSelected: TColor;
mx, my: integer; mx, my: integer;
procedure CreateGradient; override; procedure CreateGradient; override;
function GetHintStr(X, Y: Integer): String; override; function GetHintStr({%H-}X, {%H-}Y: Integer): String; override;
function GetSelectedColor: TColor; virtual; function GetSelectedColor: TColor; override;
procedure InternalDrawMarker(X, Y: Integer; C: TColor); procedure InternalDrawMarker(X, Y: Integer; C: TColor);
procedure SetSelectedColor(C: TColor); virtual; procedure SetSelectedColor(C: TColor); override;
procedure WebSafeChanged; dynamic; procedure WebSafeChanged; dynamic;
procedure CMGotFocus(var Message: TLMessage); message CM_ENTER; procedure CMGotFocus(var Message: TLMessage); message CM_ENTER;
procedure CMLostFocus(var Message: TLMessage); message CM_EXIT; 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; property MarkerStyle: TMarkerStyle read FMarkerStyle write SetMarkerStyle;
public public
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
property ColorUnderCursor; property ColorUnderCursor;
published published
property SelectedColor: TColor read GetSelectedColor write SetSelectedColor;
property HintFormat: string read FHintFormat write FHintFormat; property HintFormat: string read FHintFormat write FHintFormat;
property WebSafe: boolean read FWebSafe write SetWebSafe default false; property WebSafe: boolean read FWebSafe write SetWebSafe default false;
end; end;
@ -78,11 +76,70 @@ type
property OnStartDrag; property OnStartDrag;
end; 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 implementation
uses uses
IntfGraphics, fpimage, Math, IntfGraphics, fpimage,
ScanLines, PalUtils, SelPropUtils; PalUtils, SelPropUtils, mbUtils;
constructor TmbCustomPicker.Create(AOwner: TComponent); constructor TmbCustomPicker.Create(AOwner: TComponent);
begin begin
@ -107,14 +164,14 @@ begin
inherited; inherited;
Invalidate; Invalidate;
end; end;
(*
procedure TmbCustomPicker.CMMouseLeave(var Message: TLMessage); procedure TmbCustomPicker.CMMouseLeave(var Message: TLMessage);
begin begin
mx := 0; mx := 0;
my := 0; my := 0;
inherited; inherited;
end; end;
*)
procedure TmbCustomPicker.CreateGradient; procedure TmbCustomPicker.CreateGradient;
var var
x, y: Integer; x, y: Integer;
@ -205,4 +262,282 @@ begin
Invalidate; Invalidate;
end; 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. end.

4
components/mbColorLib/mbColorTree.pas
View File

@ -35,12 +35,12 @@ type
protected protected
procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW; procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW;
function CustomDrawItem(Node: TTreeNode; State: TCustomDrawState; 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 DoArrow(c: TCanvas; dir: TScrollDirection; p: TPoint; sel: boolean);
procedure DrawColorItem(R: TRect; Selected: boolean; AIndex: Integer; procedure DrawColorItem(R: TRect; Selected: boolean; AIndex: Integer;
AItemText: String; Expanded: boolean); dynamic; AItemText: String; Expanded: boolean); dynamic;
procedure DrawInfoItem(R: TRect; Index: integer); 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 MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
public public

4
components/mbColorLib/mbDeskPickerButton.pas
View File

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

20
components/mbColorLib/mbOfficeColorDialog.pas
View File

@ -15,15 +15,16 @@ type
FSelColor: TColor; FSelColor: TColor;
FUseHint: boolean; FUseHint: boolean;
FMaxHue, FMaxSat, FMaxLum: Integer; FMaxHue, FMaxSat, FMaxLum: Integer;
FPickerIndex: Integer;
public public
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
function Execute: boolean; overload; function Execute: boolean; overload;
function Execute(AColor: TColor): boolean; overload; function Execute(AColor: TColor): boolean; overload;
published published
property SelectedColor: TColor read FSelColor write FSelColor default clWhite; property SelectedColor: TColor read FSelColor write FSelColor default clWhite;
property MaxHue: Integer read FMaxHue write FMaxHue default 359; property MaxHue: Integer read FMaxHue write FMaxHue default 360;
property MaxSaturation: Integer read FMaxSat write FMaxSat default 240; property MaxSaturation: Integer read FMaxSat write FMaxSat default 255;
property MaxLuminance: Integer read FMaxLum write FMaxLum default 240; property MaxLuminance: Integer read FMaxLum write FMaxLum default 255;
property UseHints: boolean read FUseHint write FUseHint default false; property UseHints: boolean read FUseHint write FUseHint default false;
end; end;
@ -36,9 +37,9 @@ begin
inherited; inherited;
FSelColor := clWhite; FSelColor := clWhite;
FUseHint := false; FUseHint := false;
FMaxHue := 359; FMaxHue := 360;
FMaxSat := 240; FMaxSat := 255;
FMaxLum := 240; FMaxLum := 255;
end; end;
function TmbOfficeColorDialog.Execute: boolean; function TmbOfficeColorDialog.Execute: boolean;
@ -50,16 +51,19 @@ function TmbOfficeColorDialog.Execute(AColor: TColor): boolean;
begin begin
FWin := TOfficeMoreColorsWin.Create(Application); FWin := TOfficeMoreColorsWin.Create(Application);
try try
FWin.OldSwatch.Color := AColor;
FWin.ShowHint := FUseHint; FWin.ShowHint := FUseHint;
FWin.MaxHue := FMaxHue; FWin.MaxHue := FMaxHue;
FWin.MaxSaturation := FMaxSat; FWin.MaxSaturation := FMaxSat;
FWin.MaxLuminance := FMaxLum; FWin.MaxLuminance := FMaxLum;
FWin.PickerIndex := FPickerIndex;
// FWin.OldSwatch.Color := AColor;
FWin.SelectedColor := AColor;
Result := (FWin.ShowModal = IdOK); Result := (FWin.ShowModal = IdOK);
if Result then if Result then
FSelColor := FWin.NewSwatch.Color FSelColor := FWin.SelectedColor //FWin.NewSwatch.Color
else else
FSelColor := clNone; FSelColor := clNone;
FPickerIndex := FWin.PickerIndex;
finally finally
FWin.Free; FWin.Free;
end; 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 +' '#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 +#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, RAxisColorPicker, GAxisColorPicker, BAxisColorPicker,
CColorPicker, MColorPicker, YColorPicker, KColorPicker, CColorPicker, MColorPicker, YColorPicker, KColorPicker,
HRingPicker, HRingPicker,
HColorPicker, SColorPicker, LColorPicker, VColorPicker, HColorPicker, SColorPicker, LVColorPicker, LColorPicker, VColorPicker,
HSColorPicker, HSVColorPicker, HSLColorPicker, HSLRingPicker, HSColorPicker, HSVColorPicker, HSLColorPicker, HSLRingPicker,
SLColorPicker, SLHColorPicker, SLColorPicker, SLHColorPicker,
CIEAColorPicker, CIEBColorPicker, CIELColorPicker, CIEAColorPicker, CIEBColorPicker, CIELColorPicker,
@ -34,7 +34,7 @@ begin
TRAxisColorPicker, TGAxisColorPicker, TBAxisColorPicker, TRAxisColorPicker, TGAxisColorPicker, TBAxisColorPicker,
TCColorPicker, TMColorPicker, TYColorPicker, TKColorPicker, TCColorPicker, TMColorPicker, TYColorPicker, TKColorPicker,
THRingPicker, THRingPicker,
THColorPicker, TSColorPicker, TLColorPicker, TVColorPicker, THColorPicker, TSColorPicker, TLVColorPicker, TLColorPicker, TVColorPicker,
THSColorPicker, THSVColorPicker, THSLColorPicker, THSLRingPicker, THSColorPicker, THSVColorPicker, THSLColorPicker, THSLRingPicker,
TSLColorPicker, TSLHColorPicker, TSLColorPicker, TSLHColorPicker,
TCIEAColorPicker, TCIEBColorPicker, TCIELColorPicker, TCIEAColorPicker, TCIEBColorPicker, TCIELColorPicker,

238
components/mbColorLib/mbTrackBarPicker.pas
View File

@ -7,7 +7,7 @@ interface
uses uses
LCLIntf, LCLType, LMessages, SysUtils, Classes, Controls, Graphics, Forms, LCLIntf, LCLType, LMessages, SysUtils, Classes, Controls, Graphics, Forms,
Themes, ExtCtrls, Themes, ExtCtrls,
PalUtils, mbBasicPicker; PalUtils, mbColorConv, mbBasicPicker;
const const
TBA_Resize = 0; TBA_Resize = 0;
@ -86,6 +86,7 @@ type
procedure SetBorderStyle(Value: TBorderStyle); override; procedure SetBorderStyle(Value: TBorderStyle); override;
procedure CMGotFocus(var Message: TLMessage); message CM_ENTER; procedure CMGotFocus(var Message: TLMessage); message CM_ENTER;
procedure CMLostFocus(var Message: TLMessage); message CM_EXIT; procedure CMLostFocus(var Message: TLMessage); message CM_EXIT;
property HintFormat: string read FHintFormat write FHintFormat;
public public
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
@ -96,7 +97,6 @@ type
property BevelOuter: TPanelBevel read FBevelOuter write SetBevelOuter default bvNone; property BevelOuter: TPanelBevel read FBevelOuter write SetBevelOuter default bvNone;
property BevelWidth: TBevelWidth read FBevelWidth write SetBevelWidth default 1; property BevelWidth: TBevelWidth read FBevelWidth write SetBevelWidth default 1;
property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsNone; 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 Increment: integer read FIncrement write FIncrement default 1;
property Layout: TTrackBarLayout read FLayout write SetLayout default lyHorizontal; property Layout: TTrackBarLayout read FLayout write SetLayout default lyHorizontal;
property ArrowPlacement: TSliderPlacement read FPlacement write SetPlacement default spAfter; property ArrowPlacement: TSliderPlacement read FPlacement write SetPlacement default spAfter;
@ -140,11 +140,58 @@ type
property OnStartDrag; property OnStartDrag;
end; 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 implementation
uses uses
IntfGraphics, fpimage, Math, IntfGraphics, fpimage, Math,
ScanLines, HTMLColors; mbUtils, HTMLColors;
const const
{ 3D border styles } { 3D border styles }
@ -634,7 +681,6 @@ begin
my := Y; my := Y;
FArrowPos := IfThen(FLayout = lyHorizontal, XToArrowPos(X), YToArrowPos(Y)); FArrowPos := IfThen(FLayout = lyHorizontal, XToArrowPos(X), YToArrowPos(Y));
Execute(TBA_MouseDown); Execute(TBA_MouseDown);
//Invalidate;
end; end;
inherited; inherited;
end; end;
@ -653,7 +699,6 @@ begin
my := Y; my := Y;
FArrowPos := IfThen(FLayout = lyHorizontal, XToArrowPos(X), YToArrowPos(Y)); FArrowPos := IfThen(FLayout = lyHorizontal, XToArrowPos(X), YToArrowPos(Y));
Execute(TBA_MouseMove); Execute(TBA_MouseMove);
// Invalidate;
end; end;
inherited; inherited;
end; end;
@ -666,7 +711,6 @@ begin
my := Y; my := Y;
FArrowPos := IfThen(FLayout = lyHorizontal, XToArrowPos(X), YToArrowPos(Y)); FArrowPos := IfThen(FLayout = lyHorizontal, XToArrowPos(X), YToArrowPos(Y));
Execute(TBA_MouseUp); Execute(TBA_MouseUp);
// Invalidate;
end; end;
inherited; inherited;
@ -804,4 +848,186 @@ begin
Result := pos; Result := pos;
end; 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. 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"/> <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."/> <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"/> <Version Major="2" Minor="1"/>
<Files Count="46"> <Files Count="48">
<Item1> <Item1>
<Filename Value="PalUtils.pas"/> <Filename Value="PalUtils.pas"/>
<UnitName Value="PalUtils"/> <UnitName Value="PalUtils"/>
@ -202,6 +202,14 @@
<AddToUsesPkgSection Value="False"/> <AddToUsesPkgSection Value="False"/>
<UnitName Value="mbReg"/> <UnitName Value="mbReg"/>
</Item46> </Item46>
<Item47>
<Filename Value="mbcolorconv.pas"/>
<UnitName Value="mbcolorconv"/>
</Item47>
<Item48>
<Filename Value="LVColorPicker.pas"/>
<UnitName Value="LVColorPicker"/>
</Item48>
</Files> </Files>
<RequiredPkgs Count="3"> <RequiredPkgs Count="3">
<Item1> <Item1>

1
components/mbColorLib/mbutils.pas
View File

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