mbColorLib: All HSV/HSL controls have a property for MaxHue/MaxSaturation/MaxValue (MaxLuminance). Some refactoring avoiding duplicate storage of H, S, L (V) in the complex pickers.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5540 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2016-12-19 16:38:29 +00:00
parent d42ba252f3
commit c75b85e42a
30 changed files with 1399 additions and 803 deletions
--- 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.