delphi - firemonkey中的圆形颜色渐变(色调)

Question

尝试在 firemonkey 中实现类似于此的环形颜色选择器:http://dph.am/iDropper/

我认为可以使用在笔划上具有多点渐变的 TCircle 来完成。根据我的实验和研究，渐变只能从上到下或从中心向外。

有没有办法让TGradient跟随描边的路径？

Answer 1

它的边缘可能有点粗糙，但这里有一个基于 Firemonkey 环的颜色选择器，适合任何寻找的人......

必须归功于我用作此基础的 MX Software 的 mbColor Lib - http://mxs.bergsoft.net/ .

unit uRingColorPicker;

interface

uses
  System.SysUtils, System.Classes, System.Types, FMX.Types, FMX.Controls,
  FMX.Objects, FMX.Graphics, System.UITypes, Math, System.UIConsts,
  FMX.Colors;

type
  TRingColorPicker = class(TPaintBox)
  private
    { Private declarations }
    bm: TBitmap;
    FOnChange: TNotifyEvent;
    mdx, mdy: double;
    FSat: integer;
    FHue: integer;
    FValue: integer;
    FManual: boolean;
    FChange: boolean;
    FRadius: integer;
    FHueLineColor: TAlphaColor;
    FSelectedColor: TAlphaColor;
    Quad: TColorQuad;

    procedure PaintHSVCircle;
    procedure UpdateCoords;
    procedure SetHue(Value: integer);
    procedure SetSat(Value: integer);
    procedure SetValue(Value: integer);
    procedure SetHueLineColor(const Value: TAlphaColor);
    procedure SetSelectedColor(const Value: TAlphaColor);
    procedure SetQuadPosSize;
    procedure SelectionChanged(x, y: single);
    function GetSelectedColor: TAlphaColor;
  protected
    { Protected declarations }
    procedure Paint; override;
    procedure Resize; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Single); override;
  public
    { Public declarations }
    property SelectedColor: TAlphaColor read GetSelectedColor write SetSelectedColor;
    function PointInObject(X, Y: Single): Boolean; override;

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    { Published declarations }
    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 OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('LightFactoryFMX', [TRingColorPicker]);
end;

function PointInCirc(p: TPointF; size : integer): boolean;
var
  r: integer;
begin
  r := size div 2;
  Result := (SQR(p.x - r) + SQR(p.y - r) <= SQR(r));
end;

function MathRound(AValue: Extended): Int64; inline;
begin
  if AValue >= 0 then
    Result := Trunc(AValue + 0.5)
  else
    Result := Trunc(AValue - 0.5);
end;

function MulDiv(nNumber, nNumerator, nDenominator: Integer): Integer;
begin
  if nDenominator = 0 then
    Result := -1
  else
    Result := MathRound(Int64(nNumber) * Int64(nNumerator) / nDenominator);
end;

{ TRingColorPicker }

constructor TRingColorPicker.Create(AOwner: TComponent);
begin
  inherited;
  bm := TBitmap.Create;
  bm.Resize(204, 204);
  Width := 204;
  Height := 204;
  FManual := false;
  FChange := true;
  FRadius := Round(Width * 0.35);

  Quad := TColorQuad.Create(Self);
  Quad.Parent := self;
  Quad.Visible := true;
  Quad.Stored := false;
  Quad.Locked := true;
  Quad.Sat := 1;
  Quad.Lum := 0.5;
end;

destructor TRingColorPicker.Destroy;
begin
  bm.Free;
  Quad.Free;
  inherited;
end;

procedure TRingColorPicker.PaintHSVCircle;
var
  i, j, size: integer;
  vBitMapData  : TBitmapData;
  tc: TAlphaColor;
  H, x, y, Radius, RadiusSquared, dSquared: Single;
begin
  size := Round(Min(Width, Height));
  Radius := size / 2;
  RadiusSquared := Radius*Radius;
  bm.Clear($00ffffff);
  if bm.Map(TMapAccess.Write, vBitMapData) then
  begin
    for j := 0 to size - 1 do
    begin
      Y := Size - 1 - j - Radius;
      for i := 0 to size - 1 do
      begin
        X := i - Radius;
        dSquared := X*X + Y*Y;
        if (dSquared>(RadiusSquared - (FRadius*FRadius))) and (dSquared <= RadiusSquared) then
        begin
          H := 180 * (1 + ArcTan2(X, Y) / PI);
          H := H + 90;
          if H > 360 then H := H - 360;
          tc := HSLtoRGB(H/360, 1, 0.5); //S/255
          vBitmapData.SetPixel(i, Size - 1 - j, tc); // set the pixel colour at x:10, y:20
        end
      end;
    end;
    bm.Unmap(vBitMapData);         // unlock the bitmap
  end;
end;

function TRingColorPicker.GetSelectedColor: TAlphaColor;
begin
  result := Quad.ColorBox.Color;
end;

