gradient.pas

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

  for Y := 0 to 255 do
  begin
    Row := PRGBTripleArray(Pattern.ScanLine[Y]);
    Row[0] := Colors[Y];
  end;
end;

procedure LinearVertical(const Colors: TGradientColors; Pattern: TBitmap);
var
  X: Integer;
  Row: PRGBTripleArray;
begin
  Pattern.Width := 256;
  Pattern.Height := 1;
  Row := PRGBTripleArray(Pattern.ScanLine[0]);
  for X := 0 to 255 do
    Row[X] := Colors[X];
end;

procedure ReflectedHorizontal(const Colors: TGradientColors; Pattern: TBitmap);
var
  Y: Integer;
  Row: PRGBTripleArray;
begin
  Pattern.Width := 1;
  Pattern.Height := 512;
  for Y := 0 to 255 do
  begin
    Row := PRGBTripleArray(Pattern.ScanLine[Y]);
    Row[0] := Colors[255 - Y];
    Row := PRGBTripleArray(Pattern.ScanLine[511 - Y]);
    Row[0] := Colors[255 - Y];
  end;
end;

procedure ReflectedVertical(const Colors: TGradientColors; Pattern: TBitmap);
var
  X: Integer;
  Row: PRGBTripleArray;
begin
  Pattern.Width := 512;
  Pattern.Height := 1;
  Row := PRGBTripleArray(Pattern.ScanLine[0]);
  for X := 0 to 255 do
  begin
    Row[X] := Colors[255 - X];
    Row[511 - X] := Colors[255 - X];
  end;
end;

procedure DiagonalLinearForward(const Colors: TGradientColors; Pattern: TBitmap);
var
  X, Y: Integer;
  Row: PRGBTripleArray;
begin
  Pattern.Width := 128;
  Pattern.Height := 129;
  for Y := 0 to 128 do
  begin
    Row := PRGBTripleArray(Pattern.ScanLine[Y]);
    for X := 0 to 127 do
      Row[X] := Colors[127 + (Y - X)];
  end;
end;

procedure DiagonalLinearBackward(const Colors: TGradientColors; Pattern: TBitmap);
var
  X, Y: Integer;
  Row: PRGBTripleArray;
begin
  Pattern.Width := 128;
  Pattern.Height := 129;
  for Y := 0 to 128 do
  begin
    Row := PRGBTripleArray(Pattern.ScanLine[Y]);
    for X := 0 to 127 do
      Row[X] := Colors[X + Y];
  end;
end;

procedure DiagonalReflectedForward(const Colors: TGradientColors; Pattern: TBitmap);
var
  X, Y: Integer;
  Row: PRGBTripleArray;
begin
  Pattern.Width := 256;
  Pattern.Height := 256;
  for Y := 0 to 255 do
  begin
    Row := PRGBTripleArray(Pattern.ScanLine[Y]);
    for X := 0 to 255 do
      if X > Y then
        Row[X] := Colors[X - Y]
      else
        Row[X] := Colors[Y - X];
  end;
end;

procedure DiagonalReflectedBackward(const Colors: TGradientColors; Pattern: TBitmap);
var
  X, Y: Integer;
  Row: PRGBTripleArray;
begin
  Pattern.Width := 256;
  Pattern.Height := 256;
  for Y := 0 to 255 do
  begin
    Row := PRGBTripleArray(Pattern.ScanLine[Y]);
    for X := 0 to 255 do
      if X + Y < 255 then
        Row[X] := Colors[255 - (X + Y)]
      else
        Row[X] := Colors[(Y + X) - 255];
  end;
end;

procedure ArrowLeft(const Colors: TGradientColors; Pattern: TBitmap);
var
  X, Y: Integer;
  Row: PRGBTripleArray;
begin
  Pattern.Width := 129;
  Pattern.Height := 256;
  for Y := 0 to 127 do
  begin
    Row := PRGBTripleArray(Pattern.ScanLine[Y]);
    for X := 0 to 128 do
      Row[X] := Colors[255 - (X + Y)];
  end;
  for Y := 128 to 255 do
  begin
    Row := PRGBTripleArray(Pattern.ScanLine[Y]);
    for X := 0 to 128 do
      Row[X] := Colors[Y - X];
  end;
end;

