From b24e7d5d2c7722e77e22dc3836e4e8e251410cea Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Thu, 5 Jan 2017 18:49:22 +0000 Subject: [PATCH] mbColorLib: Add property BrightnessMode (Luminance or Value) to most pickers to get consistent usage of luminance of value parameters. Add new LVColorPicker (switchable between Luminance and Value). Office dialog working again (still buggy). git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5596 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/mbColorLib/BColorPicker.pas | 7 +- components/mbColorLib/CColorPicker.pas | 7 +- components/mbColorLib/CIEAColorPicker.pas | 3 +- components/mbColorLib/CIEBColorPicker.pas | 3 +- components/mbColorLib/CIELColorPicker.pas | 4 +- components/mbColorLib/GAxisColorPicker.pas | 2 - components/mbColorLib/GColorPicker.pas | 9 +- components/mbColorLib/HColorPicker.pas | 210 +++----- components/mbColorLib/HRingPicker.pas | 280 +++-------- components/mbColorLib/HSColorPicker.pas | 363 +++----------- components/mbColorLib/HSLColorPicker.pas | 459 +++++++++++------- components/mbColorLib/HSLRingPicker.pas | 200 ++++---- components/mbColorLib/HSVColorPicker.pas | 298 ++---------- components/mbColorLib/HexaColorPicker.pas | 9 +- components/mbColorLib/KColorPicker.pas | 7 +- components/mbColorLib/LColorPicker.pas | 36 +- components/mbColorLib/LVColorPicker.pas | 335 +++++++++++++ components/mbColorLib/MColorPicker.pas | 7 +- .../mbColorLib/OfficeMoreColorsDialog.lfm | 42 +- .../mbColorLib/OfficeMoreColorsDialog.pas | 262 ++++++++-- components/mbColorLib/PalUtils.pas | 10 +- components/mbColorLib/RAxisColorPicker.pas | 2 - components/mbColorLib/RColorPicker.pas | 9 +- components/mbColorLib/RGBCIEUtils.pas | 25 +- components/mbColorLib/RGBHSLUtils.pas | 16 +- components/mbColorLib/RGBHSVUtils.pas | 10 +- components/mbColorLib/SColorPicker.pas | 208 +++----- components/mbColorLib/SLColorPicker.pas | 343 +++++-------- components/mbColorLib/SLHColorPicker.pas | 276 ++++++----- components/mbColorLib/ScreenWin.pas | 6 +- components/mbColorLib/VColorPicker.pas | 22 +- components/mbColorLib/YColorPicker.pas | 16 +- .../mbColorLib/examples/fulldemo/main.lfm | 111 +++-- .../mbColorLib/examples/fulldemo/main.pas | 51 +- components/mbColorLib/mbBasicPicker.pas | 7 +- components/mbColorLib/mbColorPalette.pas | 6 +- .../mbColorLib/mbColorPickerControl.pas | 357 +++++++++++++- components/mbColorLib/mbColorTree.pas | 4 +- components/mbColorLib/mbDeskPickerButton.pas | 4 +- components/mbColorLib/mbOfficeColorDialog.pas | 20 +- components/mbColorLib/mbReg.lrs | 12 + components/mbColorLib/mbReg.pas | 4 +- components/mbColorLib/mbTrackBarPicker.pas | 238 ++++++++- components/mbColorLib/mbcolorconv.pas | 316 ++++++++++++ components/mbColorLib/mbcolorliblaz.lpk | 10 +- components/mbColorLib/mbutils.pas | 1 + 46 files changed, 2759 insertions(+), 1868 deletions(-) create mode 100644 components/mbColorLib/LVColorPicker.pas create mode 100644 components/mbColorLib/mbcolorconv.pas diff --git a/components/mbColorLib/BColorPicker.pas b/components/mbColorLib/BColorPicker.pas index b2cf5d2d3..9fc45588f 100644 --- a/components/mbColorLib/BColorPicker.pas +++ b/components/mbColorLib/BColorPicker.pas @@ -20,24 +20,25 @@ type FRed, FGreen, FBlue: integer; function ArrowPosFromBlue(b: integer): integer; function BlueFromArrowPos(p: integer): integer; - function GetSelectedColor: TColor; procedure SetBlue(b: integer); procedure SetGreen(g: integer); procedure SetRed(r: integer); - procedure SetSelectedColor(c: TColor); protected procedure Execute(tbaAction: integer); override; function GetArrowPos: integer; override; function GetGradientColor(AValue: Integer): TColor; override; + function GetSelectedColor: TColor; override; function GetSelectedValue: integer; override; + procedure SetSelectedColor(c: TColor); override; public constructor Create(AOwner: TComponent); override; published property Blue: integer read FBlue write SetBlue default 255; property Green: integer read FGreen write SetGreen default 128; property Red: integer read FRed write SetRed default 128; - property SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed; + property SelectedColor default clRed; property Layout default lyVertical; + property HintFormat; end; diff --git a/components/mbColorLib/CColorPicker.pas b/components/mbColorLib/CColorPicker.pas index 60a8d0d84..240ee6df1 100644 --- a/components/mbColorLib/CColorPicker.pas +++ b/components/mbColorLib/CColorPicker.pas @@ -17,17 +17,17 @@ type FCyan, FMagenta, FYellow, FBlack: integer; function ArrowPosFromCyan(c: integer): integer; function CyanFromArrowPos(p: integer): integer; - function GetSelectedColor: TColor; procedure SetBlack(k: integer); procedure SetCyan(c: integer); procedure SetMagenta(m: integer); - procedure SetSelectedColor(clr: TColor); procedure SetYellow(y: integer); protected procedure Execute(tbaAction: integer); override; function GetArrowPos: integer; override; function GetGradientColor(AValue: Integer): TColor; override; + function GetSelectedColor: TColor; override; function GetSelectedValue: integer; override; + procedure SetSelectedColor(clr: TColor); override; public constructor Create(AOwner: TComponent); override; published @@ -35,8 +35,9 @@ type property Cyan: integer read FCyan write SetCyan default 255; property Magenta: integer read FMagenta write SetMagenta default 0; property Yellow: integer read FYellow write SetYellow default 0; - property SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed; + property SelectedColor default clRed; property Layout default lyVertical; + property HintFormat; end; diff --git a/components/mbColorLib/CIEAColorPicker.pas b/components/mbColorLib/CIEAColorPicker.pas index 6018cfeca..d80aa0c86 100644 --- a/components/mbColorLib/CIEAColorPicker.pas +++ b/components/mbColorLib/CIEAColorPicker.pas @@ -7,8 +7,7 @@ unit CIEAColorPicker; interface uses - LCLIntf, LCLType, LMessages, - SysUtils, Classes, Controls, Graphics, Forms, + LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Forms, HTMLColors, RGBCIEUtils, mbColorPickerControl; type diff --git a/components/mbColorLib/CIEBColorPicker.pas b/components/mbColorLib/CIEBColorPicker.pas index d5a97af21..24b0db4c9 100644 --- a/components/mbColorLib/CIEBColorPicker.pas +++ b/components/mbColorLib/CIEBColorPicker.pas @@ -7,8 +7,7 @@ unit CIEBColorPicker; interface uses - LCLIntf, LCLType, LMessages, - SysUtils, Classes, Controls, Graphics, Forms, + LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Forms, HTMLColors, RGBCIEUtils, mbColorPickerControl; type diff --git a/components/mbColorLib/CIELColorPicker.pas b/components/mbColorLib/CIELColorPicker.pas index fdfbf0c97..e2f103ed5 100644 --- a/components/mbColorLib/CIELColorPicker.pas +++ b/components/mbColorLib/CIELColorPicker.pas @@ -7,8 +7,7 @@ unit CIELColorPicker; interface uses - LCLIntf, LCLType, LMessages, - SysUtils, Classes, Controls, Graphics, Math, Forms, + LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Math, Forms, HTMLColors, RGBCIEUtils, mbColorPickerControl; type @@ -171,7 +170,6 @@ end; procedure TCIELColorPicker.Resize; begin - FManual := false; mx := Round((FA + 128) * Width / 255); my := Round((255 - (FB + 128)) * Height / 255); inherited; diff --git a/components/mbColorLib/GAxisColorPicker.pas b/components/mbColorLib/GAxisColorPicker.pas index 153f71071..f0c9df649 100644 --- a/components/mbColorLib/GAxisColorPicker.pas +++ b/components/mbColorLib/GAxisColorPicker.pas @@ -61,7 +61,6 @@ begin FB := 0; FR := 0; FSelected := clLime; - FManual := false; MarkerStyle := msCircle; end; @@ -159,7 +158,6 @@ end; procedure TGAxisColorPicker.Resize; begin - FManual := false; mx := Round(FB * Width / 255); my := Round((255 - FR) * Height / 255); inherited; diff --git a/components/mbColorLib/GColorPicker.pas b/components/mbColorLib/GColorPicker.pas index 94d366c29..452e1eb2f 100644 --- a/components/mbColorLib/GColorPicker.pas +++ b/components/mbColorLib/GColorPicker.pas @@ -7,7 +7,7 @@ unit GColorPicker; interface uses - LCLIntf, LCLType, LMessages, SysUtils, Classes, Controls, Graphics, Forms, + LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Forms, HTMLColors, mbTrackBarPicker; type @@ -15,25 +15,26 @@ type private FRed, FGreen, FBlue: integer; function ArrowPosFromGreen(g: integer): integer; - function GetSelectedColor: TColor; function GreenFromArrowPos(p: integer): integer; procedure SetBlue(b: integer); procedure SetGreen(g: integer); procedure SetRed(r: integer); - procedure SetSelectedColor(c: TColor); protected procedure Execute(tbaAction: integer); override; function GetArrowPos: integer; override; function GetGradientColor(AValue: Integer): TColor; override; + function GetSelectedColor: TColor; override; function GetSelectedValue: integer; override; + procedure SetSelectedColor(c: TColor); override; public constructor Create(AOwner: TComponent); override; published property Red: integer read FRed write SetRed default 128; property Green: integer read FGreen write SetGreen default 255; property Blue: integer read FBlue write SetBlue default 128; - property SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed; + property SelectedColor default clRed; property Layout default lyVertical; + property HintFormat; end; diff --git a/components/mbColorLib/HColorPicker.pas b/components/mbColorLib/HColorPicker.pas index aede1432a..1e53fcc4b 100644 --- a/components/mbColorLib/HColorPicker.pas +++ b/components/mbColorLib/HColorPicker.pas @@ -7,27 +7,14 @@ unit HColorPicker; interface uses - LCLIntf, LCLType, LMessages, SysUtils, Classes, Controls, Graphics, Forms, - RGBHSVUtils, HTMLColors, mbTrackBarPicker; + LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Forms, + HTMLColors, mbColorConv, mbTrackBarPicker; type - THColorPicker = class(TmbTrackBarPicker) + THColorPicker = class(TmbHSLVTrackBarPicker) private - FHue, FSat, FVal: Double; - FMaxHue, FMaxSat, FMaxVal: Integer; - function ArrowPosFromHue(h: integer): integer; - function HueFromArrowPos(p: integer): integer; - function GetHue: Integer; - function GetSat: Integer; - function GetSelectedColor: TColor; - function GetVal: Integer; - procedure SetHue(h: integer); - procedure SetMaxHue(h: Integer); - procedure SetMaxSat(s: Integer); - procedure SetMaxVal(v: Integer); - procedure SetSat(s: integer); - procedure SetSelectedColor(c: TColor); - procedure SetVal(v: integer); + function ArrowPosFromHue(h: Double): integer; + function HueFromArrowPos(p: integer): Double; protected function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; override; @@ -35,17 +22,19 @@ type function GetArrowPos: integer; override; function GetGradientColor(AValue: Integer): TColor; override; function GetSelectedValue: integer; override; + procedure SetMaxHue(H: Integer); override; + procedure SetRelHue(H: Double); override; + procedure SetSelectedColor(c: TColor); override; public constructor Create(AOwner: TComponent); override; published - property Hue: integer read GetHue write SetHue; - property Saturation: integer read GetSat write SetSat; - property Value: integer read GetVal write SetVal; property Layout default lyHorizontal; - property MaxHue: Integer read FMaxHue write SetMaxHue default 359; - property MaxSaturation: Integer read FMaxSat write SetMaxSat default 255; - property MaxValue: Integer read FMaxVal write SetMaxVal default 255; - property SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed; + property Hue default 0; + property Saturation default 255; + property Luminance default 127; + property Value default 255; + property SelectedColor default clRed; + property HintFormat; end; @@ -59,29 +48,27 @@ uses constructor THColorPicker.Create(AOwner: TComponent); begin inherited; - FMaxHue := 359; - FMaxSat := 255; - FMaxVal := 255; FGradientWidth := FMaxHue; FGradientHeight := 1; FSat := 1.0; FVal := 1.0; - SetHue(0); + FLum := 0.5; + Hue := 0; HintFormat := 'Hue: %value (selected)'; end; -function THColorPicker.ArrowPosFromHue(h: integer): integer; +function THColorPicker.ArrowPosFromHue(H: Double): integer; var a: integer; begin if Layout = lyHorizontal then begin - a := Round((Width - 12) * h / FMaxHue); + a := Round((Width - 12) * H); if a > Width - FLimit then a := Width - FLimit; end else begin - a := Round((Height - 12) * h / FMaxHue); + a := Round((Height - 12) * H); if a > Height - FLimit then a := Height - FLimit; end; if a < 0 then a := 0; @@ -92,40 +79,44 @@ function THColorPicker.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; begin if Layout = lyVertical then WheelDelta := -WheelDelta; - inherited; + WheelDelta := WheelDelta * 3; // use larger steps + Result := inherited; end; procedure THColorPicker.Execute(tbaAction: integer); +var + dHue: Double; begin + if FMaxHue = 0 then dHue := 0 else dHue := Increment / FMaxHue; case tbaAction of TBA_Resize: - SetHue(GetHue); + SetRelHue(FHue); // wp: Is this working? TBA_MouseMove: - SetHue(HueFromArrowPos(FArrowPos)); + SetRelHue(HueFromArrowPos(FArrowPos)); TBA_MouseDown: - SetHue(HueFromArrowPos(FArrowPos)); + SetRelHue(HueFromArrowPos(FArrowPos)); TBA_MouseUp: - SetHue(HueFromArrowPos(FArrowPos)); + SetRelHue(HueFromArrowPos(FArrowPos)); TBA_WheelUp: - SetHue(GetHue() + Increment); + SetRelHue(FHue + dHue); TBA_WheelDown: - SetHue(GetHue() - Increment); + SetRelHue(FHue - dHue); TBA_VKLeft: - SetHue(GetHue() - Increment); + SetRelHue(FHue - dHue); TBA_VKCtrlLeft: - SetHue(0); + SetRelHue(0); TBA_VKRight: - SetHue(GetHue() + Increment); + SetRelHue(FHue + dHue); TBA_VKCtrlRight: - SetHue(FMaxHue); + SetRelHue(1 - dHue); // go one step below 360, or the hue will flip back to 0 TBA_VKUp: - SetHue(GetHue() - Increment); + SetRelHue(FHue - dHue); TBA_VKCtrlUp: - SetHue(0); + SetRelHue(0); TBA_VKDown: - SetHue(GetHue() + Increment); + SetRelHue(FHue + dHue); TBA_VKCtrlDown: - SetHue(FMaxHue); + SetRelHue(1 - dHue); else inherited; end; @@ -136,109 +127,55 @@ begin if FMaxHue = 0 then Result := inherited GetArrowPos else - Result := ArrowPosFromHue(GetHue()); + Result := ArrowPosFromHue(FHue); end; function THColorPicker.GetGradientColor(AValue: Integer): TColor; var h: Double; begin - if Layout = lyVertical then AValue := (FMaxHue + 1) - AValue; + if Layout = lyVertical then AValue := FMaxHue - 1 - AValue; + // Width is FMaxHue --> last index is FMaxHue - 1 h := AValue / FMaxHue; - Result := HSVtoColor(h, FSat, FVal); -end; - -function THColorPicker.GetHue: Integer; -begin - Result := round(FHue * FMaxHue); -end; - -function THColorPicker.GetSat: Integer; -begin - Result := round(FSat * FMaxSat); -end; - -function THColorPicker.GetSelectedColor: TColor; -begin - Result := HSVtoColor(FHue, FSat, FVal); - if WebSafe then - Result := GetWebSafe(Result); + Result := HSLVtoColor(h, FSat, FLum, FVal); end; function THColorPicker.GetSelectedValue: integer; begin - Result := GetHue(); + Result := Hue; end; -function THColorPicker.GetVal: Integer; -begin - Result := round(FVal * FMaxVal); -end; - -function THColorPicker.HueFromArrowPos(p: integer): integer; +function THColorPicker.HueFromArrowPos(p: integer): Double; var - h: integer; + h: Double; begin case Layout of - lyHorizontal: - h := Round(p / (Width - 12) * FMaxHue); - lyVertical: - h := Round(p / (Height - 12) * MaxHue); + lyHorizontal : h := p / (Width - 12); + lyVertical : h := p / (Height - 12) end; - Clamp(h, 0, FMaxHue); + Clamp(h, 0, 1.0 - 1/FMaxHue); Result := h; end; -procedure THColorPicker.SetHue(h: integer); -begin - Clamp(h, 0, FMaxHue); - if GetHue <> h then - begin - FHue := h / FMaxHue; - FArrowPos := ArrowPosFromHue(h); - Invalidate; - DoChange; - end; -end; - procedure THColorPicker.SetMaxHue(h: Integer); begin if h = FMaxHue then exit; FMaxHue := h; - FGradientWidth := FMaxHue + 1; // 0 .. FMaxHue --> FMaxHue + 1 pixels + FGradientWidth := FMaxHue; // we don't want to access H=360, i.e. don't use FMaxHue+1 CreateGradient; Invalidate; - //if FChange and Assigned(OnChange) then OnChange(Self); end; -procedure THColorPicker.SetMaxSat(s: Integer); +procedure THColorPicker.SetRelHue(H: Double); begin - if s = FMaxSat then + if FMaxHue = 0 then exit; - FMaxSat := s; - CreateGradient; - Invalidate; - //if FChange and Assigned(OnChange) then OnChange(Self); -end; - -procedure THColorPicker.SetMaxVal(v: Integer); -begin - if v = FMaxVal then - exit; - FMaxVal := v; - CreateGradient; - Invalidate; -// if FChange and Assigned(OnChange) then OnChange(Self); -end; - -procedure THColorPicker.SetSat(s: integer); -begin - Clamp(s, 0, FMaxSat); - if GetSat() <> s then + Clamp(H, 0, 1 - 1/FMaxHue); // don't go up to 360 because this will flip back to the start + if (FHue <> H) then begin - FSat := s / FMaxSat; - CreateGradient; + FHue := H; + FArrowPos := ArrowPosFromHue(H); Invalidate; DoChange; end; @@ -246,7 +183,10 @@ end; procedure THColorPicker.SetSelectedColor(c: TColor); var - h, s, v: integer; + H: Double = 0; + S: Double = 0; + L: Double = 0; + V: Double = 0; needNewGradient: Boolean; begin if WebSafe then @@ -254,27 +194,25 @@ begin if c = GetSelectedColor then exit; - RGBToHSVRange(GetRValue(c), GetGValue(c), GetBValue(c), h, s, v); - needNewGradient := (s <> FSat) or (v <> FVal); - FHue := h; - FSat := s; - FVal := v; + ColorToHSLV(c, H, S, L, V); + case BrightnessMode of + bmLuminance: + begin + needNewGradient := (S <> FSat) or (L <> FLum); + FLum := L; + end; + bmValue: + begin + needNewGradient := (S <> FSat) or (V <> FVal); + FVal := V; + end; + end; + FHue := H; + FSat := S; if needNewGradient then CreateGradient; Invalidate; DoChange; end; -procedure THColorPicker.SetVal(v: integer); -begin - Clamp(v, 0, FMaxVal); - if GetVal() <> v then - begin - FVal := v / FMaxVal; - CreateGradient; - Invalidate; - DoChange; - end; -end; - end. diff --git a/components/mbColorLib/HRingPicker.pas b/components/mbColorLib/HRingPicker.pas index 98e5d4980..ea18048b9 100644 --- a/components/mbColorLib/HRingPicker.pas +++ b/components/mbColorLib/HRingPicker.pas @@ -8,60 +8,44 @@ interface uses LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Math, Forms, - RGBHSVUtils, HTMLColors, mbColorPickerControl; + HTMLColors, mbColorConv, mbColorPickerControl; type - THRingPicker = class(TmbColorPickerControl) + THRingPicker = class(TmbHSLVColorPickerControl) private - FHue, FSat, FVal: Double; - FMaxHue, FMaxSat, FMaxVal: Integer; - FHueLineColor: TColor; FSelectedColor: TColor; - mx, my, mdx, mdy: integer; - //FChange: boolean; + FHueLineColor: TColor; FRadius: integer; - FDragging: Boolean; - function GetHue: Integer; - function GetSat: Integer; - function GetValue: Integer; - function RadHue(New: integer): integer; - procedure SetMaxHue(h: Integer); - procedure SetMaxSat(s: Integer); - procedure SetMaxValue(v: Integer); procedure SetRadius(r: integer); - procedure SetHue(h: integer); - procedure SetSat(s: integer); - procedure SetValue(v: integer); procedure SetHueLineColor(c: TColor); - procedure SelectionChanged(x, y: integer); - procedure UpdateCoords; protected procedure CreateGradient; override; procedure DrawHueLine; function GetGradientColor2D(X, Y: Integer): TColor; override; function GetSelectedColor: TColor; override; - procedure KeyDown(var Key: Word; Shift: TShiftState); override; - procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; - procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; - function MouseOnPicker(X, Y: Integer): Boolean; - procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; +// function MouseOnPicker(X, Y: Integer): Boolean; procedure Paint; override; procedure Resize; override; + procedure SelectColor(x, y: integer); override; + procedure SetRelHue(H: Double); override; procedure SetSelectedColor(c: TColor); override; + procedure UpdateCoords; public constructor Create(AOwner: TComponent); override; function GetColorAtPoint(x, y: integer): TColor; override; property ColorUnderCursor; published - property Hue: integer read GetHue write SetHue; - property Saturation: integer read GetSat write SetSat; - property Value: integer read GetValue write SetValue; - property MaxHue: Integer read FMaxHue write SetMaxHue default 359; - property MaxSaturation: Integer read FMaxSat write SetMaxSat default 255; - property MaxValue: Integer read FMaxVal write SetMaxValue default 255; + property Hue default 0; + property Luminance default 127; + property Saturation default 255; + property Value default 255; + property MaxHue default 360; + property MaxLuminance default 255; + property MaxSaturation default 255; + property MaxValue default 255; property HueLineColor: TColor read FHueLineColor write SetHueLineColor default clGray; property Radius: integer read FRadius write SetRadius default 40; - property SelectedColor default clNone; + property SelectedColor default clRed; //clNone; property OnChange; end; @@ -77,17 +61,13 @@ constructor THRingPicker.Create(AOwner: TComponent); begin inherited; SetInitialBounds(0, 0, 204, 204); - FMaxHue := 359; - FMaxSat := 255; - FMaxVal := 255; + FHue := 0.0; FVal := 1.0; -// FHue := 0.0; + FLum := 0.5; FSat := 1.0; - FHueLineColor := clGray; SetSelectedColor(clRed); -// FSelectedColor := clRed; clNone; - FManual := false; FRadius := 40; + FHueLineColor := clGray; HintFormat := 'Hue: %h (selected)'; TabStop := true; end; @@ -108,7 +88,7 @@ begin radius := Min(Width, Height) div 2; if (FHue >= 0) and (FHue <= 1.0) then begin - angle := -FHue * 2 * pi; + angle := -FHue * TWO_PI; SinCos(angle, sinAngle, cosAngle); Canvas.Pen.Color := FHueLineColor; Canvas.MoveTo(radius, radius); @@ -134,9 +114,7 @@ begin else if angle > 360 then angle := angle - 360; h := angle / 360; - Result := HSVtoColor(h, FSat, FVal); - if WebSafe then - Result := GetWebSafe(Result); + Result := HSLVtoColor(h, FSat, FLum, FVal); end else Result := clNone; @@ -149,7 +127,6 @@ var dSq, rSq: Integer; radius, size: Integer; H: Double; - q: TRGBQuad; begin size := FGradientWidth; // or Height, they are the same... radius := size div 2; @@ -162,79 +139,21 @@ begin H := 180 * (1 + arctan2(dx, dy) / pi); // wp: order (x,y) is correct! H := H + 90; if H > 360 then H := H - 360; - Result := HSVtoColor(H/360, FSat, FVal); + Result := HSLVtoColor(H/360, FSat, FLum, FVal); if WebSafe then Result := GetWebSafe(Result); end else Result := GetDefaultColor(dctBrush); end; -function THRingPicker.GetHue: Integer; -begin - Result := round(FHue * FMaxHue); -end; - -function THRingPicker.GetSat: Integer; -begin - Result := round(FSat * FMaxSat); -end; - function THRingPicker.GetSelectedColor: TColor; begin if FSelectedColor <> clNone then - begin - Result := HSVtoColor(FHue, FSat, FVal); - if WebSafe then - Result := GetWebSafe(Result); - end + Result := HSLVtoColor(FHue, FSat, FLum, FVal) else Result := clNone; end; - -function THRingPicker.GetValue: Integer; -begin - Result := round(FVal * FMaxVal); -end; - -procedure THRingPicker.KeyDown(var Key: Word; Shift: TShiftState); -var - eraseKey: Boolean; - delta: Integer; -begin - eraseKey := true; - if ssCtrl in Shift then - delta := 10 - else - delta := 1; - - case Key of - VK_LEFT : SetHue(RadHue(GetHue() + delta)); - VK_RIGHT : SetHue(RadHue(GetHue() - delta)); - else erasekey := false; - end; - - if eraseKey then - Key := 0; - - inherited; -end; - -procedure THRingPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; - X, Y: Integer); -begin - inherited; - if csDesigning in ComponentState then - Exit; - if (Button = mbLeft) and MouseOnPicker(X, Y) - then begin - mdx := x; - mdy := y; - SelectionChanged(X, Y); - FDragging := true; - end; - SetFocus; -end; - + { function THRingPicker.MouseOnPicker(X, Y: Integer): Boolean; var diameter, r: Integer; @@ -245,33 +164,7 @@ begin P := Point(x, y); ctr := Point(r, r); Result := PtInCircle(P, ctr, r) and not PtInCircle(P, ctr, Radius); -end; - -procedure THRingPicker.MouseMove(Shift: TShiftState; X, Y: Integer); -begin - inherited; - if csDesigning in ComponentState then Exit; - if (ssLeft in Shift) and FDragging then - begin - mdx := x; - mdy := y; - SelectionChanged(X, Y); - end; -end; - -procedure THRingPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; - X, Y: Integer); -begin - inherited; - if csDesigning in ComponentState then Exit; - if (Button = mbLeft) and FDragging then - begin - mdx := x; - mdy := y; - SelectionChanged(X, Y); - FDragging := false; - end; -end; +end; } procedure THRingPicker.Paint; var @@ -302,45 +195,26 @@ begin DoChange; end; -function THRingPicker.RadHue(New: integer): integer; -begin - if New < 0 then New := New + (FMaxHue + 1); - if New > (FMaxHue + 1) then New := New - (FMaxHue + 1); - Result := New; -end; - procedure THRingPicker.Resize; begin inherited; - CreateGradient; + if Min(Width, Height) <> FGradientWidth then + CreateGradient; UpdateCoords; end; -procedure THRingPicker.SelectionChanged(x, y: integer); +procedure THRingPicker.SelectColor(x, y: integer); var angle, dx, dy, Radius: integer; begin + mx := y; + my := y; FSelectedColor := clWhite; radius := Min(Width, Height) div 2; dx := x - radius; dy := y - radius; angle := round(360 + 180*arctan2(-dy, dx) / pi); - if angle < 0 then - inc(angle, 360) - else if angle > 360 then - dec(angle, 360); - SetHue(MulDiv(angle, FMaxHue + 1, 360)); -end; - -procedure THRingPicker.SetHue(h: integer); -begin - h := RadHue(h); - if GetHue() <> h then - begin - FHue := h / FMaxHue; - Invalidate; - DoChange; - end; + SetRelHue(angle/360); end; procedure THRingPicker.SetHueLineColor(c: TColor); @@ -352,36 +226,6 @@ begin end; end; -procedure THRingPicker.SetMaxHue(h: Integer); -begin - if h = FMaxHue then - exit; - FMaxHue := h; - CreateGradient; - Invalidate; -// if FChange and Assigned(OnChange) then OnChange(Self); -end; - -procedure THRingPicker.SetMaxSat(s: Integer); -begin - if s = FMaxSat then - exit; - FMaxSat := s; - CreateGradient; - Invalidate; -// if FChange and Assigned(OnChange) then OnChange(Self); -end; - -procedure THRingPicker.SetMaxValue(v: Integer); -begin - if v = FMaxVal then - exit; - FMaxVal := v; - CreateGradient; - Invalidate; -// if FChange and Assigned(OnChange) then OnChange(Self); -end; - procedure THRingPicker.SetRadius(r: integer); begin if FRadius <> r then @@ -391,20 +235,38 @@ begin end; end; -procedure THRingPicker.SetSat(s: integer); +procedure THRingPicker.SetRelHue(H: Double); begin - Clamp(s, 0, FMaxSat); - if GetSat() <> s then + if H > 1 then H := H - 1; + if H < 0 then H := H + 1; + if FHue <> h then begin - FSat := s / FMaxSat; + FHue := h; + UpdateCoords; Invalidate; DoChange; end; end; +(* +procedure THRingPicker.SetSat(s: integer); +begin + Clamp(s, 0, FMaxSat); + if Saturation <> s then + begin + FSat := s / FMaxSat; + UpdateCoords; + Invalidate; + DoChange; + end; +end; +*) procedure THRingPicker.SetSelectedColor(c: TColor); var - h, s, v: Double; + H: Double = 0; + S: Double = 0; + L: Double = 0; + V: Double = 0; needNewGradient: Boolean; begin if WebSafe then @@ -412,11 +274,21 @@ begin if c = GetSelectedColor then Exit; - RGBToHSV(GetRValue(c), GetGValue(c), GetBValue(c), h, s, v); - needNewGradient := (s <> FSat) or (v <> FVal); + ColorToHSLV(c, H, S, L, V); + case BrightnessMode of + bmLuminance: + begin + needNewGradient := (S <> FSat) or (L <> FLum); + FLum := L; + end; + bmValue: + begin + needNewGradient := (S <> FSat) or (V <> FVal); + FVal := V; + end; + end; FHue := h; FSat := s; - FVal := v; UpdateCoords; if needNewGradient then CreateGradient; @@ -424,18 +296,22 @@ begin DoChange; end; -procedure THRingPicker.SetValue(v: integer); +(* +procedure THRingPicker.SetVal(v: integer); begin Clamp(v, 0, FMaxVal); - if GetValue() <> V then + if Value <> V then begin FVal := V / FMaxVal; - CreateGradient; - Invalidate; + if BrightnessMode = bmValue then + begin + CreateGradient; + Invalidate; + end; DoChange; end; end; - +*) procedure THRingPicker.UpdateCoords; var r, angle: double; @@ -446,8 +322,8 @@ begin r := -radius * FSat; angle := -(FHue * 2 + 1) * pi; SinCos(angle, sinAngle, cosAngle); - mdx := round(cosAngle * r) + radius; - mdy := round(sinAngle * r) + radius; + mx := round(cosAngle * r) + radius; + my := round(sinAngle * r) + radius; end; end. diff --git a/components/mbColorLib/HSColorPicker.pas b/components/mbColorLib/HSColorPicker.pas index 5d11acbe4..6e145b569 100644 --- a/components/mbColorLib/HSColorPicker.pas +++ b/components/mbColorLib/HSColorPicker.pas @@ -4,94 +4,77 @@ unit HSColorPicker; {$MODE DELPHI} {$ENDIF} -{$DEFINE USE COLOR_TO_RGB} - interface uses LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Forms, - RGBHSLUtils, HTMLColors, mbColorPickerControl; + HTMLColors, mbColorConv, mbColorPickerControl; type { THSColorPicker } - THSColorPicker = class(TmbColorPickerControl) + THSColorPicker = class(TmbHSLVColorPickerControl) private - FHue, FSat, FLum, FLumSel: Double; - FMaxHue, FMaxSat, FMaxLum: Integer; - function GetHue: Integer; - function GetLum: Integer; - function GetSat: Integer; - procedure SetHue(H: integer); - procedure SetLum(L: Integer); - procedure SetSat(S: integer); - procedure SetMaxHue(H: Integer); - procedure SetMaxLum(L: Integer); - procedure SetMaxSat(S: Integer); + FLumDisp, FValDisp: Double; // Lum and Value used for display protected - procedure CorrectCoords(var x, y: integer); procedure CreateWnd; override; procedure DrawMarker(x, y: integer); function GetGradientColor2D(x, y: Integer): TColor; override; - procedure KeyDown(var Key: Word; Shift: TShiftState); override; - procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; - procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; - procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + function GetSelectedColor: TColor; override; procedure Paint; override; function PredictColor: TColor; procedure Resize; override; - procedure SelectColor(x, y: Integer); + procedure SelectColor(x, y: Integer); override; + procedure SetMaxHue(H: Integer); override; + procedure SetMaxSat(S: Integer); override; + procedure SetRelHue(H: Double); override; + procedure SetRelSat(S: Double); override; procedure SetSelectedColor(c: TColor); override; procedure UpdateCoords; public constructor Create(AOwner: TComponent); override; function GetColorAtPoint(x, y: Integer): TColor; override; - function GetSelectedColor: TColor; override; published property SelectedColor default clRed; - property Hue: integer read GetHue write SetHue default 0; - property Saturation: integer read GetSat write SetSat default 240; - property Luminance: Integer read GetLum write SetLum default 120; - property MaxHue: Integer read FMaxHue write SetMaxHue default 359; - property MaxSaturation: Integer read FMaxSat write SetMaxSat default 240; - property MaxLuminance: Integer read FMaxLum write SetMaxLum default 240; + property Hue default 0; + property Saturation default 255; + property Luminance default 127; + property Value default 255; + property MaxHue default 360; + property MaxSaturation default 255; + property MaxLuminance default 255; + property MaxValue default 255; property MarkerStyle default msCross; property OnChange; end; + implementation uses - math, mbUtils; + Math, mbUtils; -{THSColorPicker} +{ THSColorPicker } constructor THSColorPicker.Create(AOwner: TComponent); begin inherited; - FMaxHue := 359; - FMaxSat := 240; - FMaxLum := 240; - FGradientWidth := FMaxHue + 1; + FGradientWidth := FMaxHue; // We want to skip the point at 360° --> no +1 FGradientHeight := FMaxSat + 1; SetInitialBounds(0, 0, FGradientWidth, FGradientHeight); FHue := 0; FSat := 1.0; FLum := 0.5; - FLumSel := 0.5; + FLumDisp := 0.5; + FVal := 1.0; + FValDisp := 1.0; FSelected := clRed; CreateGradient; HintFormat := 'H: %h S: %hslS'#13'Hex: %hex'; MarkerStyle := msCross; end; -procedure THSColorPicker.CorrectCoords(var x, y: integer); -begin - Clamp(x, 0, Width - 1); - Clamp(y, 0, Height - 1); -end; - procedure THSColorPicker.CreateWnd; begin inherited; @@ -101,16 +84,10 @@ end; procedure THSColorPicker.DrawMarker(x, y: integer); var c: TColor; - L: Double; + dummy: Double = 0; begin CorrectCoords(x, y); - - {$IFDEF USE_COLOR_TO_RGB} - ColorToHSL(FSelected, FHue, FSat, L); - {$ELSE} - RGBToHSL(FSelected, FHue, FSat, L); - {$ENDIF} - + ColorToHSLV(FSelected, FHue, FSat, dummy, dummy); if Focused or (csDesigning in ComponentState) then c := clBlack else @@ -124,13 +101,9 @@ var begin if InRange(x, 0, Width - 1) and InRange(y, 0, Height - 1) then begin - H := x / (Width - 1); + H := x / Width; // Width = FMaxHue S := 1 - y / (Height - 1); - {$IFDEF USE_COLOR_TO_RGB} - Result := HSLToColor(H, S, FLumSel); - {$ELSE} - Result := HSLToRGB(H, S, FLumSel); - {$ENDIF} + Result := HSLVtoColor(H, S, FLum, FVal); end else Result := clNone; end; @@ -141,121 +114,12 @@ var begin H := x / FMaxHue; S := 1 - y / FMaxSat; - {$IFDEF USE_COLOR_TO_RGB} - Result := HSLToColor(H, S, FLum); - {$ELSE} - Result := HSLtoRGB(H, S, FLum); - {$ENDIF} -end; - -function THSColorPicker.GetHue: Integer; -begin - Result := Round(FHue * (FMaxHue + 1)); -end; - -function THSColorPicker.GetLum: Integer; -begin - Result := Round(FLum * FMaxLum); -end; - -function THSColorPicker.GetSat: Integer; -begin - Result := Round(FSat * FMaxSat); + Result := HSLVtoColor(H, S, FLumDisp, FValDisp); end; function THSColorPicker.GetSelectedColor: TColor; begin - {$IFDEF USE_COLOR_TO_RGB} - Result := HSLToColor(FHue, FSat, FLumSel); - {$ELSE} - Result := HSLtoRGB(FHue, FSat, FLumSel); - {$ENDIF} -end; - -procedure THSColorPicker.KeyDown(var Key: Word; Shift: TShiftState); -var - eraseKey: Boolean; - delta: Integer; -begin - eraseKey := true; - delta := IfThen(ssCtrl in Shift, 10, 1); - - case Key of - VK_LEFT : SelectColor(mx - delta, my); - VK_RIGHT : SelectColor(mx + delta, my); - VK_UP : SelectColor(mx, my - delta); - VK_DOWN : SelectColor(mx, my + delta); - else eraseKey := false; - end; - { - case Key of - VK_LEFT: - begin - mxx := dx - delta; - myy := dy; - FSelected := GetColorAtPoint(mxx, myy); - if Assigned(OnChange) then OnChange(Self); - FManual := true; - Invalidate; - end; - VK_RIGHT: - begin - mxx := dx + delta; - myy := dy; - FSelected := GetColorAtPoint(mxx, myy); - if Assigned(OnChange) then OnChange(Self); - FManual := true; - Invalidate; - end; - VK_UP: - begin - mxx := dx; - myy := dy - delta; - FSelected := GetColorAtPoint(mxx, myy); - if Assigned(OnChange) then OnChange(Self); - FManual := true; - Invalidate; - end; - VK_DOWN: - begin - mxx := dx; - myy := dy + delta; - FSelected := GetColorAtPoint(mxx, myy); - if Assigned(OnChange) then OnChange(Self); - FManual := true; - Invalidate; - end; - else - eraseKey := false; - end; - } - - if eraseKey then - Key := 0; - - inherited; -end; - -procedure THSColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); -begin - inherited; - if Button = mbLeft then - SelectColor(x, y); - SetFocus; -end; - -procedure THSColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer); -begin - inherited; - if ssLeft in Shift then - SelectColor(x, y); -end; - -procedure THSColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); -begin - inherited; - if Button = mbLeft then - SelectColor(x, y); + Result := HSLVtoColor(FHue, FSat, FLum, FVal); end; procedure THSColorPicker.Paint; @@ -265,15 +129,8 @@ begin end; function THSColorPicker.PredictColor: TColor; -var - H, S, L: Double; begin - {$IFDEF USE_COLOR_TO_RGB} - ColorToHSL(GetColorUnderCursor, H, S, L); - {$ELSE} - RGBtoHSL(GetColorUnderCursor, H, S, L); - {$ENDIF} - Result := HSLToRGB(H, S, L); + Result := GetColorUnderCursor; end; procedure THSColorPicker.Resize; @@ -284,7 +141,10 @@ end; procedure THSColorPicker.SelectColor(x, y: Integer); var - H, S, L: Double; + H: Double = 0; + S: Double = 0; + L: Double = 0; + V: Double = 0; c: TColor; begin CorrectCoords(x, y); @@ -292,129 +152,59 @@ begin my := y; c := GetColorAtPoint(x, y); if WebSafe then c := GetWebSafe(c); - {$IFDEF USE_COLOR_TO_RGB} - ColorToHSL(c, H, S, L); - {$ELSE} - RGBtoHSL(c, H, S, L); - {$ENDIF} + ColorToHSLV(c, H, S, L, V); if (H = FHue) and (S = FSat) then exit; FHue := H; FSat := S; - {$IFDEF USE_COLOR_TO_RGB} - FSelected := ColorToHSL(FHue, FSat, FLumSel); - {$ELSE} - FSelected := HSLToRGB(FHue, FSat, FLumSel); - {$ENDIF} + FSelected := HSLVtoColor(FHue, FSat, FLum, FVal); Invalidate; DoChange; end; -(* - BeginUpdate; - try - mxx := x; - myy := y; - CorrectCoords(mxx, myy); - c := GetColorAtPoint(mxx, myy); - if WebSafe then c := GetWebSafe(c); - {$IFDEF USE_COLOR_TO_RGB} - ColorToHSL(c, FHue, FSat, L); - {$ELSE} - RGBtoHSL(c, FHue, FSat, L); - {$ENDIF} - FSelected := c; - FManual := false; - Invalidate; - finally - EndUpdate; - end; -end; -*) - -procedure THSColorPicker.SetHue(H: integer); -begin - Clamp(H, 0, FMaxHue); - if H = GetHue then - exit; - - FHue := H / (FMaxHue + 1); - {$IFDEF USE_COLOR_TO_RGB} - FSelected := HSLtoColor(FHue, FSat, FLumSel); - {$ELSE} - FSelected := HSLToRGB(FHue, FSat, FLumSel); - {$ENDIF} - UpdateCoords; - Invalidate; - DoChange; -(* - {$IFDEF USE_COLOR_TO_RGB} - SetSelectedColor(HSLtoColor(FHue, FSat, FLumSel)); - {$ELSE} - SetSelectedColor(HSLToRGB(FHue, FSat, FLumSel)); - {$ENDIF} - *) -end; - -// Sets the luminance value used for the display. It is not necessarily that -// of the selected color. -// The true luminance of the selected color is given by LumSel -procedure THSColorPicker.SetLum(L: Integer); -begin - Clamp(L, 0, FMaxLum); - if L = GetLum then - exit; - - FLum := L / FMaxLum; - CreateGradient; - Invalidate; - DoChange; -end; - -procedure THSColorPicker.SetSat(S: integer); -begin - Clamp(S, 0, FMaxSat); - if S = GetSat then - exit; - - FSat := S / FMaxSat; - FSelected := HSLToRGB(FHue, FSat, FLumSel); - UpdateCoords; - Invalidate; - DoChange; -end; - procedure THSColorPicker.SetMaxHue(H: Integer); begin if H = FMaxHue then exit; - FMaxHue := H; - FGradientWidth := FMaxHue + 1; - CreateGradient; - Invalidate; -end; - -procedure THSColorPicker.SetMaxLum(L: Integer); -begin - if L = FMaxLum then - exit; - FMaxLum := L; - CreateGradient; - Invalidate; - if Assigned(OnChange) then OnChange(Self); + FGradientWidth := H + 1; + inherited; end; procedure THSColorPicker.SetMaxSat(S: Integer); begin if S = FMaxSat then exit; - FMaxSat := S; - FGradientHeight := FMaxSat + 1; - CreateGradient; + FGradientHeight := S + 1; + inherited; +end; + +procedure THSColorPicker.SetRelHue(H: Double); +begin + Clamp(H, 0, 1 - 1/FMaxHue); // Don't use H=360° + if H = FHue then + exit; + + FHue := H; + FSelected := GetSelectedColor; + UpdateCoords; Invalidate; + DoChange; +end; + +procedure THSColorPicker.SetRelSat(S: Double); +begin + Clamp(S, 0.0, 1.0); + if S = FSat then + exit; + + FSat := S; + FSelected := GetSelectedColor; + UpdateCoords; + Invalidate; + DoChange; end; // NOTE: In the picker display only the hue and the saturation of the input @@ -423,31 +213,32 @@ end; // input color. procedure THSColorPicker.SetSelectedColor(c: TColor); var - H, S, L: Double; + H: Double = 0; + S: Double = 0; + L: Double = 0; + V: Double = 0; begin if WebSafe then c := GetWebSafe(c); - {$IFDEF USE_COLOR_TO_RGB} - ColorToHSL(c, H, S, L); - {$ELSE} - RGBtoHSL(c, H, S, L); - {$ENDIF} - - FSelected := c; + ColorToHSLV(c, H, S, L, V); if (H = FHue) and (S = FSat) then exit; + FSelected := c; FHue := H; FSat := S; - FLumSel := L; + case BrightnessMode of + bmLuminance : FLum := L; + bmValue : FVal := V; + end; UpdateCoords; Invalidate; DoChange; end; -procedure THSCOlorPicker.UpdateCoords; +procedure THSColorPicker.UpdateCoords; begin mx := Round(FHue * Width); my := Round((1.0 - FSat) * Height); diff --git a/components/mbColorLib/HSLColorPicker.pas b/components/mbColorLib/HSLColorPicker.pas index 8d591ad85..72ab52f30 100644 --- a/components/mbColorLib/HSLColorPicker.pas +++ b/components/mbColorLib/HSLColorPicker.pas @@ -7,54 +7,76 @@ unit HSLColorPicker; interface uses - LCLIntf, LCLType, LMessages, - SysUtils, Classes, Controls, Graphics, Forms, Menus, Themes, - HTMLColors, RGBHSLUtils, HSColorPicker, LColorPicker, mbBasicPicker; + LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Forms, Menus, Themes, + HTMLColors, mbColorConv, HSColorPicker, LVColorPicker, mbBasicPicker; type THSLColorPicker = class(TmbBasicPicker) private FHSPicker: THSColorPicker; - FLPicker: TLColorPicker; - FSelectedColor: TColor; - FRValue, FGValue, FBValue: integer; - FHSHint, FLHint: string; - FLMenu, FHSMenu: TPopupMenu; - FLumIncrement: integer; - FHSCursor, FLCursor: TCursor; + FLVPicker: TLVColorPicker; + FRed, FGreen, FBlue: integer; + FHSHint: string; + FLVMenu, FHSMenu: TPopupMenu; + FLVIncrement: integer; + FHSCursor, FLVCursor: TCursor; PBack: TBitmap; - function GetH: Integer; - function GetS: Integer; - function GetL: Integer; - function GetMaxH: Integer; - function GetMaxS: Integer; - function GetMaxL: Integer; - procedure SetH(H: integer); - procedure SetS(S: integer); - procedure SetL(L: integer); - procedure SetLumIncrement(i: integer); - procedure SetMaxH(H: Integer); - procedure SetMaxS(S: Integer); - procedure SetMaxL(L: Integer); - procedure SetR(R: integer); - procedure SetG(G: integer); - procedure SetB(B: integer); - procedure SetHSHint(h: string); - procedure SetLHint(h: string); - procedure SetLMenu(m: TPopupMenu); - procedure SetHSMenu(m: TPopupMenu); + function GetBrightnessMode: TBrightnessMode; + function GetHue: Integer; + function GetSat: Integer; + function GetLum: Integer; + function GetVal: Integer; + function GetMaxHue: Integer; + function GetMaxSat: Integer; + function GetMaxLum: Integer; + function GetMaxVal: Integer; + function GetRelHue: Double; + function GetRelSat: Double; + function GetRelLum: Double; + function GetRelVal: Double; + function GetLVHint(AMode: TBrightnessMode): String; + + procedure SetBrightnessMode(AMode: TBrightnessMode); + + procedure SetHue(H: integer); + procedure SetSat(S: integer); + procedure SetLum(L: integer); + procedure SetVal(V: Integer); + + procedure SetMaxHue(H: Integer); + procedure SetMaxLum(L: Integer); + procedure SetMaxSat(S: Integer); + procedure SetMaxVal(V: Integer); + + procedure SetRed(R: integer); + procedure SetGreen(G: integer); + procedure SetBlue(B: integer); + + procedure SetRelHue(H: Double); + procedure SetRelLum(L: Double); + procedure SetRelSat(S: Double); + procedure SetRelVal(V: Double); + procedure SetHSCursor(c: TCursor); - procedure SetLCursor(c: TCursor); - procedure SetSelectedColor(Value: TColor); + procedure SetHSHint(h: string); + procedure SetHSMenu(m: TPopupMenu); + + procedure SetLVCursor(c: TCursor); + procedure SetLVHint(AMode: TBrightnessMode; AText: string); + procedure SetLVMenu(m: TPopupMenu); + procedure SetLVIncrement(i: integer); + protected procedure DoChange; override; procedure DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); function GetColorUnderCursor: TColor; override; + function GetSelectedColor: TColor; override; procedure HSPickerChange(Sender: TObject); - procedure LPickerChange(Sender: TObject); + procedure LVPickerChange(Sender: TObject); procedure Paint; override; procedure Resize; override; - procedure SelectColor(c: TColor); + procedure SetSelectedColor(Value: TColor); override; + public constructor Create(AOwner: TComponent); override; destructor Destroy; override; @@ -62,24 +84,33 @@ type function GetSelectedHexColor: string; procedure SetFocus; override; property ColorUnderCursor; - property Red: integer read FRValue write SetR; - property Green: integer read FGValue write SetG; - property Blue: integer read FBValue write SetB; + property Red: integer read FRed write SetRed; + property Green: integer read FGreen write SetGreen; + property Blue: integer read FBlue write SetBlue; + property RelHue: Double read GetRelHue write SetRelHue; + property RelSaturation: Double read GetRelSat write SetRelSat; + property RelLuminance: Double read GetRelLum write SetRelLum; + property RelValue: Double read GetRelVal write SetRelVal; published - property Hue: integer read GetH write SetH default 0; - property Saturation: integer read GetS write SetS default 240; - property Luminance: integer read GetL write SetL default 120; - property LuminanceIncrement: integer read FLumIncrement write SetLumIncrement default 1; - property SelectedColor: TColor read FSelectedColor write SetSelectedColor default clRed; + property BrightnessMode: TBrightnessMode read GetBrightnessMode + write SetBrightnessMode default bmLuminance; + property Hue: integer read GetHue write SetHue default 0; + property Saturation: integer read GetSat write SetSat default 255; + property Luminance: integer read GetLum write SetLum default 127; + property LVIncrement: integer read FLVIncrement write SetLVIncrement default 1; + property Value: Integer read GetVal write SetVal default 255; + property SelectedColor default clRed; property HSPickerPopupMenu: TPopupMenu read FHSMenu write SetHSMenu; - property LPickerPopupMenu: TPopupMenu read FLMenu write SetLMenu; + property LVPickerPopupMenu: TPopupMenu read FLVMenu write SetLVMenu; property HSPickerHintFormat: string read FHSHint write SetHSHint; - property LPickerHintFormat: string read FLHint write SetLHint; + property LPickerHintFormat: string index bmLuminance read GetLVHint write SetLVHint; + property VPickerHintFormat: string index bmValue read GetLVHint write SetLVHint; property HSPickerCursor: TCursor read FHSCursor write SetHSCursor default crDefault; - property LPickerCursor: TCursor read FLCursor write SetLCursor default crDefault; - property MaxHue: Integer read GetMaxH write SetMaxH default 359; - property MaxSaturation: Integer read GetMaxS write SetMaxS default 240; - property MaxLuminance: Integer read GetMaxL write SetMaxL default 240; + property LVPickerCursor: TCursor read FLVCursor write SetLVCursor default crDefault; + property MaxHue: Integer read GetMaxHue write SetMaxHue default 360; + property MaxSaturation: Integer read GetMaxSat write SetMaxSat default 255; + property MaxLuminance: Integer read GetMaxLum write SetMaxLum default 127; + property MaxValue: Integer read GetMaxVal write SetMaxVal default 255; property TabStop default true; property ShowHint; property ParentShowHint; @@ -98,7 +129,7 @@ type implementation -{THSLColorPicker} +{ THSLColorPicker } uses mbTrackbarPicker; @@ -112,9 +143,10 @@ begin // PBack.PixelFormat := pf32bit; SetInitialBounds(0, 0, 206, 146); TabStop := true; - FLumIncrement := 1; + + FLVIncrement := 1; FHSCursor := crDefault; - FLCursor := crDefault; + FLVCursor := crDefault; FHSPicker := THSColorPicker.Create(Self); InsertControl(FHSPicker); @@ -122,36 +154,45 @@ begin begin SetInitialBounds(0, 6, 174, 134); Anchors := [akLeft, akTop, akRight, akBottom]; - Visible := true; - MaxHue := 359; - MaxSaturation := 240; - MaxLuminance := 240; + // Visible := true; + BrightnessMode := bmLuminance; + MaxHue := 360; + MaxSaturation := 255; + MaxLuminance := 255; + MaxValue := 255; OnChange := HSPickerChange; OnMouseMove := DoMouseMove; end; - FLPicker := TLColorPicker.Create(Self); - InsertControl(FLPicker); - with FLPicker do + FLVPicker := TLVColorPicker.Create(Self); + InsertControl(FLVPicker); + with FLVPicker do begin Layout := lyVertical; SetInitialBounds(184, 0, 25, 146); Anchors := [akRight, akTop, akBottom]; - Visible := true; +// Visible := true; + BrightnessMode := bmLuminance; MaxHue := FHSPicker.MaxHue; MaxSaturation := FHSPicker.MaxSaturation; MaxLuminance := FHSPicker.MaxLuminance; + MaxValue := FHSPicker.MaxValue; Luminance := MaxLuminance div 2; - OnChange := LPickerChange; + Value := MaxValue; + OnChange := LVPickerChange; OnMouseMove := DoMouseMove; end; Hue := 0; Saturation := FHSPicker.MaxLuminance; Luminance := FHSPicker.MaxLuminance div 2; + Value := FHSPicker.MaxValue; - FHSHint := 'H: %h S: %hslS'#13'Hex: %hex'; - FLHint := 'Luminance: %l'; + HSPickerHintFormat := 'H: %h S: %hslS'#13'Hex: %hex'; + { + FLVHint[bmLuminance] := 'Luminance: %l'; + FLVHint[bmValue] := 'Value: %v'; + } end; destructor THSLColorPicker.Destroy; @@ -161,27 +202,35 @@ begin end; procedure THSLColorPicker.DoChange; +var + c: TColor; begin - FSelectedColor := FLPicker.SelectedColor; - FRValue := GetRValue(FSelectedColor); - FGValue := GetGValue(FSelectedColor); - FBValue := GetBValue(FSelectedColor); + c := FLVPicker.SelectedColor; + FRed := GetRValue(c); + FGreen := GetGValue(c); + FBlue := GetBValue(c); inherited; end; -procedure THSLColorPicker.DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); +procedure THSLColorPicker.DoMouseMove(Sender: TObject; Shift: TShiftState; + X, Y: Integer); begin if Assigned(OnMouseMove) then OnMouseMove(Self, Shift, x, y); inherited; end; +function THSLColorPicker.GetBrightnessMode: TBrightnessMode; +begin + Result := FHSPicker.BrightnessMode; +end; + function THSLColorPicker.GetColorUnderCursor: TColor; begin Result := FHSPicker.ColorUnderCursor; end; -function THSLColorPicker.GetH: Integer; +function THSLColorPicker.GetHue: Integer; begin Result := FHSPicker.Hue; end; @@ -191,46 +240,89 @@ begin Result := FHSPicker.GetHexColorUnderCursor; end; -function THSLColorPicker.GetS: Integer; +function THSLColorPicker.GetSat: Integer; begin Result := FHSPicker.Saturation; end; -function THSLColorPicker.GetL: integer; +function THSLColorPicker.GetLum: integer; begin - Result := FLPicker.Luminance; + Result := FLVPicker.Luminance; end; -function THSLColorPicker.GetMaxH: Integer; +function THSLColorPicker.GetVal: Integer; +begin + Result := FLVPicker.Value; +end; + +function THSLColorPicker.GetMaxHue: Integer; begin Result := FHSPicker.MaxHue; end; -function THSLColorPicker.GetMaxS: Integer; +function THSLColorPicker.GetMaxSat: Integer; begin Result := FHSPicker.MaxSaturation; end; -function THSLColorPicker.GetMaxL: Integer; +function THSLColorPicker.GetMaxLum: Integer; begin - Result := FLPicker.MaxLuminance; + Result := FLVPicker.MaxLuminance; +end; + +function THSLColorPicker.GetMaxVal: Integer; +begin + Result := FLVPicker.MaxValue; +end; + +function THSLColorPicker.GetRelHue: Double; +begin + Result := FHSPicker.RelHue; +end; + +function THSLColorPicker.GetRelLum: Double; +begin + Result := FLVPicker.RelLuminance; +end; + +function THSLColorPicker.GetRelSat: Double; +begin + Result := FHSPicker.RelSaturation; +end; + +function THSLColorPicker.GetRelVal: Double; +begin + Result := FLVPicker.RelValue; +end; + +function THSLColorPicker.GetLVHint(AMode: TBrightnessMode): String; +begin + case AMode of + bmLuminance: Result := FLVPicker.LHintFormat; + bmValue : Result := FLVPicker.VHintFormat; + end; +end; + +function THSLColorPicker.GetSelectedColor: TColor; +begin + Result := FLVPicker.SelectedColor; end; function THSLColorPicker.GetSelectedHexColor: string; begin - Result := ColorToHex(FSelectedColor); + Result := ColorToHex(GetSelectedColor); end; procedure THSLColorPicker.HSPickerChange(Sender: TObject); begin - if FHSPicker.Hue <> FLPicker.Hue then - FLPicker.Hue := FHSPicker.Hue; - if FHSPicker.Saturation <> FLPicker.Saturation then - FLPicker.Saturation := FHSPicker.Saturation; + if FHSPicker.Hue <> FLVPicker.Hue then + FLVPicker.Hue := FHSPicker.Hue; + if FHSPicker.Saturation <> FLVPicker.Saturation then + FLVPicker.Saturation := FHSPicker.Saturation; DoChange; end; -procedure THSLColorPicker.LPickerChange(Sender: TObject); +procedure THSLColorPicker.LVPickerChange(Sender: TObject); begin DoChange; end; @@ -239,14 +331,14 @@ procedure THSLColorPicker.Resize; begin inherited; - if (FHSPicker = nil) or (FLPicker = nil) then + if (FHSPicker = nil) or (FLVPicker = nil) then exit; - FHSPicker.Width := Width - FLPicker.Width - 15; + FHSPicker.Width := Width - FLVPicker.Width - 15; FHSPicker.Height := Height - 12; - FLPicker.Left := Width - FLPicker.Width - 2; - FLPicker.Height := Height; // - 12; + FLVPicker.Left := Width - FLVPicker.Width - 2; + FLVPicker.Height := Height; // - 12; end; procedure THSLColorPicker.Paint; @@ -255,17 +347,16 @@ begin Canvas.Draw(0, 0, PBack); end; -procedure THSLColorPicker.SelectColor(c: TColor); +procedure THSLColorPicker.SetBlue(B: integer); begin - FSelectedColor := c; - FHSPicker.SelectedColor := c; - FLPicker.SelectedColor := c; + FBlue := B; + SetSelectedColor(RGBtoColor(FRed, FGreen, FBlue)); end; -procedure THSLColorPicker.SetB(B: integer); +procedure THSLColorPicker.SetBrightnessMode(AMode: TBrightnessMode); begin - FBValue := B; - SetSelectedColor(RGB(FRValue, FGValue, FBValue)); + FHSPicker.BrightnessMode := AMode; + FLVPicker.BrightnessMode := AMode; end; procedure THSLColorPicker.SetFocus; @@ -274,16 +365,16 @@ begin FHSPicker.SetFocus; end; -procedure THSLColorPicker.SetG(G: integer); +procedure THSLColorPicker.SetGreen(G: integer); begin - FGValue := G; - SetSelectedColor(RGB(FRValue, FGValue, FBValue)); + FGreen := G; + SetSelectedColor(RGBtoColor(FRed, FGreen, FBlue)); end; -procedure THSLColorPicker.SetH(H: integer); +procedure THSLColorPicker.SetHue(H: integer); begin FHSPicker.Hue := H; - FLPicker.Hue := H; + FLVPicker.Hue := H; end; procedure THSLColorPicker.SetHSCursor(c: TCursor); @@ -304,84 +395,124 @@ begin FHSPicker.PopupMenu := m; end; -procedure THSLColorPicker.SetL(L: integer); +procedure THSLColorPicker.SetLum(L: integer); begin - FLPicker.Luminance := L; + FLVPicker.Luminance := L; end; -procedure THSLColorPicker.SetLHint(h: string); +procedure THSLColorPicker.SetLVCursor(c: TCursor); begin - FLHint := h; - FLPicker.HintFormat := h; + FLVCursor := c; + FLVPicker.Cursor := c; end; -procedure THSLColorPicker.SetLMenu(m: TPopupMenu); +procedure THSLColorPicker.SetLVHint(AMode: TBrightnessMode; AText: string); begin - FLMenu := m; - FLPicker.PopupMenu := m; -end; - -procedure THSLColorPicker.SetLumIncrement(i: integer); -begin - FLumIncrement := i; - FLPicker.Increment := i; -end; - -procedure THSLColorPicker.SetLCursor(c: TCursor); -begin - FLCursor := c; - FLPicker.Cursor := c; -end; - -procedure THSLColorPicker.SetMaxH(H: Integer); -begin - FHSPicker.MaxHue := H; - FLPicker.MaxHue := H; -end; - -procedure THSLColorPicker.SetMaxL(L: Integer); -begin - FHSPicker.MaxLuminance := L; - FLPicker.MaxLuminance := L; -end; - -procedure THSLColorPicker.SetMaxS(S: Integer); -begin - FHSPicker.MaxSaturation := S; - FLPicker.MaxSaturation := S; -end; - -procedure THSLColorPicker.SetR(R: integer); -begin - FRValue := R; - SetSelectedColor(RGB(FRValue, FGValue, FBValue)); -end; - -procedure THSLColorPicker.SetS(S: integer); -begin - if S <> FHSPicker.Saturation then - FHSPicker.Saturation := S; - if S <> FLPicker.Saturation then - FLPicker.Saturation := S; -end; - -procedure THSLColorPicker.SetSelectedColor(Value: TColor); -begin - if FSelectedColor <> Value then - begin - SelectColor(Value); - //FLPicker.Hue := FHSPicker.HueValue; - //FLPicker.Saturation := FHSPicker.SaturationValue; + case AMode of + bmLuminance: FLVPicker.LHintFormat := AText; + bmValue : FLVPicker.VHintFormat := AText; end; end; -(* -procedure THSLColorPicker.WMSetFocus( - var Message: {$IFDEF FPC}TLMSetFocus{$ELSE}TWMSetFocus{$ENDIF} ); +procedure THSLColorPicker.SetLVIncrement(i: integer); begin - FHSPicker.SetFocus; - Message.Result := 1; + FLVIncrement := i; + FLVPicker.Increment := i; end; - *) + +procedure THSLColorPicker.SetLVMenu(m: TPopupMenu); +begin + FLVMenu := m; + FLVPicker.PopupMenu := m; +end; + +procedure THSLColorPicker.SetMaxHue(H: Integer); +begin + FHSPicker.MaxHue := H; + FLVPicker.MaxHue := H; +end; + +procedure THSLColorPicker.SetMaxLum(L: Integer); +begin + FHSPicker.MaxLuminance := L; + FLVPicker.MaxLuminance := L; +end; + +procedure THSLColorPicker.SetMaxSat(S: Integer); +begin + FHSPicker.MaxSaturation := S; + FLVPicker.MaxSaturation := S; +end; + +procedure THSLColorPicker.SetMaxVal(V: Integer); +begin + FLVPicker.MaxValue := V; +end; + +procedure THSLColorPicker.SetRed(R: integer); +begin + FRed := R; + SetSelectedColor(RGBtoColor(FRed, FGreen, FBlue)); +end; + +procedure THSLColorPicker.SetRelHue(H: Double); +begin + FHSPicker.RelHue := H; + FLVPicker.RelHue := H; +end; + +procedure THSLCOlorPicker.SetRelSat(S: Double); +begin + FHSPicker.RelSaturation := S; + FLVPicker.RelSaturation := S; +end; + +procedure THSLColorPicker.SetRelLum(L: Double); +begin + FHSPicker.RelLuminance := L; + FLVPicker.RelLuminance := L; +end; + +procedure THSLColorPicker.SetRelVal(V: Double); +begin + FHSPicker.RelValue := V; + FLVPicker.RelValue := V; +end; + +procedure THSLColorPicker.SetSat(S: integer); +begin + if S <> FHSPicker.Saturation then + FHSPicker.Saturation := S; + if S <> FLVPicker.Saturation then + FLVPicker.Saturation := S; +end; + +procedure THSLColorPicker.SetSelectedColor(Value: TColor); +var + c: TColor; + H: Double = 0; + S: Double = 0; + LV: Double = 0; +begin + c := GetSelectedColor; + if c <> Value then + begin + case GetBrightnessMode of + bmLuminance: ColorToHSL(c, H, S, LV); + bmValue : ColorToHSV(c, H, S, LV); + end; +// FSelectedColor := c; + FHSPicker.RelHue := H; + FHSPicker.RelSaturation := S; +// FHSPicker.SelectedColor := c; + FLVPicker.SelectedColor := c; + end; +end; + +procedure THSLColorPicker.SetVal(V: Integer); +begin + FLVPicker.Value := V; +end; + end. diff --git a/components/mbColorLib/HSLRingPicker.pas b/components/mbColorLib/HSLRingPicker.pas index 12fafd82c..935e51e02 100644 --- a/components/mbColorLib/HSLRingPicker.pas +++ b/components/mbColorLib/HSLRingPicker.pas @@ -9,7 +9,7 @@ interface uses LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Forms, Menus, Math, Themes, - RGBHSLUtils, HRingPicker, SLColorPicker, HTMLColors, mbBasicPicker; + mbColorConv, HRingPicker, SLColorPicker, HTMLColors, mbBasicPicker; type THSLRingPicker = class(TmbBasicPicker) @@ -17,41 +17,50 @@ type FRingPicker: THRingPicker; FSLPicker: TSLColorPicker; FSelectedColor: TColor; - FRValue, FGValue, FBValue: integer; +// FRValue, FGValue, FBValue: integer; FRingHint, FSLHint: string; FSLMenu, FRingMenu: TPopupMenu; FSLCursor, FRingCursor: TCursor; PBack: TBitmap; + function GetBrightnessMode: TBrightnessMode; function GetHue: Integer; function GetLum: Integer; function GetSat: Integer; + function GetVal: Integer; function GetMaxHue: Integer; function GetMaxLum: Integer; function GetMaxSat: Integer; + function GetRed: Integer; + function GetGreen: Integer; + function GetBlue: Integer; + function GetLVHint(AMode: TBrightnessMode): String; + procedure SetBrightnessMode(AMode: TBrightnessMode); procedure SetHue(H: integer); procedure SetSat(S: integer); procedure SetLum(L: integer); + procedure SetVal(V: Integer); procedure SetMaxHue(H: Integer); procedure SetMaxLum(L: Integer); procedure SetMaxSat(S: Integer); - procedure SetR(v: integer); - procedure SetG(v: integer); - procedure SetB(v: integer); + procedure SetRed(R: integer); + procedure SetGreen(G: integer); + procedure SetBlue(B: integer); procedure SetRingHint(h: string); - procedure SetSLHint(h: string); procedure SetSLMenu(m: TPopupMenu); procedure SetRingMenu(m: TPopupMenu); procedure SetRingCursor(c: TCursor); procedure SetSLCursor(c: TCursor); + procedure SetLVHint(AMode: TBrightnessMode; AText: String); protected - procedure CreateWnd; override; +// procedure CreateWnd; override; procedure DoChange; override; procedure DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); function GetColorUnderCursor: TColor; override; + function GetSelectedColor: TColor; override; procedure Paint; override; procedure Resize; override; procedure RingPickerChange(Sender: TObject); - procedure SelectColor(c: TColor); + procedure SetSelectedColor(c: TColor); override; procedure SLPickerChange(Sender: TObject); public constructor Create(AOwner: TComponent); override; @@ -60,21 +69,25 @@ type function GetSelectedHexColor: string; procedure SetFocus; override; property ColorUnderCursor; - property Red: integer read FRValue write SetR; - property Green: integer read FGValue write SetG; - property Blue: integer read FBValue write SetB; + property Red: integer read GetRed write SetRed; + property Green: integer read GetGreen write SetGreen; + property Blue: integer read GetBlue write SetBlue; published + property BrightnessMode: TBrightnessMode read GetBrightnessMode + write SetBrightnessMode default bmValue; property Hue: integer read GetHue write SetHue default 0; - property Saturation: integer read GetSat write SetSat default 240; - property Luminance: integer read GetLum write SetLum default 120; - property SelectedColor: TColor read FSelectedColor write SelectColor default clRed; + property Saturation: integer read GetSat write SetSat default 255; + property Luminance: integer read GetLum write SetLum default 127; + property Value: Integer read GetVal write SetVal default 255; + property SelectedColor default clRed; property RingPickerPopupMenu: TPopupMenu read FRingMenu write SetRingMenu; property SLPickerPopupMenu: TPopupMenu read FSLMenu write SetSLMenu; property RingPickerHintFormat: string read FRingHint write SetRingHint; - property SLPickerHintFormat: string read FSLHint write SetSLHint; + property SLPickerHintFormat: string index bmLuminance read GetLVHint write SetLVHint; + property SVPickerHintFormat: String index bmValue read GetLVHint write SetLVHint; property RingPickerCursor: TCursor read FRingCursor write SetRingCursor default crDefault; property SLPickerCursor: TCursor read FSLCursor write SetSLCursor default crDefault; - property MaxHue: Integer read GetMaxHue write SetMaxHue default 359; + property MaxHue: Integer read GetMaxHue write SetMaxHue default 360; property MaxLuminance: Integer read GetMaxLum write SetMaxLum default 240; property MaxSaturation: Integer read GetMaxSat write SetMaxSat default 240; property TabStop default true; @@ -100,30 +113,20 @@ begin inherited; // ControlStyle := ControlStyle - [csAcceptsControls] + [csOpaque{$IFDEF DELPHI_7_UP}, csParentBackground{$ENDIF}]; - FRValue := 255; - FGValue := 0; - FBValue := 0; PBack := TBitmap.Create; // PBack.PixelFormat := pf32bit; SetInitialBounds(0, 0, 245, 245); TabStop := true; - FSelectedColor := clRed; FRingCursor := crDefault; FSLCursor := crDefault; - FRingHint := 'Hue: %h'; - FSLHint := 'S: %hslS L: %l'#13'Hex: %hex'; FRingPicker := THRingPicker.Create(Self); InsertControl(FRingPicker); with FRingPicker do begin SetInitialBounds(0, 0, 246, 246); - //Radius := 40; + BrightnessMode := bmValue; Align := alClient; - Visible := true; - Saturation := FRingPicker.MaxSaturation; - Value := FRingPicker.MaxValue; - Hue := 0; OnChange := RingPickerChange; OnMouseMove := DoMouseMove; end; @@ -133,14 +136,14 @@ begin with FSLPicker do begin SetInitialBounds(63, 63, 120, 120); - MaxSaturation := 240; - MaxLuminance := 240; - Saturation := 240; - Luminance := 240; - Visible := true; + BrightnessMode := bmValue; + SLHintFormat := 'S: %hslS L: %l'#13'Hex: %hex'; + SVHintFormat := 'S: %hslS V: %v'#13'Hex: %hex'; OnChange := SLPickerChange; OnMouseMove := DoMouseMove; end; + + SetSelectedColor(clRed); end; destructor THSLRingPicker.Destroy; @@ -148,22 +151,16 @@ begin PBack.Free; inherited Destroy; end; - + (* procedure THSLRingPicker.CreateWnd; begin inherited; - PaintParentBack(PBack); -end; + //PaintParentBack(PBack); +end; *) procedure THSLRingPicker.DoChange; begin - if (FRingPicker = nil) or (FSLPicker = nil) then - exit; - - FRValue := GetRValue(FSLPicker.SelectedColor); - FGValue := GetGValue(FSLPicker.SelectedColor); - FBValue := GetBValue(FSLPicker.SelectedColor); - + FSelectedColor := FSLPicker.SelectedColor; inherited; end; @@ -174,11 +171,26 @@ begin inherited; end; +function THSLRingPicker.GetBlue: Integer; +begin + Result := GetRValue(FSelectedColor); +end; + +function THSLRingPicker.GetBrightnessMode: TBrightnessMode; +begin + Result := FSLPicker.BrightnessMode; +end; + function THSLRingPicker.GetColorUnderCursor: TColor; begin Result := FSLPicker.ColorUnderCursor; end; +function THSLRingPicker.GetGreen: Integer; +begin + Result := GetGValue(FSelectedColor); +end; + function THSLRingPicker.GetHexColorUnderCursor: string; begin Result := FSLPicker.GetHexColorUnderCursor; @@ -194,6 +206,14 @@ begin Result := FSLPicker.Luminance; end; +function THSLRingPicker.GetLVHint(AMode: TBrightnessMode): String; +begin + case BrightnessMode of + bmLuminance: Result := FSLPicker.SLHintFormat; + bmValue : Result := FSLPicker.SVHintFormat; + end; +end; + function THSLRingPicker.GetMaxHue: Integer; begin Result := FRingPicker.MaxHue; @@ -209,16 +229,31 @@ begin Result := FSLPicker.MaxLuminance; end; +function THSLRingPicker.GetRed: Integer; +begin + Result := GetRValue(FSelectedColor); +end; + function THSLRingPicker.GetSat: Integer; begin Result := FSLPicker.Saturation; end; +function THSLRingPicker.GetSelectedColor: TColor; +begin + Result := FSelectedColor; +end; + function THSLRingPicker.GetSelectedHexColor: string; begin Result := ColorToHex(FSelectedColor); end; +function THSLRingPicker.GetVal: Integer; +begin + Result := FSLPicker.Value; +end; + procedure THSLRingPicker.Paint; begin PaintParentBack(PBack); @@ -250,8 +285,6 @@ end; procedure THSLRingPicker.RingPickerChange(Sender: TObject); begin - if (FRingPicker = nil) or (FSLPicker = nil) then - exit; if FSLPicker.Hue <> FRingPicker.Hue then begin FSLPicker.Hue := FRingPicker.Hue; @@ -259,23 +292,15 @@ begin end; end; -procedure THSLRingPicker.SelectColor(c: TColor); +procedure THSLRingPicker.SetBlue(B: integer); begin - if (FRingPicker = nil) or (FSLPicker = nil) then - exit; - - FRingPicker.Hue := GetHValue(c); - //FRingPicker.Saturation := FRingPicker.MaxSaturation; - //FRingPicker.Value := FRingPicker.MaxValue; - - FSLPicker.SelectedColor := c; - FSelectedColor := c; + SetSelectedColor(RgbToColor(Red, Green, B)); end; -procedure THSLRingPicker.SetB(v: integer); +procedure THSLRingPicker.SetBrightnessMode(AMode: TBrightnessMode); begin - FBValue := v; - SelectColor(RGB(FRValue, FGValue, FBValue)); + FRingPicker.BrightnessMode := AMode; + FSLPicker.BrightnessMode := AMode; end; procedure THSLRingPicker.SetFocus; @@ -284,47 +309,51 @@ begin FRingPicker.SetFocus; end; -procedure THSLRingPicker.SetG(v: integer); +procedure THSLRingPicker.SetGreen(G: integer); begin - FGValue := v; - SelectColor(RGB(FRValue, FGValue, FBValue)); + SetSelectedColor(RgbToColor(Red, G, Blue)); end; procedure THSLRingPicker.SetHue(H: integer); begin - if (FRingPicker = nil) or (FSLPicker = nil) then - exit; - FRingPicker.Hue := H; FSLPicker.Hue := H; end; procedure THSLRingPicker.SetLum(L: integer); begin - if (FSLPicker = nil) then - exit; FSLPicker.Luminance := L; end; +procedure THSLRingPicker.SetLVHint(AMode: TBrightnessMode; AText: string); +begin + case AMode of + bmLuminance: FSLPicker.SLHintFormat := AText; + bmValue : FSLPicker.SVHintFormat := AText; + end; +end; + procedure THSLRingPicker.SetMaxHue(H: Integer); begin FRingPicker.MaxHue := H; + FSLPicker.MaxHue := H; end; procedure THSLRingPicker.SetMaxLum(L: Integer); begin + FRingPicker.MaxLuminance := L; FSLPicker.MaxLuminance := L; end; procedure THSLRingPicker.SetMaxSat(S: Integer); begin + FRingPicker.MaxSaturation := S; FSLPicker.MaxSaturation := S; end; -procedure THSLRingPicker.SetR(v: integer); +procedure THSLRingPicker.SetRed(R: integer); begin - FRValue := v; - SelectColor(RGB(FRValue, FGValue, FBValue)); + SetSelectedColor(RgbToColor(R, Green, Blue)); end; procedure THSLRingPicker.SetRingCursor(c: TCursor); @@ -347,36 +376,45 @@ end; procedure THSLRingPicker.SetSat(S: integer); begin - if (FSLPicker = nil) then - exit; FSLPicker.Saturation := S; end; +procedure THSLRingPicker.SetSelectedColor(c: TColor); +var + H, S, LV: Double; +begin + case BrightnessMode of + bmLuminance: ColorToHSL(c, H, S, LV); + bmValue : ColorToHSV(c, H, S, LV); + end; + FRingPicker.RelHue := H; + FSLPicker.SelectedColor := c; + FSelectedColor := FSLPicker.SelectedColor; +end; + procedure THSLRingPicker.SetSLCursor(c: TCursor); begin FSLCursor := c; FSLPicker.Cursor := c; end; -procedure THSLRingPicker.SetSLHint(h: string); -begin - FSLHint := h; - FSLPicker.HintFormat := h; -end; - procedure THSLRingPicker.SetSLMenu(m: TPopupMenu); begin FSLMenu := m; FSLPicker.PopupMenu := m; end; +procedure THSLRingPicker.SetVal(V: integer); +begin + FSLPicker.Value := V; +end; + procedure THSLRingPicker.SLPickerChange(Sender: TObject); begin - if (FSLPicker <> nil) and (FSelectedColor <> FSLPicker.SelectedColor) then - begin - FSelectedColor := FSLPicker.SelectedColor; - DoChange; - end; + if FSelectedColor = FSLPicker.SelectedColor then + exit; + FSelectedColor := FSLPicker.SelectedColor; + DoChange; end; end. diff --git a/components/mbColorLib/HSVColorPicker.pas b/components/mbColorLib/HSVColorPicker.pas index 476c9baa9..1f463e42c 100644 --- a/components/mbColorLib/HSVColorPicker.pas +++ b/components/mbColorLib/HSVColorPicker.pas @@ -8,34 +8,17 @@ interface uses LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Math, Forms, Themes, - RGBHSVUtils, Scanlines, HTMLColors, mbColorPickerControl; + HTMLColors, mbColorConv, mbColorPickerControl; type - THSVColorPicker = class(TmbColorPickerControl) + THSVColorPicker = class(TmbHSLVColorPickerControl) private - FHue, FSat, FValue: Double; - FMaxHue, FMaxSat, FMaxValue: Integer; FSatCircColor, FHueLineColor: TColor; - FSelectedColor: TColor; FShowSatCirc: boolean; FShowHueLine: boolean; FShowSelCirc: boolean; - function RadHue(New: integer): integer; - function GetHue: Integer; - function GetSat: Integer; - function GetValue: Integer; - function GetRed: Integer; - function GetGreen: Integer; - function GetBlue: Integer; - procedure SetMaxHue(h: Integer); - procedure SetMaxSat(s: Integer); - procedure SetMaxValue(v: Integer); - procedure SetHue(h: integer); - procedure SetSat(s: integer); - procedure SetValue(V: integer); - procedure SetRed(r: Integer); - procedure SetGreen(g: Integer); - procedure SetBlue(b: Integer); + procedure SetRelHue(H: Double); + procedure SetRelSat(S: Double); procedure SetSatCircColor(c: TColor); procedure SetHueLineColor(c: TColor); procedure DrawSatCirc; @@ -47,31 +30,26 @@ type procedure UpdateCoords; protected procedure CreateGradient; override; - procedure CreateWnd; override; +// procedure CreateWnd; override; function GetGradientColor2D(X, Y: Integer): TColor; override; - function GetSelectedColor: TColor; override; procedure Paint; override; procedure Resize; override; - procedure KeyDown(var Key: Word; Shift: TShiftState); override; - procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; - procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; - procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; - procedure SelectColor(x, y: integer); + procedure SelectColor(x, y: integer); override; procedure SetSelectedColor(c: TColor); override; public constructor Create(AOwner: TComponent); override; function GetColorAtPoint(x, y: integer): TColor; override; - property Red: Integer read GetRed write SetRed; - property Green: Integer read GetGreen write SetGreen; - property Blue: Integer read GetBlue write SetBlue; published + property BrightnessMode default bmValue; property SelectedColor default clRed; - property Hue: integer read GetHue write SetHue default 0; - property Saturation: integer read GetSat write SetSat default 255; - property Value: integer read GetValue write SetValue default 255; - property MaxHue: Integer read FMaxHue write SetMaxHue default 359; - property MaxSaturation: Integer read FMaxSat write SetMaxSat default 255; - property MaxValue: Integer read FMaxValue write SetMaxValue default 255; + property Hue default 0; + property Luminance default 127; + property Saturation default 255; + property Value default 255; + property MaxHue default 360; + property MaxLuminance default 255; + property MaxSaturation default 255; + property MaxValue default 255; property SaturationCircleColor: TColor read FSatCircColor write SetSatCircColor default clSilver; property HueLineColor: TColor read FHueLineColor write SetHueLineColor default clGray; property ShowSaturationCircle: boolean read FShowSatCirc write SetShowSatCirc default true; @@ -92,16 +70,14 @@ constructor THSVColorPicker.Create(AOwner: TComponent); begin inherited; SetInitialBounds(0, 0, 204, 204); - FMaxHue := 359; - FMaxSat := 255; - FMaxValue := 255; FHue := 0; FSat := 1.0; - FValue := 1.0; + FLum := 0.5; + FVal := 1.0; + SetSelectedColor(clRed); + BrightnessMode := bmValue; FSatCircColor := clSilver; FHueLineColor := clGray; - FSelectedColor := clRed; - FManual := false; FShowSatCirc := true; FShowHueLine := true; FShowSelCirc := true; @@ -114,13 +90,13 @@ begin FGradientHeight := FGradientWidth; inherited; end; - + (* procedure THSVColorPicker.CreateWnd; begin inherited; CreateGradient; UpdateCoords; -end; +end; *) procedure THSVColorPicker.DrawSatCirc; var @@ -171,11 +147,6 @@ begin InternalDrawMarker(x, y, c); end; -function THSVColorPicker.GetBlue: Integer; -begin - Result := GetBValue(FSelectedColor); -end; - function THSVColorPicker.GetColorAtPoint(x, y: integer): TColor; var angle: Double; @@ -196,7 +167,7 @@ begin angle := angle - 360; h := angle / 360; s := r / radius; - Result := HSVtoColor(h, s, FValue); + Result := HSLVtoColor(h, s, FLum, FVal); if WebSafe then Result := GetWebSafe(Result); end else @@ -209,8 +180,7 @@ var dx, dy: Integer; dSq, radiusSq: Integer; radius, size: Integer; - S, H, V: Double; - q: TRGBQuad; + S, H: Double; begin size := FGradientWidth; // or Height, they are the same... radius := size div 2; @@ -227,102 +197,13 @@ begin H := 180 * (1 + arctan2(dx, dy) / pi); // wp: order (x,y) is correct! H := H + 90; if H > 360 then H := H - 360; - Result := HSVtoColor(H/360, S, FValue); + Result := HSLVtoColor(H/360, S, FLum, FVal); if WebSafe then Result := GetWebSafe(Result); end else Result := GetDefaultColor(dctBrush); end; -function THSVColorPicker.GetGreen: Integer; -begin - Result := GetGValue(FSelectedColor); -end; - -function THSVColorPicker.GetHue: Integer; -begin - Result := round(FHue * FMaxHue); -end; - -function THSVColorPicker.GetRed: Integer; -begin - Result := GetRValue(FSelectedColor); -end; - -function THSVColorPicker.GetSat: Integer; -begin - Result := round(FSat * FMaxSat); -end; - -function THSVColorPicker.GetSelectedColor: TColor; -begin - if FSelectedColor <> clNone then - begin - Result := HSVtoColor(FHue, FSat, FValue); - if WebSafe then - Result := GetWebSafe(Result); - end - else - Result := clNone; -end; - -function THSVColorPicker.GetValue: Integer; -begin - Result := round(FValue * FMaxValue); -end; - -procedure THSVColorPicker.KeyDown(var Key: Word; Shift: TShiftState); -var - eraseKey: Boolean; - delta: Integer; -begin - eraseKey := true; - delta := IfThen(ssCtrl in shift, 10, 1); - - case Key of - VK_LEFT : SetHue(RadHue(GetHue() + delta)); - VK_RIGHT : SetHue(RadHue(GetHue() - delta)); - VK_UP : SetSat(GetSat() + delta); - VK_DOWN : SetSat(GetSat() - delta); - else eraseKey := false; - end; - - if eraseKey then - Key := 0; - - inherited; -end; - -procedure THSVColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; - X, Y: Integer); -begin - inherited; - if csDesigning in ComponentState then - exit; - if (Button = mbLeft) and PointInCircle(Point(x, y), Min(Width, Height)) then - SelectColor(X, Y); - SetFocus; -end; - -procedure THSVColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer); -begin - inherited; - if csDesigning in ComponentState then - exit; - if (ssLeft in Shift) and PointInCircle(Point(x, y), Min(Width, Height)) then - SelectColor(X, Y); -end; - -procedure THSVColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; - X, Y: Integer); -begin - inherited; - if csDesigning in ComponentState then - exit; - if (Button = mbLeft) and PointInCircle(Point(x, y), Min(Width, Height)) then - SelectColor(X, Y); -end; - procedure THSVColorPicker.Paint; var rgn: HRGN; @@ -342,13 +223,6 @@ begin DrawMarker(mx, my); end; -function THSVColorPicker.RadHue(New: integer): integer; -begin - if New < 0 then New := New + (FMaxHue + 1); - if New > (FMaxHue + 1) then New := New - (FMaxHue + 1); - Result := New; -end; - procedure THSVColorPicker.Resize; begin inherited; @@ -393,48 +267,12 @@ begin FHue := H; FSat := S; - FSelectedColor := HSVToColor(FHue, FSat, FValue); + FSelected := HSLVToColor(FHue, FSat, FLum, FVal); UpdateCoords; Invalidate; DoChange; end; -procedure THSVColorPicker.SetBlue(b: Integer); -var - c: TColor; -begin - Clamp(b, 0, 255); - if b = GetBValue(FSelectedColor) then - exit; - c := RgbToColor(GetRValue(FSelectedColor), GetGValue(FSelectedColor), b); - SetSelectedColor(c); -end; - -procedure THSVColorPicker.SetGreen(g: Integer); -var - c: TColor; -begin - Clamp(g, 0, 255); - if g = GetGValue(FSelectedColor) then - exit; - c := RgbToColor(GetRValue(FSelectedColor), g, GetBValue(FSelectedColor)); - SetSelectedColor(c); -end; - -procedure THSVColorPicker.SetHue(h: integer); -begin - if h > FMaxHue then h := h - (FMaxHue + 1); - if h < 0 then h := h + (FMaxHue + 1); - if GetHue() <> h then - begin - FHue := h / FMaxHue; - FSelectedColor := HSVToColor(FHue, FSat, FValue); - UpdateCoords; - Invalidate; - DoChange; - end; -end; - procedure THSVColorPicker.SetHueLineColor(c: TColor); begin if FHueLineColor <> c then @@ -444,54 +282,27 @@ begin end; end; -procedure THSVColorPicker.SetMaxHue(h: Integer); +procedure THSVColorPicker.SetRelHue(H: Double); begin - if h = FMaxHue then - exit; - FMaxHue := h; - CreateGradient; - //if FChange and Assigned(OnChange) then OnChange(Self); - Invalidate; -end; - -procedure THSVColorPicker.SetMaxSat(s: Integer); -begin - if s = FMaxSat then - exit; - FMaxSat := s; - CreateGradient; - //if FChange and Assigned(OnChange) then OnChange(Self); - Invalidate; -end; - -procedure THSVColorPicker.SetMaxValue(v: Integer); -begin - if v = FMaxValue then - exit; - FMaxValue := v; - CreateGradient; - //if FChange and Assigned(OnChange) then OnChange(Self); - Invalidate; -end; - -procedure THSVColorPicker.SetRed(r: Integer); -var - c: TColor; -begin - Clamp(r, 0, 255); - if r = GetRValue(FSelectedColor) then - exit; - c := RgbToColor(r, GetGValue(FSelectedColor), GetBValue(FSelectedColor)); - SetSelectedColor(c); -end; - -procedure THSVColorPicker.SetSat(s: integer); -begin - Clamp(s, 0, FMaxSat); - if GetSat() <> s then + if H > 1 then H := H - 1; + if H < 0 then H := H + 1; + if FHue <> h then begin - FSat := s / FMaxSat; - FSelectedColor := HSVToColor(FHue, FSat, FValue); + FHue := h; + FSelected := HSLVtoColor(FHue, FSat, FLum, FVal); + UpdateCoords; + Invalidate; + DoChange; + end; +end; + +procedure THSVColorPicker.SetRelSat(S: Double); +begin + Clamp(S, 0.0, 1.0); + if FSat <> S then + begin + FSat := s; + FSelected := HSLVToColor(FHue, FSat, FLum, FVal); UpdateCoords; Invalidate; DoChange; @@ -508,15 +319,13 @@ begin end; procedure THSVColorPicker.SetSelectedColor(c: TColor); -var - h, s, v: Double; begin if WebSafe then c := GetWebSafe(c); - if c = FSelectedColor then + if c = FSelected then exit; - RGBtoHSV(GetRValue(c), GetGValue(c), GetBValue(c), FHue, FSat, FValue); - FSelectedColor := c; + ColorToHSLV(c, FHue, FSat, FLum, FVal); + FSelected := c; UpdateCoords; Invalidate; DoChange; @@ -549,19 +358,6 @@ begin end; end; -procedure THSVColorPicker.SetValue(V: integer); -begin - Clamp(V, 0, FMaxValue); - if GetValue() <> V then - begin - FValue := V / FMaxValue; - FSelectedColor := HSVToColor(FHue, FSat, FValue); - CreateGradient; - Invalidate; - DoChange; - end; -end; - procedure THSVColorPicker.UpdateCoords; var r, angle: double; diff --git a/components/mbColorLib/HexaColorPicker.pas b/components/mbColorLib/HexaColorPicker.pas index dcdc5915f..5d83aa809 100644 --- a/components/mbColorLib/HexaColorPicker.pas +++ b/components/mbColorLib/HexaColorPicker.pas @@ -11,8 +11,7 @@ interface uses LCLIntf, LCLType, LMessages, SysUtils, Classes, Controls, Graphics, StdCtrls, Forms, Themes, Math, - HTMLColors, RGBHSLUtils, RGBHSVUtils, RGBCMYKUtils, RGBCIEUtils, - mbBasicPicker; + HTMLColors, mbBasicPicker; const CustomCell = -2; @@ -90,7 +89,6 @@ type procedure SetNewArrowStyle(Value: boolean); procedure SetMarker(Value: TMarker); procedure SetRadius(r: integer); - procedure SetSelectedColor(const Value: TColor); procedure SetSliderVisible(Value: boolean); procedure SetSliderWidth(w: integer); function SelectAvailableColor(Color: TColor): boolean; @@ -100,6 +98,7 @@ type procedure KeyDown(var Key: Word; Shift: TShiftState); override; procedure Paint; override; procedure Resize; override; + procedure SetSelectedColor(Value: TColor); override; procedure CMHintShow(var Message: TLMessage); message CM_HINTSHOW; procedure WMLButtonDown(var Message: TLMLButtonDown); message LM_LBUTTONDOWN; procedure WMLButtonUp(var Message: TLMLButtonUp); message LM_LBUTTONUP; @@ -705,7 +704,7 @@ begin FBWCombRect := Rect( FColorCombRect.Left, FColorCombRect.Bottom - 4, - Round(17 * FCombSize * cos(Pi / 6) / 2) + 6 * FCombSize, + Round(17 * FCombSize * cos(Pi / 6) / 2) {%H-}+ 6 * FCombSize, FColorCombRect.Bottom + 2 * FCombSize ); if FSliderVisible then @@ -977,7 +976,7 @@ begin end; end; -procedure THexaColorPicker.SetSelectedColor(const Value: TColor); +procedure THexaColorPicker.SetSelectedColor(Value: TColor); begin FCurrentColor := Value; SelectColor(Value); diff --git a/components/mbColorLib/KColorPicker.pas b/components/mbColorLib/KColorPicker.pas index 9a8197dac..0d4d284c8 100644 --- a/components/mbColorLib/KColorPicker.pas +++ b/components/mbColorLib/KColorPicker.pas @@ -17,17 +17,17 @@ type FCyan, FMagenta, FYellow, FBlack: integer; function ArrowPosFromBlack(k: integer): integer; function BlackFromArrowPos(p: integer): integer; - function GetSelectedColor: TColor; procedure SetBlack(k: integer); procedure SetCyan(c: integer); procedure SetMagenta(m: integer); - procedure SetSelectedColor(clr: TColor); procedure SetYellow(y: integer); protected procedure Execute(tbaAction: integer); override; function GetArrowPos: integer; override; function GetGradientColor(AValue: Integer): TColor; override; + function GetSelectedColor: TColor; override; function GetSelectedValue: integer; override; + procedure SetSelectedColor(clr: TColor); override; public constructor Create(AOwner: TComponent); override; published @@ -35,8 +35,9 @@ type property Magenta: integer read FMagenta write SetMagenta default 0; property Yellow: integer read FYellow write SetYellow default 0; property Black: integer read FBlack write SetBlack default 0; - property SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed; + property SelectedColor default clRed; property Layout default lyVertical; + property HintFormat; end; implementation diff --git a/components/mbColorLib/LColorPicker.pas b/components/mbColorLib/LColorPicker.pas index be78caf82..7165ca8fe 100644 --- a/components/mbColorLib/LColorPicker.pas +++ b/components/mbColorLib/LColorPicker.pas @@ -8,7 +8,7 @@ interface uses LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Forms, - HTMLColors, RGBHSLUtils, mbTrackBarPicker; + HTMLColors, {RGBHSLUtils, }mbTrackBarPicker; type TLColorPicker = class(TmbTrackBarPicker) @@ -19,7 +19,6 @@ type function GetHue: Integer; function GetLuminance: Integer; function GetSat: Integer; - function GetSelectedColor: TColor; function LumFromArrowPos(p: integer): integer; procedure SetHue(H: integer); procedure SetLuminance(L: integer); @@ -27,37 +26,39 @@ type procedure SetMaxLum(L: Integer); procedure SetMaxSat(S: Integer); procedure SetSat(S: integer); - procedure SetSelectedColor(c: TColor); protected procedure Execute(tbaAction: integer); override; function GetArrowPos: integer; override; function GetGradientColor(AValue: Integer): TColor; override; + function GetSelectedColor: TColor; override; function GetSelectedValue: integer; override; + procedure SetSelectedColor(c: TColor); override; public constructor Create(AOwner: TComponent); override; published property Hue: integer read GetHue write SetHue; property Saturation: integer read GetSat write SetSat; property Luminance: integer read GetLuminance write SetLuminance; - property MaxHue: Integer read FMaxHue write SetmaxHue default 359; - property MaxSaturation: Integer read FMaxSat write SetMaxSat default 240; - property MaxLuminance: Integer read FMaxLum write SetMaxLum default 240; - property SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed; + property MaxHue: Integer read FMaxHue write SetmaxHue default 360; + property MaxSaturation: Integer read FMaxSat write SetMaxSat default 255; + property MaxLuminance: Integer read FMaxLum write SetMaxLum default 255; + property SelectedColor default clRed; + property HintFormat; end; implementation uses - mbUtils; + mbUtils, mbColorConv; {TLColorPicker} constructor TLColorPicker.Create(AOwner: TComponent); begin inherited; - FMaxHue := 359; - FMaxSat := 240; - FMaxLum := 240; + FMaxHue := 360; + FMaxSat := 255; + FMaxLum := 255; FGradientWidth := FMaxLum + 1; FGradientHeight := 1; FHue := 0; @@ -130,7 +131,7 @@ end; function TLColorPicker.GetGradientColor(AValue: Integer): TColor; begin - Result := HSLToRGB(FHue, FSat, AValue/FMaxLum); + Result := HSLToColor(FHue, FSat, AValue/FMaxLum); end; function TLColorPicker.GetHue: Integer; @@ -150,7 +151,7 @@ end; function TLColorPicker.GetSelectedColor: TColor; begin - Result := HSLToRGB(FHue, FSat, FLuminance); + Result := HSLToColor(FHue, FSat, FLuminance); if WebSafe then Result := GetWebSafe(Result); end; @@ -165,8 +166,8 @@ var L: integer; begin case Layout of - lyHorizontal : L := Round(p / (Width - 12) * FMaxLum); - lyVertical : L := Round(MaxLum - p /(Height - 12) * FMaxLum); + lyHorizontal : L := Round( p / (Width - 12) * FMaxLum); + lyVertical : L := Round((1.0 - p /(Height - 12)) * FMaxLum); end; Clamp(L, 0, FMaxLum); Result := L; @@ -193,7 +194,6 @@ begin FArrowPos := ArrowPosFromLum(L); Invalidate; DoChange; -// if FChange and Assigned(OnChange) then OnChange(Self); end; end; @@ -250,8 +250,8 @@ begin if c = GetSelectedColor then exit; -// ColortoHSL(c, FHue, FSat, FLuminance); // not working in HSLPicker - RGBtoHSL(c, H, S, L); +// ColortoHSL(c, H, S, L); // not working in HSLPicker + ColorToHSL(c, H, S, L); needNewGradient := (H <> FHue) or (S <> FSat); FHue := H; FSat := S; diff --git a/components/mbColorLib/LVColorPicker.pas b/components/mbColorLib/LVColorPicker.pas new file mode 100644 index 000000000..debebd24b --- /dev/null +++ b/components/mbColorLib/LVColorPicker.pas @@ -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. diff --git a/components/mbColorLib/MColorPicker.pas b/components/mbColorLib/MColorPicker.pas index f7d684124..6bcfc9484 100644 --- a/components/mbColorLib/MColorPicker.pas +++ b/components/mbColorLib/MColorPicker.pas @@ -14,18 +14,18 @@ type private FCyan, FMagenta, FYellow, FBlack: integer; function ArrowPosFromMagenta(m: integer): integer; - function GetSelectedColor: TColor; function MagentaFromArrowPos(p: integer): integer; procedure SetBlack(k: integer); procedure SetCyan(c: integer); procedure SetMagenta(m: integer); - procedure SetSelectedColor(clr: TColor); procedure SetYellow(y: integer); protected procedure Execute(tbaAction: integer); override; function GetArrowPos: integer; override; function GetGradientColor(AValue: Integer): TColor; override; + function GetSelectedColor: TColor; override; function GetSelectedValue: integer; override; + procedure SetSelectedColor(clr: TColor); override; public constructor Create(AOwner: TComponent); override; published @@ -33,8 +33,9 @@ type property Magenta: integer read FMagenta write SetMagenta default 255; property Yellow: integer read FYellow write SetYellow default 0; property Black: integer read FBlack write SetBlack default 0; - property SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed; + property SelectedColor default clRed; property Layout default lyVertical; + property HintFormat; end; diff --git a/components/mbColorLib/OfficeMoreColorsDialog.lfm b/components/mbColorLib/OfficeMoreColorsDialog.lfm index 196d2e58b..e6edd3de5 100644 --- a/components/mbColorLib/OfficeMoreColorsDialog.lfm +++ b/components/mbColorLib/OfficeMoreColorsDialog.lfm @@ -56,9 +56,10 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin TabIndex = 1 TabOrder = 0 OnChange = PagesChange + OnChanging = PagesChanging object Standard: TTabSheet Caption = 'Standard' - ClientHeight = 273 + ClientHeight = 277 ClientWidth = 243 object Label2: TLabel Left = 6 @@ -73,11 +74,11 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin AnchorSideTop.Control = Label2 AnchorSideTop.Side = asrBottom Left = 0 - Height = 246 - Top = 26 + Height = 254 + Top = 22 Width = 240 Anchors = [akTop, akLeft, akRight, akBottom] - HintFormat = 'RGB(%r, %g, %b)'#13'Hex: %h' + HintFormat = 'RGB(%r, %g, %b)'#13'Hex: %hex' IntensityText = 'Intensity' TabOrder = 0 Constraints.MinHeight = 85 @@ -173,7 +174,7 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin Caption = '&Sat:' ParentColor = False end - object LLum: TLabel + object LLumVal: TLabel Left = 120 Height = 15 Top = 249 @@ -200,11 +201,12 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin Height = 141 Top = 0 Width = 232 - Hue = 180 - Saturation = 227 - SelectedColor = 16315911 + SelectedColor = 460791 + Saturation = 241 HSPickerHintFormat = 'H: %h S: %s'#13'Hex: %hex' LPickerHintFormat = 'Luminance: %l' + VPickerHintFormat = 'Value: %value (selected)' + MaxLuminance = 255 Align = alClient TabOrder = 0 OnChange = ColorPickerChange @@ -218,9 +220,14 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin Height = 124 Top = 0 Width = 136 + SelectedColor = 14803455 + Saturation = 30 Luminance = 240 RingPickerHintFormat = 'Hue: %h' - SLPickerHintFormat = 'S: %hslS L: %l'#13'Hex: %hex' + SLPickerHintFormat = 'S: %hslS V: %v'#13'Hex: %hex' + SVPickerHintFormat = 'S: %hslS V: %v'#13'Hex: %hex' + MaxLuminance = 255 + MaxSaturation = 255 ParentShowHint = False Anchors = [akTop, akLeft, akBottom] TabOrder = 0 @@ -242,13 +249,16 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin Top = 0 Width = 232 ParentColor = False + SelectedColor = clWhite + Saturation = 0 Luminance = 240 HPickerHintFormat = 'Hue: %h' SLPickerHintFormat = 'S: %hslS L: %l'#13'Hex: %hex' + MaxSaturation = 255 + MaxLuminance = 255 ParentShowHint = False Align = alClient TabOrder = 0 - Color = clMenuHighlight OnChange = ColorPickerChange end end @@ -260,7 +270,7 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin Height = 32 Top = 0 Width = 218 - HintFormat = 'Red: %value (selected)' + SelectedColor = 8026879 Layout = lyHorizontal SelectionIndicator = siRect Anchors = [akTop, akLeft, akRight] @@ -268,7 +278,7 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin OnChange = ColorPickerChange Green = 122 Blue = 122 - SelectedColor = 8026879 + HintFormat = 'Red: %value (selected)' end object GTrackbar: TGColorPicker AnchorSideRight.Control = nbRGB @@ -277,9 +287,9 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin Height = 32 Top = 40 Width = 216 + SelectedColor = 8060794 BevelInner = bvLowered BevelOuter = bvRaised - HintFormat = 'Green: %value (selected)' Layout = lyHorizontal SelectionIndicator = siRect Anchors = [akTop, akLeft, akRight] @@ -287,7 +297,7 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin OnChange = ColorPickerChange Red = 122 Blue = 122 - SelectedColor = 8060794 + HintFormat = 'Green: %value (selected)' end object BTrackbar: TBColorPicker AnchorSideRight.Control = nbRGB @@ -296,7 +306,7 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin Height = 32 Top = 80 Width = 216 - HintFormat = 'Blue: %value (selected)' + SelectedColor = 16743034 Layout = lyHorizontal SelectionIndicator = siRect Anchors = [akTop, akLeft, akRight] @@ -304,7 +314,7 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin OnChange = ColorPickerChange Green = 122 Red = 122 - SelectedColor = 16743034 + HintFormat = 'Blue: %value (selected)' end object Label6: TLabel AnchorSideTop.Control = RTrackbar diff --git a/components/mbColorLib/OfficeMoreColorsDialog.pas b/components/mbColorLib/OfficeMoreColorsDialog.pas index 1c19a606d..0ce558cbd 100644 --- a/components/mbColorLib/OfficeMoreColorsDialog.pas +++ b/components/mbColorLib/OfficeMoreColorsDialog.pas @@ -5,7 +5,7 @@ interface uses LCLIntf, LCLType, SysUtils, Variants, Classes, Graphics, Controls, Forms, StdCtrls, ExtCtrls, ComCtrls, - HexaColorPicker, HSLColorPicker, RGBHSLUtils, mbColorPreview, + HexaColorPicker, HSLColorPicker, mbColorConv, mbColorPreview, {$IFDEF mbXP_Lib}mbXPSpinEdit, mbXPSizeGrip,{$ELSE} Spin,{$ENDIF} HTMLColors, SLHColorPicker, HSLRingPicker, RColorPicker, GColorPicker, BColorPicker; @@ -22,7 +22,7 @@ type Label6: TLabel; Label7: TLabel; Label8: TLabel; - LLum: TLabel; + LLumVal: TLabel; LSat: TLabel; LHue: TLabel; nbRGB: TPage; @@ -51,49 +51,66 @@ type NewSwatch: TmbColorPreview; OldSwatch: TmbColorPreview; procedure cbColorDisplayChange(Sender: TObject); - procedure FormShow(Sender: TObject); - procedure HSLChange(Sender: TObject); - procedure ERedChange(Sender: TObject); - procedure EGreenChange(Sender: TObject); + procedure ColorPickerChange(Sender: TObject); procedure EBlueChange(Sender: TObject); + procedure EGreenChange(Sender: TObject); procedure EHueChange(Sender: TObject); + procedure ELumValChange(Sender: TObject); + procedure ERedChange(Sender: TObject); procedure ESatChange(Sender: TObject); - procedure ELumChange(Sender: TObject); procedure FormCreate(Sender: TObject); - procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); + procedure FormKeyDown(Sender: TObject; var Key: Word; {%H-}Shift: TShiftState); procedure FormResize(Sender: TObject); + procedure FormShow(Sender: TObject); function GetHint(c: TColor): string; procedure HexaChange(Sender: TObject); + procedure HSLChange(Sender: TObject); procedure HSLRingChange(Sender: TObject); procedure NewSwatchColorChange(Sender: TObject); procedure OldSwatchColorChange(Sender: TObject); procedure PagesChange(Sender: TObject); - procedure ColorPickerChange(Sender: TObject); + procedure PagesChanging(Sender: TObject; var {%H-}AllowChange: Boolean); procedure SLHChange(Sender: TObject); private {$IFDEF mbXP_Lib} ERed, EGreen, EBlue: TmbXPSpinEdit; - EHue, ESat, ELum: TmbXPSpinEdit; + EHue, ESat, ELumVal: TmbXPSpinEdit; grip: TmbXPSizeGrip; {$ELSE} ERed, EGreen, EBlue: TSpinEdit; - EHue, ESat, ELum: TSpinEdit; + EHue, ESat, ELumVal: TSpinEdit; {$ENDIF} FMaxHue: Integer; FMaxSat: Integer; FMaxLum: Integer; + FMaxVal: Integer; + FSelectedColor: TColor; + FBrightnessMode: TBrightnessMode; FLockChange: Integer; + function GetPickerIndex: Integer; + function GetSelectedColor: TColor; function GetShowHint: Boolean; procedure SetAllCustom(c: TColor); procedure SetAllToSel(c: TColor); + procedure SetBrightnessMode(AMode: TBrightnessMode); + procedure SetMaxHue(H: Integer); + procedure SetMaxLum(L: Integer); + procedure SetMaxSat(S: Integer); + procedure SetMaxVal(V: Integer); + procedure SetPickerIndex(AValue: Integer); + procedure SetSelectedColor(c: TColor); procedure SetShowHint(AValue: boolean); protected + procedure BeginUpdate; procedure CreateParams(var Params: TCreateParams); override; -// procedure CreateWnd; override; + procedure EndUpdate; public - property MaxHue: Integer read FMaxHue write FMaxHue; - property MaxSaturation: Integer read FMaxSat write FMaxSat; - property MaxLuminance: Integer read FMaxLum write FMaxLum; + property PickerIndex: Integer read GetPickerIndex write SetPickerIndex; + property SelectedColor: TColor read GetSelectedColor write SetSelectedColor; + property MaxHue: Integer read FMaxHue write SetMaxHue; + property MaxSaturation: Integer read FMaxSat write SetMaxSat; + property MaxLuminance: Integer read FMaxLum write SetMaxLum; + property MaxValue: Integer read FMaxVal write SetMaxVal; published property ShowHint: Boolean read GetShowHint write SetShowHint; end; @@ -105,8 +122,16 @@ implementation {$R *.lfm} +procedure TOfficeMoreColorsWin.BeginUpdate; +begin + inc(FLockChange); +end; + procedure TOfficeMoreColorsWin.ColorPickerChange(Sender: TObject); begin + if FLockChange > 0 then + exit; + if Sender = HSL then SetAllCustom(HSL.SelectedColor); if Sender = HSLRing then @@ -183,27 +208,42 @@ begin try HSL.Hue := EHue.Value; SLH.Hue := EHue.Value; - NewSwatch.Color := HSLToRGB(EHue.Value/FMaxHue, ESat.Value/FMaxSat, ELum.Value/FMaxLum); + case FBrightnessMode of + bmLuminance: + NewSwatch.Color := HSLToColor(EHue.Value/FMaxHue, ESat.Value/FMaxSat, ELumVal.Value/FMaxLum); + bmValue: + NewSwatch.Color := HSVtoColor(EHue.Value/FMaxHue, ESat.Value/FMaxSat, ELumVal.Value/FMaxVal); + end; finally dec(FLockChange); end; end; end; -procedure TOfficeMoreColorsWin.ELumChange(Sender: TObject); +procedure TOfficeMoreColorsWin.ELumValChange(Sender: TObject); begin - if (ELum.Text <> '') and ELum.Focused and (FLockChange = 0) then + if (ELumVal.Text <> '') and ELumVal.Focused and (FLockChange = 0) then begin inc(FLockChange); try - HSL.Luminance := ELum.Value; - NewSwatch.Color := HSLToRGB(EHue.Value/FMaxHue, ESat.Value/FMaxSat, ELum.Value/FMaxLum); + HSL.Luminance := ELumVal.Value; + case FBrightnessMode of + bmLuminance: + NewSwatch.Color := HSLToColor(EHue.Value/FMaxHue, ESat.Value/FMaxSat, ELumVal.Value/FMaxLum); + bmValue: + NewSwatch.Color := HSVtoColor(EHue.Value/FMaxHue, ESat.Value/FMaxSat, ELumVal.Value/FMaxVal); + end; finally dec(FLockChange); end; end; end; +procedure TOfficeMoreColorsWin.EndUpdate; +begin + dec(FLockChange); +end; + procedure TOfficeMoreColorsWin.ERedChange(Sender: TObject); begin if (ERed.Text <> '') and ERed.Focused and (FLockChange = 0) then @@ -227,7 +267,12 @@ begin try HSL.Saturation := ESat.Value; SLH.Saturation := ESat.Value; - NewSwatch.Color := HSLToRGB(EHue.Value/FMaxHue, ESat.Value/FMaxSat, ELum.Value/FMaxLum); + case FBrightnessMode of + bmLuminance: + NewSwatch.Color := HSLToColor(EHue.Value/FMaxHue, ESat.Value/FMaxSat, ELumval.Value/FMaxLum); + bmValue: + NewSwatch.Color := HSVtoColor(EHue.Value/FMaxHue, ESat.Value/FMaxSat, ELumval.Value/FMaxVal); + end; finally dec(FLockChange); end; @@ -236,21 +281,27 @@ end; procedure TOfficeMoreColorsWin.FormCreate(Sender: TObject); begin - FMaxHue := 359; - FMaxSat := 240; - FMaxLum := 240; + FBrightnessMode := bmLuminance; + + FMaxHue := 360; + FMaxSat := 255; + FMaxLum := 255; + FMaxVal := 255; HSL.MaxHue := FMaxHue; HSL.MaxSaturation := FMaxSat; HSL.MaxLuminance := FMaxLum; + HSL.BrightnessMode := FBrightnessMode; HSLRing.MaxHue := FMaxHue; HSLRing.MaxSaturation := FMaxSat; HSLRing.MaxLuminance := FMaxLum; + HSLRing.BrightnessMode := FBrightnessMode; SLH.MaxHue := FMaxHue; SLH.MaxSaturation := FMaxSat; SLH.MaxLuminance := FMaxLum; + SLH.BrightnessMode := FBrightnessMode; {$IFDEF mbXP_Lib} ERed := TmbXPSpinEdit.CreateParented(Custom.Handle); @@ -263,7 +314,7 @@ begin EBlue := TSpinEdit.CreateParented(Custom.Handle); EHue := TSpinEdit.CreateParented(Custom.Handle); ESat := TSpinEdit.CreateParented(Custom.Handle); - ELum := TSpinEdit.CreateParented(Custom.Handle); + ELumVal := TSpinEdit.CreateParented(Custom.Handle); {$ENDIF} with ERed do begin @@ -340,9 +391,9 @@ begin OnChange := @ESatChange; // TabOrder := EHue.TabOrder + 1; end; - with ELum do + with ELumVal do begin - Name := 'ELum'; + Name := 'ELumVal'; Width := 47; Height := 22; Left := cbColorDisplay.Left + cbColorDisplay.Width - Width; @@ -352,7 +403,7 @@ begin MaxValue := FMaxLum; MinValue := 0; Value := 0; - OnChange := @ELumChange; + OnChange := @ELumValChange; // TabOrder := ESat.TabOrder + 1; end; Custom.InsertControl(ERed); @@ -360,7 +411,7 @@ begin Custom.InsertControl(EBlue); Custom.InsertControl(EHue); Custom.InsertControl(ESat); - Custom.InsertControl(ELum); + Custom.InsertControl(ELumVal); {$IFDEF mbXP_Lib} with grip do @@ -375,7 +426,7 @@ begin InsertControl(grip); {$ENDIF} - OKBtn.TabOrder := ELum.TabOrder + 1; + OKBtn.TabOrder := ELumVal.TabOrder + 1; CancelBtn.TabOrder := OKBtn.TabOrder + 1; end; @@ -415,6 +466,32 @@ begin ]); end; +function TOfficeMoreColorsWin.GetPickerIndex: Integer; +begin + Result := PickerNotebook.PageIndex + 1; + if Pages.PageIndex = 0 then + Result := -Result; +end; + +procedure TOfficeMoreColorsWin.SetPickerIndex(AValue: Integer); +begin + if AValue = 0 then begin + Pages.PageIndex := 0; + PickerNotebook.PageIndex := 0; + end else + begin + PickerNotebook.PageIndex := abs(AValue) - 1; + if AValue > 0 then + Pages.PageIndex := 1 else + Pages.PageIndex := 0; + end; +end; + +function TOfficeMoreColorsWin.GetSelectedColor: TColor; +begin + Result := NewSwatch.Color; +end; + function TOfficeMoreColorsWin.GetShowHint: Boolean; begin Result := inherited ShowHint; @@ -436,13 +513,14 @@ begin end; procedure TOfficeMoreColorsWin.NewSwatchColorChange(Sender: TObject); -var - r,g,b: Integer; - h,s,l: Integer; begin NewSwatch.Hint := GetHint(NewSwatch.Color); + + exit; + + if (ERed = nil) or (EBlue = nil) or (EGreen = nil) or - (EHue = nil) or (ESat = nil) or (ELum = nil) + (EHue = nil) or (ESat = nil) or (ELumVal = nil) then exit; @@ -452,33 +530,57 @@ end; procedure TOfficeMoreColorsWin.OldSwatchColorChange(Sender: TObject); begin OldSwatch.Hint := GetHint(OldSwatch.Color); - SetAllToSel(OldSwatch.Color); + + + + //SetAllToSel(OldSwatch.Color); end; procedure TOfficeMoreColorsWin.PagesChange(Sender: TObject); begin - SetAllToSel(NewSwatch.Color); + SetAllToSel(FSelectedColor); //NewSwatch.Color); +end; + +procedure TOfficeMoreColorsWin.PagesChanging(Sender: TObject; + var AllowChange: Boolean); +begin + FSelectedColor := NewSwatch.Color; + { + case Pages.PageIndex of + 0: FSelectedColor := Hexa.SelectedColor; + 1: case PickerNotebook.PageIndex of + 0: FSelectedColor := HSL.SelectedColor; + 1: FSelectedColor := HSLRing.SelectedColor; + 2: FSelectedColor := SLH.SelectedColor; + 3: FSelectedColor := RgbToColor(RTrackbar.Red, GTrackbar.Green, BTrackbar.Blue); + end; + end; + } end; procedure TOfficeMoreColorsWin.SetAllCustom(c: TColor); var r, g, b: Integer; - H, S, L: Double; -// h, s, l: Integer; + H, S, L, V: Double; begin if (ERed = nil) or (EGreen = nil) or (EBlue = nil) or - (EHue = nil) or (ESat = nil) or (ELum = nil) or + (EHue = nil) or (ESat = nil) or (ELumVal = nil) or (PickerNotebook = nil) or (HSL = nil) or (HSLRing = nil) or (SLH = nil) + or (FLockChange > 0) then exit; + BeginUpdate; + NewSwatch.Color := c; r := GetRValue(c); g := GetGValue(c); b := GetBValue(c); - RGBToHSL(c, H, S, L); -// RGBtoHSLRange(c, h, s, l); + case FBrightnessMode of + bmLuminance : ColorToHSL(c, H, S, L); + bmValue : ColortoHSV(c, H, S, V); + end; if PickerNotebook.ActivePage = nbHSL.Name then HSL.SelectedColor := c @@ -503,13 +605,17 @@ begin EBlue.Value := b; EHue.Value := H * HSL.MaxHue; ESat.Value := S * HSL.MaxSaturation; - ELum.Value := L * HSL.MaxLuminance; + case FBrightnessMode of + bmLuminance: ELumVal.Value := L * HSL.MaxLuminance; + bmValue : ELumVal.Value := V * HSL.MaxValue; + end; + + EndUpdate; end; procedure TOfficeMoreColorsWin.SetAllToSel(c: TColor); -var - h, s, l: Integer; begin + //inc(FLockChange); case Pages.ActivePageIndex of // Standard Page 0: Hexa.SelectedColor := c; @@ -517,6 +623,71 @@ begin 1: SetAllCustom(c); end; NewSwatch.Color := c; + //dec(FLockChange); +end; + +procedure TOfficeMoreColorsWin.SetBrightnessMode(AMode: TBrightnessMode); +begin + FBrightnessMode := AMode; + case AMode of + bmLuminance: LLumVal.Caption := 'Lum:'; + bmValue : LLumval.Caption := 'Val:'; + end; +end; + +procedure TOfficeMoreColorsWin.SetMaxHue(H: Integer); +var + hh: Double; +begin + inc(FLockChange); + hh := EHue.Value / FMaxHue; + FMaxHue := H; + EHue.MaxValue := H; + EHue.Value := round(hh * FMaxHue); + dec(FLockChange); +end; + +procedure TOfficeMoreColorsWin.SetMaxLum(L: Integer); +var + ll: Double; +begin + inc(FLockChange); + ll := ELumVal.Value / FMaxLum; + FMaxLum := L; + ELumVal.MaxValue := L; + ELumVal.Value := round(ll * FMaxLum); + dec(FLockChange); +end; + +procedure TOfficeMoreColorsWin.SetMaxSat(S: Integer); +var + ss: Double; +begin + inc(FLockChange); + ss := ESat.Value / FMaxSat; + FMaxSat := S; + ESat.MaxValue := S; + ESat.Value := round(ss * FMaxSat); + dec(FLockChange); +end; + +procedure TOfficeMoreColorsWin.SetMaxVal(V: Integer); +var + vv: Double; +begin + inc(FLockChange); + vv := ELumVal.Value / FMaxVal; + FMaxVal := V; + ELumVal.MaxValue := V; + ELumVal.Value := round(vv * FMaxVal); + dec(FLockChange); +end; + +procedure TOfficeMoreColorsWin.SetSelectedColor(c: TColor); +begin + FSelectedColor := c; + OldSwatch.Color := c; + SetAllToSel(FSelectedColor); end; procedure TOfficeMoreColorsWin.SetShowHint(AValue: Boolean); @@ -526,6 +697,9 @@ begin HSL.ShowHint := AValue; HSLRing.ShowHint := AValue; SLH.ShowHint := AValue; + RTrackbar.ShowHint := AValue; + GTrackbar.ShowHint := AValue; + BTrackbar.ShowHint := AValue; end; procedure TOfficeMoreColorsWin.SLHChange(Sender: TObject); diff --git a/components/mbColorLib/PalUtils.pas b/components/mbColorLib/PalUtils.pas index ceaa27c38..701a6fffa 100644 --- a/components/mbColorLib/PalUtils.pas +++ b/components/mbColorLib/PalUtils.pas @@ -50,13 +50,13 @@ function ReadJASCPal(PalFile: TFileName): string; //saves a string list to a JASC .pal file procedure SaveJASCPal(pal: TStrings; FileName: TFileName); - +(* //reads Photoshop .aco file into an Aco record function ReadPhotoshopAco(PalFile: TFileName): AcoColors; //reads Photoshop .act file function ReadPhotoshopAct(PalFile: TFileName): string; - + *) implementation @@ -87,7 +87,7 @@ function FormatHint(fmt: string; c: TColor): string; var h: string; begin - h := AnsiReplaceText(fmt, '%hex', ColorToHex(c)); + h := AnsiReplaceText(fmt, '%hex', '#' + ColorToHex(c)); h := AnsiReplaceText(h, '%cieL', IntToStr(Round(GetCIElValue(c)))); h := AnsiReplaceText(h, '%cieA', IntToStr(Round(GetCIEaValue(c)))); h := AnsiReplaceText(h, '%cieB', IntToStr(Round(GetCIEbValue(c)))); @@ -579,7 +579,7 @@ begin s[i] := WideChar(w); end; end; - + (* function GetAcoColor(space,w,x,y,z: word): TColor; begin case space of @@ -711,5 +711,5 @@ begin end; CloseFile(f); end; - + *) end. diff --git a/components/mbColorLib/RAxisColorPicker.pas b/components/mbColorLib/RAxisColorPicker.pas index eb929fa0b..08ed5c4e8 100644 --- a/components/mbColorLib/RAxisColorPicker.pas +++ b/components/mbColorLib/RAxisColorPicker.pas @@ -157,7 +157,6 @@ end; procedure TRAxisColorPicker.Resize; begin - FManual := false; mx := Round(FB * Width / 255); my := Round((255 - FG) * Height / 255); inherited; @@ -231,7 +230,6 @@ begin FG := g; FB := b; FSelected := c; - FManual := false; mx := Round(FB * Width / 255); // BLUE on x my := Round((255 - FG) * Height / 255); // GREEN on y if needNewGradient then diff --git a/components/mbColorLib/RColorPicker.pas b/components/mbColorLib/RColorPicker.pas index 17a567496..f7c2498c2 100644 --- a/components/mbColorLib/RColorPicker.pas +++ b/components/mbColorLib/RColorPicker.pas @@ -6,7 +6,7 @@ interface uses LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Forms, - HTMLColors, Scanlines, mbTrackBarPicker; + HTMLColors, mbTrackBarPicker; type @@ -16,25 +16,26 @@ type private FRed, FGreen, FBlue: integer; function ArrowPosFromRed(r: integer): integer; - function GetSelectedColor: TColor; function RedFromArrowPos(p: integer): integer; procedure SetBlue(b: integer); procedure SetGreen(g: integer); procedure SetRed(r: integer); - procedure SetSelectedColor(c: TColor); protected procedure Execute(tbaAction: integer); override; function GetArrowPos: integer; override; function GetGradientColor(AValue: Integer): TColor; override; + function GetSelectedColor: TColor; override; function GetSelectedValue: integer; override; + procedure SetSelectedColor(c: TColor); override; public constructor Create(AOwner: TComponent); override; published property Red: integer read FRed write SetRed default 255; property Green: integer read FGreen write SetGreen default 128; property Blue: integer read FBlue write SetBlue default 128; - property SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed; + property SelectedColor default clRed; property Layout default lyVertical; + property HintFormat; end; diff --git a/components/mbColorLib/RGBCIEUtils.pas b/components/mbColorLib/RGBCIEUtils.pas index 42c739ff5..499d4f868 100644 --- a/components/mbColorLib/RGBCIEUtils.pas +++ b/components/mbColorLib/RGBCIEUtils.pas @@ -243,7 +243,8 @@ end; procedure RGBToLCH(clr: TColor; var l, c, h: double); var - a, b: double; + a: Double = 0; + b: Double = 0; begin RGBToLab(clr, l, a, b); LabToLCH(l, a, b, l, c, h); @@ -251,7 +252,9 @@ end; function LCHToRGB(l, c, h: double): TColor; var - lum, a, b: double; + lum: Double = 0; + a: Double = 0; + b: double = 0; begin LCHToLab(l, c, h, lum, a, b); Result := LabToRGB(lum, a, b); @@ -283,36 +286,38 @@ end; function GetCIELValue(c: TColor): double; var - d: real; + d: Double = 0; begin - XYZToLab(RGBToXYZ(c), Result, d, d); + XYZToLab(RGBToXYZ(c), Result{%H-}, d, d); end; function GetCIEAValue(c: TColor): double; var - d: double; + d: double = 0; begin - XYZToLab(RGBToXYZ(c), d, Result, d); + XYZToLab(RGBToXYZ(c), d, Result{%H-}, d); end; function GetCIEBValue(c: TColor): double; var - d: double; + d: double = 0; begin - XYZToLab(RGBToXYZ(c), d, d, Result); + XYZToLab(RGBToXYZ(c), d, d, Result{%H-}); end; function GetCIECValue(c: TColor): double; var - d: double; + d: double = 0; begin + Result := 0.0; RGBToLCH(c, d, Result, d); end; function GetCIEHValue(c: TColor): double; var - d: double; + d: double = 0; begin + Result := 0.0; RGBToLCH(c, d, d, Result); end; diff --git a/components/mbColorLib/RGBHSLUtils.pas b/components/mbColorLib/RGBHSLUtils.pas index 7e8abfbd1..63574921e 100644 --- a/components/mbColorLib/RGBHSLUtils.pas +++ b/components/mbColorLib/RGBHSLUtils.pas @@ -14,13 +14,13 @@ var //set these variables to your needs, e.g. 360, 255, 255 MaxSat: integer = 240; MaxLum: integer = 240; -function HSLtoRGB(H, S, L: double): TColor; +{function HSLtoRGB(H, S, L: double): TColor;} function HSLRangeToRGB(H, S, L: integer): TColor; -procedure ColorToHSL(AColor: TColor; var H, S, L: Double); +{procedure ColorToHSL(AColor: TColor; var H, S, L: Double);} function HSLtoColor(H, S, L: Double): TColor; -procedure RGBtoHSL(RGB: TColor; out H, S, L: Double); +{procedure RGBtoHSL(RGB: TColor; out H, S, L: Double); } procedure RGBtoHSLRange(RGB: TColor; out H1, S1, L1: integer); function GetHValue(AColor: TColor): integer; @@ -36,7 +36,7 @@ implementation uses mbUtils; - + (* procedure ColorToHSL(AColor: TColor; var H, S, L: Double); function RGBMaxValue(r, g, b: Double): Double; @@ -81,7 +81,7 @@ begin if H < 0 then H := H + 360; H := H / 360; end; -end; +end; *) function HSLtoColor(H, S, L: Double): TColor; const @@ -133,9 +133,6 @@ var begin if Hue > 10 then Hue := Hue + 1; - - - if Hue < 0 then Hue := Hue + 1 else if Hue > 1 then @@ -224,9 +221,6 @@ procedure RGBtoHSLRange(RGB: TColor; out H1, S1, L1: integer); var R, G, B, D, Cmax, Cmin, h, s, l: double; begin - H := h1; - S := s1; - L := l1; R := GetRValue(RGB) / 255; G := GetGValue(RGB) / 255; B := GetBValue(RGB) / 255; diff --git a/components/mbColorLib/RGBHSVUtils.pas b/components/mbColorLib/RGBHSVUtils.pas index cb243827f..902f77545 100644 --- a/components/mbColorLib/RGBHSVUtils.pas +++ b/components/mbColorLib/RGBHSVUtils.pas @@ -11,11 +11,11 @@ uses Scanlines; { The next four procedures assume H, S, V to be in the range 0..1 } -procedure ColorToHSV(c: TColor; out H, S, V: Double); -procedure RGBtoHSV(R, G, B: Integer; out H, S, V: Double); +//procedure ColorToHSV(c: TColor; out H, S, V: Double); +//procedure RGBtoHSV(R, G, B: Integer; out H, S, V: Double); -function HSVtoColor(H, S, V: Double): TColor; -procedure HSVtoRGB(H, S, V: Double; out R, G, B: Integer); +//function HSVtoColor(H, S, V: Double): TColor; +//procedure HSVtoRGB(H, S, V: Double; out R, G, B: Integer); { These next procedure assume H to be in the range 0..360 and S, V in the range 0..255 } @@ -117,8 +117,6 @@ procedure RGBToHSVRange(R, G, B: integer; out H, S, V: integer); var Delta, Min, H1, S1: double; begin - h1 := h; - s1 := s; Min := MinIntValue([R, G, B]); V := MaxIntValue([R, G, B]); Delta := V - Min; diff --git a/components/mbColorLib/SColorPicker.pas b/components/mbColorLib/SColorPicker.pas index 0488a49fe..c2f0a38fe 100644 --- a/components/mbColorLib/SColorPicker.pas +++ b/components/mbColorLib/SColorPicker.pas @@ -7,43 +7,31 @@ unit SColorPicker; interface uses - LCLIntf, LCLType, LMessages, - SysUtils, Classes, Controls, Graphics, Forms, - RGBHSVUtils, mbTrackBarPicker, HTMLColors, Scanlines; + LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Forms, + mbColorConv, mbTrackBarPicker, HTMLColors; type - TSColorPicker = class(TmbTrackBarPicker) + TSColorPicker = class(TmbHSLVTrackBarPicker) private - FVal, FHue, FSat: Double; - FMaxVal, FMaxHue, FMaxSat: Integer; - function ArrowPosFromSat(s: integer): integer; - function GetHue: Integer; - function GetSat: Integer; - function GetSelectedColor: TColor; - function GetVal: Integer; - function SatFromArrowPos(p: integer): integer; - procedure SetHue(h: integer); - procedure SetMaxHue(h: Integer); - procedure SetMaxSat(s: Integer); - procedure SetMaxVal(v: Integer); - procedure SetSat(s: integer); - procedure SetValue(v: integer); - procedure SetSelectedColor(c: TColor); + function ArrowPosFromSat(s: Double): integer; + function SatFromArrowPos(p: integer): Double; protected procedure Execute(tbaAction: integer); override; function GetArrowPos: integer; override; function GetGradientColor(AValue: Integer): TColor; override; function GetSelectedValue: integer; override; + procedure SetMaxSat(S: Integer); override; + procedure SetRelSat(S: Double); override; + procedure SetSelectedColor(c: TColor); override; public constructor Create(AOwner: TComponent); override; published - property Hue: integer read GetHue write SetHue; - property Saturation: integer read GetSat write SetSat; - property Value: integer read GetVal write SetValue; - property MaxHue: Integer read FMaxHue write SetMaxHue default 359; - property MaxSaturation: Integer read FMaxSat write SetMaxSat default 255; - property MaxValue: Integer read FMaxVal write SetMaxVal default 255; - property SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed; + property Hue default 0; + property Saturation default 255; + property Luminance default 127; + property Value default 255; + property SelectedColor default clRed; + property HintFormat; end; @@ -57,29 +45,27 @@ uses constructor TSColorPicker.Create(AOwner: TComponent); begin inherited; - FMaxHue := 359; - FMaxSat := 255; - FMaxVal := 255; FGradientWidth := FMaxSat + 1; FGradientHeight := 1; FHue := 0; + FLum := 0.5; FVal := 1.0; - SetSat(FMaxSat); + Saturation := 255; HintFormat := 'Saturation: %value (selected)'; end; -function TSColorPicker.ArrowPosFromSat(s: integer): integer; +function TSColorPicker.ArrowPosFromSat(s: Double): integer; var a: integer; begin if Layout = lyHorizontal then begin - a := Round(s / FMaxSat * (Width - 12)); + a := Round(s * (Width - 12)); if a > Width - FLimit then a := Width - FLimit; end else begin - a := Round((FMaxSat - s) / FMaxSat * (Height - 12)); + a := Round((1.0 - s) * (Height - 12)); if a > Height - FLimit then a := Height - FLimit; end; if a < 0 then a := 0; @@ -87,36 +73,39 @@ begin end; procedure TSColorPicker.Execute(tbaAction: integer); +var + dSat: Double; begin + if FMaxSat = 0 then dSat := 0 else dSat := Increment / FMaxSat; case tbaAction of TBA_Resize: - SetSat(GetSat()); + SetRelSat(FSat); TBA_MouseMove: - SetSat(SatFromArrowPos(FArrowPos)); + SetRelSat(SatFromArrowPos(FArrowPos)); TBA_MouseDown: - SetSat(SatFromArrowPos(FArrowPos)); + SetRelSat(SatFromArrowPos(FArrowPos)); TBA_MouseUp: - SetSat(SatFromArrowPos(FArrowPos)); + SetRelSat(SatFromArrowPos(FArrowPos)); TBA_WheelUp: - SetSat(GetSat() + Increment); + SetRelSat(FSat + dSat); TBA_WheelDown: - SetSat(GetSat() - Increment); + SetRelSat(FSat - dSat); TBA_VKLeft: - SetSat(GetSat() - Increment); + SetRelSat(FSat - dSat); TBA_VKCtrlLeft: - SetSat(0); + SetRelSat(0.0); TBA_VKRight: - SetSat(GetSat() + Increment); + SetRelSat(FSat + dSat); TBA_VKCtrlRight: - SetSat(FMaxSat); + SetRelSat(1.0); TBA_VKUp: - SetSat(GetSat() + Increment); + SetRelSat(FSat + dSat); TBA_VKCtrlUp: - SetSat(FMaxSat); + SetRelSat(1.0); TBA_VKDown: - SetSat(GetSat() - Increment); + SetRelSat(FSat - dSat); TBA_VKCtrlDown: - SetSat(0); + SetRelSat(0.0); else inherited; end; @@ -127,103 +116,49 @@ begin if FMaxSat = 0 then Result := inherited GetArrowPos else - Result := ArrowPosFromSat(GetSat()); + Result := ArrowPosFromSat(FSat); end; function TSColorPicker.GetGradientColor(AValue: Integer): TColor; begin - Result := HSVtoColor(FHue, AValue/FMaxSat, FVal); -end; - -function TSColorPicker.GetHue: Integer; -begin - Result := round(FHue * FMaxHue); -end; - -function TSColorPicker.GetSat: Integer; -begin - Result := round(FSat * FMaxSat); -end; - -function TSColorPicker.GetSelectedColor: TColor; -begin - Result := HSVToColor(FHue, FSat, FVal); - if WebSafe then - Result := GetWebSafe(Result); + Result := HSLVtoColor(FHue, AValue/FMaxSat, FLum, FVal); end; function TSColorPicker.GetSelectedValue: integer; begin - Result := GetSat(); + Result := Saturation; end; -function TSColorPicker.GetVal: Integer; -begin - Result := round(FVal * FMaxVal); -end; - -function TSColorPicker.SatFromArrowPos(p: integer): integer; +function TSColorPicker.SatFromArrowPos(p: integer): Double; var - s: integer; + s: Double; begin case Layout of - lyHorizontal: s := Round(p / (Width - 12) * FMaxSat); - lyVertical : s := Round(FMaxSat - p / (Height - 12) * FMaxSat); + lyHorizontal: s := p / (Width - 12); + lyVertical : s := 1.0 - p / (Height - 12); end; - Clamp(s, 0, FMaxSat); + Clamp(s, 0, 1.0); Result := s; end; -procedure TSColorPicker.SetMaxHue(h: Integer); +procedure TSColorPicker.SetMaxSat(S: Integer); begin - if h = FMaxHue then + if S = FMaxSat then exit; - FMaxHue := h; - CreateGradient; - //if FChange and Assigned(OnChange) then OnChange(Self); - Invalidate; -end; - -procedure TSColorPicker.SetMaxSat(s: Integer); -begin - if s = FMaxSat then - exit; - FMaxSat := s; + FMaxSat := S; FGradientWidth := FMaxSat + 1; CreateGradient; - //if FChange and Assigned(OnChange) then OnChange(Self); Invalidate; + DoChange; end; -procedure TSColorPicker.SetMaxVal(v: Integer); +procedure TSColorPicker.SetRelSat(S: Double); begin - if v = FMaxVal then - exit; - FMaxVal := v; - CreateGradient; - //if FChange and Assigned(OnChange) then OnChange(Self); - Invalidate; -end; - -procedure TSColorPicker.SetHue(h: integer); -begin - Clamp(h, 0, FMaxHue); - if GetHue() <> h then + Clamp(S, 0, 1.0); + if FSat <> S then begin - FHue := h / FMaxHue; - CreateGradient; - Invalidate; - DoChange; - end; -end; - -procedure TSColorPicker.SetSat(s: integer); -begin - Clamp(s, 0, FMaxSat); - if GetSat() <> s then - begin - FSat := s / FMaxSat; - FArrowPos := ArrowPosFromSat(s); + FSat := S; + FArrowPos := ArrowPosFromSat(S); Invalidate; DoChange; end; @@ -231,7 +166,10 @@ end; procedure TSColorPicker.SetSelectedColor(c: TColor); var - h, s, v: integer; + H: Double = 0; + S: Double = 0; + L: Double = 0; + V: Double = 0; needNewGradient: Boolean; begin if WebSafe then @@ -239,27 +177,25 @@ begin if c = GetSelectedColor then exit; - RGBToHSVRange(GetRValue(c), GetGValue(c), GetBValue(c), h, s, v); - needNewGradient := (h <> FHue) or (v <> FVal); - FHue := h; - FSat := s; - FVal := v; + ColorToHSLV(c, H,S,L,V); + case BrightnessMode of + bmLuminance: + begin + needNewGradient := (H <> FHue) or (L <> FLum); + FLum := L; + end; + bmValue: + begin + needNewGradient := (H <> FHue) or (V <> FVal); + FVal := V; + end; + end; + FHue := H; + FSat := S; if needNewGradient then CreateGradient; Invalidate; DoChange; end; -procedure TSColorPicker.SetValue(v: integer); -begin - Clamp(v, 0, FMaxVal); - if GetVal() <> v then - begin - FVal := v / FMaxVal; - CreateGradient; - Invalidate; - DoChange; - end; -end; - end. diff --git a/components/mbColorLib/SLColorPicker.pas b/components/mbColorLib/SLColorPicker.pas index 175403771..88ed79ec2 100644 --- a/components/mbColorLib/SLColorPicker.pas +++ b/components/mbColorLib/SLColorPicker.pas @@ -5,74 +5,74 @@ unit SLColorPicker; interface uses - LCLIntf, LCLType, LMessages, - SysUtils, Classes, Controls, Graphics, Forms, - mbColorPickerControl; + LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Forms, + mbColorConv, mbColorPickerControl; type - TSLColorPicker = class(TmbColorPickerControl) + TSLColorPicker = class(TmbHSLVColorPickerControl) private - FHue, FSat, FLum: Double; - FMaxHue, FMaxSat, FMaxLum: integer; - procedure DrawMarker(x, y: integer); - function GetHue: Integer; - function GetLum: Integer; - function GetSat: Integer; - procedure SetHue(H: integer); - procedure SetLum(L: integer); - procedure SetSat(S: integer); - procedure SetMaxHue(H: Integer); - procedure SetMaxLum(L: Integer); - procedure SetMaxSat(S: Integer); - procedure UpdateCoords; + FHint: array[TBrightnessMode] of string; + function GetHint(AMode: TBrightnessMode): String; + procedure SetHint(AMode: TBrightnessMode; AText: String); protected procedure CorrectCoords(var x, y: integer); procedure CreateWnd; override; + procedure DrawMarker(x, y: integer); function GetGradientColor2D(X, Y: Integer): TColor; override; - procedure KeyDown(var Key: Word; Shift: TShiftState); override; - procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; - procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; - procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure Resize; override; procedure Paint; override; - procedure SelectColor(x, y: integer); + procedure SelectColor(x, y: integer); override; + procedure SetBrightnessMode(AMode: TBrightnessMode); override; + procedure SetMaxLum(L: Integer); override; + procedure SetMaxSat(S: Integer); override; + procedure SetMaxVal(V: Integer); override; + procedure SetRelLum(L: Double); override; + procedure SetRelSat(S: Double); override; + procedure SetRelVal(V: Double); override; procedure SetSelectedColor(c: TColor); override; + procedure UpdateCoords; public constructor Create(AOwner: TComponent); override; function GetColorAtPoint(x, y: integer): TColor; override; property ColorUnderCursor; published - property Hue: integer read GetHue write SetHue default 0; - property Saturation: integer read GetSat write SetSat default 0; - property Luminance: integer read GetLum write SetLum default 240; - property MaxHue: Integer read FMaxHue write SetMaxHue default 359; - property MaxSaturation: Integer read FMaxSat write SetMaxSat default 240; - property MaxLuminance: Integer read FMaxLum write SetMaxLum default 240; + property Hue default 0; + property Saturation default 0; + property Luminance default 255; + property Value default 255; + property MaxHue default 360; + property MaxSaturation default 255; + property MaxLuminance default 255; + property MaxValue default 255; property SelectedColor default clWhite; property MarkerStyle default msCircle; + property SLHintFormat: String index bmLuminance read GetHint write SetHint; + property SVHintFormat: String index bmValue read GetHint write SetHint; property OnChange; end; implementation uses - Math, - ScanLines, RGBHSLUtils, HTMLColors, mbUtils; + HTMLColors, mbUtils; { TSLColorPicker } constructor TSLColorPicker.Create(AOwner: TComponent); begin inherited; - FMaxHue := 359; - FMaxSat := 240; - FMaxLum := 240; - FGradientWidth := FMaxSat + 1; // x --> Saturation - FGradientHeight := FMaxLum + 1; // y --> Luminance + FGradientWidth := FMaxSat + 1; // x --> Saturation + case BrightnessMode of + bmLuminance : FGradientHeight := FMaxLum + 1; // y --> Luminance + bmValue : FGradientHeight := FMaxVal + 1; // y --> value + end; SetInitialBounds(0, 0, FGradientWidth, FGradientHeight); - FSelected := clWhite; - RGBToHSL(FSelected, FHue, FSat, FLum); - HintFormat := 'S: %hslS L: %l'#13'Hex: %hex'; + FHue := 0; + FSat := 1.0; + FLum := 1.0; + FVal := 1.0; + SLHintFormat := 'S: %hslS L: %l' + LineEnding + 'Hex: %hex'; + SVHintFormat := 'S: %hslS V: %v' + LineEnding + 'Hex: %hex'; MarkerStyle := msCircle; end; @@ -99,135 +99,28 @@ end; function TSLColorPicker.GetColorAtPoint(x, y: integer): TColor; var - S, L: Double; + S, LV: Double; begin S := x / (Width - 1); - L := 1.0 - y / (Height - 1); - Result := HSLToRGB(FHue, S, L); -// Result := HSLToRGB(FHue, x/(Width - 1), (Height - 1 - y) / (Height - 1)); - if WebSafe then - Result := GetWebSafe(Result); + LV := 1.0 - y / (Height - 1); + Result := HSLVtoColor(FHue, S, LV, LV); end; -{ This picker has Saturation along the X and Luminance along the Y axis. - - NOTE: The HSL conversion (HSLtoColor) seems to be wrong - but it produces the display seen elsewhere } +{ This picker has Saturation along the X and Luminance or Value on the Y axis. } function TSLColorPicker.GetGradientColor2D(X, Y: Integer): TColor; begin -// Result := HSLtoColor(FHue, x / FMaxSat, (FMaxLum - y) / FMaxLum); // wrong formula - Result := HSLtoRGB(FHue, x / FMaxSat, (FMaxLum - y) / FMaxLum); // correct, but looks wrong... + Result := HSLVtoColor(FHue, x/FMaxSat, 1.0 - y/FMaxLum, 1.0 - y/FMaxVal); end; -function TSLColorPicker.GetHue: Integer; +function TSLColorPicker.GetHint(AMode: TBrightnessMode): String; begin - Result := round(FHue * FMaxHue); -end; - -function TSLColorPicker.GetLum: Integer; -begin - Result := round(FLum * FMaxLum); -end; - -function TSLColorPicker.GetSat: Integer; -begin - Result := round(FSat * FMaxSat); -end; - -procedure TSLColorPicker.KeyDown(var Key: Word; Shift: TShiftState); -var - eraseKey: Boolean; - delta: Integer; -begin - eraseKey := true; - delta := IfThen(ssCtrl in Shift, 10, 1); - - case Key of - VK_LEFT : SelectColor(mx - delta, my); - VK_RIGHT : SelectColor(mx + delta, my); - VK_UP : SelectColor(mx, my - delta); - VK_DOWN : SelectColor(mx, my + delta); - else eraseKey := false; - end; - { - case Key of - VK_LEFT: - if (mdx - delta >= 0) then - begin - Dec(mdx, delta); - SelectionChanged(mdx, mdy); - FManual := true; - DoChange; - end; - VK_RIGHT: - if (mdx + delta < Width) then - begin - Inc(mdx, delta); - SelectionChanged(mdx, mdy); - FManual := true; - DoChange; - end; - VK_UP: - if (mdy - delta >= 0) then - begin - Dec(mdy, delta); - SelectionChanged(mdx, mdy); - FManual := true; - DoChange; - end; - VK_DOWN: - if (mdy + delta < Height) then - begin - Inc(mdy, delta); - SelectionChanged(mdx, mdy); - FManual := true; - DoChange; - end; - else - eraseKey := false; - end; - } - - if eraseKey then - Key := 0; - - inherited; -end; - -procedure TSLColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; - X, Y: Integer); -begin - inherited; - if csDesigning in ComponentState then - Exit; - if (Button = mbLeft) then - SelectColor(X, Y); - SetFocus; -end; - -procedure TSLColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer); -begin - inherited; - if csDesigning in ComponentState then - Exit; - if (ssLeft in Shift) then - SelectColor(X, Y); -end; - -procedure TSLColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; - X, Y: Integer); -begin - inherited; - if csDesigning in ComponentState then - Exit; - if (Button = mbLeft)then - SelectColor(X, Y); + Result := FHint[AMode]; end; procedure TSLColorPicker.Paint; begin Canvas.StretchDraw(ClientRect, FBufferBMP); - UpdateCoords; +// UpdateCoords; DrawMarker(mx, my); end; @@ -239,88 +132,94 @@ end; procedure TSLColorPicker.SelectColor(x, y: integer); var - S, L: Double; + S, LV: Double; begin CorrectCoords(x, y); S := x / (Width - 1); - L := 1 - y / (Height - 1); - if (S = FSat) and (L = FLum) then - exit; + LV := 1 - y / (Height - 1); + case BrightnessMode of + bmLuminance: + begin + if (S = FSat) and (LV = FLum) then + exit; + FLum := LV; + end; + bmValue: + begin + if (S = FSat) and (LV = FVal) then + exit; + FVal := LV; + end; + end; FSat := S; - FLum := L; - FSelected := HSLtoRGB(FHue, FSat, FLum); + FSelected := HSLVtoColor(FHue, FSat, FLum, FVal); + Invalidate; UpdateCoords; DoChange; end; -procedure TSLColorPicker.SetHue(H: integer); +procedure TSLColorPicker.SetBrightnessMode(AMode: TBrightnessMode); begin - Clamp(H, 0, FMaxHue); - if GetHue() <> H then - begin - FHue := h / FMaxHue; - FSelected := HSLtoRGB(FHue, FSat, FLum); - CreateGradient; - UpdateCoords; - Invalidate; - DoChange; - end; + inherited; + HintFormat := FHint[AMode]; end; -procedure TSLColorPicker.SetLum(L: integer); +procedure TSLColorPicker.SetHint(AMode: TBrightnessMode; AText: String); begin - Clamp(L, 0, FMaxLum); - if GetLum() <> L then - begin - FLum := L / FMaxLum; - FSelected := HSLtoRGB(FHue, FSat, FLum); - UpdateCoords; - Invalidate; - DoChange; - end; -end; - -procedure TSLColorPicker.SetMaxHue(H: Integer); -begin - if H = FMaxHue then - exit; - FMaxHue := H; - CreateGradient; - //if FChange and Assigned(OnChange) then OnChange(Self); - Invalidate; + FHint[AMode] := AText; end; procedure TSLColorPicker.SetMaxLum(L: Integer); begin if L = FMaxLum then exit; - FMaxLum := L; - FGradientHeight := FMaxLum + 1; - CreateGradient; - //if FChange and Assigned(OnChange) then OnChange(Self); - Invalidate; + if BrightnessMode = bmLuminance then + FGradientHeight := L + 1; + inherited; end; procedure TSLColorPicker.SetMaxSat(S: Integer); begin if S = FMaxSat then exit; - FMaxSat := S; - FGradientWidth := FMaxSat + 1; - CreateGradient; - //if FChange and Assigned(OnChange) then OnChange(Self); - Invalidate; + FGradientWidth := S + 1; // inherited will re-create the gradient + inherited; end; -procedure TSLColorPicker.SetSat(S: integer); +procedure TSLColorPicker.SetMaxVal(V: Integer); begin - Clamp(S, 0, FMaxSat); - if GetSat() <> S then + if V = FMaxVal then + exit; + if BrightnessMode = bmValue then + FGradientHeight := V + 1; + inherited; +end; + +procedure TSLColorPicker.SetRelLum(L: Double); +begin + Clamp(L, 0.0, 1.0); + if FLum <> L then begin - FSat := S / FMaxSat; - FSelected := HSLtoRGB(FHue, FSat, FLum); + FLum := L; + if BrightnessMode = bmLuminance then + begin + FSelected := HSLtoColor(FHue, FSat, FLum); + UpdateCoords; + Invalidate; + end; + DoChange; + end; +end; + +procedure TSLColorPicker.SetRelSat(S: Double); +begin + Clamp(S, 0.0, 1.0); + if FSat <> S then + begin + FSat := S; + FSelected := HSLVtoColor(FHue, FSat, FLum, FVal); UpdateCoords; Invalidate; DoChange; @@ -329,7 +228,10 @@ end; procedure TSLColorPicker.SetSelectedColor(c: TColor); var - H, S, L: Double; + H: Double = 0; + S: Double = 0; + L: Double = 0; + V: Double = 0; needNewGradient: Boolean; begin if WebSafe then @@ -337,12 +239,14 @@ begin if c = GetSelectedColor then exit; - RGBToHSL(c, H, S, L); -// ColorToHSL(c, H, S, L); + ColorToHSLV(c, H, S, L, V); needNewGradient := (FHue <> H); FHue := H; FSat := S; - FLum := L; + case BrightnessMode of + bmLuminance : FLum := L; + bmValue : FVal := V; + end; FSelected := c; UpdateCoords; if needNewGradient then @@ -351,10 +255,29 @@ begin DoChange; end; +procedure TSLColorPicker.SetRelVal(V: Double); +begin + Clamp(V, 0.0, 1.0); + if FVal <> V then + begin + FVal := V; + if BrightnessMode = bmValue then + begin + FSelected := HSVtoColor(FHue, FSat, FVal); + UpdateCoords; + Invalidate; + end; + DoChange; + end; +end; + procedure TSLColorPicker.UpdateCoords; begin mx := round(FSat * (Width - 1)); - my := round((1.0 - FLum) * (Height - 1)); + case BrightnessMode of + bmLuminance : my := round((1.0 - FLum) * (Height - 1)); + bmValue : my := round((1.0 - FVal) * (Height - 1)); + end; end; diff --git a/components/mbColorLib/SLHColorPicker.pas b/components/mbColorLib/SLHColorPicker.pas index d47d258e0..834d9c486 100644 --- a/components/mbColorLib/SLHColorPicker.pas +++ b/components/mbColorLib/SLHColorPicker.pas @@ -7,7 +7,7 @@ interface uses LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Forms, Menus, Themes, RGBHSLUtils, mbTrackBarPicker, HTMLColors, SLColorPicker, HColorPicker, - mbBasicPicker; + mbColorConv, mbBasicPicker; type TSLHColorPicker = class(TmbBasicPicker) @@ -15,25 +15,36 @@ type FSLPicker: TSLColorPicker; FHPicker: THColorPicker; FSelectedColor: TColor; - FHValue, FSValue, FLValue: Double; - FMaxH, FMaxS, FMaxL: Integer; - FRValue, FGValue, FBValue: integer; +// FHValue, FSValue, FLValue: Double; +// FRed, FGreen, FBlue: integer; FSLHint, FHHint: string; FSLMenu, FHMenu: TPopupMenu; FSLCursor, FHCursor: TCursor; PBack: TBitmap; - function GetH: Integer; - function GetS: Integer; - function GetL: Integer; - procedure SetH(H: integer); - procedure SetS(S: integer); - procedure SetL(L: integer); - procedure SetR(R: integer); - procedure SetG(G: integer); - procedure SetB(B: integer); - procedure SetMaxH(H: Integer); - procedure SetMaxS(S: Integer); - procedure SetMaxL(L: Integer); + function GetBrightnessMode: TBrightnessMode; + function GetHue: Integer; + function GetSat: Integer; + function GetLum: Integer; + function GetVal: Integer; + function GetMaxHue: Integer; + function GetMaxLum: Integer; + function GetMaxSat: Integer; + function GetMaxVal: Integer; + function GetRed: Integer; + function GetGreen: Integer; + function GetBlue: Integer; + procedure SetBlue(B: integer); + procedure SetBrightnessMode(bm: TBrightnessMode); + procedure SetGreen(G: integer); + procedure SetHue(H: integer); + procedure SetLum(L: integer); + procedure SetRed(R: integer); + procedure SetSat(S: integer); + procedure SetVal(V: Integer); + procedure SetMaxHue(H: Integer); + procedure SetMaxSat(S: Integer); + procedure SetMaxLum(L: Integer); + procedure SetMaxVal(V: Integer); procedure SetHHint(h: string); procedure SetSLHint(h: string); procedure SetSLMenu(m: TPopupMenu); @@ -46,10 +57,11 @@ type procedure DoChange; override; procedure DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); function GetColorUnderCursor: TColor; override; + function GetSelectedColor: TColor; override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure Paint; override; procedure Resize; override; - procedure SelectColor(c: TColor); + procedure SetSelectedColor(c: TColor); override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; @@ -59,23 +71,26 @@ type function GetSelectedHexColor: string; procedure SetFocus; override; property ColorUnderCursor; - property Red: integer read FRValue write SetR default 255; - property Green: integer read FGValue write SetG default 0; - property Blue: integer read FBValue write SetB default 0; + property Red: integer read GetRed write SetRed default 255; + property Green: integer read GetGreen write SetGreen default 0; + property Blue: integer read GetBlue write SetBlue default 0; published - property Hue: integer read GetH write SetH default 0; - property Saturation: integer read GetS write SetS default 240; - property Luminance: integer read GetL write SetL default 120; - property SelectedColor: TColor read FSelectedColor write SelectColor default clRed; + property BrightnessMode: TBrightnessMode read GetBrightnessMode + write SetBrightnessMode default bmValue; + property SelectedColor default clRed; + property Hue: integer read GetHue write SetHue default 0; + property Saturation: integer read GetSat write SetSat default 255; + property Value: Integer read GetVal write SetVal default 255; + property Luminance: integer read GetLum write SetLum default 127; property HPickerPopupMenu: TPopupMenu read FHMenu write SetHMenu; property SLPickerPopupMenu: TPopupMenu read FSLMenu write SetSLMenu; property HPickerHintFormat: string read FHHint write SetHHint; property SLPickerHintFormat: string read FSLHint write SetSLHint; property HPickerCursor: TCursor read FHCursor write SetHCursor default crDefault; property SLPickerCursor: TCursor read FSLCursor write SetSLCursor default crDefault; - property MaxHue: Integer read FMaxH write SetMaxH default 359; - property MaxSaturation: Integer read FMaxS write SetMaxS default 240; - property MaxLuminance: Integer read FMaxL write SetMaxL default 240; + property MaxHue: Integer read GetMaxHue write SetMaxHue default 360; + property MaxSaturation: Integer read GetMaxSat write SetMaxSat default 240; + property MaxLuminance: Integer read GetMaxLum write SetMaxLum default 240; property TabStop default true; property ShowHint; property ParentShowHint; @@ -107,19 +122,15 @@ begin inherited; //ControlStyle := ControlStyle - [csAcceptsControls] + [csOpaque]; - FMaxH := 359; - FMaxS := 240; - FMaxL := 240; PBack := TBitmap.Create; // PBack.PixelFormat := pf32bit; ParentColor := true; SetInitialBounds(0, 0, WSL + DIST + WH, HSL + 2*VDELTA); TabStop := true; - FSelectedColor := clRed; - FHPicker := THColorPicker.Create(Self); - InsertControl(FHPicker); FHCursor := crDefault; FSLCursor := crDefault; + FHHint := 'Hue: %h'; + FSLHint := 'S: %hslS L: %l'#13'Hex: %hex'; // Saturation-Lightness picker FSLPicker := TSLColorPicker.Create(Self); @@ -127,28 +138,21 @@ begin with FSLPicker do begin SetInitialBounds(0, VDELTA, WSL, HSL); - Visible := true; - SelectedColor := clRed; - MaxHue := FMaxH; - MaxSaturation := FMaxS; - MaxLuminance := FMaxL; - //Saturation := FMaxS; - //Luminance := FMaxL; + Cursor := FSLCursor; + BrightnessMode := bmValue; OnChange := SLPickerChange; OnMouseMove := DoMouseMove; end; // Hue picker + FHPicker := THColorPicker.Create(Self); + InsertControl(FHPicker); with FHPicker do begin + Cursor := FHCursor; Layout := lyVertical; // put before setting width and height SetInitialBounds(WSL + DIST, 0, WH, HSL + 2*VDELTA); - MaxHue := self.FMaxH; - MaxSaturation := 255; - MaxValue := 255; - //Saturation := MaxSaturation; - Value := MaxValue; - Visible := true; + BrightnessMode := bmValue; ArrowPlacement := spBoth; NewArrowStyle := true; OnChange := HPickerChange; @@ -156,14 +160,7 @@ begin end; // red - FHValue := 0; - FSValue := 1.0; - FLValue := 0.5; - FRValue := 255; - FGValue := 0; - FBValue := 0; - FHHint := 'Hue: %h'; - FSLHint := 'S: %hslS L: %l'#13'Hex: %hex'; + SelectedColor := clRed; end; destructor TSLHColorPicker.Destroy; @@ -175,12 +172,6 @@ end; procedure TSLHColorPicker.DoChange; begin FSelectedColor := FSLPicker.SelectedColor; - FHValue := FHPicker.Hue / FHPicker.MaxHue; - FSValue := FSLPicker.Saturation / FSLPicker.MaxSaturation; - FLValue := FSLPicker.Luminance / FSLPicker.MaxLuminance; - FRValue := GetRValue(FSelectedColor); - FGValue := GetGValue(FSelectedColor); - FBValue := GetBValue(FSelectedColor); inherited; end; @@ -190,14 +181,29 @@ begin OnMouseMove(Self, Shift, x, y); end; +function TSLHColorPicker.GetBrightnessMode: TBrightnessMode; +begin + Result := FSLPicker.BrightnessMode; +end; + function TSLHColorPicker.GetColorUnderCursor: TColor; begin Result := FSLPicker.ColorUnderCursor; end; -function TSLHColorPicker.GetH: Integer; +function TSLHColorPicker.GetBlue: Integer; begin - Result := Round(FHValue * FMaxH); + Result := GetBValue(FSelectedColor); +end; + +function TSLHColorPicker.GetGreen: Integer; +begin + Result := GetGValue(FSelectedColor); +end; + +function TSLHColorPicker.GetHue: Integer; +begin + Result := FHPicker.Hue; end; function TSLHColorPicker.GetHexColorUnderCursor: string; @@ -205,14 +211,44 @@ begin Result := FSLPicker.GetHexColorUnderCursor; end; -function TSLHColorPicker.GetL: Integer; +function TSLHColorPicker.GetLum: Integer; begin - Result := ROund(FLValue * FMaxL); + Result := FSLPicker.Luminance; end; -function TSLHColorPicker.GetS: Integer; +function TSLHColorPicker.GetMaxHue: Integer; begin - Result := Round(FSValue * FMaxS); + Result := FSLPicker.MaxHue; +end; + +function TSLHColorPicker.GetMaxLum: Integer; +begin + Result := FSLPicker.MaxLuminance; +end; + +function TSLHColorPicker.GetMaxSat: Integer; +begin + Result := FSLPicker.MaxSaturation; +end; + +function TSLHColorPicker.GetMaxVal: Integer; +begin + Result := FSLPicker.MaxValue; +end; + +function TSLHColorPicker.GetRed: Integer; +begin + Result := GetRValue(FSelectedColor); +end; + +function TSLHColorPicker.GetSat: Integer; +begin + Result := FSLPicker.Saturation; +end; + +function TSLHColorPicker.GetSelectedColor: TColor; +begin + Result := FSelectedColor; end; function TSLHColorPicker.GetSelectedHexColor: string; @@ -220,6 +256,11 @@ begin Result := ColorToHex(FSelectedColor); end; +function TSLHColorPicker.GetVal: Integer; +begin + REsult := FSLPicker.Value; +end; + procedure TSLHColorPicker.HPickerChange(Sender: TObject); begin if FSLPicker.Hue = FHPicker.Hue then @@ -243,7 +284,6 @@ end; procedure TSLHColorPicker.Resize; begin inherited; -// PaintParentBack; if (FSLPicker = nil) or (FHPicker = nil) then exit; @@ -255,36 +295,32 @@ begin FHPicker.Height := Height; end; -procedure TSLHColorPicker.SelectColor(c: TColor); -begin - FSelectedColor := c; - FHPicker.Hue := GetHValue(c); - FSLPicker.SelectedColor := c; -end; - -procedure TSLHColorPicker.SetB(B: integer); -begin - FBValue := B; - SelectColor(RGB(FRValue, FGValue, FBValue)); -end; - procedure TSLHColorPicker.SetFocus; begin inherited; FSLPicker.SetFocus; end; -procedure TSLHColorPicker.SetH(H: integer); +procedure TSLHColorPicker.SetBlue(B: integer); begin - FHValue := H / FMaxH; - FSLPicker.Hue := H; - FHPicker.Hue := H; + SetSelectedColor(RgbToColor(Red, Green, B)); end; -procedure TSLHColorPicker.SetG(G: integer); +procedure TSLHColorPicker.SetBrightnessMode(bm: TBrightnessMode); begin - FGValue := G; - SelectColor(RGB(FRValue, FGValue, FBValue)); + FSLPicker.BrightnessMode := bm; + FHPicker.BrightnessMode := bm; +end; + +procedure TSLHColorPicker.SetGreen(G: integer); +begin + SetSelectedColor(RgbToColor(Red, G, Blue)); +end; + +procedure TSLHColorPicker.SetHCursor(c: TCursor); +begin + FHCursor := c; + FHPicker.Cursor := c; end; procedure TSLHColorPicker.SetHHint(h: string); @@ -299,70 +335,84 @@ begin FHPicker.PopupMenu := m; end; -procedure TSLHColorPicker.SetL(L: integer); +procedure TSLHColorPicker.SetHue(H: integer); +begin + FHPicker.Hue := H; + FSLPicker.Hue := H; +end; + +procedure TSLHColorPicker.SetLum(L: integer); begin - FLValue := L / FMaxL; FSLPicker.Luminance := L; end; -procedure TSLHColorPicker.SetMaxH(H: Integer); +procedure TSLHColorPicker.SetMaxHue(H: Integer); begin - FMaxH := H; FSLPicker.MaxHue := H; FHPicker.MaxHue := H; end; -procedure TSLHColorPicker.SetMaxL(L: Integer); +procedure TSLHColorPicker.SetMaxLum(L: Integer); begin - FMaxL := L; FSLPicker.MaxLuminance := L; + FHPicker.MaxLuminance := L; end; -procedure TSLHColorPicker.SetMaxS(S: Integer); +procedure TSLHColorPicker.SetMaxSat(S: Integer); begin - FMaxS := S; FSLPicker.MaxSaturation := S; + FHPicker.MaxSaturation := S; end; -procedure TSLHColorPicker.SetR(R: integer); +procedure TSLHColorPicker.SetMaxVal(V: Integer); begin - FRValue := R; - SelectColor(RGB(FRValue, FGValue, FBValue)); + FSLPicker.MaxValue := V; + FHPicker.MaxValue := V; end; -procedure TSLHColorPicker.SetS(S: integer); +procedure TSLHColorPicker.SetRed(R: integer); +begin + SetSelectedColor(RgbToColor(R, Green, Blue)); +end; + +procedure TSLHColorPicker.SetSat(S: integer); begin - FSValue := S / FMaxS; FSLPicker.Saturation := S; end; +procedure TSLHColorPicker.SetSelectedColor(c: TColor); +begin + FSelectedColor := c; + FHPicker.Hue := GetHValue(c); + FSLPicker.SelectedColor := c; +end; + procedure TSLHColorPicker.SetSLHint(h: string); begin FSLHint := h; FSLPicker.HintFormat := h; end; -procedure TSLHColorPicker.SetSLMenu(m: TPopupMenu); -begin - FSLMenu := m; - FSLPicker.PopupMenu := m; -end; - -procedure TSLHColorPicker.SetHCursor(c: TCursor); -begin - FHCursor := c; - FHPicker.Cursor := c; -end; - procedure TSLHColorPicker.SetSLCursor(c: TCursor); begin FSLCursor := c; FSLPicker.Cursor := c; end; +procedure TSLHColorPicker.SetSLMenu(m: TPopupMenu); +begin + FSLMenu := m; + FSLPicker.PopupMenu := m; +end; + +procedure TSLHColorPicker.SetVal(V: Integer); +begin + FSLPicker.Value := V; +end; + procedure TSLHColorPicker.SLPickerChange(Sender: TObject); begin - if FSLPicker.SelectedColor = FSelectedColor then + if FSelectedColor = FSLPicker.SelectedColor then exit; FSelectedColor := FSLPicker.SelectedColor; DoChange; diff --git a/components/mbColorLib/ScreenWin.pas b/components/mbColorLib/ScreenWin.pas index 90531a417..a6f421a05 100644 --- a/components/mbColorLib/ScreenWin.pas +++ b/components/mbColorLib/ScreenWin.pas @@ -21,9 +21,9 @@ type procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure FormMouseMove(Sender: TObject; - Shift: TShiftState; X, Y: Integer); - procedure FormMouseUp(Sender: TObject; Button: TMouseButton; - Shift: TShiftState; X, Y: Integer); + {%H-}Shift: TShiftState; X, Y: Integer); + procedure FormMouseUp(Sender: TObject; {%H-}Button: TMouseButton; + {%H-}Shift: TShiftState; X, Y: Integer); procedure FormShow(Sender: TObject); private diff --git a/components/mbColorLib/VColorPicker.pas b/components/mbColorLib/VColorPicker.pas index 33cf2191d..bc715e80e 100644 --- a/components/mbColorLib/VColorPicker.pas +++ b/components/mbColorLib/VColorPicker.pas @@ -7,13 +7,8 @@ interface {$ENDIF} uses - {$IFDEF FPC} - LCLIntf, LCLType, LMessages, - {$ELSE} - Windows, Messages, - {$ENDIF} - SysUtils, Classes, Controls, Forms, Graphics, - RGBHSVUtils, mbTrackBarPicker, HTMLColors, Scanlines; + LCLIntf, LCLType, SysUtils, Classes, Controls, Forms, Graphics, + {RGBHSVUtils,} mbTrackBarPicker, HTMLColors; type TVColorPicker = class(TmbTrackBarPicker) @@ -24,9 +19,7 @@ type function ValFromArrowPos(p: integer): integer; function GetHue: Integer; function GetSat: Integer; - function GetSelectedColor: TColor; function GetValue: Integer; - procedure SetSelectedColor(c: TColor); procedure SetHue(h: integer); procedure SetMaxHue(h: Integer); procedure SetMaxSat(s: Integer); @@ -37,7 +30,9 @@ type procedure Execute(tbaAction: integer); override; function GetArrowPos: integer; override; function GetGradientColor(AValue: Integer): TColor; override; + function GetSelectedColor: TColor; override; function GetSelectedValue: integer; override; + procedure SetSelectedColor(c: TColor); override; public constructor Create(AOwner: TComponent); override; published @@ -47,13 +42,14 @@ type property MaxHue: Integer read FMaxHue write SetMaxHue default 359; property MaxSaturation: Integer read FMaxSat write SetMaxSat default 255; property MaxValue: Integer read FMaxVal write SetMaxVal default 255; - property SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed; + property SelectedColor default clRed; + property HintFormat; end; implementation uses - mbUtils; + mbUtils, mbColorConv; {TVColorPicker} @@ -224,7 +220,7 @@ end; procedure TVColorPicker.SetSelectedColor(c: TColor); var - h, s, v: integer; + h, s, v: Double; needNewGradient: Boolean; begin if WebSafe then @@ -232,7 +228,7 @@ begin if c = GetSelectedColor then exit; - RGBToHSVRange(GetRValue(c), GetGValue(c), GetBValue(c), h, s, v); + RGBToHSV(GetRValue(c), GetGValue(c), GetBValue(c), h, s, v); needNewGradient := (h <> FHue) or (s <> FSat); FHue := h; FSat := s; diff --git a/components/mbColorLib/YColorPicker.pas b/components/mbColorLib/YColorPicker.pas index 4e612b985..529c00899 100644 --- a/components/mbColorLib/YColorPicker.pas +++ b/components/mbColorLib/YColorPicker.pas @@ -7,13 +7,8 @@ interface {$ENDIF} uses - {$IFDEF FPC} - LCLIntf, LCLType, LMessages, - {$ELSE} - Windows, Messages, - {$ENDIF} - SysUtils, Classes, Controls, Graphics, Forms, - RGBCMYKUtils, mbTrackBarPicker, HTMLColors, Scanlines; + LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Forms, + RGBCMYKUtils, mbTrackBarPicker, HTMLColors; type TYColorPicker = class(TmbTrackBarPicker) @@ -21,8 +16,6 @@ type FYellow, FMagenta, FCyan, FBlack: integer; function ArrowPosFromYellow(y: integer): integer; function YellowFromArrowPos(p: integer): integer; - function GetSelectedColor: TColor; - procedure SetSelectedColor(clr: TColor); procedure SetYellow(y: integer); procedure SetMagenta(m: integer); procedure SetCyan(c: integer); @@ -31,7 +24,9 @@ type procedure Execute(tbaAction: integer); override; function GetArrowPos: integer; override; function GetGradientColor(AValue: Integer): TColor; override; + function GetSelectedColor: TColor; override; function GetSelectedValue: integer; override; + procedure SetSelectedColor(clr: TColor); override; public constructor Create(AOwner: TComponent); override; published @@ -39,8 +34,9 @@ type property Magenta: integer read FMagenta write SetMagenta default 0; property Cyan: integer read FCyan write SetCyan default 0; property Black: integer read FBlack write SetBlack default 0; - property SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed; + property SelectedColor default clRed; property Layout default lyVertical; + property HintFormat; end; implementation diff --git a/components/mbColorLib/examples/fulldemo/main.lfm b/components/mbColorLib/examples/fulldemo/main.lfm index ba204f750..8aafcc27e 100644 --- a/components/mbColorLib/examples/fulldemo/main.lfm +++ b/components/mbColorLib/examples/fulldemo/main.lfm @@ -15,10 +15,10 @@ object Form1: TForm1 Height = 404 Top = 6 Width = 476 - ActivePage = TabSheet7 + ActivePage = TabSheet1 Align = alClient BorderSpacing.Around = 6 - TabIndex = 7 + TabIndex = 0 TabOrder = 0 OnChange = PageControl1Change OnMouseMove = PageControl1MouseMove @@ -31,10 +31,12 @@ object Form1: TForm1 Height = 360 Top = 8 Width = 454 - Saturation = 146 - SelectedColor = 3289805 + SelectedColor = 3552968 + Saturation = 147 HSPickerHintFormat = 'H: %h S: %s'#13'Hex: #%hex' LPickerHintFormat = 'Luminance: %l' + VPickerHintFormat = 'Value: %value (selected)' + MaxLuminance = 255 Anchors = [akTop, akLeft, akRight, akBottom] TabOrder = 0 OnChange = HSLColorPicker1Change @@ -611,7 +613,10 @@ object Form1: TForm1 Width = 322 Luminance = 240 RingPickerHintFormat = 'Hue: %h' - SLPickerHintFormat = 'S: %s L: %l'#13'Hex: %hex' + SLPickerHintFormat = 'S: %hslS V: %v'#13'Hex: %hex' + SVPickerHintFormat = 'S: %hslS V: %v'#13'Hex: %hex' + MaxLuminance = 255 + MaxSaturation = 255 Anchors = [akTop, akLeft, akRight, akBottom] TabOrder = 0 OnChange = HSLRingPicker1Change @@ -632,25 +637,22 @@ object Form1: TForm1 HintFormat = 'H: %h S: %s V: %v'#13'Hex: %hex' Anchors = [akTop, akLeft, akRight, akBottom] TabOrder = 0 - OnMouseMove = HSVColorPicker1MouseMove Saturation = 0 OnChange = HSVColorPicker1Change end - object VColorPicker2: TVColorPicker + object LVColorPicker1: TLVColorPicker Left = 437 Height = 375 Top = 2 Width = 22 - HintFormat = 'Value: %v (selected)' Layout = lyVertical NewArrowStyle = True Anchors = [akTop, akRight, akBottom] TabOrder = 1 - OnChange = VColorPicker2Change - Hue = 0 - Saturation = 0 - Value = 255 - SelectedColor = clWhite + OnChange = LVColorPicker1Change + BrightnessMode = bmValue + LHintFormat = 'Luminance: %lum (selected)' + VHintFormat = 'Value: %value (selected)' end end object TabSheet6: TTabSheet @@ -663,9 +665,13 @@ object Form1: TForm1 Height = 364 Top = 6 Width = 458 + SelectedColor = 213 + Value = 213 Luminance = 100 HPickerHintFormat = 'Hue: %h (selected)' SLPickerHintFormat = 'S: %s L: %l'#13'Hex: %hex' + MaxSaturation = 255 + MaxLuminance = 255 Anchors = [akTop, akLeft, akRight, akBottom] TabOrder = 0 OnChange = SLHColorPicker1Change @@ -782,20 +788,20 @@ object Form1: TForm1 Height = 25 Top = 265 Width = 420 - HintFormat = 'Luminance: %l (selected)' + SelectedColor = 460777 SelectionIndicator = siRect Anchors = [akLeft, akRight, akBottom] TabOrder = 2 Hue = 0 Saturation = 240 Luminance = 120 + HintFormat = 'Luminance: %l (selected)' end object VColorPicker1: TVColorPicker Left = 34 Height = 21 Top = 233 Width = 420 - HintFormat = 'Value: %v (selected)' ArrowPlacement = spBefore NewArrowStyle = True SelectionIndicator = siRect @@ -804,23 +810,22 @@ object Form1: TForm1 Hue = 0 Saturation = 255 Value = 255 + HintFormat = 'Value: %v (selected)' end object HColorPicker1: THColorPicker Left = 34 Height = 61 Top = 304 Width = 420 - HintFormat = 'Hue: %h (under mouse)' + SelectedColor = 8882175 Increment = 5 ArrowPlacement = spBoth SelectionIndicator = siRect Anchors = [akLeft, akRight, akBottom] TabOrder = 4 OnGetHintStr = HColorPicker1GetHintStr - Hue = 0 - Saturation = 120 - Value = 255 - SelectedColor = 8882175 + Luminance = 195 + HintFormat = 'Hue: %h (under mouse)' end object SColorPicker1: TSColorPicker AnchorSideTop.Control = OfficeColorDialogButton @@ -829,7 +834,7 @@ object Form1: TForm1 Height = 291 Top = 74 Width = 19 - HintFormat = 'Saturation: %s (selected)' + SelectedColor = 11534335 Layout = lyVertical ArrowPlacement = spBefore NewArrowStyle = True @@ -838,9 +843,8 @@ object Form1: TForm1 BorderSpacing.Top = 8 TabOrder = 5 Hue = 60 - Saturation = 80 - Value = 255 - SelectedColor = 11534335 + Luminance = 215 + HintFormat = 'Saturation: %s (selected)' end object Memo1: TMemo AnchorSideLeft.Control = Label9 @@ -903,12 +907,13 @@ object Form1: TForm1 Height = 155 Top = 6 Width = 211 - SelectedColor = 15797774 + SelectedColor = 15406357 HintFormat = 'H: %h S: %s'#13'Hex: %hex' TabOrder = 0 OnMouseMove = HSColorPicker1MouseMove Hue = 240 - Saturation = 214 + Luminance = 128 + Saturation = 215 MarkerStyle = msSquare OnChange = HSColorPicker1Change end @@ -917,12 +922,14 @@ object Form1: TForm1 Height = 130 Top = 168 Width = 161 - SelectedColor = 6974058 + SelectedColor = 6579300 HintFormat = 'H: %h S: %s L: %l'#13'Hex: %hex' TabOrder = 1 OnMouseMove = SLColorPicker1MouseMove Luminance = 100 MarkerStyle = msCross + SLHintFormat = 'S: %hslS L: %l'#13#10'Hex: %hex' + SVHintFormat = 'S: %hslS V: %v'#13#10'Hex: %hex' OnChange = SLColorPicker1Change end object HRingPicker1: THRingPicker @@ -930,13 +937,11 @@ object Form1: TForm1 Height = 130 Top = 168 Width = 133 - SelectedColor = clRed + SelectedColor = 66047 HintFormat = 'Hue: %h (selected)' TabOrder = 2 OnMouseMove = HRingPicker1MouseMove - Hue = 0 - Saturation = 255 - Value = 255 + Luminance = 128 OnChange = HRingPicker1Change end end @@ -964,10 +969,10 @@ object Form1: TForm1 Height = 353 Top = 19 Width = 22 - HintFormat = 'Cyan: %c (selected)' + SelectedColor = clAqua Anchors = [akTop, akLeft, akBottom] TabOrder = 0 - SelectedColor = clAqua + HintFormat = 'Cyan: %c (selected)' end object MColorPicker1: TMColorPicker AnchorSideTop.Control = CColorPicker1 @@ -977,11 +982,11 @@ object Form1: TForm1 Height = 353 Top = 19 Width = 22 - HintFormat = 'Magenta: %m (selected)' + SelectedColor = clFuchsia ArrowPlacement = spBefore Anchors = [akTop, akLeft, akBottom] TabOrder = 1 - SelectedColor = clFuchsia + HintFormat = 'Magenta: %m (selected)' end object YColorPicker1: TYColorPicker AnchorSideTop.Control = CColorPicker1 @@ -991,11 +996,11 @@ object Form1: TForm1 Height = 353 Top = 19 Width = 31 - HintFormat = 'Yellow: %y (selected)' + SelectedColor = clYellow ArrowPlacement = spBoth Anchors = [akTop, akLeft, akBottom] TabOrder = 2 - SelectedColor = clYellow + HintFormat = 'Yellow: %y (selected)' end object KColorPicker1: TKColorPicker AnchorSideTop.Control = CColorPicker1 @@ -1005,13 +1010,13 @@ object Form1: TForm1 Height = 353 Top = 19 Width = 22 - HintFormat = 'Black: %k (selected)' + SelectedColor = 16711422 NewArrowStyle = True Anchors = [akTop, akLeft, akBottom] TabOrder = 3 Cyan = 0 Black = 1 - SelectedColor = 16711422 + HintFormat = 'Black: %k (selected)' end object RColorPicker1: TRColorPicker AnchorSideTop.Control = CColorPicker1 @@ -1021,14 +1026,14 @@ object Form1: TForm1 Height = 353 Top = 19 Width = 22 - HintFormat = 'Red: %r (selected)' + SelectedColor = 8026879 ArrowPlacement = spBefore NewArrowStyle = True Anchors = [akTop, akLeft, akBottom] TabOrder = 4 Green = 122 Blue = 122 - SelectedColor = 8026879 + HintFormat = 'Red: %r (selected)' end object GColorPicker1: TGColorPicker AnchorSideTop.Control = CColorPicker1 @@ -1038,14 +1043,14 @@ object Form1: TForm1 Height = 353 Top = 19 Width = 34 - HintFormat = 'Green: %g (selected)' + SelectedColor = 8060794 ArrowPlacement = spBoth NewArrowStyle = True Anchors = [akTop, akLeft, akBottom] TabOrder = 5 Red = 122 Blue = 122 - SelectedColor = 8060794 + HintFormat = 'Green: %g (selected)' end object BColorPicker1: TBColorPicker AnchorSideTop.Control = CColorPicker1 @@ -1055,72 +1060,72 @@ object Form1: TForm1 Height = 353 Top = 19 Width = 22 - HintFormat = 'Blue: %b (selected)' + SelectedColor = 16743034 SelectionIndicator = siRect Anchors = [akTop, akLeft, akBottom] TabOrder = 6 Green = 122 Red = 122 - SelectedColor = 16743034 + HintFormat = 'Blue: %b (selected)' end object KColorPicker2: TKColorPicker Left = 322 Height = 79 Top = 27 Width = 69 + SelectedColor = 16711422 BevelInner = bvRaised BevelOuter = bvRaised BorderStyle = bsSingle - HintFormat = 'Black: %k (selected)' ArrowPlacement = spBoth NewArrowStyle = True TabOrder = 7 Cyan = 0 Black = 1 - SelectedColor = 16711422 + HintFormat = 'Black: %k (selected)' end object MColorPicker2: TMColorPicker Left = 320 Height = 61 Top = 110 Width = 91 + SelectedColor = clFuchsia BevelInner = bvLowered BevelOuter = bvRaised BorderStyle = bsSingle - HintFormat = 'Magenta: %m (selected)' Layout = lyHorizontal ArrowPlacement = spBoth NewArrowStyle = True TabOrder = 8 - SelectedColor = clFuchsia + HintFormat = 'Magenta: %m (selected)' end object CColorPicker2: TCColorPicker Left = 322 Height = 74 Top = 172 Width = 61 + SelectedColor = clAqua BevelInner = bvRaised BevelOuter = bvLowered BorderStyle = bsSingle - HintFormat = 'Cyan: %c (selected)' ArrowPlacement = spBoth NewArrowStyle = True TabOrder = 9 - SelectedColor = clAqua + HintFormat = 'Cyan: %c (selected)' end object YColorPicker2: TYColorPicker Left = 320 Height = 63 Top = 256 Width = 81 + SelectedColor = clYellow BevelInner = bvLowered BevelOuter = bvLowered BorderStyle = bsSingle - HintFormat = 'Yellow: %y (selected)' ArrowPlacement = spBoth NewArrowStyle = True TabOrder = 10 - SelectedColor = clYellow + HintFormat = 'Yellow: %y (selected)' end end object TabSheet10: TTabSheet diff --git a/components/mbColorLib/examples/fulldemo/main.pas b/components/mbColorLib/examples/fulldemo/main.pas index f77a21430..13b111cb6 100644 --- a/components/mbColorLib/examples/fulldemo/main.pas +++ b/components/mbColorLib/examples/fulldemo/main.pas @@ -4,16 +4,18 @@ interface uses - LCLIntf, LCLType, SysUtils, Variants,Classes, Graphics, Controls, - Forms, Dialogs, HSLColorPicker, ComCtrls, StdCtrls, ExtCtrls, mbColorPreview, + LCLIntf, LCLType, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, HSLColorPicker, ComCtrls, StdCtrls, ExtCtrls, mbColorPreview, HexaColorPicker, mbColorPalette, HSLRingPicker, HSVColorPicker, PalUtils, SLHColorPicker, mbDeskPickerButton, mbOfficeColorDialog, SColorPicker, - HColorPicker, VColorPicker, mbTrackBarPicker, LColorPicker, HRingPicker, - SLColorPicker, HSColorPicker, IniFiles, mbColorPickerControl, - BColorPicker, GColorPicker, RColorPicker, KColorPicker, YColorPicker, - MColorPicker, CColorPicker, CIEBColorPicker, CIEAColorPicker, Typinfo, - CIELColorPicker, BAxisColorPicker, GAxisColorPicker, RAxisColorPicker, - mbColorTree, mbColorList {for internet shortcuts}, mbBasicPicker; + HColorPicker, LVColorPicker, mbTrackBarPicker, LColorPicker, HRingPicker, + SLColorPicker, HSColorPicker, IniFiles, mbColorPickerControl, BColorPicker, + GColorPicker, RColorPicker, KColorPicker, YColorPicker, MColorPicker, + CColorPicker, CIEBColorPicker, CIEAColorPicker, Typinfo, CIELColorPicker, + BAxisColorPicker, GAxisColorPicker, RAxisColorPicker, mbColorTree, + mbColorList, mbBasicPicker, + + VColorPicker; type @@ -63,7 +65,6 @@ type HSColorPicker1: THSColorPicker; SLColorPicker1: TSLColorPicker; HRingPicker1: THRingPicker; - VColorPicker2: TVColorPicker; CheckBox1: TCheckBox; CbMarker: TComboBox; Label4: TLabel; @@ -82,6 +83,7 @@ type TabSheet9: TTabSheet; CColorPicker1: TCColorPicker; MColorPicker1: TMColorPicker; + LVColorPicker1: TLVColorPicker; YColorPicker1: TYColorPicker; KColorPicker1: TKColorPicker; Label8: TLabel; @@ -131,8 +133,6 @@ type procedure HSLRingPicker1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure HSVColorPicker1Change(Sender: TObject); - procedure HSVColorPicker1MouseMove(Sender: TObject; Shift: TShiftState; - X, Y: Integer); procedure SLHColorPicker1Change(Sender: TObject); procedure SLHColorPicker1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); @@ -149,7 +149,7 @@ type Y: Integer); procedure udSizeChangingEx(Sender: TObject; var AllowChange: Boolean; NewValue: SmallInt; Direction: TUpDownDirection); - procedure VColorPicker2Change(Sender: TObject); + procedure LVColorPicker1Change(Sender: TObject); procedure FormCreate(Sender: TObject); procedure CheckBox1Click(Sender: TObject); procedure CbMarkerChange(Sender: TObject); @@ -176,7 +176,8 @@ implementation {$R mxico.res} //MXS icon resource file, for internet shortcut only uses - RGBHSLUtils; + mbColorConv; +// RGBHSLUtils; procedure TForm1.tb1Change(Sender: TObject); begin @@ -244,15 +245,9 @@ end; procedure TForm1.HSVColorPicker1Change(Sender: TObject); begin - sc.color := HSVColorPicker1.SelectedColor; - VColorPicker2.Saturation := HSVColorPicker1.Saturation; - VColorPicker2.Hue := HSVColorPicker1.Hue; -end; - -procedure TForm1.HSVColorPicker1MouseMove(Sender: TObject; - Shift: TShiftState; X, Y: Integer); -begin -uc.Color := HSVColorPicker1.ColorUnderCursor; + LVColorPicker1.Saturation := HSVColorPicker1.Saturation; + LVColorPicker1.Hue := HSVColorPicker1.Hue; + sc.color := LVColorPicker1.SelectedColor; end; procedure TForm1.SLHColorPicker1Change(Sender: TObject); @@ -322,17 +317,19 @@ begin uc.color := hringpicker1.ColorUnderCursor; end; -procedure TForm1.VColorPicker2Change(Sender: TObject); +procedure TForm1.LVColorPicker1Change(Sender: TObject); begin - HSVColorPicker1.Value := VColorPicker2.Value; + if (sc = nil) or (uc = nil) or (LVColorPicker1 = nil) or (HSVColorPicker1 = nil) then + exit; + LVColorPicker1.Saturation := HSVColorPicker1.Saturation; + LVColorPicker1.Hue := HSVColorPicker1.Hue; + sc.Color := LVColorPicker1.SelectedColor; + uc.Color := HSVtoColor(HSVColorPicker1.RelHue, HSVColorPicker1.RelSaturation, HSVColorPicker1.RelValue); end; // only for internet shortcuts procedure TForm1.FormCreate(Sender: TObject); begin -// MaxHue := 360; -// MaxSat := 240; -// MaxLum := 240; with TIniFile.Create(ExtractFilePath(Application.ExeName) + '\MXS Website.url') do try WriteString('InternetShortcut','URL', 'http://mxs.bergsoft.net'); diff --git a/components/mbColorLib/mbBasicPicker.pas b/components/mbColorLib/mbBasicPicker.pas index 1f89a5aee..a9dec134e 100644 --- a/components/mbColorLib/mbBasicPicker.pas +++ b/components/mbColorLib/mbBasicPicker.pas @@ -25,14 +25,16 @@ type procedure CreateGradient; virtual; procedure DoChange; virtual; function GetColorUnderCursor: TColor; virtual; - function GetGradientColor(AValue: Integer): TColor; virtual; - function GetGradientColor2D(X, Y: Integer): TColor; virtual; + function GetGradientColor({%H-}AValue: Integer): TColor; virtual; + function GetGradientColor2D({%H-}X, {%H-}Y: Integer): TColor; virtual; function GetHintPos(X, Y: Integer): TPoint; virtual; function GetHintStr(X, Y: Integer): String; virtual; + function GetSelectedColor: TColor; virtual; abstract; procedure PaintParentBack; virtual; overload; procedure PaintParentBack(ACanvas: TCanvas); overload; procedure PaintParentBack(ACanvas: TCanvas; ARect: TRect); overload; procedure PaintParentBack(ABitmap: TBitmap); overload; + procedure SetSelectedColor(c: TColor); virtual; abstract; procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW; procedure CMParentColorChanged(var Message: TLMessage); message CM_PARENTCOLORCHANGED; property ColorUnderCursor: TColor read GetColorUnderCursor; @@ -46,6 +48,7 @@ type function GetHexColorUnderCursor: string; virtual; published property ParentColor default true; + property SelectedColor: TColor read GetSelectedColor write SetSelectedColor; end; implementation diff --git a/components/mbColorLib/mbColorPalette.pas b/components/mbColorLib/mbColorPalette.pas index 3403836a3..664c4acd7 100644 --- a/components/mbColorLib/mbColorPalette.pas +++ b/components/mbColorLib/mbColorPalette.pas @@ -64,7 +64,7 @@ type procedure DrawCell(ACanvas: TCanvas; AColor: string); procedure DrawCellBack(ACanvas: TCanvas; R: TRect; AIndex: integer); function GetColorUnderCursor: TColor; override; - function GetHintStr(X, Y: Integer): String; override; + function GetHintStr({%H-}X, {%H-}Y: Integer): String; override; function GetIndexUnderCursor: integer; procedure KeyDown(var Key: Word; Shift: TShiftState); override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; @@ -146,8 +146,6 @@ type implementation -uses - mbUtils; { TmbColorPalette } @@ -684,6 +682,7 @@ begin FNames.Clear; FColors.Text := ReadJASCPal(FileName); end + (* else if SameText(ExtractFileExt(FileName), '.aco') then begin supported := true; @@ -702,6 +701,7 @@ begin FNames.Clear; FColors.Text := ReadPhotoshopAct(FileName); end + *) else raise Exception.Create('The file format you are trying to load is not supported in this version of the palette'#13'Please send a request to MXS along with the files of this format so'#13'loading support for this file can be added too'); if supported then diff --git a/components/mbColorLib/mbColorPickerControl.pas b/components/mbColorLib/mbColorPickerControl.pas index 7dfea8500..b464ea859 100644 --- a/components/mbColorLib/mbColorPickerControl.pas +++ b/components/mbColorLib/mbColorPickerControl.pas @@ -6,7 +6,7 @@ interface uses LCLIntf, LCLType, LMessages, SysUtils, Classes, Controls, Graphics, Forms, Themes, - RGBHSLUtils, RGBHSVUtils, RGBCMYKUtils, RGBCIEUtils, HTMLColors, mbBasicPicker; + HTMLColors, mbColorConv, mbBasicPicker; type TMarkerStyle = (msCircle, msSquare, msCross, msCrossCirc); @@ -21,24 +21,22 @@ type procedure SetMarkerStyle(s: TMarkerStyle); procedure SetWebSafe(s: boolean); protected - FManual: Boolean; FSelected: TColor; mx, my: integer; procedure CreateGradient; override; - function GetHintStr(X, Y: Integer): String; override; - function GetSelectedColor: TColor; virtual; + function GetHintStr({%H-}X, {%H-}Y: Integer): String; override; + function GetSelectedColor: TColor; override; procedure InternalDrawMarker(X, Y: Integer; C: TColor); - procedure SetSelectedColor(C: TColor); virtual; + procedure SetSelectedColor(C: TColor); override; procedure WebSafeChanged; dynamic; procedure CMGotFocus(var Message: TLMessage); message CM_ENTER; procedure CMLostFocus(var Message: TLMessage); message CM_EXIT; - procedure CMMouseLeave(var Message: TLMessage); message CM_MOUSELEAVE; +// procedure CMMouseLeave(var Message: TLMessage); message CM_MOUSELEAVE; property MarkerStyle: TMarkerStyle read FMarkerStyle write SetMarkerStyle; public constructor Create(AOwner: TComponent); override; property ColorUnderCursor; published - property SelectedColor: TColor read GetSelectedColor write SetSelectedColor; property HintFormat: string read FHintFormat write FHintFormat; property WebSafe: boolean read FWebSafe write SetWebSafe default false; end; @@ -78,11 +76,70 @@ type property OnStartDrag; end; + TmbHSLVColorPickerControl = class(TmbColorPickerControl) + private + FBrightnessMode: TBrightnessMode; + function GetHue: Integer; + function GetLum: Integer; + function GetSat: Integer; + function GetVal: Integer; + function GetRed: Integer; + function GetGreen: Integer; + function GetBlue: Integer; + procedure SetHue(h: integer); + procedure SetLum(L: Integer); + procedure SetSat(s: integer); + procedure SetVal(v: integer); + procedure SetRed(R: Integer); + procedure SetGreen(G: Integer); + procedure SetBlue(B: Integer); + protected + FHue, FSat, FLum, FVal: Double; + FMaxHue, FMaxSat, FMaxLum, FMaxVal: Integer; + procedure ColorToHSLV(c: TColor; var H, S, L, V: Double); + procedure CorrectCoords(var x, y: integer); + function HSLVtoColor(H, S, L, V: Double): TColor; + procedure KeyDown(var Key: Word; Shift: TShiftState); override; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + procedure SelectColor({%H-}x, {%H-}y: Integer); virtual; + procedure SetBrightnessMode(AMode: TBrightnessMode); virtual; + procedure SetMaxHue(H: Integer); virtual; + procedure SetMaxLum(L: Integer); virtual; + procedure SetMaxSat(S: Integer); virtual; + procedure SetMaxVal(V: Integer); virtual; + procedure SetRelHue(H: Double); virtual; + procedure SetRelLum(L: Double); virtual; + procedure SetRelSat(S: Double); virtual; + procedure SetRelVal(V: Double); virtual; + public + constructor Create(AOwner: TComponent); override; + property RelHue: Double read FHue write SetRelHue; + property RelSaturation: Double read FSat write SetRelSat; + property RelLuminance: Double read FLum write SetRelLum; + property RelValue: Double read FVal write SetRelVal; + property Red: Integer read GetRed write SetRed; + property Green: Integer read GetGreen write SetGreen; + property Blue: Integer read GetBlue write SetBlue; + published + property BrightnessMode: TBrightnessMode + read FBrightnessMode write SetBrightnessMode default bmLuminance; + property Hue: integer read GetHue write SetHue; + property Luminance: Integer read GetLum write SetLum; + property Saturation: integer read GetSat write SetSat; + property Value: integer read GetVal write SetVal; + property MaxHue: Integer read FMaxHue write SetMaxHue default 360; + property MaxSaturation: Integer read FMaxSat write SetMaxSat default 255; + property MaxLuminance: Integer read FMaxLum write SetMaxLum default 255; + property MaxValue: Integer read FMaxVal write SetMaxVal default 255; + end; + implementation uses - IntfGraphics, fpimage, - ScanLines, PalUtils, SelPropUtils; + Math, IntfGraphics, fpimage, + PalUtils, SelPropUtils, mbUtils; constructor TmbCustomPicker.Create(AOwner: TComponent); begin @@ -107,14 +164,14 @@ begin inherited; Invalidate; end; - + (* procedure TmbCustomPicker.CMMouseLeave(var Message: TLMessage); begin mx := 0; my := 0; inherited; end; - + *) procedure TmbCustomPicker.CreateGradient; var x, y: Integer; @@ -205,4 +262,282 @@ begin Invalidate; end; + +{ TmbHSLVColorPickerControl } + +constructor TmbHSLVColorPickerControl.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FBrightnessMode := bmLuminance; + FMaxHue := 360; + FMaxSat := 255; + FMaxVal := 255; + FMaxLum := 255; +end; + +procedure TmbHSLVColorPickerControl.ColorToHSLV(c: TColor; + var H, S, L, V: Double); +begin + case FBrightnessMode of + bmLuminance : ColorToHSL(c, H, S, L); + bmValue : ColorToHSV(c, H, S, V); + end; +end; + +procedure TmbHSLVColorPickerControl.CorrectCoords(var x, y: integer); +begin + Clamp(x, 0, Width - 1); + Clamp(y, 0, Height - 1); +end; + +function TmbHSLVColorPickerControl.GetBlue: Integer; +begin + Result := GetBValue(GetSelectedColor); +end; + +function TmbHSLVColorPickerControl.GetGreen: Integer; +begin + Result := GetGValue(GetSelectedColor); +end; + +function TmbHSLVColorPickerControl.GetHue: Integer; +begin + Result := Round(FHue * FMaxHue); +end; + +function TmbHSLVColorPickerControl.GetLum: Integer; +begin + Result := Round(FLum * FMaxLum); +end; + +function TmbHSLVColorPickerControl.GetRed: Integer; +begin + Result := GetRValue(GetSelectedColor); +end; + +function TmbHSLVColorPickerControl.GetSat: Integer; +begin + Result := Round(FSat * FMaxSat); +end; + +function TmbHSLVColorPickerControl.GetVal: Integer; +begin + Result := Round(FVal * FMaxVal); +end; + +function TmbHSLVColorPickerControl.HSLVtoColor(H, S, L, V: Double): TColor; +begin + case FBrightnessMode of + bmLuminance : Result := HSLToColor(H, S, L); + bmValue : Result := HSVtoColor(H, S, V); + end; + if WebSafe then + Result := GetWebSafe(Result); +end; + +procedure TmbHSLVColorPickerControl.KeyDown(var Key: Word; Shift: TShiftState); +var + eraseKey: Boolean; + delta: Integer; +begin + eraseKey := true; + delta := IfThen(ssCtrl in Shift, 10, 1); + + case Key of + VK_LEFT : SelectColor(mx - delta, my); + VK_RIGHT : SelectColor(mx + delta, my); + VK_UP : SelectColor(mx, my - delta); + VK_DOWN : SelectColor(mx, my + delta); + else eraseKey := false; + end; + + if eraseKey then + Key := 0; + + inherited; +end; + +procedure TmbHSLVColorPickerControl.MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +begin + inherited; + if csDesigning in ComponentState then + Exit; + if Button = mbLeft then + SelectColor(x, y); + SetFocus; +end; + +procedure TmbHSLVColorPickerControl.MouseMove(Shift: TShiftState; X, Y: Integer); +begin + inherited; + if csDesigning in ComponentState then + Exit; + if ssLeft in Shift then + SelectColor(x, y); +end; + +procedure TmbHSLVColorPickerControl.MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +begin + inherited; + if csDesigning in ComponentState then + Exit; + if Button = mbLeft then + SelectColor(x, y); +end; + +procedure TmbHSLVColorPickerControl.SelectColor(x, y: Integer); +begin +end; + +procedure TmbHSLVColorPickerControl.SetBlue(B: Integer); +begin + Clamp(B, 0, 255); + SetSelectedColor(RgbToColor(Red, Green, B)); +end; + +procedure TmbHSLVColorPickerControl.SetBrightnessMode(AMode: TBrightnessMode); +var + c: TColor; +begin + c := HSLVtoColor(FHue, FSat, FLum, FVal); + FBrightnessMode := AMode; + ColorToHSLV(c, FHue, FSat, FLum, FVal); + CreateGradient; + Invalidate; + DoChange; +end; + +procedure TmbHSLVColorPickerControl.SetGreen(G: Integer); +begin + Clamp(G, 0, 255); + SetSelectedColor(RgbToColor(Red, G, Blue)); +end; + +procedure TmbHSLVColorPickerControl.SetHue(H: Integer); +begin + SetRelHue(H / FMaxHue); +end; + +procedure TmbHSLVColorPickerControl.SetLum(L: Integer); +begin + SetRelLum(L / FMaxLum); +end; + +procedure TmbHSLVColorPickerControl.SetMaxHue(h: Integer); +begin + if h = FMaxHue then + exit; + FMaxHue := h; + CreateGradient; + Invalidate; +end; + +procedure TmbHSLVColorPickerControl.SetMaxLum(L: Integer); +begin + if L = FMaxLum then + exit; + FMaxLum := L; + if BrightnessMode = bmLuminance then begin + CreateGradient; + Invalidate; + end; +end; + +procedure TmbHSLVColorPickerControl.SetMaxSat(S: Integer); +begin + if S = FMaxSat then + exit; + FMaxSat := S; + CreateGradient; + Invalidate; +end; + +procedure TmbHSLVColorPickerControl.SetMaxVal(V: Integer); +begin + if V = FMaxVal then + exit; + FMaxVal := V; + if BrightnessMode = bmLuminance then + begin + CreateGradient; + Invalidate; + end; +end; + +procedure TmbHSLVColorPickerControl.SetRed(R: Integer); +begin + Clamp(R, 0, 255); + SetSelectedColor(RgbToColor(R, Green, Blue)); +end; + +procedure TmbHSLVColorPickerControl.SetRelHue(H: Double); +begin + Clamp(H, 0, 1.0); + if FHue <> H then + begin + FHue := H; + FSelected := HSLVtoColor(FHue, FSat, FLum, FVal); + CreateGradient; + Invalidate; + DoChange; + end; +end; + +procedure TmbHSLVColorPickerControl.SetRelLum(L: Double); +begin + Clamp(L, 0, 1.0); + if FLum <> L then + begin + FLum := L; + FSelected := HSLVtoColor(FHue, FSat, FLum, FVal); + if BrightnessMode = bmLuminance then begin + CreateGradient; + Invalidate; + end; + DoChange; + end; +end; + +procedure TmbHSLVColorPickerControl.SetRelSat(S: Double); +begin + Clamp(S, 0, 1.0); + if FSat <> S then + begin + FSat := S; + FSelected := HSLVtoColor(FHue, FSat, FLum, FVal); + CreateGradient; + Invalidate; + DoChange; + end; +end; + +procedure TmbHSLVColorPickerControl.SetRelVal(V: Double); +begin + Clamp(v, 0, 1.0); + if FVal <> V then + begin + FVal := V; + if BrightnessMode = bmValue then + begin + FSelected := HSLVtoColor(FHue, FSat, FLum, FVal); + CreateGradient; + Invalidate; + end; + DoChange; + end; +end; + +procedure TmbHSLVColorPickerControl.SetSat(S: Integer); +begin + SetRelSat(S / FMaxSat); +end; + +procedure TmbHSLVColorPickerControl.SetVal(V: Integer); +begin + SetRelVal(V / FMaxVal); +end; + + end. diff --git a/components/mbColorLib/mbColorTree.pas b/components/mbColorLib/mbColorTree.pas index ca7eac9c7..515fce8b7 100644 --- a/components/mbColorLib/mbColorTree.pas +++ b/components/mbColorLib/mbColorTree.pas @@ -35,12 +35,12 @@ type protected procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW; function CustomDrawItem(Node: TTreeNode; State: TCustomDrawState; - Stage: TCustomDrawStage; var PaintImages: Boolean): Boolean; override; + {%H-}Stage: TCustomDrawStage; var {%H-}PaintImages: Boolean): Boolean; override; procedure DoArrow(c: TCanvas; dir: TScrollDirection; p: TPoint; sel: boolean); procedure DrawColorItem(R: TRect; Selected: boolean; AIndex: Integer; AItemText: String; Expanded: boolean); dynamic; procedure DrawInfoItem(R: TRect; Index: integer); dynamic; - function IsCustomDrawn(Target: TCustomDrawTarget; Stage: TCustomDrawStage): Boolean; override; + function IsCustomDrawn({%H-}Target: TCustomDrawTarget; {%H-}Stage: TCustomDrawStage): Boolean; override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; public diff --git a/components/mbColorLib/mbDeskPickerButton.pas b/components/mbColorLib/mbDeskPickerButton.pas index 128114982..522bc715d 100644 --- a/components/mbColorLib/mbDeskPickerButton.pas +++ b/components/mbColorLib/mbDeskPickerButton.pas @@ -60,8 +60,8 @@ type var Handled: Boolean); public constructor Create(AOwner: TComponent); override; - procedure ExecuteTarget(Target: TObject); override; - function HandlesTarget(Target: TObject): Boolean; override; + procedure ExecuteTarget({%H-}Target: TObject); override; + function HandlesTarget({%H-}Target: TObject): Boolean; override; // procedure UpdateTarget(Target: TObject); override; published property Caption; diff --git a/components/mbColorLib/mbOfficeColorDialog.pas b/components/mbColorLib/mbOfficeColorDialog.pas index 3f84ac31a..3bf7fc567 100644 --- a/components/mbColorLib/mbOfficeColorDialog.pas +++ b/components/mbColorLib/mbOfficeColorDialog.pas @@ -15,15 +15,16 @@ type FSelColor: TColor; FUseHint: boolean; FMaxHue, FMaxSat, FMaxLum: Integer; + FPickerIndex: Integer; public constructor Create(AOwner: TComponent); override; function Execute: boolean; overload; function Execute(AColor: TColor): boolean; overload; published property SelectedColor: TColor read FSelColor write FSelColor default clWhite; - property MaxHue: Integer read FMaxHue write FMaxHue default 359; - property MaxSaturation: Integer read FMaxSat write FMaxSat default 240; - property MaxLuminance: Integer read FMaxLum write FMaxLum default 240; + property MaxHue: Integer read FMaxHue write FMaxHue default 360; + property MaxSaturation: Integer read FMaxSat write FMaxSat default 255; + property MaxLuminance: Integer read FMaxLum write FMaxLum default 255; property UseHints: boolean read FUseHint write FUseHint default false; end; @@ -36,9 +37,9 @@ begin inherited; FSelColor := clWhite; FUseHint := false; - FMaxHue := 359; - FMaxSat := 240; - FMaxLum := 240; + FMaxHue := 360; + FMaxSat := 255; + FMaxLum := 255; end; function TmbOfficeColorDialog.Execute: boolean; @@ -50,16 +51,19 @@ function TmbOfficeColorDialog.Execute(AColor: TColor): boolean; begin FWin := TOfficeMoreColorsWin.Create(Application); try - FWin.OldSwatch.Color := AColor; FWin.ShowHint := FUseHint; FWin.MaxHue := FMaxHue; FWin.MaxSaturation := FMaxSat; FWin.MaxLuminance := FMaxLum; + FWin.PickerIndex := FPickerIndex; +// FWin.OldSwatch.Color := AColor; + FWin.SelectedColor := AColor; Result := (FWin.ShowModal = IdOK); if Result then - FSelColor := FWin.NewSwatch.Color + FSelColor := FWin.SelectedColor //FWin.NewSwatch.Color else FSelColor := clNone; + FPickerIndex := FWin.PickerIndex; finally FWin.Free; end; diff --git a/components/mbColorLib/mbReg.lrs b/components/mbColorLib/mbReg.lrs index 220cb86b4..ce2ad44fa 100644 --- a/components/mbColorLib/mbReg.lrs +++ b/components/mbColorLib/mbReg.lrs @@ -646,3 +646,15 @@ LazarusResources.Add('TVColorPicker','PNG',[ +' '#12'H'#3#162#0'Y'#128',A%P'#23#160'F'#208'#'#168#145#238#208'._'#200#185 +#241#12'o'#213'fM'#147#161'f;'#0#0#0#0'IEND'#174'B`'#130 ]); +LazarusResources.Add('TLVColorPicker','PNG',[ + #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#6#0#0#0#224'w='#248#0 + +#0#0#9'pHYs'#0#0#11#19#0#0#11#19#1#0#154#156#24#0#0#0#163'IDATH'#199#237#149 + +'1'#10#195'0'#12'E'#191'\'#155#128'e'#199#6#15#6#239#134#244'&9_.'#147'k'#197 + +'''P'#183#210#165#161#164#205#208'`'#129#16#130'/'#189'E'#31#145#136#224#204 + +#208'89:'#224#183#128#24#163#180#214#16'B@J'#9'9g'#148'RPJ'#193#178','#244'5' + +'`'#219'6'#138'1'#202'0'#12'0'#198'@k'#13#165'no'#151#3#0#29'9'#211#233'>' + +#201#232'G'#164#148#176#174'+'#237#138'E'#228'P'#206#243','#159#232#232':FSJ' + +#9'3'#131#153#225#156#131#181#22#206#185'g'#191'W_'#231#152#25#222'{'#169#181 + +#170#238#228#14#248#19#0#245#151'y}'#192#3#148#140'h'#197#198'%'#238'5'#0#0#0 + +#0'IEND'#174'B`'#130 +]); diff --git a/components/mbColorLib/mbReg.pas b/components/mbColorLib/mbReg.pas index a9a370c1c..4b6962134 100644 --- a/components/mbColorLib/mbReg.pas +++ b/components/mbColorLib/mbReg.pas @@ -19,7 +19,7 @@ uses RAxisColorPicker, GAxisColorPicker, BAxisColorPicker, CColorPicker, MColorPicker, YColorPicker, KColorPicker, HRingPicker, - HColorPicker, SColorPicker, LColorPicker, VColorPicker, + HColorPicker, SColorPicker, LVColorPicker, LColorPicker, VColorPicker, HSColorPicker, HSVColorPicker, HSLColorPicker, HSLRingPicker, SLColorPicker, SLHColorPicker, CIEAColorPicker, CIEBColorPicker, CIELColorPicker, @@ -34,7 +34,7 @@ begin TRAxisColorPicker, TGAxisColorPicker, TBAxisColorPicker, TCColorPicker, TMColorPicker, TYColorPicker, TKColorPicker, THRingPicker, - THColorPicker, TSColorPicker, TLColorPicker, TVColorPicker, + THColorPicker, TSColorPicker, TLVColorPicker, TLColorPicker, TVColorPicker, THSColorPicker, THSVColorPicker, THSLColorPicker, THSLRingPicker, TSLColorPicker, TSLHColorPicker, TCIEAColorPicker, TCIEBColorPicker, TCIELColorPicker, diff --git a/components/mbColorLib/mbTrackBarPicker.pas b/components/mbColorLib/mbTrackBarPicker.pas index b26f49e37..b7f635516 100644 --- a/components/mbColorLib/mbTrackBarPicker.pas +++ b/components/mbColorLib/mbTrackBarPicker.pas @@ -7,7 +7,7 @@ interface uses LCLIntf, LCLType, LMessages, SysUtils, Classes, Controls, Graphics, Forms, Themes, ExtCtrls, - PalUtils, mbBasicPicker; + PalUtils, mbColorConv, mbBasicPicker; const TBA_Resize = 0; @@ -86,6 +86,7 @@ type procedure SetBorderStyle(Value: TBorderStyle); override; procedure CMGotFocus(var Message: TLMessage); message CM_ENTER; procedure CMLostFocus(var Message: TLMessage); message CM_EXIT; + property HintFormat: string read FHintFormat write FHintFormat; public constructor Create(AOwner: TComponent); override; @@ -96,7 +97,6 @@ type property BevelOuter: TPanelBevel read FBevelOuter write SetBevelOuter default bvNone; property BevelWidth: TBevelWidth read FBevelWidth write SetBevelWidth default 1; property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsNone; - property HintFormat: string read FHintFormat write FHintFormat; property Increment: integer read FIncrement write FIncrement default 1; property Layout: TTrackBarLayout read FLayout write SetLayout default lyHorizontal; property ArrowPlacement: TSliderPlacement read FPlacement write SetPlacement default spAfter; @@ -140,11 +140,58 @@ type property OnStartDrag; end; + { TmbHSLVTrackbarPicker } + + TmbHSLVTrackbarPicker = class(TmbTrackbarPicker) + private + FBrightnessMode: TBrightnessMode; + function GetHue: Integer; + function GetLum: Integer; + function GetSat: Integer; + function GetVal: Integer; + procedure SetHue(h: integer); + procedure SetLum(L: Integer); + procedure SetSat(s: integer); + procedure SetVal(v: integer); + protected + FHue, FSat, FLum, FVal: Double; + FMaxHue, FMaxSat, FMaxLum, FMaxVal: Integer; + procedure ColorToHSLV(c: TColor; var H, S, L, V: Double); + function GetSelectedColor: TColor; override; + function HSLVtoColor(H, S, L, V: Double): TColor; + procedure SetBrightnessMode(AMode: TBrightnessMode); virtual; + procedure SetMaxHue(h: Integer); virtual; + procedure SetMaxLum(L: Integer); virtual; + procedure SetMaxSat(s: Integer); virtual; + procedure SetMaxVal(v: Integer); virtual; + procedure SetRelHue(H: Double); virtual; + procedure SetRelLum(L: Double); virtual; + procedure SetRelSat(S: Double); virtual; + procedure SetRelVal(V: Double); virtual; + public + constructor Create(AOwner: TComponent); override; + property RelHue: Double read FHue write SetRelHue; + property RelSaturation: Double read FSat write SetRelSat; + property RelLuminance: Double read FLum write SetRelLum; + property RelValue: Double read FVal write SetRelVal; + published + property BrightnessMode: TBrightnessMode + read FBrightnessMode write SetBrightnessMode default bmLuminance; + property Hue: integer read GetHue write SetHue; + property Luminance: Integer read GetLum write SetLum; + property Saturation: integer read GetSat write SetSat; + property Value: integer read GetVal write SetVal; + property MaxHue: Integer read FMaxHue write SetMaxHue default 360; + property MaxSaturation: Integer read FMaxSat write SetMaxSat default 255; + property MaxLuminance: Integer read FMaxLum write SetMaxLum default 255; + property MaxValue: Integer read FMaxVal write SetMaxVal default 255; + end; + implementation uses IntfGraphics, fpimage, Math, - ScanLines, HTMLColors; + mbUtils, HTMLColors; const { 3D border styles } @@ -634,7 +681,6 @@ begin my := Y; FArrowPos := IfThen(FLayout = lyHorizontal, XToArrowPos(X), YToArrowPos(Y)); Execute(TBA_MouseDown); - //Invalidate; end; inherited; end; @@ -653,7 +699,6 @@ begin my := Y; FArrowPos := IfThen(FLayout = lyHorizontal, XToArrowPos(X), YToArrowPos(Y)); Execute(TBA_MouseMove); -// Invalidate; end; inherited; end; @@ -666,7 +711,6 @@ begin my := Y; FArrowPos := IfThen(FLayout = lyHorizontal, XToArrowPos(X), YToArrowPos(Y)); Execute(TBA_MouseUp); -// Invalidate; end; inherited; @@ -804,4 +848,186 @@ begin Result := pos; end; + +{ TmbHSLVTrackbarPicker } + +constructor TmbHSLVTrackbarPicker.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FBrightnessMode := bmLuminance; + FMaxHue := 360; + FMaxSat := 255; + FMaxVal := 255; + FMaxLum := 255; +end; + +procedure TmbHSLVTrackbarPicker.ColorToHSLV(c: TColor; var H, S, L, V: Double); +begin + case FBrightnessMode of + bmLuminance : ColorToHSL(c, H, S, L); + bmValue : ColorToHSV(c, H, S, V); + end; +end; + +function TmbHSLVTrackbarPicker.GetHue: Integer; +begin + Result := round(FHue * FMaxHue); +end; + +function TmbHSLVTrackbarPicker.GetLum: Integer; +begin + Result := round(FLum * FMaxLum); +end; + +function TmbHSLVTrackbarPicker.GetSat: Integer; +begin + Result := round(FSat * FMaxSat); +end; + +function TmbHSLVTrackbarPicker.GetSelectedColor: TColor; +begin + Result := HSLVtoColor(FHue, FSat, FLum, FVal); +end; + +function TmbHSLVTrackbarPicker.GetVal: Integer; +begin + Result := round(FVal * FMaxVal); +end; + +function TmbHSLVTrackbarPicker.HSLVtoColor(H, S, L, V: Double): TColor; +begin + case FBrightnessMode of + bmLuminance : Result := HSLToColor(H, S, L); + bmValue : Result := HSVtoColor(H, S, V); + end; + if WebSafe then + Result := GetWebSafe(Result); +end; + +procedure TmbHSLVTrackbarPicker.SetBrightnessMode(AMode: TBrightnessMode); +var + c: TColor; +begin + c := HSLVtoColor(FHue, FSat, FLum, FVal); + FBrightnessMode := AMode; + ColorToHSLV(c, FHue, FSat, FLum, FVal); + CreateGradient; + Invalidate; + DoChange; +end; + +procedure TmbHSLVTrackbarPicker.SetHue(H: Integer); +begin + SetRelHue(H / FMaxHue); +end; + +procedure TmbHSLVTrackbarPicker.SetLum(L: Integer); +begin + SetRelLum(L / FMaxLum); +end; + +procedure TmbHSLVTrackbarPicker.SetMaxHue(h: Integer); +begin + if h = FMaxHue then + exit; + FMaxHue := h; + FGradientWidth := FMaxHue; // we don't want to access H=360, i.e. don't use FMaxHue+1 + //CreateGradient; + Invalidate; +end; + +procedure TmbHSLVTrackbarPicker.SetMaxLum(L: Integer); +begin + if L = FMaxLum then + exit; + FMaxLum := L; + if FBrightnessMode = bmLuminance then begin + //CreateGradient; + Invalidate; + end; +end; + +procedure TmbHSLVTrackbarPicker.SetMaxSat(S: Integer); +begin + if S = FMaxSat then + exit; + FMaxSat := S; + //CreateGradient; + Invalidate; +end; + +procedure TmbHSLVTrackbarPicker.SetMaxVal(V: Integer); +begin + if V = FMaxVal then + exit; + FMaxVal := V; + if FBrightnessMode = bmValue then begin + //CreateGradient; + Invalidate; + end; +end; + +procedure TmbHSLVTrackbarPicker.SetRelHue(H: Double); +begin + Clamp(H, 0, 1 - 1/FMaxHue); // don't go up to 360 because this will flip back to the start + if (FHue <> H) then + begin + FHue := H; + CreateGradient; + Invalidate; + DoChange; + end; +end; + +procedure TmbHSLVTrackbarPicker.SetRelLum(L: Double); +begin + Clamp(L, 0, 1.0); + if (FLum <> L) then + begin + FLum := L; + if BrightnessMode = bmLuminance then begin + CreateGradient; + Invalidate; + end; + DoChange; + end; +end; + +procedure TmbHSLVTrackbarPicker.SetRelSat(S: Double); +begin + Clamp(S, 0, 1.0); + if FSat <> S then + begin + FSat := S; + CreateGradient; + Invalidate; + DoChange; + end; +end; + +procedure TmbHSLVTrackbarPicker.SetRelVal(V: Double); +begin + Clamp(V, 0, 1.0); + if FVal <> V then + begin + FVal := V; + if BrightnessMode = bmValue then + begin + CreateGradient; + Invalidate; + end; + DoChange; + end; +end; + +procedure TmbHSLVTrackbarPicker.SetSat(S: Integer); +begin + SetRelSat(S / FMaxSat); +end; + +procedure TmbHSLVTrackbarPicker.SetVal(V: Integer); +begin + SetRelVal(V / FMaxVal); +end; + end. diff --git a/components/mbColorLib/mbcolorconv.pas b/components/mbColorLib/mbcolorconv.pas new file mode 100644 index 000000000..fb98beeed --- /dev/null +++ b/components/mbColorLib/mbcolorconv.pas @@ -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. + diff --git a/components/mbColorLib/mbcolorliblaz.lpk b/components/mbColorLib/mbcolorliblaz.lpk index 1721ccc7a..af2a60ff6 100644 --- a/components/mbColorLib/mbcolorliblaz.lpk +++ b/components/mbColorLib/mbcolorliblaz.lpk @@ -15,7 +15,7 @@ - + @@ -202,6 +202,14 @@ + + + + + + + + diff --git a/components/mbColorLib/mbutils.pas b/components/mbColorLib/mbutils.pas index a3bca921b..9b8d2135e 100644 --- a/components/mbColorLib/mbutils.pas +++ b/components/mbColorLib/mbutils.pas @@ -21,6 +21,7 @@ function IsEmptyRect(R: TRect): Boolean; const EMPTY_RECT: TRect = (Left: -1; Top: -1; Right: -1; Bottom: -1); + TWO_PI = 2.0 * pi; implementation