procedure TRingColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
  inherited;
  if (Button = TMouseButton.mbLeft) and PointInCirc(PointF(x, y), Round(Min(Width, Height))) then
  begin
    SelectionChanged(X, Y);
    FManual := true;
    if Fchange then
      if Assigned(FOnChange) then FOnChange(Self);
  end;
  SetFocus;
end;

procedure TRingColorPicker.SelectionChanged(x, y: Single);
var
  Angle, Distance: integer;
  xDelta, yDelta, Radius: Double;
begin
  if PointInCirc(PointF(x, y), Round(Min(Width, Height))) then
  begin
    FSelectedColor := TAlphaColorRec.White;
    Radius := Min(Width, Height) / 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);
    Fchange := false;
    SetHue(Angle);
    Distance := ROUND(SQRT(SQR(xDelta) + SQR(yDelta)));
    if  Distance >= Radius then SetSat(255)
    else SetSat(MulDiv(Distance, 255, Round(Radius)));
    Fchange := true;
  end;
end;

procedure TRingColorPicker.MouseMove(Shift: TShiftState; X, Y: Single);
begin
  inherited;
  if (ssLeft in Shift) and PointInCirc(PointF(x, y), Round(Min(Width, Height))) then
  begin
    SelectionChanged(X, Y);
    FManual := true;
    if Fchange then
      if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

procedure TRingColorPicker.UpdateCoords;
var
  r, angle: real;
  radius: double;
begin
  radius := Min(Width, Height) / 2;
  r := -MulDiv(Round(radius), FSat, 255);
  angle := -FHue*PI/180 - PI;
  mdx := (COS(angle)*ROUND(r)) + radius;
  mdy := (SIN(angle)*ROUND(r)) + radius;
end;

procedure TRingColorPicker.Paint;
begin
  inherited;
  PaintHSVCircle;
  Canvas.BeginScene;
  Canvas.DrawBitmap(bm, bm.BoundsF, bm.BoundsF, 1);
  Canvas.EndScene;
  SetQuadPosSize;
end;

function TRingColorPicker.PointInObject(X, Y: Single): Boolean;
var
  size: integer;
  Radius, RadiusSquared, dSquared: Single;
begin
  X := X - Position.X;
  Y := Y - Position.Y;
  size := Round(Min(Width, Height));
  Radius := size / 2;
  RadiusSquared := Radius*Radius;
  Y := Size - 1 - Y - Radius;
  X := X - Radius;
  dSquared := X*X + Y*Y;
  result := (dSquared>(RadiusSquared - (FRadius*FRadius))) and (dSquared <= RadiusSquared);
end;

procedure TRingColorPicker.Resize;
begin
  inherited;
  bm.Resize(Round(Width), Round(Height));
  FRadius := Round(Width * 0.35);
  UpdateCoords;
  SetQuadPosSize;
end;

procedure TRingColorPicker.SetQuadPosSize;
var
  size: integer;
  Radius, a, d: Single;
begin
  size := Round(Min(Width, Height));
  Radius := Round(FRadius * 0.9);
  a := SQRT((Radius*Radius) / 2);
  d := (size / 2) - a;
  if assigned(Quad) then
  begin
    if Quad.Position.X <> d then
      Quad.Position.X := d;
    if Quad.Position.Y <> d then
      Quad.Position.Y := d;
    if Quad.Width <> a * 2 then
      Quad.Width := a * 2;
    if Quad.Height <> a * 2 then
      Quad.Height := a * 2;
  end;
end;

procedure TRingColorPicker.SetHue(Value: integer);
begin
  if Value > 360 then Value := 360;
  if Value < 0 then Value := 0;
  if FHue <> Value then
  begin
    FHue := Value;
    FManual := false;
    UpdateCoords;
    InvalidateRect(RectF(0,0,width,height));
    Quad.Hue := Value/360;
    Quad.RotationAngle := 360-FHue;
    if Fchange then
      if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

procedure TRingColorPicker.SetHueLineColor(const Value: TAlphaColor);
begin
  if FHueLineColor <> Value then
  begin
    FHueLineColor := Value;
    InvalidateRect(RectF(0,0,width,height));
  end;
end;

procedure TRingColorPicker.SetSat(Value: integer);
begin
  if Value > 255 then Value := 255;
  if Value < 0 then Value := 0;
  if FSat <> Value then
  begin
    FSat := Value;
    FManual := false;
    UpdateCoords;
    InvalidateRect(RectF(0,0,width,height));
    if Fchange then
      if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

procedure TRingColorPicker.SetSelectedColor(const Value: TAlphaColor);
var
  H, S, L: Single;
begin
  FSelectedColor := Value;
  RGBtoHSL(FSelectedColor, H, S, L);
  Fchange := false;
  SetHue(Round(H*360));
  Quad.Sat := S;
  Quad.Lum := L;
  Fchange := true;
end;

procedure TRingColorPicker.SetValue(Value: integer);
begin
  if Value > 255 then Value := 255;
  if Value < 0 then Value := 0;
  if FValue <> Value then
  begin
    FValue := Value;
    FManual := false;
    InvalidateRect(RectF(0,0,width,height));
    if Fchange then
      if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

end.