圆形颜色梯度（色调）在firemonkey

试图实现类似firemonkey的环颜色选择器，以这样的：圆形颜色梯度（色调）在firemonkey

我认为它可以使用TCircle与行程的多点梯度来完成。从我的实验和研究中，渐变只能从上到下或中心化。

有没有办法让TGradient遵循中风的路径？

来源

2016-09-22 Martin

您需要一个锥形渐变，即AFAIK，不直接支持。您可能必须自己绘制它。 –

我已经开始着手使用mbColor Lib作为我的基础 – Martin

如果我的内存正确地服务于我，Firemonkey库已包含类似的组件。如果不检查Delphi附带的样品。我记得那件事，并希望它也可用于VCL，但事实并非如此。 – SilverWarior

这可能是周围的边缘有点粗糙，但这里是为寻找一个Firemonkey基于环的颜色选择器...

信用，必须给予MX软件的mbColor库，我作为基本 - 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.

来源

2016-09-23 08:24:42 Martin

圆形颜色梯度（色调）在firemonkey

回答

相关问题