334 lines
9.3 KiB
ObjectPascal
334 lines
9.3 KiB
ObjectPascal
|
|
{******************************************}
|
|
{ }
|
|
{ FastReport v4.0 }
|
|
{ Gradient object }
|
|
{ }
|
|
{ Copyright (c) 1998-2008 }
|
|
{ by Alexander Tzyganenko, }
|
|
{ Fast Reports Inc. }
|
|
{ }
|
|
{******************************************}
|
|
|
|
unit FMX.frxGradient;
|
|
|
|
interface
|
|
|
|
{$I fmx.inc}
|
|
{$I frx.inc}
|
|
{$I fmx.inc}
|
|
|
|
uses
|
|
System.SysUtils, System.Types, System.UITypes, System.Classes, System.UIConsts, FMX.Types, FMX.frxClass
|
|
, System.Variants
|
|
{$IFDEF DELPHI18}
|
|
,FMX.Controls
|
|
{$ENDIF}
|
|
{$IFDEF DELPHI19}
|
|
, FMX.Graphics
|
|
{$ENDIF}
|
|
{$IFDEF DELPHI28}
|
|
, FMX.BaseTypeAliases
|
|
{$ENDIF};
|
|
|
|
type
|
|
{$I frxFMX_PlatformsAttribute.inc}
|
|
TfrxGradientObject = class(TComponent); // fake component
|
|
|
|
TfrxGradientStyle = (gsHorizontal, gsVertical, gsElliptic, gsRectangle,
|
|
gsVertCenter, gsHorizCenter);
|
|
|
|
TfrxGradientView = class(TfrxView)
|
|
private
|
|
FBeginColor: TAlphaColor;
|
|
FEndColor: TAlphaColor;
|
|
FStyle: TfrxGradientStyle;
|
|
procedure DrawGradient(X, Y, X1, Y1: Integer);
|
|
function GetColor: TAlphaColor;
|
|
procedure SetColor(const Value: TAlphaColor);
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
procedure Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); override;
|
|
class function GetDescription: String; override;
|
|
published
|
|
property BeginColor: TAlphaColor read FBeginColor write FBeginColor default claWhite;
|
|
property EndColor: TAlphaColor read FEndColor write FEndColor default claGray;
|
|
property Style: TfrxGradientStyle read FStyle write FStyle;
|
|
property Frame;
|
|
property Color: TAlphaColor read GetColor write SetColor;
|
|
end;
|
|
|
|
|
|
implementation
|
|
|
|
uses System.Math, FMX.frxGradientRTTI, FMX.frxDsgnIntf, FMX.frxRes;
|
|
|
|
|
|
constructor TfrxGradientView.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
FBeginColor := claWhite;
|
|
FEndColor := claGray;
|
|
end;
|
|
|
|
class function TfrxGradientView.GetDescription: String;
|
|
begin
|
|
Result := frxResources.Get('obGrad');
|
|
end;
|
|
|
|
function MulDiv(nNumber, nNumerator, nDenominator: Single): Single; overload; inline;
|
|
begin
|
|
Result := (nNumber * nNumerator) / nDenominator;
|
|
end;
|
|
|
|
function MulDiv(nNumber, nNumerator, nDenominator: Double): Double; overload; inline;
|
|
begin
|
|
Result := (nNumber * nNumerator) / nDenominator;
|
|
end;
|
|
|
|
function MulDiv(nNumber, nNumerator, nDenominator: Integer): Integer; overload; inline;
|
|
begin
|
|
Result := (nNumber * nNumerator) div nDenominator;
|
|
end;
|
|
|
|
function RGB(r, g, b: Byte): TAlphaColor;
|
|
begin
|
|
Result := (r or (g shl 8) or (b shl 16)) or $FF000000;
|
|
end;
|
|
|
|
|
|
procedure TfrxGradientView.DrawGradient(X, Y, X1, Y1: Integer);
|
|
var
|
|
FromR, FromG, FromB: Cardinal;
|
|
DiffR, DiffG, DiffB: Integer;
|
|
ox, oy, dx, dy: Integer;
|
|
|
|
procedure DoHorizontal(fr, fg, fb, dr, dg, db: Integer);
|
|
var
|
|
ColorRect: TRectF;
|
|
I: Integer;
|
|
R, G, B: Byte;
|
|
begin
|
|
ColorRect.Top := oy;
|
|
ColorRect.Bottom := oy + dy;
|
|
for I := 0 to 255 do
|
|
begin
|
|
ColorRect.Left := MulDiv (I, dx, 256) + ox;
|
|
ColorRect.Right := MulDiv (I + 1, dx, 256) + ox;
|
|
R := fr + MulDiv(I, dr, 255);
|
|
G := fg + MulDiv(I, dg, 255);
|
|
B := fb + MulDiv(I, db, 255);
|
|
FCanvas.Fill.Color := RGB(R, G, B);
|
|
FCanvas.FillRect(ColorRect, 0, 0, AllCorners, 1, TCornerType.ctBevel);
|
|
end;
|
|
end;
|
|
|
|
procedure DoVertical(fr, fg, fb, dr, dg, db: Integer);
|
|
var
|
|
ColorRect: TRectF;
|
|
I: Integer;
|
|
R, G, B: Byte;
|
|
begin
|
|
ColorRect.Left := ox;
|
|
ColorRect.Right := ox + dx;
|
|
for I := 0 to 255 do
|
|
begin
|
|
ColorRect.Top := MulDiv (I, dy, 256) + oy;
|
|
ColorRect.Bottom := MulDiv (I + 1, dy, 256) + oy;
|
|
R := fr + MulDiv(I, dr, 255);
|
|
G := fg + MulDiv(I, dg, 255);
|
|
B := fb + MulDiv(I, db, 255);
|
|
FCanvas.Fill.Color := RGB(R, G, B);
|
|
FCanvas.FillRect(ColorRect, 0, 0, AllCorners, 1, TCornerType.ctBevel);
|
|
end;
|
|
end;
|
|
|
|
procedure DoElliptic(fr, fg, fb, dr, dg, db: Integer);
|
|
var
|
|
I: Integer;
|
|
R, G, B: Byte;
|
|
Pw, Ph: Double;
|
|
x1, y1, x2, y2: Double;
|
|
bmp: TBitmap;
|
|
begin
|
|
bmp := TBitmap.Create(dx, dy);
|
|
//bmp.Width := dx;
|
|
//bmp.Height := dy;
|
|
// bmp.Canvas.Stroke.Kind := TBrushKind.;
|
|
|
|
x1 := 0 - (dx / 4);
|
|
x2 := dx + (dx / 4);
|
|
y1 := 0 - (dy / 4);
|
|
y2 := dy + (dy / 4);
|
|
Pw := ((dx / 4) + (dx / 2)) / 155;
|
|
Ph := ((dy / 4) + (dy / 2)) / 155;
|
|
for I := 0 to 155 do
|
|
begin
|
|
x1 := x1 + Pw;
|
|
x2 := X2 - Pw;
|
|
y1 := y1 + Ph;
|
|
y2 := y2 - Ph;
|
|
R := fr + MulDiv(I, dr, 155);
|
|
G := fg + MulDiv(I, dg, 155);
|
|
B := fb + MulDiv(I, db, 155);
|
|
bmp.Canvas.Fill.Color := R or (G shl 8) or (b shl 16);
|
|
bmp.Canvas.FillEllipse(RectF(Trunc(x1), Trunc(y1), Trunc(x2), Trunc(y2)), 1);
|
|
end;
|
|
|
|
// FCanvas.DrawBitmap(ox, oy, bmp);
|
|
FCanvas.DrawBitmap(bmp, RectF(0, 0, dx, dy), RectF(ox, oy, ox + dx, oy + dy), 1);
|
|
bmp.Free;
|
|
end;
|
|
|
|
procedure DoRectangle(fr, fg, fb, dr, dg, db: Integer);
|
|
var
|
|
I: Integer;
|
|
R, G, B: Byte;
|
|
Pw, Ph: Real;
|
|
x1, y1, x2, y2: Double;
|
|
begin
|
|
//FCanvas.Pen.Style := psClear;
|
|
//FCanvas.Pen.Mode := pmCopy;
|
|
x1 := 0 + ox;
|
|
x2 := ox + dx;
|
|
y1 := 0 + oy;
|
|
y2 := oy + dy;
|
|
Pw := (dx / 2) / 255;
|
|
Ph := (dy / 2) / 255;
|
|
for I := 0 to 255 do
|
|
begin
|
|
x1 := x1 + Pw;
|
|
x2 := X2 - Pw;
|
|
y1 := y1 + Ph;
|
|
y2 := y2 - Ph;
|
|
R := fr + MulDiv(I, dr, 255);
|
|
G := fg + MulDiv(I, dg, 255);
|
|
B := fb + MulDiv(I, db, 255);
|
|
FCanvas.Fill.Color := RGB(R, G, B);
|
|
|
|
FCanvas.FillRect(RectF(Integer(Trunc(x1)), Integer(Trunc(y1)), Integer(Trunc(x2)), Integer(Trunc(y2))), 0, 0, AllCorners, 1, TCornerType.ctBevel);
|
|
end;
|
|
//FCanvas.Pen.Style := psSolid;
|
|
end;
|
|
|
|
procedure DoVertCenter(fr, fg, fb, dr, dg, db: Integer);
|
|
var
|
|
ColorRect: TRectF;
|
|
I: Integer;
|
|
R, G, B: Byte;
|
|
Haf: Integer;
|
|
begin
|
|
Haf := dy Div 2;
|
|
ColorRect.Left := 0 + ox;
|
|
ColorRect.Right := ox + dx;
|
|
for I := 0 to Haf do
|
|
begin
|
|
ColorRect.Top := MulDiv(I, Haf, Haf) + oy;
|
|
ColorRect.Bottom := MulDiv(I + 1, Haf, Haf) + oy;
|
|
R := fr + MulDiv(I, dr, Haf);
|
|
G := fg + MulDiv(I, dg, Haf);
|
|
B := fb + MulDiv(I, db, Haf);
|
|
FCanvas.Fill.Color := RGB(R, G, B);
|
|
FCanvas.FillRect(ColorRect, 0, 0, AllCorners, 1, TCornerType.ctBevel);
|
|
ColorRect.Top := dy - (MulDiv (I, Haf, Haf)) + oy;
|
|
ColorRect.Bottom := dy - (MulDiv (I + 1, Haf, Haf)) + oy;
|
|
FCanvas.FillRect(ColorRect, 0, 0, AllCorners, 1, TCornerType.ctBevel);
|
|
end;
|
|
end;
|
|
|
|
procedure DoHorizCenter(fr, fg, fb, dr, dg, db: Integer);
|
|
var
|
|
ColorRect: TRectF;
|
|
I: Integer;
|
|
R, G, B: Byte;
|
|
Haf: Integer;
|
|
begin
|
|
Haf := dx Div 2;
|
|
ColorRect.Top := 0 + oy;
|
|
ColorRect.Bottom := oy + dy;
|
|
for I := 0 to Haf do
|
|
begin
|
|
ColorRect.Left := MulDiv(I, Haf, Haf) + ox;
|
|
ColorRect.Right := MulDiv(I + 1, Haf, Haf) + ox;
|
|
R := fr + MulDiv(I, dr, Haf);
|
|
G := fg + MulDiv(I, dg, Haf);
|
|
B := fb + MulDiv(I, db, Haf);
|
|
FCanvas.Fill.Color := RGB(R, G, B);
|
|
FCanvas.FillRect(ColorRect, 0, 0, AllCorners, 1, TCornerType.ctBevel);
|
|
ColorRect.Left := dx - (MulDiv (I, Haf, Haf)) + ox;
|
|
ColorRect.Right := dx - (MulDiv (I + 1, Haf, Haf)) + ox;
|
|
FCanvas.FillRect(ColorRect, 0, 0, AllCorners, 1, TCornerType.ctBevel);
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
ox := X;
|
|
oy := Y;
|
|
dx := X1 - X;
|
|
dy := Y1 - Y;
|
|
FromR := FBeginColor and $000000ff;
|
|
FromG := (FBeginColor shr 8) and $000000ff;
|
|
FromB := (FBeginColor shr 16) and $000000ff;
|
|
DiffR := (FEndColor and $000000ff) - FromR;
|
|
DiffG := ((FEndColor shr 8) and $000000ff) - FromG;
|
|
DiffB := ((FEndColor shr 16) and $000000ff) - FromB;
|
|
|
|
case FStyle of
|
|
gsHorizontal:
|
|
DoHorizontal(FromR, FromG, FromB, DiffR, DiffG, DiffB);
|
|
gsVertical:
|
|
DoVertical(FromR, FromG, FromB, DiffR, DiffG, DiffB);
|
|
gsElliptic:
|
|
DoElliptic(FromR, FromG, FromB, DiffR, DiffG, DiffB);
|
|
gsRectangle:
|
|
DoRectangle(FromR, FromG, FromB, DiffR, DiffG, DiffB);
|
|
gsVertCenter:
|
|
DoVertCenter(FromR, FromG, FromB, DiffR, DiffG, DiffB);
|
|
gsHorizCenter:
|
|
DoHorizCenter(FromR, FromG, FromB, DiffR, DiffG, DiffB);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxGradientView.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX,
|
|
OffsetY: Extended);
|
|
begin
|
|
BeginDraw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY);
|
|
DrawGradient(FX, FY, FX1, FY1);
|
|
DrawFrame;
|
|
end;
|
|
|
|
function TfrxGradientView.GetColor: TAlphaColor;
|
|
var
|
|
R, G, B: Byte;
|
|
FromR, FromG, FromB: Cardinal;
|
|
DiffR, DiffG, DiffB: Integer;
|
|
begin
|
|
FromR := FBeginColor and $000000ff;
|
|
FromG := (FBeginColor shr 8) and $000000ff;
|
|
FromB := (FBeginColor shr 16) and $000000ff;
|
|
DiffR := (FEndColor and $000000ff) - FromR;
|
|
DiffG := ((FEndColor shr 8) and $000000ff) - FromG;
|
|
DiffB := ((FEndColor shr 16) and $000000ff) - FromB;
|
|
R := FromR + Cardinal(MulDiv(127, DiffR, 255));
|
|
G := FromG + Cardinal(MulDiv(127, DiffG, 255));
|
|
B := FromB + Cardinal(MulDiv(127, DiffB, 255));
|
|
result := RGB(R, G, B);
|
|
end;
|
|
|
|
procedure TfrxGradientView.SetColor(const Value: TAlphaColor);
|
|
begin
|
|
inherited Color := value;
|
|
end;
|
|
|
|
initialization
|
|
StartClassGroup(TFmxObject);
|
|
ActivateClassGroup(TFmxObject);
|
|
GroupDescendentsWith(TfrxGradientObject, TFmxObject);
|
|
frxObjects.RegisterObject1(TfrxGradientView, nil, '', '', 0, 141);
|
|
|
|
finalization
|
|
frxObjects.UnRegister(TfrxGradientView);
|
|
|
|
|
|
end.
|