procedure ArrowRight(const Colors: TGradientColors; Pattern: TBitmap);
var
  X, Y: Integer;
  Row: PRGBTripleArray;
begin
  Pattern.Width := 129;
  Pattern.Height := 256;
  for Y := 0 to 127 do
  begin
    Row := PRGBTripleArray(Pattern.ScanLine[Y]);
    for X := 0 to 128 do
      Row[X] := Colors[(X - Y) + 127];
  end;
  for Y := 128 to 255 do
  begin
    Row := PRGBTripleArray(Pattern.ScanLine[Y]);
    for X := 0 to 128 do
      Row[X] := Colors[(X + Y) - 128];
  end;
end;

procedure ArrowUp(const Colors: TGradientColors; Pattern: TBitmap);
var
  X, Y: Integer;
  Row: PRGBTripleArray;
begin
  Pattern.Width := 256;
  Pattern.Height := 129;
  for Y := 0 to 128 do
  begin
    Row := PRGBTripleArray(Pattern.ScanLine[Y]);
    for X := 0 to 127 do
      Row[X] := Colors[255 - (X + Y)];
    for X := 128 to 255 do
      Row[X] := Colors[X - Y];
  end;
end;

procedure ArrowDown(const Colors: TGradientColors; Pattern: TBitmap);
var
  X, Y: Integer;
  Row: PRGBTripleArray;
begin
  Pattern.Width := 256;
  Pattern.Height := 129;
  for Y := 0 to 128 do
  begin
    Row := PRGBTripleArray(Pattern.ScanLine[Y]);
    for X := 0 to 127 do
      Row[X] := Colors[127 + (Y - X)];
    for X := 128 to 255 do
      Row[X] := Colors[(X + Y) - 128];
  end;
end;

procedure Diamond(const Colors: TGradientColors; Pattern: TBitmap);
var
  X, Y: Integer;
  Row: PRGBTripleArray;
begin
  Pattern.Width := 256;
  Pattern.Height := 256;
  for Y := 0 to 127 do
  begin
    Row := PRGBTripleArray(Pattern.ScanLine[Y]);
    for X := 0 to 127 do
      Row[X] := Colors[255 - (X + Y)];
    for X := 128 to 255 do
      Row[X] := Colors[X - Y];
  end;
  for Y := 128 to 255 do
  begin
    Row := PRGBTripleArray(Pattern.ScanLine[Y]);
    for X := 0 to 127 do
      Row[X] := Colors[Y - X];
    for X := 128 to 255 do
      Row[X] := Colors[(X + Y) - 255];
  end;
end;

procedure Butterfly(const Colors: TGradientColors; Pattern: TBitmap);
var
  X, Y: Integer;
  Row: PRGBTripleArray;
begin
  Pattern.Width := 256;
  Pattern.Height := 256;
  for Y := 0 to 127 do
  begin
    Row := PRGBTripleArray(Pattern.ScanLine[Y]);
    for X := 0 to 127 do
      Row[X] := Colors[(X - Y) + 128];
    for X := 128 to 255 do
      Row[X] := Colors[383 - (X + Y)];
  end;
  for Y := 128 to 255 do
  begin
    Row := PRGBTripleArray(Pattern.ScanLine[Y]);
    for X := 0 to 127 do
      Row[X] := Colors[(X + Y) - 128];
    for X := 128 to 255 do
      Row[X] := Colors[128 + (Y - X)];
  end;
end;

{ TGradient }

type
  TPatternBuilder = procedure(const Colors: TGradientColors; Pattern: TBitmap);

const
  PatternBuilder: array[TGradientStyle] of TPatternBuilder = (nil,
    RadialCentral, RadialTop, RadialBottom, RadialLeft, RadialRight,
    RadialTopLeft, RadialTopRight, RadialBottomLeft, RadialBottomRight,
    LinearHorizontal, LinearVertical, ReflectedHorizontal, ReflectedVertical,
    DiagonalLinearForward, DiagonalLinearBackward, DiagonalReflectedForward,
    DiagonalReflectedBackward, ArrowLeft, ArrowRight, ArrowUp, ArrowDown,
    Diamond, Butterfly);

constructor TGradient.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csOpaque];
  Width := 100;
  Height := 100;
  fColorBegin := clWhite;
  fColorEnd := clBtnFace;
  fRotation := 0;
  fStyle := gsRadialC;
  fReverse := False;
  fPattern := TBitmap.Create;
  fPattern.PixelFormat := pf24bit;
  UpdatePattern;
