gradient.pas

delphi语言开发的矢量图形处理对象

{------------------------------------------------------------------------------}
{                                                                              }
{  TGradient v2.51                                                              }
{  by Kambiz R. Khojasteh                                                      }
{                                                                              }
{  [e-mail]                                                       }
{  http://www.delphiarea.com                                                   }
{                                                                              }
{------------------------------------------------------------------------------}

unit Gradient;

interface

uses
  Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs, Menus;

type

  PRGBTripleArray = ^TRGBTripleArray;
  TRGBTripleArray = array[0..1024] of TRGBTriple;

  TGradientColors = array[0..255] of TRGBTriple;

  TGradientShift = -100..100;
  TGradientRotation = -100..100;

  TGradientStyle = (gsCustom, gsRadialC, gsRadialT, gsRadialB, gsRadialL,
    gsRadialR, gsRadialTL, gsRadialTR, gsRadialBL, gsRadialBR, gsLinearH,
    gsLinearV, gsReflectedH, gsReflectedV, gsDiagonalLF, gsDiagonalLB,
    gsDiagonalRF, gsDiagonalRB, gsArrowL, gsArrowR, gsArrowU, gsArrowD,
    gsDiamond, gsButterfly);

  TGradient = class(TGraphicControl)
  private
    fColorBegin: TColor;
    fColorEnd: TColor;
    fStyle: TGradientStyle;
    fReverse: Boolean;
    fPattern: TBitmap;
    fRotation :TGradientRotation;

    procedure SetColorBegin(Value: TColor);
    procedure SetColorEnd(Value: TColor);
    procedure SetReverse(Value: Boolean);
  protected
    procedure UpdatePattern; virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property ColorBegin: TColor read fColorBegin write SetColorBegin default clWhite;
    property ColorEnd: TColor read fColorEnd write SetColorEnd default clBtnFace;
    property Reverse: Boolean read fReverse write SetReverse default False;
    property Pattern: TBitmap read fPattern;
  end;


implementation

procedure RadialCentral(const Colors: TGradientColors; Pattern: TBitmap);
var
  X, Y: Integer;
  Row: PRGBTripleArray;
  PreCalcX, PreCalcY: Integer;
  PreCalcXs: array[0..361] of Integer;
begin
  Pattern.Width := 362;
  Pattern.Height := 362;
  for X := 0 to 180 do
  begin
    PreCalcX := 180 - X;
    PreCalcXs[X] := PreCalcX * PreCalcX;
  end;
  for X := 181 to 361 do
  begin
    PreCalcX := X - 181;
    PreCalcXs[X] := PreCalcX * PreCalcX;
  end;
  for Y := 0 to 361 do
  begin
    PreCalcY := 180 - Y;
    PreCalcY := PreCalcY * PreCalcY;
    Row := PRGBTripleArray(Pattern.ScanLine[Y]);
    for X := 0 to 361 do
      Row[X] := Colors[Round(Sqrt(PreCalcXs[X] + PreCalcY))];
  end;
  { Not optimized code
  for Y := 0 to 361 do
  begin
    Row := PRGBTripleArray(Pattern.ScanLine[Y]);
    for X := 0 to 180 do
      Row[X] := Colors[Round(Sqrt(Sqr(180 - X) + Sqr(180 - Y)))];
    for X := 181 to 361 do
      Row[X] := Colors[Round(Sqrt(Sqr(X - 181) + Sqr(180 - Y)))];
  end;
  }
end;

procedure RadialTop(const Colors: TGradientColors; Pattern: TBitmap);
var
  X, Y: Integer;
  Row: PRGBTripleArray;
  PreCalcX, PreCalcY: Integer;
  PreCalcXs: array[0..361] of Integer;
begin
  Pattern.Width := 362;
  Pattern.Height := 181;
  for X := 0 to 180 do
  begin
    PreCalcX := 180 - X;
    PreCalcXs[X] := PreCalcX * PreCalcX;
  end;
  for X := 181 to 361 do
  begin
    PreCalcX := X - 181;
    PreCalcXs[X] := PreCalcX * PreCalcX;
  end;
  for Y := 0 to 180 do
  begin
    PreCalcY := Y * Y;
    Row := PRGBTripleArray(Pattern.ScanLine[Y]);
    for X := 0 to 361 do
      Row[X] := Colors[Round(Sqrt(PreCalcXs[X] + PreCalcY))];
  end;
  { Not optimized code
  for Y := 0 to 180 do
  begin
    Row := PRGBTripleArray(Pattern.ScanLine[Y]);
    for X := 0 to 180 do
      Row[X] := Colors[Round(Sqrt(Sqr(180 - X) + Sqr(Y)))];
    for X := 181 to 361 do
      Row[X] := Colors[Round(Sqrt(Sqr(X - 181) + Sqr(Y)))];
  end;
  }
end;

procedure RadialBottom(const Colors: TGradientColors; Pattern: TBitmap);
var
  X, Y: Integer;
  Row: PRGBTripleArray;
  PreCalcX, PreCalcY: Integer;
  PreCalcXs: array[0..361] of Integer;
begin
  Pattern.Width := 362;
  Pattern.Height := 181;
  for X := 0 to 180 do
  begin
    PreCalcX := 180 - X;
    PreCalcXs[X] := PreCalcX * PreCalcX;
  end;
  for X := 181 to 361 do
  begin
    PreCalcX := X - 181;
    PreCalcXs[X] := PreCalcX * PreCalcX;
  end;
  for Y := 0 to 180 do
  begin
    PreCalcY := 180 - Y;
    PreCalcY := PreCalcY * PreCalcY;
    Row := PRGBTripleArray(Pattern.ScanLine[Y]);
    for X := 0 to 361 do
      Row[X] := Colors[Round(Sqrt(PreCalcXs[X] + PreCalcY))];
  end;
  { Not optimized code
  for Y := 0 to 180 do
  begin
    Row := PRGBTripleArray(Pattern.ScanLine[Y]);
    for X := 0 to 180 do
      Row[X] := Colors[Round(Sqrt(Sqr(180 - X) + Sqr(180 - Y)))];
    for X := 181 to 361 do
      Row[X] := Colors[Round(Sqrt(Sqr(X - 181) + Sqr(180 - Y)))];
  end;
  }
end;

procedure RadialLeft(const Colors: TGradientColors; Pattern: TBitmap);
var
  X, Y: Integer;
  Row: PRGBTripleArray;
  PreCalcY: Integer;
  PreCalcYs: array[0..361] of Integer;
begin
  Pattern.Width := 181;
  Pattern.Height := 362;
  for Y := 0 to 180 do
  begin
    PreCalcY := 180 - Y;
    PreCalcYs[Y] := PreCalcY * PreCalcY;
  end;
  for Y := 181 to 361 do
  begin
    PreCalcY := Y - 181;
    PreCalcYs[Y] := PreCalcY * PreCalcY;
  end;
  for Y := 0 to 361 do
  begin
    Row := PRGBTripleArray(Pattern.ScanLine[Y]);
    for X := 0 to 180 do
      Row[X] := Colors[Round(Sqrt(X * X + PreCalcYs[Y]))];
  end;
  { Not optimized code
  for Y := 0 to 180 do
  begin
    Row := PRGBTripleArray(Pattern.ScanLine[Y]);
    for X := 0 to 180 do
      Row[X] := Colors[Round(Sqrt(Sqr(X) + Sqr(180 - Y)))];
  end;
  for Y := 181 to 361 do
  begin
    Row := PRGBTripleArray(Pattern.ScanLine[Y]);
    for X := 0 to 180 do
      Row[X] := Colors[Round(Sqrt(Sqr(X) + Sqr(Y - 181)))];
  end;
  }
end;

procedure RadialRight(const Colors: TGradientColors; Pattern: TBitmap);
var
  X, Y: Integer;
  Row: PRGBTripleArray;
  PreCalcX, PreCalcY: Integer;
  PreCalcXs: array[0..180] of Integer;
  PreCalcYs: array[0..361] of Integer;
begin
  Pattern.Width := 181;
  Pattern.Height := 362;
  for X := 0 to 180 do
  begin
    PreCalcX := 180 - X;
    PreCalcXs[X] := PreCalcX * PreCalcX;
  end;
  for Y := 0 to 180 do
  begin
    PreCalcY := 180 - Y;
    PreCalcYs[Y] := PreCalcY * PreCalcY;
  end;
  for Y := 181 to 361 do
  begin
    PreCalcY := Y - 181;
    PreCalcYs[Y] := PreCalcY * PreCalcY;
  end;
  for Y := 0 to 361 do
  begin
    Row := PRGBTripleArray(Pattern.ScanLine[Y]);
    for X := 0 to 180 do
      Row[X] := Colors[Round(Sqrt(PreCalcXs[X] + PreCalcYs[Y]))];
  end;
  { Not optimized code
  for Y := 0 to 180 do
  begin
    Row := PRGBTripleArray(Pattern.ScanLine[Y]);
    for X := 0 to 180 do
      Row[X] := Colors[Round(Sqrt(Sqr(180 - X) + Sqr(180 - Y)))];
  end;
  for Y := 181 to 361 do
  begin
    Row := PRGBTripleArray(Pattern.ScanLine[Y]);
    for X := 0 to 180 do
      Row[X] := Colors[Round(Sqrt(Sqr(180 - X) + Sqr(Y - 181)))];
  end;
  }
end;

procedure RadialTopLeft(const Colors: TGradientColors; Pattern: TBitmap);
var
  X, Y: Integer;
  Row: PRGBTripleArray;
  PreCalcY: Integer;
  PreCalcXs: array[0..180] of Integer;
begin
  Pattern.Width := 181;
  Pattern.Height := 181;
  for X := 0 to 180 do
    PreCalcXs[X] := X * X;
  for Y := 0 to 180 do
  begin
    PreCalcY := Y * Y;
    Row := PRGBTripleArray(Pattern.ScanLine[Y]);
    for X := 0 to 180 do
      Row[X] := Colors[Round(Sqrt(PreCalcXs[X] + PreCalcY))];
  end;
  { Not optimized code
  for Y := 0 to 180 do
  begin
    Row := PRGBTripleArray(Pattern.ScanLine[Y]);
    for X := 0 to 180 do
      Row[X] := Colors[Round(Sqrt(Sqr(X) + Sqr(Y)))];
  end;
  }
end;

procedure RadialTopRight(const Colors: TGradientColors; Pattern: TBitmap);
var
  X, Y: Integer;
  Row: PRGBTripleArray;
  PreCalcX, PreCalcY: Integer;
  PreCalcXs: array[0..180] of Integer;
begin
  Pattern.Width := 181;
  Pattern.Height := 181;
  for X := 0 to 180 do
  begin
    PreCalcX := 180 - X;
    PreCalcXs[X] := PreCalcX * PreCalcX;
  end;
  for Y := 0 to 180 do
  begin
    PreCalcY := Y * Y;
    Row := PRGBTripleArray(Pattern.ScanLine[Y]);
    for X := 0 to 180 do
      Row[X] := Colors[Round(Sqrt(PreCalcXs[X] + PreCalcY))];
  end;
  { Not optimized code
  for Y := 0 to 180 do
  begin
    Row := PRGBTripleArray(Pattern.ScanLine[Y]);
    for X := 0 to 180 do
      Row[X] := Colors[Round(Sqrt(Sqr(180 - X) + Sqr(Y)))];
  end;
  }
end;

procedure RadialBottomLeft(const Colors: TGradientColors; Pattern: TBitmap);
var
  X, Y: Integer;
  Row: PRGBTripleArray;
  PreCalcY: Integer;
  PreCalcXs: array[0..180] of Integer;
begin
  Pattern.Width := 181;
  Pattern.Height := 181;
  for X := 0 to 180 do
    PreCalcXs[X] := X * X;
  for Y := 0 to 180 do
  begin
    PreCalcY := 180 - Y;
    PreCalcY := PreCalcY * PreCalcY;
    Row := PRGBTripleArray(Pattern.ScanLine[Y]);
    for X := 0 to 180 do
      Row[X] := Colors[Round(Sqrt(PreCalcXs[X] + PreCalcY))];
  end;
  { Not optimized code
  for Y := 0 to 180 do
  begin
    Row := PRGBTripleArray(Pattern.ScanLine[Y]);
    for X := 0 to 180 do
      Row[X] := Colors[Round(Sqrt(Sqr(X) + Sqr(180 - Y)))];
  end;
  }
end;

procedure RadialBottomRight(const Colors: TGradientColors; Pattern: TBitmap);
var
  X, Y: Integer;
  Row: PRGBTripleArray;
  PreCalcX, PreCalcY: Integer;
  PreCalcXs: array[0..180] of Integer;
begin
  Pattern.Width := 181;
  Pattern.Height := 181;
  for X := 0 to 180 do
  begin
    PreCalcX := 180 - X;
    PreCalcXs[X] := PreCalcX * PreCalcX;
  end;
  for Y := 0 to 180 do
  begin
    PreCalcY := 180 - Y;
    PreCalcY := PreCalcY * PreCalcY;
    Row := PRGBTripleArray(Pattern.ScanLine[Y]);
    for X := 0 to 180 do
      Row[X] := Colors[Round(Sqrt(PreCalcXs[X] + PreCalcY))];
  end;
  { Not optimized code
  for Y := 0 to 180 do
  begin
    Row := PRGBTripleArray(Pattern.ScanLine[Y]);
    for X := 0 to 180 do
      Row[X] := Colors[Round(Sqrt(Sqr(180 - X) + Sqr(180 - Y)))];
  end;
  }
end;

procedure LinearHorizontal(const Colors: TGradientColors; Pattern: TBitmap);
var
  Y: Integer;
  Row: PRGBTripleArray;
begin
  Pattern.Width := 1;
  Pattern.Height := 256;