diff --git a/components/mbColorLib/BColorPicker.pas b/components/mbColorLib/BColorPicker.pas index 8a60f5f09..6a5571b47 100644 --- a/components/mbColorLib/BColorPicker.pas +++ b/components/mbColorLib/BColorPicker.pas @@ -37,8 +37,8 @@ type public constructor Create(AOwner: TComponent); override; published - property Red: integer read FRed write SetRed default 122; - property Green: integer read FGreen write SetGreen default 122; + property Red: integer read FRed write SetRed default 128; + property Green: integer read FGreen write SetGreen default 128; property Blue: integer read FBlue write SetBlue default 255; property SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed; property Layout default lyVertical; @@ -57,9 +57,9 @@ constructor TBColorPicker.Create(AOwner: TComponent); begin inherited; FGradientWidth := 256; - FGradientHeight := 12; - FRed := 122; - FGreen := 122; + FGradientHeight := 1; + FRed := 128; + FGreen := 128; FBlue := 255; FArrowPos := ArrowPosFromBlue(255); FChange := false; diff --git a/components/mbColorLib/CColorPicker.pas b/components/mbColorLib/CColorPicker.pas index ff2f82f0a..0dca22c57 100644 --- a/components/mbColorLib/CColorPicker.pas +++ b/components/mbColorLib/CColorPicker.pas @@ -54,7 +54,7 @@ constructor TCColorPicker.Create(AOwner: TComponent); begin inherited; FGradientWidth := 256; - FGradientHeight := 12; + FGradientHeight := 1; FCyan := 255; FMagenta := 0; FYellow := 0; @@ -70,7 +70,7 @@ end; function TCColorPicker.GetGradientColor(AValue: Integer): TColor; begin - Result := CMYKtoTColor(AValue, FMagenta, FYellow, FBlack); + Result := CMYKtoColor(AValue, FMagenta, FYellow, FBlack); end; procedure TCColorPicker.SetCyan(C: integer); @@ -158,10 +158,9 @@ end; function TCColorPicker.GetSelectedColor: TColor; begin - if not WebSafe then - Result := CMYKtoTColor(FCyan, FMagenta, FYellow, FBlack) - else - Result := GetWebSafe(CMYKtoTColor(FCyan, FMagenta, FYellow, FBlack)); + Result := CMYKtoColor(FCyan, FMagenta, FYellow, FBlack); + if WebSafe then + Result := GetWebSafe(Result); end; function TCColorPicker.GetSelectedValue: integer; @@ -176,13 +175,16 @@ begin if WebSafe then clr := GetWebSafe(clr); ColorToCMYK(clr, c, m, y, k); FChange := false; - SetMagenta(m); - SetYellow(y); - SetBlack(k); - SetCyan(c); + FMagenta := m; + FYellow := y; + FBlack := k; + FCyan := c; + FManual := false; + CreateGradient; + Invalidate; + if FChange and Assigned(OnChange) then OnChange(Self); FManual := false; FChange := true; - if Assigned(OnChange) then OnChange(Self); end; function TCColorPicker.GetArrowPos: integer; diff --git a/components/mbColorLib/GColorPicker.pas b/components/mbColorLib/GColorPicker.pas index d6ab3d56d..3d39fc503 100644 --- a/components/mbColorLib/GColorPicker.pas +++ b/components/mbColorLib/GColorPicker.pas @@ -32,9 +32,9 @@ type public constructor Create(AOwner: TComponent); override; published - property Red: integer read FRed write SetRed default 122; + 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 122; + property Blue: integer read FBlue write SetBlue default 128; property SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed; property Layout default lyVertical; end; @@ -50,10 +50,10 @@ constructor TGColorPicker.Create(AOwner: TComponent); begin inherited; FGradientWidth := 256; - FGradientHeight := 12; - FRed := 122; + FGradientHeight := 1; + FRed := 128; FGreen := 255; - FBlue := 122; + FBlue := 128; FArrowPos := ArrowPosFromGreen(255); FChange := false; Layout := lyVertical; diff --git a/components/mbColorLib/HColorPicker.pas b/components/mbColorLib/HColorPicker.pas index 588f8a58f..4b840676d 100644 --- a/components/mbColorLib/HColorPicker.pas +++ b/components/mbColorLib/HColorPicker.pas @@ -65,7 +65,7 @@ begin FMaxSat := 255; FMaxVal := 255; FGradientWidth := FMaxHue + 1; - FGradientHeight := 12; + FGradientHeight := 1; FSat := 1.0; FVal := 1.0; FChange := false; @@ -80,7 +80,7 @@ var h: Double; begin if Layout = lyVertical then AValue := (FMaxHue + 1) - AValue; - h := AValue / (FMaxHue + 1); + h := AValue / FMaxHue; Result := HSVtoColor(h, FSat, FVal); end; diff --git a/components/mbColorLib/HRingPicker.pas b/components/mbColorLib/HRingPicker.pas index e9b053e6d..116f47abf 100644 --- a/components/mbColorLib/HRingPicker.pas +++ b/components/mbColorLib/HRingPicker.pas @@ -18,7 +18,8 @@ uses type THRingPicker = class(TmbColorPickerControl) private - FHue, FSat, FValue: integer; + FHue, FSat, FValue: Double; + FMaxHue, FMaxSat, FMaxValue: Integer; FHueLineColor: TColor; FSelectedColor: TColor; FManual: boolean; @@ -26,7 +27,14 @@ type FChange: boolean; FRadius: integer; FDoChange: boolean; + 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 SetValue(v: integer); procedure SetHue(h: integer); @@ -54,9 +62,12 @@ type function GetColorAtPoint(x, y: integer): TColor; override; property ColorUnderCursor; published - property Hue: integer read FHue write SetHue default 0; - property Saturation: integer read FSat write SetSat default 0; - property Value: integer read FValue write SetValue default 255; + 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 FMaxValue write SetMaxValue default 255; property HueLineColor: TColor read FHueLineColor write SetHueLineColor default clGray; property SelectedColor default clNone; property Radius: integer read FRadius write SetRadius default 40; @@ -80,9 +91,12 @@ begin {$ELSE} SetInitialBounds(0, 0, 204, 204); {$ENDIF} - FValue := 255; - FHue := 0; - FSat := 0; + FMaxHue := 359; + FMaxSat := 255; + FMaxValue := 255; + FValue := 1.0; + FHue := 0.0; + FSat := 1.0; FHueLineColor := clGray; FSelectedColor := clNone; FManual := false; @@ -102,28 +116,24 @@ end; { Outer loop: Y, Inner loop: X } function THRingPicker.GetGradientColor2D(X, Y: Integer): TColor; var - xcoord, ycoord: Integer; - dSq, radiusSq: Integer; + dx, dy: Integer; + dSq, rSq: Integer; radius, size: Integer; - S, H, V: Integer; + H: Double; q: TRGBQuad; begin size := FGradientWidth; // or Height, they are the same... radius := size div 2; - radiusSq := sqr(radius); - xcoord := X - radius; - ycoord := Y - radius; - dSq := sqr(xcoord) + sqr(ycoord); - if dSq <= radiusSq then + rSq := sqr(radius); + dx := X - radius; + dy := Y - radius; + dSq := sqr(dx) + sqr(dy); + if dSq <= rSq then begin - if radius <> 0 then - S := round((255 * sqrt(dSq)) / radius) - else - S := 0; - H := round( 180 * (1 + arctan2(xcoord, ycoord) / pi)); // wp: order (x,y) is correct! + 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, S, FValue); + Result := HSVtoColor(H/360, FSat, FValue); if WebSafe then Result := GetWebSafe(Result); end else @@ -146,24 +156,39 @@ end; } procedure THRingPicker.UpdateCoords; var - r, angle: real; + r, angle: double; radius: integer; sinAngle, cosAngle: Double; begin radius := Min(Width, Height) div 2; - r := -MulDiv(radius, FSat, 255); - angle := -FHue * pi/180 - pi; + r := -radius * FSat; + angle := -(FHue * 2 + 1) * pi; SinCos(angle, sinAngle, cosAngle); mdx := round(cosAngle * r) + radius; mdy := round(sinAngle * r) + radius; end; +function THRingPicker.GetHue: Integer; +begin + Result := round(FHue * FMaxHue); +end; + +function THRingPicker.GetSat: Integer; +begin + Result := round(FSat * FMaxSat); +end; + +function THRingPicker.GetValue: Integer; +begin + Result := round(FValue * FMaxValue); +end; + procedure THRingPicker.SetHue(h: integer); begin - Clamp(h, 0, 360); - if FHue <> h then + Clamp(h, 0, FMaxHue); + if GetHue() <> h then begin - FHue := h; + FHue := h / FMaxHue; FManual := false; UpdateCoords; Invalidate; @@ -171,12 +196,42 @@ 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 = FMaxValue then + exit; + FMaxValue := v; + CreateGradient; + Invalidate; + if FChange and Assigned(OnChange) then OnChange(Self); +end; + procedure THRingPicker.SetSat(s: integer); begin - Clamp(s, 0, 255); - if FSat <> s then + Clamp(s, 0, FMaxSat); + if GetSat() <> s then begin - FSat := s; + FSat := s / FMaxSat; FManual := false; UpdateCoords; Invalidate; @@ -186,10 +241,10 @@ end; procedure THRingPicker.SetValue(v: integer); begin - Clamp(v, 0, 255); - if FValue <> V then + Clamp(v, 0, FMaxValue); + if GetValue() <> V then begin - FValue := V; + FValue := V / FMaxValue; FManual := false; CreateGradient; Invalidate; @@ -222,9 +277,9 @@ var radius: integer; begin radius := Min(Width, Height) div 2; - if (FHue >= 0) and (FHue <= 360) then + if (FHue >= 0) and (FHue <= 1.0) then begin - angle := -FHue*PI/180; + angle := -FHue * 2 * pi; SinCos(angle, sinAngle, cosAngle); Canvas.Pen.Color := FHueLineColor; Canvas.MoveTo(radius, radius); @@ -267,33 +322,21 @@ end; procedure THRingPicker.SelectionChanged(x, y: integer); var - angle, Distance, xDelta, yDelta, Radius: integer; + angle, dx, dy, Radius: integer; begin - if not PointInCircle(Point(x, y), Min(Width, Height)) then - begin - FChange := false; - SetSelectedColor(clNone); - FChange := true; - Exit; - end - else - FSelectedColor := clWhite; - Radius := Min(Width, Height) div 2; - xDelta := x - Radius; - yDelta := y - Radius; - angle := round(360 + 180*arctan2(-yDelta, xDelta) / pi); + 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) + inc(angle, 360) else if angle > 360 then - Dec(angle, 360); + dec(angle, 360); FChange := false; - SetHue(angle); - distance := round(sqrt(sqr(xDelta) + sqr(yDelta))); - if distance >= radius then - SetSat(255) - else - SetSat(MulDiv(distance, 255, radius)); + SetHue(MulDiv(angle, FMaxHue + 1, 360)); FChange := true; + Invalidate; end; procedure THRingPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; @@ -304,37 +347,42 @@ begin ClipCursor(nil); {$ENDIF} if csDesigning in ComponentState then Exit; - if (Button = mbLeft) and PointInCircle(Point(x, y), Min(Width, Height)) then + if (Button = mbLeft) and FDragging then begin mdx := x; mdy := y; FDoChange := true; SelectionChanged(X, Y); FManual := true; + FDragging := false; end; end; procedure THRingPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +{$IFDEF DELPHI} var R: TRect; +{$ENDIF} begin inherited; - if csDesigning in ComponentState then Exit; - if (Button = mbLeft) and PointInCircle(Point(x, y), Min(Width, Height)) then - begin + if csDesigning in ComponentState then + Exit; + if (Button = mbLeft) and MouseOnPicker(X, Y) + then begin mdx := x; mdy := y; + {$IFDEF DELPHI} R := ClientRect; InflateRect(R, 1, 1); R.TopLeft := ClientToScreen(R.TopLeft); R.BottomRight := ClientToScreen(R.BottomRight); - {$IFDEF DELPHI} ClipCursor(@R); {$ENDIF} FDoChange := true; SelectionChanged(X, Y); FManual := true; + FDragging := true; end; SetFocus; end; @@ -355,7 +403,7 @@ procedure THRingPicker.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 + if (ssLeft in Shift) and FDragging then begin mdx := x; mdy := y; @@ -369,10 +417,9 @@ function THRingPicker.GetSelectedColor: TColor; begin if FSelectedColor <> clNone then begin - if not WebSafe then - Result := HSVtoColor(FHue, FSat, FValue) - else - Result := GetWebSafe(HSVtoColor(FHue, FSat, FValue)); + Result := HSVtoColor(FHue, FSat, FValue); + if WebSafe then + Result := GetWebSafe(Result); end else Result := clNone; @@ -380,29 +427,25 @@ end; function THRingPicker.GetColorAtPoint(x, y: integer): TColor; var - angle, distance, xDelta, yDelta, radius: integer; - h, s: integer; + angle: Double; + dx, dy, radius: integer; + h: Double; begin radius := Min(Width, Height) div 2; - xDelta := x - Radius; - yDelta := y - Radius; - angle := round(360 + 180*arctan2(-yDelta, xDelta) / pi); - if angle < 0 then - Inc(angle, 360) - else if angle > 360 then - Dec(angle, 360); - h := angle; - distance := round(sqrt(sqr(xDelta) + sqr(yDelta))); - if distance >= radius then - s := 255 - else - s := MulDiv(distance, 255, radius); + if PointInCircle(Point(x, y), Min(Width, Height)) then begin - if not WebSafe then - Result := HSVtoColor(h, s, FValue) - else - Result := GetWebSafe(HSVtoColor(h, s, FValue)); + dx := x - Radius; + dy := y - Radius; + angle := 360 + 180 * arctan2(-dy, dx) / pi; + if angle < 0 then + angle := angle + 360 + else if angle > 360 then + angle := angle - 360; + h := angle / 360; + Result := HSVtoColor(h, FSat, FValue); + if WebSafe then + Result := GetWebSafe(Result); end else Result := clNone; @@ -411,15 +454,16 @@ end; procedure THRingPicker.SetSelectedColor(c: TColor); var changeSave: boolean; + h, s, v: Double; begin if WebSafe then c := GetWebSafe(c); changeSave := FChange; FManual := false; - Fchange := false; - SetValue(GetVValue(c)); - SetHue(GetHValue(c)); - SetSat(GetSValue(c)); + FChange := false; + RGBToHSV(GetRValue(c), GetGValue(c), GetBValue(c), FHue, FSat, FValue); FSelectedColor := c; + UpdateCoords; + Invalidate; FChange := changeSave; if FChange and Assigned(FOnChange) then FOnChange(Self); FChange := true; @@ -427,49 +471,29 @@ end; function THRingPicker.RadHue(New: integer): integer; begin - if New < 0 then New := New + 360; - if New > 360 then New := New - 360; + if New < 0 then New := New + (FMaxHue + 1); + if New > (FMaxHue + 1) then New := New - (FMaxHue + 1); Result := New; end; procedure THRingPicker.CNKeyDown( var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF} ); var - Shift: TShiftState; - FInherited: boolean; + shift: TShiftState; + FInherited: boolean; + delta: Integer; begin - FInherited := false; - Shift := KeyDataToShiftState(Message.KeyData); - if not (ssCtrl in Shift) then - case Message.CharCode of - VK_LEFT: - begin - FChange := false; - SetHue(RadHue(FHue + 1)); - FChange := true; - FManual := true; - if Assigned(FOnChange) then FOnChange(Self); - end; - VK_RIGHT: - begin - FChange := false; - SetHue(RadHue(FHue - 1)); - FChange := true; - FManual := true; - if Assigned(FOnChange) then FOnChange(Self); - end + FInherited := false; + shift := KeyDataToShiftState(Message.KeyData); + if ssCtrl in Shift then + delta := 10 else - begin - FInherited := true; - inherited; - end; - end - else + delta := 1; case Message.CharCode of VK_LEFT: begin FChange := false; - SetHue(RadHue(FHue + 10)); + SetHue(RadHue(GetHue() + delta)); FChange := true; FManual := true; if Assigned(FOnChange) then FOnChange(Self); @@ -477,7 +501,7 @@ begin VK_RIGHT: begin FChange := false; - SetHue(RadHue(FHue - 10)); + SetHue(RadHue(GetHue() - delta)); FChange := true; FManual := true; if Assigned(FOnChange) then FOnChange(Self); @@ -488,9 +512,9 @@ begin inherited; end; end; - if not FInherited then - if Assigned(OnKeyDown) then - OnKeyDown(Self, Message.CharCode, Shift); + if not FInherited then + if Assigned(OnKeyDown) then + OnKeyDown(Self, Message.CharCode, Shift); end; end. diff --git a/components/mbColorLib/HSColorPicker.pas b/components/mbColorLib/HSColorPicker.pas index 313936d80..162bade34 100644 --- a/components/mbColorLib/HSColorPicker.pas +++ b/components/mbColorLib/HSColorPicker.pas @@ -4,6 +4,8 @@ unit HSColorPicker; {$MODE DELPHI} {$ENDIF} +{$DEFINE USE COLOR_TO_RGB} + interface uses @@ -21,11 +23,18 @@ type THSColorPicker = class(TmbColorPickerControl) private - FHue, FSaturation, FLuminance: integer; - FLum: integer; + FHue, FSat, FLum: Double; + FMaxHue, FMaxSat, FMaxLum: Integer; dx, dy, mxx, myy: integer; - procedure SetHValue(h: integer); - procedure SetSValue(s: integer); + function GetHue: Integer; + function GetLum: Integer; + function GetSat: Integer; + procedure SetHue(H: integer); + procedure SetLum(L: Integer); + procedure SetSat(S: integer); + procedure SetMaxHue(H: Integer); + procedure SetMaxLum(L: Integer); + procedure SetMaxSat(S: Integer); protected procedure CorrectCoords(var x, y: integer); function GetGradientColor2D(X, Y: Integer): TColor; override; @@ -42,11 +51,15 @@ type function PredictColor: TColor; public constructor Create(AOwner: TComponent); override; - property Lum: integer read FLum write FLum default 120; + property Hue: integer read GetHue write SetHue; + property Saturation: integer read GetSat write SetSat; +// property Lum: integer read GetLum write SetLum; published property SelectedColor default clRed; - property HueValue: integer read FHue write SetHValue default 0; - property SaturationValue: integer read FSaturation write SetSValue default 240; + property Luminance: Integer read GetLum write SetLum; + 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 MarkerStyle default msCross; property OnChange; end; @@ -61,20 +74,22 @@ uses constructor THSColorPicker.Create(AOwner: TComponent); begin inherited; - FGradientWidth := 240; - FGradientHeight := 241; + FMaxHue := 359; + FMaxSat := 240; + FMaxLum := 240; + FGradientWidth := FMaxHue + 1; + FGradientHeight := FMaxSat + 1; {$IFDEF DELPHI} Width := 239; Height := 240; {$ELSE} - SetInitialBounds(0, 0, 239, 240); + SetInitialBounds(0, 0, FGradientWidth, FGradientHeight); {$ENDIF} HintFormat := 'H: %h S: %hslS'#13'Hex: %hex'; FHue := 0; - FSaturation := 240; - FLuminance := 120; + FSat := 1.0; + FLum := 0.5; FSelected := clRed; - FLum := 120; FManual := false; dx := 0; dy := 0; @@ -91,7 +106,11 @@ end; function THSColorPicker.GetGradientColor2D(X, Y: Integer): TColor; begin - Result := HSLRangeToRGB(x, FBufferBmp.Height - 1 - y, 120); + {$IFDEF USE_COLOR_TO_RGB} + Result := HSLToColor(x / FMaxHue, (FBufferBmp.Height - 1 - y) / FMaxSat, FLum); + {$ELSE} + Result := HSLtoRGB(x / FMaxHue, (FMaxSat - y) / FMaxSat, FLum); + {$ENDIF} end; procedure THSColorPicker.CorrectCoords(var x, y: integer); @@ -103,11 +122,16 @@ end; procedure THSColorPicker.DrawMarker(x, y: integer); var c: TColor; + L: Double; begin CorrectCoords(x, y); - RGBtoHSLRange(FSelected, FHue, FSaturation, FLuminance); - if Assigned(FOnChange) then - FOnChange(Self); + + {$IFDEF USE_COLOR_TO_RGB} + ColorToHSL(FSelected, FHue, FSat, L); + {$ELSE} + RGBToHSL(FSelected, FHue, FSat, L); + {$ENDIF} + dx := x; dy := y; if Focused or (csDesigning in ComponentState) then @@ -117,15 +141,37 @@ begin InternalDrawMarker(x, y, c); end; +function THSColorPicker.GetHue: Integer; +begin + Result := Round(FHue * FMaxHue); +end; + +function THSColorPicker.GetLum: Integer; +begin + Result := Round(FLum * FMaxLum); +end; + +function THSColorPicker.GetSat: Integer; +begin + Result := Round(FSat * FMaxSat); +end; + procedure THSColorPicker.SetSelectedColor(c: TColor); +var + L: Double; begin if WebSafe then c := GetWebSafe(c); - RGBtoHSLRange(c, FHue, FSaturation, FLuminance); + {$IFDEF USE_COLOR_TO_RGB} + ColorToHSL(c, FHue, FSat, L); + {$ELSE} + RGBtoHSL(c, FHue, FSat, L); + {$ENDIF} FSelected := c; FManual := false; - mxx := Round(FHue*(Width/239)); - myy := Round((240-FSaturation)*(Height/240)); + mxx := Round(FHue * Width); + myy := Round((1.0 - FSat) * Height); Invalidate; + if Assigned(OnChange) then OnChange(Self); end; procedure THSColorPicker.Paint; @@ -142,21 +188,23 @@ begin end; procedure THSColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +{$IFDEF DELPHI} var R: TRect; +{$ENDIF} begin inherited; mxx := x; myy := y; if Button = mbLeft then begin + {$IFDEF DELPHI} R := ClientRect; R.TopLeft := ClientToScreen(R.TopLeft); R.BottomRight := ClientToScreen(R.BottomRight); - {$IFDEF DELPHI} ClipCursor(@R); {$ENDIF} - FSelected := GetColorAtPoint(x, y); + SetSelectedColor(GetColorAtPoint(x, y)); FManual := true; Invalidate; end; @@ -171,7 +219,7 @@ begin {$ENDIF} mxx := x; myy := y; - FSelected := GetColorAtPoint(x, y); + SetSelectedColor(GetColorAtPoint(x, y)); FManual := true; Invalidate; end; @@ -183,7 +231,7 @@ begin begin mxx := x; myy := y; - FSelected := GetColorAtPoint(x, y); + SetSelectedColor(GetColorAtPoint(x, y)); FManual := true; Invalidate; end; @@ -191,121 +239,138 @@ end; function THSColorPicker.PredictColor: TColor; var - FTHue, FTSat, FTLum: integer; + H, S, L: Double; begin - RGBtoHSLRange(GetColorUnderCursor, FTHue, FTSat, FTLum); - Result := HSLRangeToRGB(FTHue, FTSat, FLum); + {$IFDEF USE_COLOR_TO_RGB} + ColorToHSL(GetColorUnderCursor, H, S, L); + {$ELSE} + RGBtoHSL(GetColorUnderCursor, H, S, L); + {$ENDIF} + Result := HSLToRGB(H, S, L); end; procedure THSColorPicker.CNKeyDown( var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF} ); var - Shift: TShiftState; - FInherited: boolean; + Shift: TShiftState; + FInherited: boolean; + delta: Integer; begin - FInherited := false; - Shift := KeyDataToShiftState(Message.KeyData); - if not (ssCtrl in Shift) then - case Message.CharCode of - VK_LEFT: - begin - mxx := dx - 1; - myy := dy; - FSelected := GetColorAtPoint(mxx, myy); - FManual := true; - Invalidate; - end; - VK_RIGHT: - begin - mxx := dx + 1; - myy := dy; - FSelected := GetColorAtPoint(mxx, myy); - FManual := true; - Invalidate; - end; - VK_UP: - begin - mxx := dx; - myy := dy - 1; - FSelected := GetColorAtPoint(mxx, myy); - FManual := true; - Invalidate; - end; - VK_DOWN: - begin - mxx := dx; - myy := dy + 1; - FSelected := GetColorAtPoint(mxx, myy); - FManual := true; - Invalidate; - end; + FInherited := false; + Shift := KeyDataToShiftState(Message.KeyData); + if (ssCtrl in Shift) then + delta := 10 else - begin - FInherited := true; - inherited; - end; - end - else + delta := 1; case Message.CharCode of - VK_LEFT: + VK_LEFT: + begin + mxx := dx - delta; + myy := dy; + FSelected := GetColorAtPoint(mxx, myy); + FManual := true; + Invalidate; + end; + VK_RIGHT: + begin + mxx := dx + delta; + myy := dy; + FSelected := GetColorAtPoint(mxx, myy); + FManual := true; + Invalidate; + end; + VK_UP: + begin + mxx := dx; + myy := dy - delta; + FSelected := GetColorAtPoint(mxx, myy); + FManual := true; + Invalidate; + end; + VK_DOWN: + begin + mxx := dx; + myy := dy + delta; + FSelected := GetColorAtPoint(mxx, myy); + FManual := true; + Invalidate; + end; + else begin - mxx := dx - 10; - myy := dy; - Refresh; - FSelected := GetColorAtPoint(mxx, myy); - FManual := true; - Invalidate; + FInherited := true; + inherited; end; - VK_RIGHT: - begin - mxx := dx + 10; - myy := dy; - Refresh; - FSelected := GetColorAtPoint(mxx, myy); - FManual := true; - Invalidate; - end; - VK_UP: - begin - mxx := dx; - myy := dy - 10; - Refresh; - FSelected := GetColorAtPoint(mxx, myy); - FManual := true; - Invalidate; - end; - VK_DOWN: - begin - mxx := dx; - myy := dy + 10; - Refresh; - FSelected := GetColorAtPoint(mxx, myy); - FManual := true; - Invalidate; - end; - else - begin - FInherited := true; - inherited; - end; end; - if not FInherited then - if Assigned(OnKeyDown) then - OnKeyDown(Self, Message.CharCode, Shift); + + if not FInherited then + if Assigned(OnKeyDown) then + OnKeyDown(Self, Message.CharCode, Shift); end; -procedure THSColorPicker.SetHValue(h: integer); +procedure THSColorPicker.SetHue(H: integer); begin - Clamp(h, 0, 239); - FHue := h; - SetSelectedColor(HSLRangeToRGB(FHue, FSaturation, 120)); // why hard-coded 120? + Clamp(H, 0, FMaxHue); + FHue := H / FMaxHue; + {$IFDEF USE_COLOR_TO_RGB} + SetSelectedColor(HSLtoColor(FHue, FSat, FLum)); + {$ELSE} + SetSelectedColor(HSLToRGB(FHue, FSat, FLum)); + {$ENDIF} end; -procedure THSColorPicker.SetSValue(s: integer); +// Sets the luminance value used for the display. It is not necessarily that +// of the selected color. +procedure THSColorPicker.SetLum(L: Integer); begin - Clamp(s, 0, 240); - FSaturation := s; - SetSelectedColor(HSLRangeToRGB(FHue, FSaturation, 120)); + Clamp(L, 0, FMaxLum); + FLum := L / FMaxLum; + CreateGradient; + {$IFDEF USE_COLOR_TO_RGB} + SetSelectedColor(HSLtoColor(FHue, FSat, FLum)); + {$ELSE} + SetSelectedColor(HSLToRGB(FHue, FSat, FLum)); + {$ENDIF} +end; + +procedure THSColorPicker.SetSat(S: integer); +begin + Clamp(S, 0, FMaxSat); + FSat := S; + {$IFDEF USE_COLOR_TO_RGB} + SetSelectedColor(HSLtoColor(FHue, FSat, FLum)); + {$ELSE} + SetSelectedColor(HSLToRGB(FHue, FSat, FLum)); + {$ENDIF} +end; + +procedure THSColorPicker.SetMaxHue(H: Integer); +begin + if H = FMaxHue then + exit; + FMaxHue := H; + FGradientWidth := FMaxHue + 1; + CreateGradient; + Invalidate; +end; + +procedure THSColorPicker.SetMaxSat(S: Integer); +begin + if S = FMaxSat then + exit; + FMaxSat := S; + FGradientHeight := FMaxSat + 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); end; end. diff --git a/components/mbColorLib/HSLColorPicker.pas b/components/mbColorLib/HSLColorPicker.pas index d2af65f5e..772fe354c 100644 --- a/components/mbColorLib/HSLColorPicker.pas +++ b/components/mbColorLib/HSLColorPicker.pas @@ -25,7 +25,6 @@ type FHSPicker: THSColorPicker; FLPicker: TLColorPicker; FSelectedColor: TColor; - FHValue, FSValue, FLValue: integer; FRValue, FGValue, FBValue: integer; FHSHint, FLHint: string; FLMenu, FHSMenu: TPopupMenu; @@ -33,14 +32,23 @@ type FHSCursor, FLCursor: TCursor; PBack: TBitmap; function GetManual: boolean; + function GetH: Integer; + function GetS: Integer; + function GetL: Integer; + function GetMaxH: Integer; + function GetMaxS: Integer; + function GetMaxL: Integer; procedure SetLumIncrement(i: integer); procedure SelectColor(c: TColor); - procedure SetH(v: integer); - procedure SetS(v: integer); - procedure SetL(v: integer); - procedure SetR(v: integer); - procedure SetG(v: integer); - procedure SetB(v: integer); + procedure SetH(H: integer); + procedure SetS(S: integer); + procedure SetL(L: 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); @@ -66,12 +74,12 @@ type function GetHexColorUnderCursor: string; override; function GetSelectedHexColor: string; property ColorUnderCursor; - property HValue: integer read FHValue write SetH default 0; - property SValue: integer read FSValue write SetS default 240; - property LValue: integer read FLValue write SetL default 120; - property RValue: integer read FRValue write SetR default 255; - property GValue: integer read FGValue write SetG default 0; - property BValue: integer read FBValue write SetB default 0; + property Hue: integer read GetH write SetH; + property Saturation: integer read GetS write SetS; + property Luminance: integer read GetL write SetL; + 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 Manual: boolean read GetManual; published property LuminanceIncrement: integer read FLumIncrement write SetLumIncrement default 1; @@ -82,6 +90,9 @@ type property LPickerHintFormat: string read FLHint write SetLHint; 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 TabStop default true; property ShowHint; property ParentShowHint; @@ -138,6 +149,9 @@ begin {$ENDIF} Anchors := [akLeft, akTop, akRight, akBottom]; Visible := true; + MaxHue := 359; + MaxSaturation := 240; + MaxLuminance := 240; OnChange := HSPickerChange; OnMouseMove := DoMouseMove; end; @@ -156,12 +170,16 @@ begin {$ENDIF} Anchors := [akRight, akTop, akBottom]; Visible := true; + MaxHue := 359; + MaxSaturation := 240; + MaxLuminance := 240; + Luminance := 120; OnChange := LPickerChange; OnMouseMove := DoMouseMove; end; - FHValue := 0; - FSValue := 240; - FLValue := 120; + Hue := 0; + Saturation := 240; + Luminance := 120; FRValue := 255; FGValue := 0; FBValue := 0; @@ -179,23 +197,21 @@ end; procedure THSLColorPicker.HSPickerChange(Sender: TObject); begin - FLPicker.Hue := FHSPicker.HueValue; - FLPicker.Saturation := FHSPicker.SaturationValue; + FLPicker.Hue := FHSPicker.Hue; + FLPicker.Saturation := FHSPicker.Saturation; + FLPicker.Invalidate; DoChange; end; procedure THSLColorPicker.LPickerChange(Sender: TObject); begin - FHSPicker.Lum := FLPicker.Luminance; +// FHSPicker.Lum := FLPicker.Luminance; FSelectedColor := FLPicker.SelectedColor; DoChange; end; procedure THSLColorPicker.DoChange; begin - FHValue := FLPicker.Hue; - FSValue := FLPicker.Saturation; - FLValue := FLPicker.Luminance; FRValue := GetRValue(FLPicker.SelectedColor); FGValue := GetGValue(FLPicker.SelectedColor); FBValue := GetBValue(FLPicker.SelectedColor); @@ -203,6 +219,36 @@ begin FOnChange(Self); end; +function THSLColorPicker.GetH: Integer; +begin + Result := FHSPicker.Hue; +end; + +function THSLColorPicker.GetS: Integer; +begin + Result := FHSPicker.Saturation; +end; + +function THSLColorPicker.GetL: integer; +begin + Result := FLPicker.Luminance; +end; + +function THSLColorPicker.GetMaxH: Integer; +begin + Result := FHSPicker.MaxHue; +end; + +function THSLColorPicker.GetMaxS: Integer; +begin + Result := FHSPicker.MaxSaturation; +end; + +function THSLColorPicker.GetMaxL: Integer; +begin + Result := FLPicker.MaxLuminance; +end; + procedure THSLColorPicker.SelectColor(c: TColor); begin FSelectedColor := c; @@ -210,41 +256,56 @@ begin FLPicker.SelectedColor := c; end; -procedure THSLColorPicker.SetH(v: integer); +procedure THSLColorPicker.SetH(H: integer); begin - FHValue := v; - FHSPicker.HueValue := v; - FLPicker.Hue := v; + FHSPicker.Hue := H; + FLPicker.Hue := H; end; -procedure THSLColorPicker.SetS(v: integer); +procedure THSLColorPicker.SetS(S: integer); begin - FSValue := v; - FHSPicker.SaturationValue := v; - FLPicker.Saturation := v; + FHSPicker.Saturation := S; + FLPicker.Saturation := S; end; -procedure THSLColorPicker.SetL(v: integer); +procedure THSLColorPicker.SetL(L: integer); begin - FLValue := v; - FLPicker.Luminance := v; + FLPicker.Luminance := L; end; -procedure THSLColorPicker.SetR(v: integer); +procedure THSLColorPicker.SetMaxH(H: Integer); begin - FRValue := v; + FHSPicker.MaxHue := H; + FLPicker.MaxHue := H; +end; + +procedure THSLColorPicker.SetMaxS(S: Integer); +begin + FHSPicker.MaxSaturation := S; + FLPicker.MaxSaturation := S; +end; + +procedure THSLColorPicker.SetMaxL(L: Integer); +begin + FHSPicker.MaxLuminance := L; + FLPicker.MaxLuminance := L; +end; + +procedure THSLColorPicker.SetR(R: integer); +begin + FRValue := R; SetSelectedColor(RGB(FRValue, FGValue, FBValue)); end; -procedure THSLColorPicker.SetG(v: integer); +procedure THSLColorPicker.SetG(G: integer); begin - FGValue := v; + FGValue := G; SetSelectedColor(RGB(FRValue, FGValue, FBValue)); end; -procedure THSLColorPicker.SetB(v: integer); +procedure THSLColorPicker.SetB(B: integer); begin - FBValue := v; + FBValue := B; SetSelectedColor(RGB(FRValue, FGValue, FBValue)); end; diff --git a/components/mbColorLib/HSLRingPicker.pas b/components/mbColorLib/HSLRingPicker.pas index 012a5ecbc..aefd8c367 100644 --- a/components/mbColorLib/HSLRingPicker.pas +++ b/components/mbColorLib/HSLRingPicker.pas @@ -25,17 +25,25 @@ type FRingPicker: THRingPicker; FSLPicker: TSLColorPicker; FSelectedColor: TColor; - FHValue, FSValue, FLValue: integer; FRValue, FGValue, FBValue: integer; FRingHint, FSLHint: string; FSLMenu, FRingMenu: TPopupMenu; FSLCursor, FRingCursor: TCursor; PBack: TBitmap; function GetManual: boolean; + function GetHue: Integer; + function GetLum: Integer; + function GetSat: Integer; + function GetMaxHue: Integer; + function GetMaxLum: Integer; + function GetMaxSat: Integer; procedure SelectColor(c: TColor); - procedure SetH(v: integer); - procedure SetS(v: integer); - procedure SetL(v: integer); + procedure SetHue(H: integer); + procedure SetSat(S: integer); + procedure SetLum(L: 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); @@ -65,9 +73,9 @@ type function GetHexColorUnderCursor: string; override; function GetSelectedHexColor: string; property ColorUnderCursor; - property HValue: integer read FHValue write SetH default 0; - property SValue: integer read FSValue write SetS default 240; - property LValue: integer read FLValue write SetL default 120; + property Hue: integer read GetHue write SetHue; + property Saturation: integer read GetSat write SetSat; + property Luminance: integer read GetLum write SetLum; property RValue: integer read FRValue write SetR default 255; property GValue: integer read FGValue write SetG default 0; property BValue: integer read FBValue write SetB default 0; @@ -80,6 +88,9 @@ type property SLPickerHintFormat: string read FSLHint write SetSLHint; 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 MaxLuminance: Integer read GetMaxLum write SetMaxLum default 240; + property MaxSaturation: Integer read GetMaxSat write SetMaxSat default 240; property TabStop default true; property ShowHint; property ParentShowHint; @@ -105,7 +116,10 @@ constructor THSLRingPicker.Create(AOwner: TComponent); begin inherited; // ControlStyle := ControlStyle - [csAcceptsControls] + [csOpaque{$IFDEF DELPHI_7_UP}, csParentBackground{$ENDIF}]; - DoubleBuffered := true; + //DoubleBuffered := true; + FRValue := 255; + FGValue := 0; + FBValue := 0; PBack := TBitmap.Create; PBack.PixelFormat := pf32bit; {$IFDEF DELPHI_7_UP} {$IFDEF DELPHI} @@ -133,11 +147,11 @@ begin {$ELSE} SetInitialBounds(0, 0, 246, 246); {$ENDIF} - Radius := 100; + //Radius := 40; Align := alClient; Visible := true; - Saturation := 255; - Value := 255; + Saturation := FRingPicker.MaxSaturation; + Value := FRingPicker.MaxValue; Hue := 0; OnChange := RingPickerChange; OnMouseMove := DoMouseMove; @@ -154,16 +168,14 @@ begin {$ELSE} SetInitialBounds(63, 63, 120, 120); {$ENDIF} + MaxSaturation := 240; + MaxLuminance := 240; + Saturation := 240; + Luminance := 240; Visible := true; OnChange := SLPickerChange; OnMouseMove := DoMouseMove; end; - FHValue := 0; - FSValue := 255; - FLValue := 255; - FRValue := 255; - FGValue := 0; - FBValue := 0; FRingHint := 'Hue: %h'; FSLHint := 'S: %hslS L: %l'#13'Hex: %hex'; end; @@ -220,9 +232,6 @@ begin if (FRingPicker = nil) or (FSLPicker = nil) then exit; - FHValue := FRingPicker.Hue; - FSValue := FSLPicker.Saturation; - FLValue := FSLPicker.Luminance; FRValue := GetRValue(FSLPicker.SelectedColor); FGValue := GetGValue(FSLPicker.SelectedColor); FBValue := GetBValue(FSLPicker.SelectedColor); @@ -236,36 +245,34 @@ begin exit; FRingPicker.Hue := GetHValue(c); - FRingPicker.Saturation := 255; - FRingPicker.Value := 255; + //FRingPicker.Saturation := FRingPicker.MaxSaturation; + //FRingPicker.Value := FRingPicker.MaxValue; + FSLPicker.SelectedColor := c; FSelectedColor := c; end; -procedure THSLRingPicker.SetH(v: integer); +procedure THSLRingPicker.SetHue(H: integer); begin if (FRingPicker = nil) or (FSLPicker = nil) then exit; - FHValue := v; - FRingPicker.Hue := v; - FSLPicker.Hue := v; + FRingPicker.Hue := H; + FSLPicker.Hue := H; end; -procedure THSLRingPicker.SetS(v: integer); +procedure THSLRingPicker.SetSat(S: integer); begin if (FSLPicker = nil) then exit; - FSValue := v; - FSLPicker.Saturation := v; + FSLPicker.Saturation := S; end; -procedure THSLRingPicker.SetL(v: integer); +procedure THSLRingPicker.SetLum(L: integer); begin if (FSLPicker = nil) then exit; - FLValue := v; - FSLPicker.Luminance := v; + FSLPicker.Luminance := L; end; procedure THSLRingPicker.SetR(v: integer); @@ -368,4 +375,49 @@ begin PaintParentBack(PBack); end; +function THSLRingPicker.GetHue: Integer; +begin + Result := FRingPicker.Hue; +end; + +function THSLRingPicker.GetSat: Integer; +begin + Result := FSLPicker.Saturation; +end; + +function THSLRingPicker.GetLum: Integer; +begin + Result := FSLPicker.Luminance; +end; + +function THSLRingPicker.GetMaxHue: Integer; +begin + Result := FRingPicker.MaxHue; +end; + +function THSLRingPicker.GetMaxSat: Integer; +begin + Result := FSLPicker.MaxSaturation; +end; + +function THSLRingPicker.GetMaxLum: Integer; +begin + Result := FSLPicker.MaxLuminance; +end; + +procedure THSLRingPicker.SetMaxHue(H: Integer); +begin + FRingPicker.MaxHue := H; +end; + +procedure THSLRingPicker.SetMaxLum(L: Integer); +begin + FSLPicker.MaxLuminance := L; +end; + +procedure THSLRingPicker.SetMaxSat(S: Integer); +begin + FSLPicker.MaxSaturation := S; +end; + end. diff --git a/components/mbColorLib/HSVColorPicker.pas b/components/mbColorLib/HSVColorPicker.pas index 40d7ccbff..d415580bc 100644 --- a/components/mbColorLib/HSVColorPicker.pas +++ b/components/mbColorLib/HSVColorPicker.pas @@ -19,7 +19,8 @@ uses type THSVColorPicker = class(TmbColorPickerControl) private - FHue, FSat, FValue: integer; + FHue, FSat, FValue: Double; + FMaxHue, FMaxSat, FMaxValue: Integer; FSatCircColor, FHueLineColor: TColor; FSelectedColor: TColor; FShowSatCirc: boolean; @@ -28,9 +29,15 @@ type FChange: boolean; FDoChange: boolean; function RadHue(New: integer): integer; - procedure SetValue(V: integer); + function GetHue: Integer; + function GetSat: Integer; + function GetValue: 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 SetSatCircColor(c: TColor); procedure SetHueLineColor(c: TColor); procedure DrawSatCirc; @@ -59,9 +66,12 @@ type constructor Create(AOwner: TComponent); override; function GetColorAtPoint(x, y: integer): TColor; override; published - property Hue: integer read FHue write SetHue default 0; - property Saturation: integer read FSat write SetSat default 0; - property Value: integer read FValue write SetValue default 255; + 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 FMaxValue write SetMaxValue default 255; property SaturationCircleColor: TColor read FSatCircColor write SetSatCircColor default clSilver; property HueLineColor: TColor read FHueLineColor write SetHueLineColor default clGray; property SelectedColor default clNone; @@ -88,9 +98,12 @@ begin {$ELSE} SetInitialBounds(0, 0, 204, 204); {$ENDIF} - FValue := 255; + FMaxHue := 359; + FMaxSat := 255; + FMaxValue := 255; FHue := 0; FSat := 0; + FValue := 1.0; FSatCircColor := clSilver; FHueLineColor := clGray; FSelectedColor := clNone; @@ -137,35 +150,49 @@ end; { Outer loop: Y, Inner loop: X } function THSVColorPicker.GetGradientColor2D(X, Y: Integer): TColor; var - xcoord, ycoord: Integer; + dx, dy: Integer; dSq, radiusSq: Integer; radius, size: Integer; - S, H, V: Integer; + S, H, V: Double; q: TRGBQuad; begin size := FGradientWidth; // or Height, they are the same... radius := size div 2; radiusSq := sqr(radius); - xcoord := X - radius; - ycoord := Y - radius; - dSq := sqr(xcoord) + sqr(ycoord); + dx := X - radius; + dy := Y - radius; + dSq := sqr(dx) + sqr(dy); if dSq <= radiusSq then begin if radius <> 0 then - S := round((255 * sqrt(dSq)) / radius) - //S := trunc((255 * sqrt(dSq)) / radius) + S := sqrt(dSq) / radius else S := 0; - H := round( 180 * (1 + arctan2(xcoord, ycoord) / pi)); // wp: order (x,y) is correct! + 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, S, FValue); + Result := HSVtoColor(H/360, S, FValue); if WebSafe then Result := GetWebSafe(Result); end else Result := GetDefaultColor(dctBrush); end; +function THSVColorPicker.GetHue: Integer; +begin + Result := round(FHue * FMaxHue); +end; + +function THSVColorPicker.GetSat: Integer; +begin + Result := round(FSat * FMaxSat); +end; + +function THSVColorPicker.GetValue: Integer; +begin + Result := round(FValue * FMaxValue); +end; + procedure THSVColorPicker.Resize; begin inherited; @@ -187,8 +214,8 @@ var radius: integer; begin radius := Min(Width, Height) div 2; - r := -MulDiv(radius, FSat, 255); - angle := -FHue* pi / 180 - PI; + r := -FSat * radius; + angle := -(FHue * 2 + 1) * pi; SinCos(angle, sinAngle, cosAngle); mdx := round(cosAngle * r) + radius; mdy := round(sinAngle * r) + radius; @@ -196,10 +223,10 @@ end; procedure THSVColorPicker.SetHue(h: integer); begin - Clamp(h, 0, 360); - if FHue <> h then + Clamp(h, 0, FMaxHue); + if GetHue() <> h then begin - FHue := h; + FHue := h / FMaxHue; FManual := false; UpdateCoords; Invalidate; @@ -209,10 +236,10 @@ end; procedure THSVColorPicker.SetSat(s: integer); begin - Clamp(s, 0, 255); - if FSat <> s then + Clamp(s, 0, FMaxSat); + if GetSat() <> s then begin - FSat := s; + FSat := s / FMaxSat; FManual := false; UpdateCoords; Invalidate; @@ -222,10 +249,10 @@ end; procedure THSVColorPicker.SetValue(V: integer); begin - Clamp(V, 0, 255); - if FValue <> V then + Clamp(V, 0, FMaxValue); + if GetValue() <> V then begin - FValue := V; + FValue := V / FMaxValue; FManual := false; CreateGradient; Invalidate; @@ -233,6 +260,36 @@ begin end; end; +procedure THSVColorPicker.SetMaxHue(h: Integer); +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.SetSatCircColor(c: TColor); begin if FSatCircColor <> c then @@ -285,12 +342,12 @@ var begin if not FShowSatCirc then exit; - if (FSat > 0) and (FSat < 255) then + if (FSat > 0) and (FSat < 1.0) then begin radius := Min(Width, Height) div 2; Canvas.Pen.Color := FSatCircColor; Canvas.Brush.Style := bsClear; - delta := MulDiv(radius, FSat, 255); + delta := round(radius * FSat); Canvas.Ellipse(radius - delta, radius - delta, radius + delta, radius + delta); end; end; @@ -304,9 +361,9 @@ begin if not FShowHueLine then exit; radius := Min(Width, Height) div 2; - if (FHue >= 0) and (FHue <= 360) then + if (FHue >= 0) and (FHue <= 1.0) then begin - angle := -FHue * pi / 180; + angle := -FHue * 2 * pi; SinCos(angle, sinAngle, cosAngle); Canvas.Pen.Color := FHueLineColor; Canvas.MoveTo(radius, radius); @@ -329,33 +386,37 @@ end; procedure THSVColorPicker.SelectionChanged(x, y: integer); var - angle, distance, xDelta, yDelta, radius: integer; + angle: Double; + dx, dy, r, radius: integer; begin - if not PointInCircle(Point(x, y), Min(Width, Height)) then + radius := Min(Width, Height) div 2; + dx := x - radius; + dy := y - radius; + r := round(sqrt(sqr(dx) + sqr(dy))); + + if r > radius then // point outside circle begin FChange := false; SetSelectedColor(clNone); FChange := true; exit; - end - else - FSelectedColor := clWhite; - radius := Min(Width, Height) div 2; - xDelta := x - radius; - yDelta := y - radius; - angle := round(360 + 180*arctan2(-yDelta, xDelta) / pi); + end; + + FSelectedColor := clWhite; + angle := 360 + 180*arctan2(-dy, dx) / pi; // wp: "-y, x" correct? The others have "x, y" if angle < 0 then - inc(angle, 360) + angle := angle + 360 else if angle > 360 then - dec(angle, 360); + angle := angle - 360; FChange := false; - SetHue(Angle); - distance := round(sqrt(sqr(xDelta) + sqr(yDelta))); - if distance >= radius then - SetSat(255) + FHue := angle / 360; + if r > radius then + FSat := 1.0 else - SetSat(MulDiv(distance, 255, radius)); + FSat := r / radius; FChange := true; + + Invalidate; end; procedure THSVColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; @@ -379,8 +440,10 @@ end; procedure THSVColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +{$IFDEF DELPHI} var R: TRect; +{$ENDIF} begin inherited; if csDesigning in ComponentState then @@ -389,11 +452,11 @@ begin begin mdx := x; mdy := y; + {$IFDEF DELPHI} R := ClientRect; InflateRect(R, 1, 1); R.TopLeft := ClientToScreen(R.TopLeft); R.BottomRight := ClientToScreen(R.BottomRight); - {$IFDEF DELPHI} ClipCursor(@R); {$ENDIF} FDoChange := true; @@ -434,10 +497,9 @@ function THSVColorPicker.GetSelectedColor: TColor; begin if FSelectedColor <> clNone then begin - if not WebSafe then - Result := HSVtoColor(FHue, FSat, FValue) - else - Result := GetWebSafe(HSVtoColor(FHue, FSat, FValue)); + Result := HSVtoColor(FHue, FSat, FValue); + if WebSafe then + Result := GetWebSafe(Result); end else Result := clNone; @@ -445,46 +507,44 @@ end; function THSVColorPicker.GetColorAtPoint(x, y: integer): TColor; var - angle, distance, xDelta, yDelta, radius: integer; - h, s: integer; + angle: Double; + dx, dy, r, radius: integer; + h, s: double; begin radius := Min(Width, Height) div 2; - xDelta := x - Radius; - yDelta := y - Radius; - angle := round(360 + 180*arctan2(-yDelta, xDelta) / pi); - if angle < 0 then - inc(angle, 360) - else if angle > 360 then - dec(angle, 360); - h := angle; - distance := round(sqrt(sqr(xDelta) + sqr(yDelta))); - if distance >= radius then - s := 255 - else - s := MulDiv(distance, 255, radius); - if PointInCircle(Point(mx, my), Min(Width, Height)) then + dx := x - Radius; + dy := y - Radius; + + r := round(sqrt(sqr(dx) + sqr(dy))); + if r <= radius then begin - if not WebSafe then - Result := HSVtoColor(h, s, FValue) - else - Result := GetWebSafe(HSVtoColor(h, s, FValue)); - end - else + angle := 360 + 180 * arctan2(-dy, dx) / pi; + if angle < 0 then + angle := angle + 360 + else if angle > 360 then + angle := angle - 360; + h := angle / 360; + s := r / radius; + Result := HSVtoColor(h, s, FValue); + if WebSafe then + Result := GetWebSafe(Result); + end else Result := clNone; end; procedure THSVColorPicker.SetSelectedColor(c: TColor); var changeSave: boolean; + h, s, v: Double; begin if WebSafe then c := GetWebSafe(c); changeSave := FChange; FManual := false; - Fchange := false; - SetValue(GetVValue(c)); - SetHue(GetHValue(c)); - SetSat(GetSValue(c)); + FChange := false; + RGBtoHSV(GetRValue(c), GetGValue(c), GetBValue(c), FHue, FSat, FValue); FSelectedColor := c; + UpdateCoords; + Invalidate; FChange := changeSave; if FChange and Assigned(FOnChange) then FOnChange(Self); FChange := true; @@ -492,67 +552,29 @@ end; function THSVColorPicker.RadHue(New: integer): integer; begin - if New < 0 then New := New + 360; - if New > 360 then New := New - 360; + if New < 0 then New := New + (FMaxHue + 1); + if New > (FMaxHue + 1) then New := New - (FMaxHue + 1); Result := New; end; procedure THSVColorPicker.CNKeyDown( var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF} ); var - Shift: TShiftState; - FInherited: boolean; + shift: TShiftState; + FInherited: boolean; + delta: Integer; begin - FInherited := false; - Shift := KeyDataToShiftState(Message.KeyData); - if not (ssCtrl in Shift) then - case Message.CharCode of - VK_LEFT: - begin - FChange := false; - SetHue(RadHue(FHue + 1)); - FChange := true; - FManual := true; - if Assigned(FOnChange) then FOnChange(Self); - end; - VK_RIGHT: - begin - FChange := false; - SetHue(RadHue(FHue - 1)); - FChange := true; - FManual := true; - if Assigned(FOnChange) then FOnChange(Self); - end; - VK_UP: - begin - FChange := false; - if FSat + 1 <= 255 then - SetSat(FSat + 1); - FChange := true; - FManual := true; - if Assigned(FOnChange) then FOnChange(Self); - end; - VK_DOWN: - begin - FChange := false; - if FSat - 1 >= 0 then - SetSat(FSat - 1); - FChange := true; - FManual := true; - if Assigned(FOnChange) then FOnChange(Self); - end; + FInherited := false; + shift := KeyDataToShiftState(Message.KeyData); + if ssCtrl in shift then + delta := 10 else - begin - FInherited := true; - inherited; - end; - end - else + delta := 1; case Message.CharCode of VK_LEFT: begin FChange := false; - SetHue(RadHue(FHue + 10)); + SetHue(RadHue(GetHue() + delta)); FChange := true; FManual := true; if Assigned(FOnChange) then FOnChange(Self); @@ -560,7 +582,7 @@ begin VK_RIGHT: begin FChange := false; - SetHue(RadHue(FHue - 10)); + SetHue(RadHue(GetHue() - delta)); FChange := true; FManual := true; if Assigned(FOnChange) then FOnChange(Self); @@ -568,8 +590,7 @@ begin VK_UP: begin FChange := false; - if FSat + 10 <= 255 then - SetSat(FSat + 10); + SetSat(GetSat() + delta); FChange := true; FManual := true; if Assigned(FOnChange) then FOnChange(Self); @@ -577,8 +598,7 @@ begin VK_DOWN: begin FChange := false; - if FSat - 10 >= 0 then - SetSat(FSat - 10); + SetSat(GetSat() - delta); FChange := true; FManual := true; if Assigned(FOnChange) then FOnChange(Self); @@ -589,9 +609,10 @@ begin inherited; end; end; - if not FInherited then - if Assigned(OnKeyDown) then - OnKeyDown(Self, Message.CharCode, Shift); + + if not FInherited then + if Assigned(OnKeyDown) then + OnKeyDown(Self, Message.CharCode, Shift); end; end. diff --git a/components/mbColorLib/KColorPicker.pas b/components/mbColorLib/KColorPicker.pas index cc1d6e469..9c3d00d7d 100644 --- a/components/mbColorLib/KColorPicker.pas +++ b/components/mbColorLib/KColorPicker.pas @@ -54,7 +54,7 @@ constructor TKColorPicker.Create(AOwner: TComponent); begin inherited; FGradientWidth := 256; - FGradientHeight := 12; + FGradientHeight := 1; FCyan := 0; FMagenta := 0; FYellow := 0; @@ -70,7 +70,7 @@ end; function TKColorPicker.GetGradientColor(AValue: Integer): TColor; begin - Result := CMYKtoTColor(FCyan, FMagenta, FYellow, AValue); + Result := CMYKtoColor(FCyan, FMagenta, FYellow, AValue); end; procedure TKColorPicker.SetBlack(k: integer); @@ -158,10 +158,9 @@ end; function TKColorPicker.GetSelectedColor: TColor; begin - if not WebSafe then - Result := CMYKtoTColor(FCyan, FMagenta, FYellow, FBlack) - else - Result := GetWebSafe(CMYKtoTColor(FCyan, FMagenta, FYellow, FBlack)); + Result := CMYKtoColor(FCyan, FMagenta, FYellow, FBlack); + if WebSafe then + Result := GetWebSafe(Result); end; function TKColorPicker.GetSelectedValue: integer; diff --git a/components/mbColorLib/LColorPicker.pas b/components/mbColorLib/LColorPicker.pas index 5c24acf6e..edecbddc5 100644 --- a/components/mbColorLib/LColorPicker.pas +++ b/components/mbColorLib/LColorPicker.pas @@ -18,12 +18,19 @@ uses type TLColorPicker = class(TmbTrackBarPicker) private - FHue, FSat, FLuminance: integer; - function ArrowPosFromLum(l: integer): integer; + FHue, FSat, FLuminance: Double; + FMaxHue, FMaxSat, FMaxLum: Integer; + function ArrowPosFromLum(L: integer): integer; function LumFromArrowPos(p: integer): integer; - procedure SetHue(h: integer); - procedure SetSat(s: integer); - procedure SetLuminance(l: integer); + function GetHue: Integer; + function GetSat: Integer; + function GetLuminance: Integer; + procedure SetHue(H: integer); + procedure SetSat(S: integer); + procedure SetLuminance(L: integer); + procedure SetMaxHue(H: Integer); + procedure SetMaxSat(S: Integer); + procedure SetMaxLum(L: Integer); function GetSelectedColor: TColor; procedure SetSelectedColor(c: TColor); protected @@ -34,9 +41,12 @@ type public constructor Create(AOwner: TComponent); override; published - property Hue: integer read FHue write SetHue default 0; - property Saturation: integer read FSat write SetSat default 240; - property Luminance: integer read FLuminance write SetLuminance default 120; + 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; end; @@ -50,13 +60,15 @@ uses constructor TLColorPicker.Create(AOwner: TComponent); begin inherited; - FGradientWidth := 256; - FGradientHeight := 12; + FMaxHue := 359; + FMaxSat := 240; + FMaxLum := 240; + FGradientWidth := FMaxLum + 1; + FGradientHeight := 1; FHue := 0; - FSat := MaxSat; - FArrowPos := ArrowPosFromLum(MaxLum div 2); + FSat := FMaxSat; FChange := false; - SetLuminance(MaxLum div 2); + SetLuminance(FMaxLum div 2); HintFormat := 'Luminance: %value (selected)'; FManual := false; FChange := true; @@ -64,15 +76,30 @@ end; function TLColorPicker.GetGradientColor(AValue: Integer): TColor; begin - Result := HSLRangeToRGB(FHue, FSat, AValue); + Result := HSLToRGB(FHue, FSat, AValue/FMaxLum); end; -procedure TLColorPicker.SetHue(h: integer); +function TLColorPicker.GetHue: Integer; begin - Clamp(h, 0, MaxHue); - if FHue <> h then + Result := Round(FHue * FMaxHue); +end; + +function TLColorPicker.GetLuminance: Integer; +begin + Result := Round(FLuminance * FMaxLum); +end; + +function TLColorPicker.GetSat: Integer; +begin + Result := Round(FSat * FMaxSat); +end; + +procedure TLColorPicker.SetHue(H: integer); +begin + Clamp(H, 0, FMaxHue); + if GetHue() <> H then begin - FHue := h; + FHue := H / FMaxHue; FManual := false; CreateGradient; Invalidate; @@ -80,12 +107,56 @@ begin end; end; -procedure TLColorPicker.SetSat(s: integer); +procedure TLColorPicker.SetLuminance(L: integer); begin - Clamp(s, 0, MaxSat); - if FSat <> s then + Clamp(L, 0, FMaxLum); + if GetLuminance() <> L then begin - FSat := s; + FLuminance := L / FMaxLum; + FArrowPos := ArrowPosFromLum(L); + FManual := false; + Invalidate; + if FChange and Assigned(OnChange) then OnChange(Self); + end; +end; + +procedure TLColorPicker.SetMaxHue(H: Integer); +begin + if H = FMaxHue then + exit; + FMaxHue := H; + CreateGradient; + Invalidate; + if FChange and Assigned(OnChange) then OnChange(Self); +end; + +procedure TLColorPicker.SetMaxLum(L: Integer); +begin + if L = FMaxLum then + exit; + FMaxLum := L; + FGradientWidth := FMaxLum + 1; // 0 .. FMaxHue --> FMaxHue + 1 pixels + CreateGradient; + Invalidate; + if FChange and Assigned(OnChange) then OnChange(Self); +end; + +procedure TLColorPicker.SetMaxSat(S: Integer); +begin + if S = FMaxSat then + exit; + FMaxSat := S; + CreateGradient; + Invalidate; + if FChange and Assigned(OnChange) then OnChange(Self); +end; + +procedure TLColorPicker.SetSat(S: integer); +begin + Clamp(S, 0, FMaxSat); + if GetSat() <> S then + begin + FSat := S / FMaxSat; FManual := false; CreateGradient; Invalidate; @@ -93,19 +164,18 @@ begin end; end; -function TLColorPicker.ArrowPosFromLum(l: integer): integer; +function TLColorPicker.ArrowPosFromLum(L: integer): integer; var a: integer; begin if Layout = lyHorizontal then begin - a := Round(((Width - 12)/MaxLum)*l); + a := Round((Width - 12) * L / FMaxLum); if a > Width - FLimit then a := Width - FLimit; end else begin - l := MaxLum - l; - a := Round(((Height - 12)/MaxLum)*l); + a := Round((Height - 12) * (FMaxLum - L) / FMaxLum); if a > Height - FLimit then a := Height - FLimit; end; if a < 0 then a := 0; @@ -117,88 +187,73 @@ var L: integer; begin if Layout = lyHorizontal then - L := Round(p/((Width - 12)/MaxLum)) + L := Round(p / (Width - 12) * FMaxLum) else - L := Round(MaxLum - p/((Height - 12)/MaxLum)); - Clamp(L, 0, MaxLum); + L := Round(MaxLum - p /(Height - 12) * FMaxLum); + Clamp(L, 0, FMaxLum); Result := L; end; -procedure TLColorPicker.SetLuminance(L: integer); -begin - Clamp(L, 0, MaxLum); - if FLuminance <> L then - begin - FLuminance := L; - FArrowPos := ArrowPosFromLum(L); - FManual := false; - Invalidate; - if FChange and Assigned(OnChange) then OnChange(Self); - end; -end; - function TLColorPicker.GetSelectedColor: TColor; begin - if not WebSafe then - Result := HSLRangeToRGB(FHue, FSat, FLuminance) - else - Result := GetWebSafe(HSLRangeToRGB(FHue, FSat, FLuminance)); + Result := HSLToRGB(FHue, FSat, FLuminance); + if WebSafe then + Result := GetWebSafe(Result); end; function TLColorPicker.GetSelectedValue: integer; begin - Result := FLuminance; + Result := GetLuminance(); end; procedure TLColorPicker.SetSelectedColor(c: TColor); -var - h1, s1, l1: integer; begin if WebSafe then c := GetWebSafe(c); - RGBtoHSLRange(c, h1, s1, l1); - Fchange := false; - SetHue(h1); - SetSat(s1); - SetLuminance(l1); - FChange := true; + ColortoHSL(c, FHue, FSat, FLuminance); + FChange := false; FManual := false; + CreateGradient; + Invalidate; if FChange and Assigned(OnChange) then OnChange(Self); end; function TLColorPicker.GetArrowPos: integer; begin - Result := ArrowPosFromLum(FLuminance); + if FMaxLum = 0 then + Result := inherited GetArrowPos + else + Result := ArrowPosFromLum(GetLuminance()); end; procedure TLColorPicker.Execute(tbaAction: integer); begin case tbaAction of TBA_Resize: - SetLuminance(FLuminance); + SetLuminance(GetLuminance()); TBA_MouseMove: - FLuminance := LumFromArrowPos(FArrowPos); + SetLuminance(LumFromArrowPos(FArrowPos)); TBA_MouseDown: - Fluminance := LumFromArrowPos(FArrowPos); + SetLuminance(LumFromArrowPos(FArrowPos)); TBA_MouseUp: - Fluminance := LumFromArrowPos(FArrowPos); + SetLuminance(LumFromArrowPos(FArrowPos)); TBA_WheelUp: - SetLuminance(FLuminance + Increment); + SetLuminance(GetLuminance() + Increment); TBA_WheelDown: - SetLuminance(FLuminance - Increment); + SetLuminance(GetLuminance() - Increment); TBA_VKRight: - SetLuminance(FLuminance + Increment); + SetLuminance(GetLuminance() + Increment); TBA_VKCtrlRight: - SetLuminance(MaxLum); + SetLuminance(FMaxLum); TBA_VKLeft: - SetLuminance(FLuminance - Increment); + SetLuminance(GetLuminance() - Increment); TBA_VKCtrlLeft: SetLuminance(0); TBA_VKUp: - SetLuminance(FLuminance + Increment); + SetLuminance(GetLuminance() + Increment); TBA_VKCtrlUp: - SetLuminance(MaxLum); + SetLuminance(FMaxLum); TBA_VKDown: - SetLuminance(FLuminance - Increment); + SetLuminance(GetLuminance() - Increment); TBA_VKCtrlDown: SetLuminance(0); else diff --git a/components/mbColorLib/MColorPicker.pas b/components/mbColorLib/MColorPicker.pas index a40d9fb83..f0366e1a4 100644 --- a/components/mbColorLib/MColorPicker.pas +++ b/components/mbColorLib/MColorPicker.pas @@ -54,7 +54,7 @@ constructor TMColorPicker.Create(AOwner: TComponent); begin inherited; FGradientWidth := 256; - FGradientHeight := 12; + FGradientHeight := 1; FCyan := 0; FMagenta := 255; FYellow := 0; @@ -71,7 +71,7 @@ end; function TMColorPicker.GetGradientColor(AValue: Integer): TColor; begin - Result := CMYKtoTColor(FCyan, AValue, FYellow, FBlack); + Result := CMYKtoColor(FCyan, AValue, FYellow, FBlack); end; procedure TMColorPicker.SetMagenta(m: integer); @@ -159,10 +159,9 @@ end; function TMColorPicker.GetSelectedColor: TColor; begin - if not WebSafe then - Result := CMYKtoTColor(FCyan, FMagenta, FYellow, FBlack) - else - Result := GetWebSafe(CMYKtoTColor(FCyan, FMagenta, FYellow, FBlack)); + Result := CMYKtoColor(FCyan, FMagenta, FYellow, FBlack); + if WebSafe then + Result := GetWebSafe(Result); end; function TMColorPicker.GetSelectedValue: integer; diff --git a/components/mbColorLib/OfficeMoreColorsDialog.pas b/components/mbColorLib/OfficeMoreColorsDialog.pas index 6da306bdc..b2daf81a1 100644 --- a/components/mbColorLib/OfficeMoreColorsDialog.pas +++ b/components/mbColorLib/OfficeMoreColorsDialog.pas @@ -187,8 +187,8 @@ begin (ERed.Focused {$IFDEF DELPHI} or ERed.Button.Focused{$ENDIF}) then begin inc(FLockChange); - HSL.RValue := ERed.Value; - SLH.RValue := ERed.Value; + HSL.Red := ERed.Value; + SLH.Red := ERed.Value; NewSwatch.Color := RGB(ERed.Value, EGreen.Value, EBlue.Value); dec(FLockChange); end; @@ -200,8 +200,8 @@ begin (EGreen.Focused {$IFDEF DELPHI}or EGreen.Button.Focused{$ENDIF}) then begin inc(FLockChange); - HSL.GValue := EGreen.Value; - SLH.GValue := EGreen.Value; + HSL.Green := EGreen.Value; + SLH.Green := EGreen.Value; NewSwatch.Color := RGB(ERed.Value, EGreen.Value, EBlue.Value); dec(FLockChange); end; @@ -213,8 +213,8 @@ begin (EBlue.Focused {$IFDEF DELPHI} or EBlue.Button.Focused{$ENDIF}) then begin inc(FLockChange); - HSL.BValue := EBlue.Value; - SLH.BValue := EBlue.Value; + HSL.Blue := EBlue.Value; + SLH.Blue := EBlue.Value; NewSwatch.Color := RGB(ERed.Value, EGreen.Value, EBlue.Value); dec(FLockChange); end; @@ -226,8 +226,8 @@ begin (EHue.Focused {$IFDEF DELPHI} or EHue.Button.Focused{$ENDIF}) then begin inc(FLockChange); - HSL.HValue := EHue.Value; - SLH.HValue := EHue.Value; + HSL.Hue := EHue.Value; + SLH.Hue := EHue.Value; NewSwatch.Color := HSLRangeToRGB(EHue.Value, ESat.Value, ELum.Value); dec(FLockChange); end; @@ -239,8 +239,8 @@ begin (ESat.Focused {$IFDEF DELPHI}or ESat.Button.Focused{$ENDIF}) then begin inc(FLockChange); - HSL.SValue := ESat.Value; - SLH.SValue := ESat.Value; + HSL.Saturation := ESat.Value; + SLH.Saturation := ESat.Value; NewSwatch.Color := HSLRangeToRGB(EHue.Value, ESat.Value, ELum.Value); dec(FLockChange); end; @@ -252,7 +252,7 @@ begin (ELum.Focused {$IFDEF DELPHI} or ELum.Button.Focused{$ENDIF}) then begin inc(FLockChange); - HSL.LValue := ELum.Value; + HSL.Luminance := ELum.Value; NewSwatch.Color := HSLRangeToRGB(EHue.Value, ESat.Value, ELum.Value); dec(FLockChange); end; diff --git a/components/mbColorLib/PalUtils.pas b/components/mbColorLib/PalUtils.pas index 216396006..ceaa27c38 100644 --- a/components/mbColorLib/PalUtils.pas +++ b/components/mbColorLib/PalUtils.pas @@ -588,13 +588,13 @@ begin 1: //HSB - HSV Result := HSVToColor(Round(w/182.04), Round(x/655.35), Round(y/655.35)); 2: //CMYK - Result := CMYKToTColor(Round(100-w/55.35), Round(100-x/655.35), Round(100-y/655.35), Round(100-z/655.35)); + Result := CMYKToColor(Round(100-w/55.35), Round(100-x/655.35), Round(100-y/655.35), Round(100-z/655.35)); 7: //Lab Result := LabToRGB(w/100, x/100, y/100); 8: //Grayscale Result := RGB(Round(w/39.0625), Round(w/39.0625), Round(w/39.0625)); 9: //Wide CMYK - Result := CMYKToTColor(w div 100, x div 100, y div 100, z div 100) + Result := CMYKToColor(w div 100, x div 100, y div 100, z div 100) else //unknown Result := RGB(w div 256, x div 256, y div 256); end; diff --git a/components/mbColorLib/RColorPicker.pas b/components/mbColorLib/RColorPicker.pas index 4b3174cbf..1e2b327ed 100644 --- a/components/mbColorLib/RColorPicker.pas +++ b/components/mbColorLib/RColorPicker.pas @@ -38,8 +38,8 @@ type constructor Create(AOwner: TComponent); override; published property Red: integer read FRed write SetRed default 255; - property Green: integer read FGreen write SetGreen default 122; - property Blue: integer read FBlue write SetBlue default 122; + 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 Layout default lyVertical; end; @@ -57,10 +57,10 @@ constructor TRColorPicker.Create(AOwner: TComponent); begin inherited; FGradientWidth := 256; - FGradientHeight := 12; + FGradientHeight := 1; FRed := 255; - FGreen := 122; - FBlue := 122; + FGreen := 128; + FBlue := 128; FArrowPos := ArrowPosFromRed(255); FChange := false; Layout := lyVertical; diff --git a/components/mbColorLib/RGBCMYKUtils.pas b/components/mbColorLib/RGBCMYKUtils.pas index 4a7a457c7..71eedb93a 100644 --- a/components/mbColorLib/RGBCMYKUtils.pas +++ b/components/mbColorLib/RGBCMYKUtils.pas @@ -2,22 +2,30 @@ unit RGBCMYKUtils; interface +// Activate only one of these defines - see comments below + +{.$DEFINE CMYK_FORMULA_1} // Original formula used by mbColorLib +{$DEFINE CMYK_FORMULA_2} // Result agrees with OpenOffice + uses {$IFDEF FPC}LCLIntf,{$ELSE} Windows,{$ENDIF} Graphics, Math; -function CMYtoTColor(C, M, Y: integer): TColor; +function CMYtoColor(C, M, Y: integer): TColor; procedure RGBtoCMY(clr: TColor; var C, M, Y: integer); -function CMYKToTColor (C, M, Y, K: integer): TColor; -procedure ColorToCMYK(clr: TColor; var C, M, Y, K: integer); + +function CMYKToColor (C, M, Y, K: Integer): TColor; +procedure ColorToCMYK(clr: TColor; out C, M, Y, K: integer); + function GetCValue(c: TColor): integer; function GetMValue(c: TColor): integer; function GetYValue(c: TColor): integer; function GetKValue(c: TColor): integer; + implementation -function CMYtoTColor(C, M, Y: integer): TColor; +function CMYtoColor(C, M, Y: integer): TColor; begin Result := RGB(255 - C, 255 - M, 255 - Y); end; @@ -29,12 +37,20 @@ begin Y := 255 - GetBValue(clr); end; -function CMYKToTColor (C, M, Y, K: integer): TColor; +{$IFDEF CMYK_FORMULA_1} +//============================================================================== +// Original formulas of mbColorLib +//============================================================================== +function CMYKtoColor(C, M, Y, K: Integer): TColor; begin - Result := RGB(255 - (C + K), 255 - (M + K), 255 - (Y + K)); + Result := RGBtoColor( + (255 - (C + K)) mod 255, // wp: added mod 255, otherwise the result is nonsense + (255 - (M + K)) mod 255, + (255 - (Y + K)) mod 255 + ); end; -procedure ColorToCMYK(clr: TColor; var C, M, Y, K: integer); +procedure ColorToCMYK(clr: TColor; out C, M, Y, K: integer); begin C := 255 - GetRValue(clr); M := 255 - GetGValue(clr); @@ -44,6 +60,56 @@ begin M := M - K; Y := Y - K; end; +{$ENDIF} + +{$IFDEF CMYK_FORMULA_2} +//============================================================================== +// Other formulas +// http://www.rapidtables.com/convert/color/cmyk-to-rgb.htm +// or https://stackoverflow.com/questions/2426432/convert-rgb-color-to-cmyk +// +// Result agrees with OpenOffice. +//============================================================================== +function CMYKtoColor(C, M, Y, K: Integer): TColor; +begin + Result := RGBtoColor( + (255-C) * (255-K) div 255, + (255-M) * (255-K) div 255, + (255-Y) * (255-K) div 255 + ); +end; + +procedure ColorToCMYK(clr: TColor; out C, M, Y, K: Integer); +var + r, g, b: Integer; + r1, g1, b1, c1, m1, y1, k1: Double; +begin + r := GetRValue(clr); + g := GetGValue(clr); + b := GetBValue(clr); + if (r = 0) and (g = 0) and (b = 0) then + begin + C := 0; + M := 0; + Y := 0; + K := 1; + exit; + end; + r1 := r / 255; + g1 := g / 255; + b1 := b / 255; + k1 := MinValue([1-r1, 1-g1, 1-b1]); + c1 := (1 - r1 - k1) / (1 - k1); + m1 := (1 - g1 - k1) / (1 - k1); + y1 := (1 - b1 - k1) / (1 - k1); + C := round(255 * c1); + M := round(255 * m1); + Y := round(255 * y1); + K := round(255 * k1); +end; +{$ENDIF} + +//============================================================================== function GetCValue(c: TColor): integer; var diff --git a/components/mbColorLib/RGBHSLUtils.pas b/components/mbColorLib/RGBHSLUtils.pas index dd8c291df..b561687f5 100644 --- a/components/mbColorLib/RGBHSLUtils.pas +++ b/components/mbColorLib/RGBHSLUtils.pas @@ -15,17 +15,23 @@ uses Graphics, Math, Scanlines; var //set these variables to your needs, e.g. 360, 255, 255 - MaxHue: integer = 359; //239; - MaxSat: integer = 100; //240; - MaxLum: integer = 100; //240; + MaxHue: integer = 359; + MaxSat: integer = 240; + MaxLum: integer = 240; + +function HSLtoRGB(H, S, L: double): TColor; +function HSLRangeToRGB(H, S, L: integer): TColor; + +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 RGBtoHSLRange(RGB: TColor; out H1, S1, L1: integer); -function HSLtoRGB (H, S, L: double): TColor; -function HSLRangeToRGB (H, S, L: integer): TColor; -procedure RGBtoHSLRange (RGB: TColor; var H1, S1, L1 : integer); function GetHValue(AColor: TColor): integer; function GetSValue(AColor: TColor): integer; function GetLValue(AColor: TColor): integer; -//procedure Clamp(var Input: integer; Min, Max: integer); + function HSLToRGBTriple(H, S, L : integer) : TRGBTriple; function HSLToRGBQuad(H, S, L: integer): TRGBQuad; procedure RGBTripleToHSL(RGBTriple : TRGBTriple; var h, s, l: integer); @@ -35,6 +41,92 @@ implementation uses mbUtils; +procedure ColorToHSL(AColor: TColor; var H, S, L: Double); + + function RGBMaxValue(r, g, b: Double): Double; + begin + Result := r; + if (Result < g) then Result := g; + if (Result < b) then Result := b; + end; + + function RGBMinValue(r, g, b: Double): Double; + begin + Result := r; + if (Result > g) then Result := g; + if (Result > b) then Result := b; + end; + +var + r, g, b: Double; + delta, min: Double; +begin + r := GetRValue(AColor)/255; + g := GetGValue(AColor)/255; + b := GetBValue(AColor)/255; + + L := RGBMaxValue(r, g, b); + min := RGBMinValue(r, g, b); + delta := L - min; + if (L = min) then + begin + H := 0.0; + S := 0.0; + end + else + begin + S := delta / L; + if r = L then + H := 60 * (g - b)/delta + else if g = L then + H := 60 * (b - r)/delta + 120 + else if b = L then + H := 60 * (r - g)/delta + 240; + if H < 0 then H := H + 360; + H := H / 360; + end; +end; + +function HSLtoColor(H, S, L: Double): TColor; +const + Divisor = 255*60; +var + hTemp, f, LS, p, q, r: integer; + intH, intS, intL: Integer; +begin + intH := round(H*360); + intS := round(S*255); + intL := round(L*255); + if intH > 360 then dec(intH, 360); + if intH < 0 then inc(intH, 360); + Clamp(intS, 0, 255); + Clamp(intL, 0, 255); + if (intS = 0) then + Result := RGBtoColor(intL, intL, intL) + else + begin + hTemp := intH mod 360; + f := hTemp mod 60; + hTemp := hTemp div 60; + LS := intL * intS; + p := intL - LS div 255; + q := intL - (LS*f) div Divisor; + r := intL - (LS*(60 - f)) div Divisor; + case hTemp of + 0: Result := RGBtoColor(intL, r, p); + 1: Result := RGBtoColor(q, intL, p); + 2: Result := RGBtoColor(p, intL, r); + 3: Result := RGBtoColor(p, q, intL); + 4: Result := RGBtoColor(r, p, intL); + 5: Result := RGBtoColor(intL, p, q); + else + Result := RGBtoColor(0, 0, 0); + end; + end; +end; + +// ============================================================================= + function HSLtoRGB(H, S, L: double): TColor; var M1, M2: double; @@ -89,7 +181,45 @@ begin Result := HSLToRGB(H / MaxHue, S / MaxSat, L / MaxLum); end; -procedure RGBtoHSLRange(RGB: TColor; var H1, S1, L1: integer); +//============================================================================== + +procedure RGBtoHSL(RGB: TColor; out H, S, L: Double); +var + R, G, B, D, Cmax, Cmin: double; +begin + R := GetRValue(RGB) / 255; + G := GetGValue(RGB) / 255; + B := GetBValue(RGB) / 255; + Cmax := Max(R, Max(G, B)); + Cmin := Min(R, Min(G, B)); + 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 := (G - B) / D + else if G = Cmax then + H := 2 + (B - R) /D + else + H := 4 + (R - G) / D; + H := H / 6; + if H < 0 then + H := H + 1; + end; +end; + +procedure RGBtoHSLRange(RGB: TColor; out H1, S1, L1: integer); var R, G, B, D, Cmax, Cmin, h, s, l: double; begin @@ -131,6 +261,8 @@ begin L1 := round(L * MaxLum); end; +// ============================================================================= + function GetHValue(AColor: TColor): integer; var d, h: integer; diff --git a/components/mbColorLib/SColorPicker.pas b/components/mbColorLib/SColorPicker.pas index c4e474b85..dd152b8a6 100644 --- a/components/mbColorLib/SColorPicker.pas +++ b/components/mbColorLib/SColorPicker.pas @@ -65,7 +65,7 @@ begin FMaxSat := 255; FMaxVal := 255; FGradientWidth := FMaxSat + 1; - FGradientHeight := 12; + FGradientHeight := 1; FChange := false; FHue := 0; FVal := 1.0; diff --git a/components/mbColorLib/SLColorPicker.pas b/components/mbColorLib/SLColorPicker.pas index 431a0c49b..f76c68a60 100644 --- a/components/mbColorLib/SLColorPicker.pas +++ b/components/mbColorLib/SLColorPicker.pas @@ -18,14 +18,21 @@ uses type TSLColorPicker = class(TmbColorPickerControl) private - FHue, FSat, FLum: integer; + FHue, FSat, FLum: Double; + FMaxHue, FMaxSat, FMaxLum: integer; FChange: boolean; procedure DrawMarker(x, y: integer); procedure SelectionChanged(x, y: integer); procedure UpdateCoords; - procedure SetHue(h: integer); - procedure SetSat(s: integer); - procedure SetLum(l: integer); + function GetHue: Integer; + function GetLum: Integer; + function GetSat: Integer; + procedure SetHue(H: integer); + procedure SetSat(S: integer); + procedure SetLum(L: integer); + procedure SetMaxHue(H: Integer); + procedure SetMaxLum(L: Integer); + procedure SetMaxSat(S: Integer); protected function GetGradientColor2D(X, Y: Integer): TColor; override; function GetSelectedColor: TColor; override; @@ -43,9 +50,12 @@ type function GetColorAtPoint(x, y: integer): TColor; override; property ColorUnderCursor; published - property Hue: integer read FHue write SetHue default 0; - property Saturation: integer read FSat write SetSat default 0; - property Luminance: integer read FLum write SetLum default 255; + property Hue: integer read GetHue write SetHue; + property Saturation: integer read GetSat write SetSat; + property Luminance: integer read GetLum write SetLum; + 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 default clWhite; property MarkerStyle default msCircle; property OnChange; @@ -61,31 +71,29 @@ uses constructor TSLColorPicker.Create(AOwner: TComponent); begin inherited; - FGradientWidth := 256; - FGradientHeight := 256; + FMaxHue := 359; + FMaxSat := 240; + FMaxLum := 240; + FGradientWidth := FMaxSat + 1; // x --> Saturation + FGradientHeight := FMaxLum + 1; // y --> Luminance {$IFDEF DELPHI} Width := 255; Height := 255; {$ELSE} - SetInitialBounds(0, 0, 256, 256); + SetInitialBounds(0, 0, FGradientWidth, FGradientHeight); {$ENDIF} - MaxHue := 360; - MaxSat := 255; - MaxLum := 255; - FHue := 0; - FSat := 0; - FLum := 255; + FHue := 0.0; + FSat := 0.0; + FLum := 1.0; FChange := true; MarkerStyle := msCircle; end; { This picker has Saturation along the X and Luminance along the Y axis. } function TSLColorPicker.GetGradientColor2D(X, Y: Integer): TColor; -var - q: TRGBQuad; begin - q := HSLtoRGBQuad(FHue, x, 255-y); - Result := RGB(q.rgbRed, q.rgbGreen, q.rgbBlue); + Result := HSLtoColor(FHue, x / FMaxSat, (FMaxLum - y) / FMaxLum); +// Result := HSLtoRGB(FHue, x / FMaxSat, (FMaxLum - y) / FMaxLum); end; procedure TSLColorPicker.Resize; @@ -103,15 +111,15 @@ end; procedure TSLColorPicker.UpdateCoords; begin - mdx := MulDiv(FSat, Width, 255); - mdy := MulDiv(255-FLum, Height, 255); + mdx := round(FSat * (Width - 1)); + mdy := round((1.0 - FLum) * (Height - 1)); end; procedure TSLColorPicker.DrawMarker(x, y: integer); var c: TColor; begin - c := not GetColorAtPoint(x, y); + c := not GetColorAtPoint(x, y); // "not" --> invert color bits InternalDrawMarker(x, y, c); end; @@ -122,12 +130,27 @@ begin DrawMarker(mdx, mdy); end; -procedure TSLColorPicker.SetHue(h: integer); +function TSLColorPicker.GetHue: Integer; begin - Clamp(h, 0, 360); - if FHue <> h then + 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.SetHue(H: integer); +begin + Clamp(H, 0, FMaxHue); + if GetHue() <> H then begin - FHue := h; + FHue := h / FMaxHue; FManual := false; CreateGradient; UpdateCoords; @@ -136,12 +159,12 @@ begin end; end; -procedure TSLColorPicker.SetSat(s: integer); +procedure TSLColorPicker.SetSat(S: integer); begin - Clamp(s, 0, 255); - if FSat <> s then + Clamp(S, 0, FMaxSat); + if GetSat() <> S then begin - FSat := s; + FSat := S / FMaxSat; FManual := false; UpdateCoords; Invalidate; @@ -151,10 +174,10 @@ end; procedure TSLColorPicker.SetLum(L: integer); begin - Clamp(L, 0, 255); - if FLum <> L then + Clamp(L, 0, FMaxLum); + if GetLum() <> L then begin - FLum := L; + FLum := L / FMaxLum; FManual := false; UpdateCoords; Invalidate; @@ -162,13 +185,53 @@ begin end; end; +procedure TSLColorPicker.SetMaxHue(H: Integer); +begin + if H = FMaxHue then + exit; + FMaxHue := H; + CreateGradient; + if FChange and Assigned(OnChange) then OnChange(Self); + Invalidate; +end; + +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; +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; +end; + procedure TSLColorPicker.SelectionChanged(x, y: integer); begin FChange := false; // SetSat(MulDiv(255, x, Width)); // SetLum(MulDiv(255, Height - y, Height)); + FSat := x / (Width - 1); + FLum := (Height - y - 1) / (Height - 1); + FManual := false; + UpdateCoords; + Invalidate; + if FChange and Assigned(FOnChange) then FOnChange(Self); + { SetSat(MulDiv(255, x, Width - 1)); SetLum(MulDiv(255, Height - y -1, Height - 1)); + } FChange := true; end; @@ -192,8 +255,10 @@ end; procedure TSLColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +{$IFDEF DELPHI} var R: TRect; +{$ENDIF} begin inherited; if csDesigning in ComponentState then @@ -202,15 +267,15 @@ begin begin mdx := x; mdy := y; + {$IFDEF DELPHI} R := ClientRect; R.TopLeft := ClientToScreen(R.TopLeft); R.BottomRight := ClientToScreen(R.BottomRight); - {$IFDEF DELPHI} ClipCursor(@R); {$ENDIF} SelectionChanged(X, Y); - FManual := true; - if Assigned(FOnChange) then FOnChange(Self); +// FManual := true; +// if Assigned(FOnChange) then FOnChange(Self); end; SetFocus; end; @@ -225,139 +290,97 @@ begin mdx := x; mdy := y; SelectionChanged(X, Y); - FManual := true; - if Assigned(FOnChange) then FOnChange(Self); +// FManual := true; +// if Assigned(FOnChange) then FOnChange(Self); end; end; procedure TSLColorPicker.SetSelectedColor(c: TColor); var - h, s, l: integer; + h, s, l: Double; begin if WebSafe then c := GetWebSafe(c); FManual := false; FChange := false; - RGBTripleToHSL(RGBtoRGBTriple(GetRValue(c), GetGValue(c), GetBValue(c)), h, s, l); - SetHue(h); - SetSat(s); - SetLum(l); + ColorToHSL(c, FHue, FSat, FLum); + FManual := false; + UpdateCoords; + Invalidate; if FChange and Assigned(FOnChange) then FOnChange(Self); FChange := true; end; function TSLColorPicker.GetSelectedColor: TColor; -var - triple: TRGBTriple; begin - triple := HSLToRGBTriple(FHue, FSat, FLum); - if not WebSafe then - Result := RGBTripleToColor(triple) - else - Result := GetWebSafe(RGBTripleToColor(triple)); + Result := HSLtoRGB(FHue, FSat, FLum); + if WebSafe then + Result := GetWebSafe(Result); end; function TSLColorPicker.GetColorAtPoint(x, y: integer): TColor; -var - triple: TRGBTriple; begin - triple := HSLToRGBTriple(FHue, MulDiv(255, x, Width), MulDiv(255, Height - y, Height)); - if not WebSafe then - Result := RGBTripleToColor(triple) - else - Result := GetWebSafe(RGBTripleToColor(triple)); + Result := HSLToRGB(FHue, x/(Width - 1), (Height - 1 - y) / (Height - 1)); + if WebSafe then + Result := GetWebSafe(Result); end; procedure TSLColorPicker.CNKeyDown( var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF} ); var - Shift: TShiftState; - FInherited: boolean; + Shift: TShiftState; + FInherited: boolean; + delta: Integer; begin - FInherited := false; - Shift := KeyDataToShiftState(Message.KeyData); - if not (ssCtrl in Shift) then - case Message.CharCode of - VK_LEFT: - if not (mdx - 1 < 0) then - begin - Dec(mdx, 1); - SelectionChanged(mdx, mdy); - FManual := true; - if Assigned(FOnChange) then FOnChange(Self); - end; - VK_RIGHT: - if not (mdx + 1 > Width) then - begin - Inc(mdx, 1); - SelectionChanged(mdx, mdy); - FManual := true; - if Assigned(FOnChange) then FOnChange(Self); - end; - VK_UP: - if not (mdy - 1 < 0) then - begin - Dec(mdy, 1); - SelectionChanged(mdx, mdy); - FManual := true; - if Assigned(FOnChange) then FOnChange(Self); - end; - VK_DOWN: - if not (mdy + 1 > Height) then - begin - Inc(mdy, 1); - SelectionChanged(mdx, mdy); - FManual := true; - if Assigned(FOnChange) then FOnChange(Self); - end; + FInherited := false; + Shift := KeyDataToShiftState(Message.KeyData); + if ssCtrl in Shift then + delta := 10 else - begin - FInherited := true; - inherited; - end; - end - else + delta := 1; + case Message.CharCode of - VK_LEFT: - if not (mdx - 10 < 0) then - begin - Dec(mdx, 10); - SelectionChanged(mdx, mdy); - FManual := true; - if Assigned(FOnChange) then FOnChange(Self); - end; - VK_RIGHT: - if not (mdx + 10 > Width) then - begin - Inc(mdx, 10); - SelectionChanged(mdx, mdy); - FManual := true; - if Assigned(FOnChange) then FOnChange(Self); - end; - VK_UP: - if not (mdy - 10 < 0) then - begin - Dec(mdy, 10); - SelectionChanged(mdx, mdy); - FManual := true; - if Assigned(FOnChange) then FOnChange(Self); - end; - VK_DOWN: - if not (mdy + 10 > Height) then - begin - Inc(mdy, 10); - SelectionChanged(mdx, mdy); - FManual := true; - if Assigned(FOnChange) then FOnChange(Self); - end; - else - begin - FInherited := true; - inherited; - end; + VK_LEFT: + if not (mdx - delta < 0) then + begin + Dec(mdx, delta); + SelectionChanged(mdx, mdy); + FManual := true; + if Assigned(FOnChange) then FOnChange(Self); + end; + VK_RIGHT: + if not (mdx + delta > Width) then + begin + Inc(mdx, delta); + SelectionChanged(mdx, mdy); + FManual := true; + if Assigned(FOnChange) then FOnChange(Self); + end; + VK_UP: + if not (mdy - delta < 0) then + begin + Dec(mdy, delta); + SelectionChanged(mdx, mdy); + FManual := true; + if Assigned(FOnChange) then FOnChange(Self); + end; + VK_DOWN: + if not (mdy + delta > Height) then + begin + Inc(mdy, delta); + SelectionChanged(mdx, mdy); + FManual := true; + if Assigned(FOnChange) then FOnChange(Self); + end; + else + begin + FInherited := true; + inherited; + end; end; - if not FInherited then - if Assigned(OnKeyDown) then - OnKeyDown(Self, Message.CharCode, Shift); + + if not FInherited then + if Assigned(OnKeyDown) then + OnKeyDown(Self, Message.CharCode, Shift); end; end. diff --git a/components/mbColorLib/SLHColorPicker.pas b/components/mbColorLib/SLHColorPicker.pas index 651b92384..5953ca061 100644 --- a/components/mbColorLib/SLHColorPicker.pas +++ b/components/mbColorLib/SLHColorPicker.pas @@ -25,7 +25,8 @@ type FSLPicker: TSLColorPicker; FHPicker: THColorPicker; FSelectedColor: TColor; - FHValue, FSValue, FLValue: integer; + FHValue, FSValue, FLValue: Double; + FMaxH, FMaxS, FMaxL: Integer; FRValue, FGValue, FBValue: integer; FSLHint, FHHint: string; FSLMenu, FHMenu: TPopupMenu; @@ -33,12 +34,18 @@ type PBack: TBitmap; function GetManual: boolean; procedure SelectColor(c: TColor); - procedure SetH(v: integer); - procedure SetS(v: integer); - procedure SetL(v: integer); - procedure SetR(v: integer); - procedure SetG(v: integer); - procedure SetB(v: integer); + 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); procedure SetHHint(h: string); procedure SetSLHint(h: string); procedure SetSLMenu(m: TPopupMenu); @@ -63,12 +70,12 @@ type function GetHexColorUnderCursor: string; override; function GetSelectedHexColor: string; property ColorUnderCursor; - property HValue: integer read FHValue write SetH default 0; - property SValue: integer read FSValue write SetS default 240; - property LValue: integer read FLValue write SetL default 120; - property RValue: integer read FRValue write SetR default 255; - property GValue: integer read FGValue write SetG default 0; - property BValue: integer read FBValue write SetB default 0; + property Hue: integer read GetH write SetH; + property Saturation: integer read GetS write SetS; + property Luminance: integer read GetL write SetL; + 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 Manual: boolean read GetManual; published property SelectedColor: TColor read FSelectedColor write SelectColor default clRed; @@ -111,6 +118,9 @@ begin inherited; //ControlStyle := ControlStyle - [csAcceptsControls] + [csOpaque]; DoubleBuffered := true; + FMaxH := 359; + FMaxS := 240; + FMaxL := 100; PBack := TBitmap.Create; PBack.PixelFormat := pf32bit; ParentColor := true; @@ -142,9 +152,14 @@ begin {$ELSE} SetInitialBounds(WSL + DIST, 0, WH, HSL + 2*VDELTA); {$ENDIF} + MaxHue := self.FMaxH; + MaxSaturation := 255; + MaxValue := 255; + Saturation := MaxSaturation; + Value := MaxValue; // Anchors := [akTop, akRight, akBottom]; Visible := true; - Layout := lyVertical; +// Layout := lyVertical; ArrowPlacement := spBoth; NewArrowStyle := true; OnChange := HPickerChange; @@ -167,12 +182,17 @@ begin //Anchors := [akLeft, akRight, akTop, akBottom]; Visible := true; SelectedColor := clRed; + MaxHue := FMaxH; + MaxSaturation := FMaxS; + MaxLuminance := FMaxL; + Saturation := FMaxS; + Luminance := FMaxL; OnChange := SLPickerChange; OnMouseMove := DoMouseMove; end; FHValue := 0; - FSValue := 255; - FLValue := 255; + FSValue := 1.0; + FLValue := 1.0; FRValue := 255; FGValue := 0; FBValue := 0; @@ -202,9 +222,9 @@ end; procedure TSLHColorPicker.DoChange; begin - FHValue := FHPicker.Hue; - FSValue := FSLPicker.Saturation; - FLValue := FSLPicker.Luminance; + FHValue := FHPicker.Hue / FHPicker.MaxHue; + FSValue := FSLPicker.Saturation / FSLPicker.MaxSaturation; + FLValue := FSLPicker.Luminance / FSLPicker.MaxLuminance; FRValue := GetRValue(FSLPicker.SelectedColor); FGValue := GetGValue(FSLPicker.SelectedColor); FBValue := GetBValue(FSLPicker.SelectedColor); @@ -219,43 +239,77 @@ begin FSLPicker.SelectedColor := c; end; -procedure TSLHColorPicker.SetH(v: integer); +function TSLHColorPicker.GetH: Integer; begin - FHValue := v; - FSLPicker.Hue := v; - FHPicker.Hue := v; + Result := Round(FHValue * FMaxH); end; -procedure TSLHColorPicker.SetS(v: integer); +function TSLHColorPicker.GetS: Integer; begin - FSValue := v; - FSLPicker.Saturation := v; + Result := Round(FSValue * FMaxS); end; -procedure TSLHColorPicker.SetL(v: integer); +function TSLHColorPicker.GetL: Integer; begin - FLValue := v; - FSLPicker.Luminance := v; + Result := ROund(FLValue * FMaxL); end; -procedure TSLHColorPicker.SetR(v: integer); +procedure TSLHColorPicker.SetH(H: integer); begin - FRValue := v; + FHValue := H / FMaxH; + FSLPicker.Hue := H; + FHPicker.Hue := H; +end; + +procedure TSLHColorPicker.SetS(S: integer); +begin + FSValue := S / FMaxS; + FSLPicker.Saturation := S; +end; + +procedure TSLHColorPicker.SetL(L: integer); +begin + FLValue := L / FMaxL; + FSLPicker.Luminance := L; +end; + +procedure TSLHColorPicker.SetR(R: integer); +begin + FRValue := R; SelectColor(RGB(FRValue, FGValue, FBValue)); end; -procedure TSLHColorPicker.SetG(v: integer); +procedure TSLHColorPicker.SetG(G: integer); begin - FGValue := v; + FGValue := G; SelectColor(RGB(FRValue, FGValue, FBValue)); end; -procedure TSLHColorPicker.SetB(v: integer); +procedure TSLHColorPicker.SetB(B: integer); begin - FBValue := v; + FBValue := B; SelectColor(RGB(FRValue, FGValue, FBValue)); end; +procedure TSLHColorPicker.SetMaxH(H: Integer); +begin + FMaxH := H; + FSLPicker.MaxHue := H; + FHPicker.MaxHue := H; +end; + +procedure TSLHColorPicker.SetMaxS(S: Integer); +begin + FMaxS := S; + FSLPicker.MaxSaturation := S; +end; + +procedure TSLHColorPicker.SetMaxL(L: Integer); +begin + FMaxL := L; + FSLPicker.MaxLuminance := L; +end; + function TSLHColorPicker.GetSelectedHexColor: string; begin Result := ColorToHex(FSelectedColor); diff --git a/components/mbColorLib/VColorPicker.pas b/components/mbColorLib/VColorPicker.pas index 523058c6e..27f559cc5 100644 --- a/components/mbColorLib/VColorPicker.pas +++ b/components/mbColorLib/VColorPicker.pas @@ -61,7 +61,7 @@ begin FMaxSat := 255; FMaxVal := 255; FGradientWidth := FMaxVal + 1; - FGradientHeight := 12; + FGradientHeight := 1; FHue := 0; FSat := 0; FChange := false; diff --git a/components/mbColorLib/YColorPicker.pas b/components/mbColorLib/YColorPicker.pas index 0278f2936..8f9106a76 100644 --- a/components/mbColorLib/YColorPicker.pas +++ b/components/mbColorLib/YColorPicker.pas @@ -54,7 +54,7 @@ constructor TYColorPicker.Create(AOwner: TComponent); begin inherited; FGradientWidth := 255; - FGradientHeight := 12; + FGradientHeight := 1; FYellow := 255; FMagenta := 0; FCyan := 0; @@ -70,7 +70,7 @@ end; function TYColorPicker.GetGradientColor(AValue: Integer): TColor; begin - Result := CMYKtoTColor(FCyan, FMagenta, AValue, FBlack); + Result := CMYKtoColor(FCyan, FMagenta, AValue, FBlack); end; procedure TYColorPicker.SetYellow(y: integer); @@ -158,10 +158,9 @@ end; function TYColorPicker.GetSelectedColor: TColor; begin - if not WebSafe then - Result := CMYKtoTColor(FCyan, FMagenta, FYellow, FBlack) - else - Result := GetWebSafe(CMYKtoTColor(FCyan, FMagenta, FYellow, FBlack)); + Result := CMYKtoColor(FCyan, FMagenta, FYellow, FBlack); + if WebSafe then + Result := GetWebSafe(Result); end; function TYColorPicker.GetSelectedValue: integer; diff --git a/components/mbColorLib/examples/fulldemo/Demo.lpi b/components/mbColorLib/examples/fulldemo/Demo.lpi index 68578641c..c0d02c90a 100644 --- a/components/mbColorLib/examples/fulldemo/Demo.lpi +++ b/components/mbColorLib/examples/fulldemo/Demo.lpi @@ -9,7 +9,9 @@ <ResourceType Value="res"/> <UseXPManifest Value="True"/> - <Icon Value="0"/> + <XPManifest> + <DpiAware Value="True"/> + </XPManifest> </General> <BuildModes Count="1"> <Item1 Name="Default" Default="True"/> @@ -56,8 +58,14 @@ </SearchPaths> <Linking> <Debugging> + <UseHeaptrc Value="True"/> <UseExternalDbgSyms Value="True"/> </Debugging> + <Options> + <Win32> + <GraphicApplication Value="True"/> + </Win32> + </Options> </Linking> </CompilerOptions> <Debugging> diff --git a/components/mbColorLib/examples/fulldemo/main.lfm b/components/mbColorLib/examples/fulldemo/main.lfm index 2bc825698..58c62ea17 100644 --- a/components/mbColorLib/examples/fulldemo/main.lfm +++ b/components/mbColorLib/examples/fulldemo/main.lfm @@ -10,6 +10,7 @@ object Form1: TForm1 OnCreate = FormCreate ShowHint = True LCLVersion = '1.7' + Scaled = True object Label1: TLabel Left = 416 Height = 15 @@ -42,9 +43,9 @@ object Form1: TForm1 Height = 384 Top = 6 Width = 403 - ActivePage = TabSheet3 + ActivePage = TabSheet1 Anchors = [akTop, akLeft, akRight, akBottom] - TabIndex = 2 + TabIndex = 0 TabOrder = 0 OnChange = PageControl1Change OnMouseMove = PageControl1MouseMove @@ -57,7 +58,7 @@ object Form1: TForm1 Height = 340 Top = 8 Width = 381 - SelectedColor = 1024 + SelectedColor = 3289805 HSPickerHintFormat = 'H: %h S: %s'#13'Hex: #%hex' LPickerHintFormat = 'Luminance: %l' Anchors = [akTop, akLeft, akRight, akBottom] @@ -600,6 +601,9 @@ object Form1: TForm1 Anchors = [akTop, akLeft, akRight, akBottom] TabOrder = 0 OnMouseMove = HSVColorPicker1MouseMove + Hue = 0 + Saturation = 0 + Value = 255 OnChange = HSVColorPicker1Change end object VColorPicker2: TVColorPicker @@ -613,6 +617,9 @@ object Form1: TForm1 Anchors = [akTop, akRight, akBottom] TabOrder = 1 OnChange = VColorPicker2Change + Hue = 0 + Saturation = 0 + Value = 255 SelectedColor = clWhite end end @@ -712,9 +719,10 @@ object Form1: TForm1 SelectionIndicator = siRect Anchors = [akLeft, akRight, akBottom] TabOrder = 2 - Saturation = 238 - Luminance = 60 - SelectedColor = 263284 + Hue = 0 + Saturation = 51 + Luminance = 240 + SelectedColor = clWhite end object VColorPicker1: TVColorPicker Left = 34 @@ -727,7 +735,7 @@ object Form1: TForm1 SelectionIndicator = siRect Anchors = [akLeft, akRight, akBottom] TabOrder = 3 - Hue = 240 + Hue = 239 Saturation = 255 Value = 40 SelectedColor = 2621440 @@ -744,7 +752,9 @@ object Form1: TForm1 Anchors = [akLeft, akRight, akBottom] TabOrder = 4 OnGetHintStr = HColorPicker1GetHintStr + Hue = 0 Saturation = 120 + Value = 255 SelectedColor = 8882175 end object SColorPicker1: TSColorPicker @@ -761,6 +771,7 @@ object Form1: TForm1 TabOrder = 5 Hue = 60 Saturation = 80 + Value = 255 SelectedColor = 11534335 end object Memo1: TMemo @@ -820,11 +831,11 @@ object Form1: TForm1 Height = 155 Top = 6 Width = 211 - SelectedColor = 518633 + SelectedColor = 15797774 HintFormat = 'H: %h S: %s'#13'Hex: %hex' TabOrder = 0 OnMouseMove = HSColorPicker1MouseMove - HueValue = 60 + Luminance = 120 MarkerStyle = msSquare OnChange = HSColorPicker1Change end @@ -833,9 +844,13 @@ object Form1: TForm1 Height = 147 Top = 144 Width = 161 + SelectedColor = 2763306 HintFormat = 'H: %h S: %s L: %l'#13'Hex: %hex' TabOrder = 1 OnMouseMove = SLColorPicker1MouseMove + Hue = 0 + Saturation = 0 + Luminance = 100 MarkerStyle = msCross OnChange = SLColorPicker1Change end @@ -847,6 +862,9 @@ object Form1: TForm1 HintFormat = 'Hue: %h (selected)' TabOrder = 2 OnMouseMove = HRingPicker1MouseMove + Hue = 0 + Saturation = 255 + Value = 255 OnChange = HRingPicker1Change end end diff --git a/components/mbColorLib/examples/trackbars/Demo.lpi b/components/mbColorLib/examples/trackbars/Demo.lpi index c5843f693..ee2ffb21a 100644 --- a/components/mbColorLib/examples/trackbars/Demo.lpi +++ b/components/mbColorLib/examples/trackbars/Demo.lpi @@ -9,10 +9,6 @@ <Title Value="Demo"/> <ResourceType Value="res"/> <UseXPManifest Value="True"/> - <XPManifest> - <TextName Value="CompanyName.ProductName.AppName"/> - <TextDesc Value="Your application description."/> - </XPManifest> <Icon Value="0"/> </General> <BuildModes Count="1"> diff --git a/components/mbColorLib/examples/trackbars/main.lfm b/components/mbColorLib/examples/trackbars/main.lfm index 391f1ed76..c38e565ac 100644 --- a/components/mbColorLib/examples/trackbars/main.lfm +++ b/components/mbColorLib/examples/trackbars/main.lfm @@ -184,6 +184,9 @@ object Form1: TForm1 Visible = False TabOrder = 5 OnChange = SLVPickerV_Change + Hue = 0 + Saturation = 0 + Value = 255 SelectedColor = clWhite end object LColorPickerV: TLColorPicker @@ -196,9 +199,10 @@ object Form1: TForm1 Anchors = [akTop, akLeft, akBottom] TabOrder = 6 OnChange = SLVPickerV_Change - Saturation = 255 - Luminance = 127 - SelectedColor = 254 + Hue = 0 + Saturation = 240 + Luminance = 239 + SelectedColor = 16645631 end object HColorPickerV: THColorPicker Left = 288 @@ -210,6 +214,9 @@ object Form1: TForm1 Anchors = [akTop, akLeft, akBottom] TabOrder = 7 OnChange = HPickerV_Change + Hue = 0 + Saturation = 255 + Value = 255 end object KColorPickerV: TKColorPicker Left = 232 @@ -305,6 +312,9 @@ object Form1: TForm1 Anchors = [akTop, akLeft, akBottom] TabOrder = 15 OnChange = SLVPickerV_Change + Hue = 0 + Saturation = 255 + Value = 255 end end end @@ -471,6 +481,9 @@ object Form1: TForm1 Visible = False TabOrder = 5 OnChange = SLVPickerH_Change + Hue = 0 + Saturation = 0 + Value = 255 SelectedColor = clWhite end object LColorPickerH: TLColorPicker @@ -483,9 +496,10 @@ object Form1: TForm1 Anchors = [akTop, akLeft, akRight] TabOrder = 6 OnChange = SLVPickerH_Change - Saturation = 255 - Luminance = 127 - SelectedColor = 254 + Hue = 0 + Saturation = 240 + Luminance = 239 + SelectedColor = 16645631 end object SColorPickerH: TSColorPicker Left = 24 @@ -497,6 +511,9 @@ object Form1: TForm1 Anchors = [akTop, akLeft, akRight] TabOrder = 7 OnChange = SLVPickerH_Change + Hue = 0 + Saturation = 255 + Value = 255 end object HColorPickerH: THColorPicker Left = 24 @@ -508,6 +525,9 @@ object Form1: TForm1 Anchors = [akTop, akLeft, akRight] TabOrder = 8 OnChange = HPickerH_Change + Hue = 0 + Saturation = 255 + Value = 255 end object KColorPickerH: TKColorPicker Left = 24 diff --git a/components/mbColorLib/examples/trackbars/main.pas b/components/mbColorLib/examples/trackbars/main.pas index 48ad4ab60..d329c16f6 100644 --- a/components/mbColorLib/examples/trackbars/main.pas +++ b/components/mbColorLib/examples/trackbars/main.pas @@ -112,7 +112,7 @@ begin if (CColorPickerH = nil) or (YColorPickerH = nil) or (MColorPickerH = nil) or (KColorPickerH = nil) or (CMYKh = nil) then exit; - CMYKh.Color := CMYKToTColor( + CMYKh.Color := CMYKToColor( CColorPickerH.Cyan, MColorPickerH.Magenta, YColorPickerH.Yellow, @@ -136,7 +136,7 @@ begin if (CColorPickerV = nil) or (YColorPickerV = nil) or (MColorPickerV = nil) or (KColorPickerV = nil) or (CMYKv = nil) then exit; - CMYKv.Color := CMYKToTColor( + CMYKv.Color := CMYKToColor( CColorPickerV.Cyan, MColorPickerV.Magenta, YColorPickerV.Yellow, @@ -156,6 +156,10 @@ end; procedure TForm1.FormCreate(Sender: TObject); begin + MaxHue := 359; + MaxSat := 240; + MaxLum := 240; + VColorPickerH.Left := LColorPickerH.Left; VColorPickerH.Top := LColorPickerH.Top; VColorPickerH.Width := LColorPickerH.Width; @@ -279,14 +283,12 @@ begin if rbHSLh.Checked then begin if (LColorPickerH = nil) then exit; - triple := HSLToRGBTriple(HColorPickerH.Hue, SColorPickerH.Saturation, LColorPickerH.Luminance); - HSLVh.Color := RGBTripleToTColor(triple); -// HSLVh.Color := HSLRangetoRGB(HColorPickerH.Hue, SColorPickerH.Saturation, LColorPickerH.Luminance); + HSLVh.Color := HSLRangeToRGB(HColorPickerH.Hue, SColorPickerH.Saturation, LColorPickerH.Luminance); end; if rbHSVh.Checked then begin if (VColorPickerH = nil) then exit; - HSLVh.Color := HSVtoColor(HColorPickerH.Hue, SColorPickerH.Saturation, VColorPickerH.Value); + HSLVh.Color := HSVRangetoColor(HColorPickerH.Hue, SColorPickerH.Saturation, VColorPickerH.Value); end; c := HSLVh.Color; @@ -310,7 +312,7 @@ begin if (LColorPickerV = nil) then exit; triple := HSLToRGBTriple(HColorPickerV.Hue, SColorPickerV.Saturation, LColorPickerV.Luminance); - HSLVv.Color := RGBTripleToTColor(triple); + HSLVv.Color := RGBTripleToColor(triple); end; if rbHSVv.Checked then begin if (VColorPickerV = nil) then diff --git a/components/mbColorLib/mbBasicPicker.pas b/components/mbColorLib/mbBasicPicker.pas index 6067156d2..141188655 100644 --- a/components/mbColorLib/mbBasicPicker.pas +++ b/components/mbColorLib/mbBasicPicker.pas @@ -93,13 +93,14 @@ end; destructor TmbBasicPicker.Destroy; begin - //HideHintWindow; + FBufferBmp.Free; inherited; end; procedure TmbBasicPicker.CMHintShow(var Message: TCMHintShow); var cp: TPoint; + hp: TPoint; begin if GetColorUnderCursor <> clNone then with TCMHintShow(Message) do @@ -111,10 +112,11 @@ begin else begin cp := HintInfo^.CursorPos; + hp := GetHintPos(cp.X, cp.Y); HintInfo^.ReshowTimeout := 0; // must be zero! HintInfo^.HideTimeout := Application.HintHidePause; HintInfo^.HintStr := GetHintStr(cp.X, cp.Y); - HintInfo^.HintPos := ClientToScreen(GetHintPos(cp.X, cp.Y)); + HintInfo^.HintPos := ClientToScreen(Point(hp.X + 16, hp.Y)); HintInfo^.CursorRect := Rect(cp.X, cp.Y, cp.X+1, cp.Y+1); Result := 0; // 0 means: show hint end; diff --git a/components/mbColorLib/mbDeskPickerButton.pas b/components/mbColorLib/mbDeskPickerButton.pas index 77c99d992..0cf68f3fd 100644 --- a/components/mbColorLib/mbDeskPickerButton.pas +++ b/components/mbColorLib/mbDeskPickerButton.pas @@ -33,7 +33,6 @@ type public constructor Create(AOwner: TComponent); override; procedure Click; override; - property SelectedColor: TColor read FSelColor; published property OnSelColorChange: TNotifyEvent read FOnColorPicked write FOnColorPicked; diff --git a/components/mbColorLib/mbTrackBarPicker.pas b/components/mbColorLib/mbTrackBarPicker.pas index 7517bcdaa..0fc13ca9e 100644 --- a/components/mbColorLib/mbTrackBarPicker.pas +++ b/components/mbColorLib/mbTrackBarPicker.pas @@ -239,7 +239,6 @@ end; destructor TmbTrackbarPicker.Destroy; begin - FBufferBmp.Free; FBack.Free; inherited; end;