end;

destructor TGradient.Destroy;
begin
  fPattern.Free;
  inherited Destroy;
end;

procedure TGradient.SetColorBegin(Value: TColor);
begin
  if fColorBegin <> Value then
  begin
    fColorBegin := Value;
    UpdatePattern;
  end;
end;

procedure TGradient.SetColorEnd(Value: TColor);
begin
  if fColorEnd <> Value then
  begin
    fColorEnd := Value;
    UpdatePattern;
  end;
end;
procedure TGradient.SetReverse(Value: Boolean);
begin
  if fReverse <> Value then
  begin
    fReverse := Value;
    UpdatePattern;
  end;
end;

procedure TGradient.UpdatePattern;
var
  Colors: TGradientColors;
  dRed, dGreen, dBlue: Integer;
  RGBColor1, RGBColor2: TColor;
  RGB1, RGB2: TRGBTriple;
  Index: Integer;
  M: Integer;
begin
  if fReverse then
  begin
    RGBColor1 := ColorToRGB(ColorEnd);
    RGBColor2 := ColorToRGB(ColorBegin);
  end
  else
  begin
    RGBColor1 := ColorToRGB(ColorBegin);
    RGBColor2 := ColorToRGB(ColorEnd);
  end;

  RGB1.rgbtRed := GetRValue(RGBColor1);
  RGB1.rgbtGreen := GetGValue(RGBColor1);
  RGB1.rgbtBlue := GetBValue(RGBColor1);

  RGB2.rgbtRed := GetRValue(RGBColor2);
  RGB2.rgbtGreen := GetGValue(RGBColor2);
  RGB2.rgbtBlue := GetBValue(RGBColor2);

  dRed := RGB2.rgbtRed - RGB1.rgbtRed;
  dGreen := RGB2.rgbtGreen - RGB1.rgbtGreen;
  dBlue := RGB2.rgbtBlue - RGB1.rgbtBlue;

  M := MulDiv(255, fRotation, 100);
  if M = 0 then
    for Index := 0 to 255 do
      with Colors[Index] do
      begin
        rgbtRed := RGB1.rgbtRed + (Index * dRed) div 255;
        rgbtGreen := RGB1.rgbtGreen + (Index * dGreen) div 255;
        rgbtBlue := RGB1.rgbtBlue + (Index * dBlue) div 255;
      end
  else if M > 0 then
  begin
    M := 255 - M;
    for Index := 0 to M - 1 do
      with Colors[Index] do
      begin
        rgbtRed := RGB1.rgbtRed + (Index * dRed) div M;
        rgbtGreen := RGB1.rgbtGreen + (Index * dGreen) div M;
        rgbtBlue := RGB1.rgbtBlue + (Index * dBlue) div M;
      end;
    for Index := M to 255 do
      with Colors[Index] do
      begin
        rgbtRed := RGB1.rgbtRed + ((255 - Index) * dRed) div (255 - M);
        rgbtGreen := RGB1.rgbtGreen + ((255 - Index) * dGreen) div (255 - M);
        rgbtBlue := RGB1.rgbtBlue + ((255 - Index) * dBlue) div (255 - M);
      end;
  end
  else if M < 0 then
  begin
    M := -M;
    for Index := 0 to M do
      with Colors[Index] do
      begin
        rgbtRed := RGB2.rgbtRed - (Index * dRed) div M;
        rgbtGreen := RGB2.rgbtGreen - (Index * dGreen) div M;
        rgbtBlue := RGB2.rgbtBlue - (Index * dBlue) div M;
      end;
    for Index := M + 1 to 255 do
      with Colors[Index] do
      begin
        rgbtRed := RGB2.rgbtRed - ((255 - Index) * dRed) div (255 - M);
        rgbtGreen := RGB2.rgbtGreen - ((255 - Index) * dGreen) div (255 - M);
        rgbtBlue := RGB2.rgbtBlue - ((255 - Index) * dBlue) div (255 - M);
      end;
  end;

  try
    if @PatternBuilder[fStyle] <> nil then
    PatternBuilder[fStyle](Colors, Pattern);
  finally
  end;
end;

end.