Градиентная заливка и сложение цветов

Материал из DRKB


Градиентная заливка и сложение цветов.[править | править код]

Иногда бывает нужно сложить два или более цветов для получения что-то типа переходного цвета. Делается это весьма просто. Координаты получаемого цвета будут равны среднему значению соответствующих координат всех цветов.

Например, нужно сложить красный и синий. Получаем

(255, 0, 0) + (0, 0, 255) = ((255+0) div 2, (0+0) div 2, (0+255) div 2) = (127, 0, 127)

В результате получаем сиреневый цвет. Та2: сложить соответствующие координаты, потом каждую сумму разделить нацело на количество цветов.

Поговорим теперь о градиентной заливке. Градиентная заливка - это заливка цветом с плавным переходом от одного цвета к другому.

Итак, пусть заданы 2 цвета своими координатами ((A1, A2, A3) и (B1, B2, B3)) и линия (длиной h пикселов), по которой нужно залить. Тогда каждый цвет каждого пикселя, находящегося на расстоянии x пикселов от начала будет равен

(A1 - (A1 - B1) / h * x,
 A2 - (A2 - B2) / h * x,
 A3 - (A3 - B3) / h * x)

Теперь, имея линию с градиентной заливкой, можно таким образом залить совершенно любую фигуру: будь то прямоугольник, круг или просто произвольная фигура.

Вот как выглядит описанный алгоритм:

{ Считается, что координаты первого цвета равны (A1, A2, A3), а второго (B1, B2, B3) }
{ Кроме того, линия начинается в координатах (X1,Y1), а заканчивается в (X2,Y1) }

var
  h, i: Integer;
begin
  h := X2 - X1 - 1;
  for i:=0 to h do
   begin
    PaintBox1.Canvas.Pen.Color := RGB(A1-(A1-B1)/h*i, A2-(A2-B2)/h*i, A3-(A3-B3)/h*i);
    PaintBox1.Canvas.Pen.Rectangle(I, Y1, I+1, Y1);
  end;
end.


Source: http://blackman.wp-club.net/
ID: 03681
ID: 03709
ID: 03747
ID: 04108



Just cut and paste the routines below into a unit somewhere and make the function declarations at the top of your unit.

You can use GetGradientColor2 to get a color that is somewhere between two other colors. For example, to get the color that is 50% between Red and Blue, do this:

var
  MyColor: TColor;
begin
  R1 := 255;
  G1 := 0;
  B1 := 0;
  R2 := 0;
  G2 := 0;
  B2 := 0;
  Percent := 0.5;
  MyNewColor := GetGradientColor2(R1, G1, B1, R2, G2, B2, Percent);


You could put percent in a loop from 0 to 1, and get all the colors as a nice gradient.

Function GetGradientColor3 works in a similar manner, except that you can do a gradient between 3 colors, such as between red to yellow to blue. This can help prevent the colors from loosing intensity when you go between say blue and red, where the purple would otherwise be darker.


{ Returns the color made up of the red, green, and blue components. Red, Green, and Blue can
  be from 0 to 255. }
function ColorFromRGB(Red, Green, Blue: Integer): Integer;
begin
  { Convert Red, Green, and Blue values to color. }
  Result := Red + Green * 256 + Blue * 65536;
end;

function GetPigmentBetween(P1, P2, Percent: Double): Integer;
{Returns a number that is Percent of the way between P1 and P2}
begin
  {Find the number between P1 and P2}
  Result := Round(((P2 - P1) * Percent) + P1);
  {Make sure we are within bounds for color.}
  if Result > 255 then
    Result := 255;
  if Result < 0 then
    Result := 0;
end;

{ Gets a color that is inbetween the colors defined by (R1,G1,B1) and (R2,G2,B2)
  Percent ranges from 0 to 1.0 (i.e. 0.5 = 50%)
  If percent =0   then the color of (R1,G1,B1) is returned
  If Percent =1   then the color of (R2,G2,B2) is returned
  if Percent is somewhere inbetween, then an inbetween color is returned. }
function GetGradientColor2(R1, G1, B1, R2, G2, B2, Percent: Double): Integer;
var
  NewRed, NewGreen, NewBlue: Integer;
begin
  { Validate input data in case it is off by a few thousanths. }
  if Percent > 1 then
    Percent := 1;
  if Percent < 0 then
    Percent := 0;
  { Calculate Red, green, and blue components for the new color. }
  NewRed := GetPigmentBetween(R1, R2, Percent);
  NewGreen := GetPigmentBetween(G1, G2, Percent);
  NewBlue := GetPigmentBetween(B1, B2, Percent);
  { Convert RGB to color }
  Result := ColorFromRGB(NewRed, NewGreen, NewBlue);
end;

{ Gets a color that is inbetween the color spread defined (R1,G1,B1), (R2,G2,B2) and (R3,G3,B3).
  This is similar to GetGradientColor2, except that it allows you to specify 3 colors instead of 2. }
function GetGradientColor3(R1, G1, B1, R2, G2, B2, R3, G3, B3, Percent: Double): Integer;
begin
  { Use GetGradient2 to do most the work }
  if Percent < 0.5 then
    Result := GetGradientColor2(R1, G1, B1, R2, G2, B2, Percent * 2)
  else
    Result := GetGradientColor2(R2, G2, B2, R3, G3, B3, (Percent - 0.5) * 2);
end;


Language: en
Source: http://www.baltsoft.com/
ID: 03682



Градиентная заливка?[править | править код]

unit Graph32;

interface

uses
  Windows, Graphics;

type
  TRGB = record
    B, G, R: Byte;
  end;

  ARGB = array [0..1] of TRGB;

  PARGB = ^ARGB;

procedure HGradientRect(Canvas: TCanvas; X1, Y1, X2, Y2: Integer;
  Color1, Color2: TColor);
procedure VGradientRect(Canvas: TCanvas; X1, Y1, X2, Y2: Integer;
  Color1, Color2: TColor);
procedure RGradientRect(Canvas: TCanvas; X1, Y1, X2, Y2: Integer;
  Color1, Color2: TColor);

var
  Bitmap: TBitmap;
  p: PARGB;

implementation

procedure HGradientRect(Canvas: TCanvas; X1, Y1, X2, Y2: Integer;
  Color1, Color2: TColor);
var
  x, y, c1, c2, r1, g1, b1: Integer;
  dr, dg, db: Real;
begin
  Bitmap.Width := abs(X1 - X2);
  Bitmap.Height := abs(Y1 - Y2);
  c1 := ColorToRGB(Color1);
  r1 := GetRValue(c1);
  g1 := GetGValue(c1);
  b1 := GetBValue(c1);
  c2 := ColorToRGB(Color2);
  dr := (GetRValue(c2) - r1) / Bitmap.Width;
  dg := (GetGValue(c2) - g1) / Bitmap.Width;
  db := (GetBValue(c2) - b1) / Bitmap.Width;
  for y := 0 to Bitmap.Height - 1 do
  begin
    p := Bitmap.ScanLine[y];
    for x := 0 to Bitmap.Width - 1 do
    begin
      p[x].R := Round(r1 + x * dr);
      p[x].G := round(g1 + x * dg);
      p[x].B := round(b1 + x * db);
    end;
  end;
  Canvas.Draw(X1, Y1, Bitmap);
end;

procedure VGradientRect(Canvas: TCanvas; X1, Y1, X2, Y2: Integer;
  Color1, Color2: TColor);
var
  x, y, c1, c2, r1, g1, b1: Integer;
  dr, dg, db: Real;
begin
  Bitmap.Width := Abs(X1 - X2);
  Bitmap.Height := Abs(Y1 - Y2);
  c1 := ColorToRGB(Color1);
  r1 := GetRValue(c1);
  g1 := GetGValue(c1);
  b1 := GetBValue(c1);
  c2 := ColorToRGB(Color2);
  dr := (GetRValue(c2) - r1) / Bitmap.Height;
  dg := (GetGValue(c2) - g1) / Bitmap.Height;
  db := (GetBValue(c2) - b1) / Bitmap.Height;
  for y := 0 to Bitmap.Height - 1 do
  begin
    p := Bitmap.ScanLine[y];
    for x := 0 to Bitmap.Width - 1 do
    begin
      p[x].R := Round(r1 + y * dr);
      p[x].G := Round(g1 + y * dg);
      p[x].B := Round(b1 + y * db);
    end;
  end;
  Canvas.Draw(X1, Y1, Bitmap);
end;

procedure RGradientRect(Canvas: TCanvas; X1, Y1, X2, Y2: Integer;
  Color1, Color2: TColor);
var
  x, y, c1, c2, r1, g1, b1: Integer;
  dr, dg, db, d: Real;
begin
  Bitmap.Width := Abs(X1 - X2);
  Bitmap.Height := Abs(Y1 - Y2);
  c1 := ColorToRGB(Color1);
  r1 := GetRValue(c1);
  g1 := GetGValue(c1);
  b1 := GetBValue(c1);
  c2 := ColorToRGB(Color2);
  d := Sqrt(Bitmap.Width * Bitmap.Width + Bitmap.Height * Bitmap.Height) / 2;
  dr := (GetRValue(c2) - r1) / d;
  dg := (GetGValue(c2) - g1) / d;
  db := (GetBValue(c2) - b1) / d;
  for y := 0 to Bitmap.Height - 1 do
  begin
    p := Bitmap.ScanLine[y];
    for x := 0 to Bitmap.Width - 1 do
    begin
      d := sqrt(((Bitmap.Width - 2 * x) * (Bitmap.Width - 2 * x) + (Bitmap.Height - 2 * y) *
        (Bitmap.Height - 2 * y)) / 4);
      p[x].R := Round(r1 + d * dr);
      p[x].G := Round(g1 + d * dg);
      p[x].B := Round(b1 + d * db);
    end;
  end;
  Canvas.Draw(X1, Y1, Bitmap);
end;

initialization

begin
  Bitmap := TBitmap.Create();
  Bitmap.PixelFormat := pf24bit;
end;

finalization

begin
  Bitmap.Free();
end;

end.


Author: Miscђka
Source: http://forum.sources.ru
ID: 03710



GradientFill[править | править код]

Еще, как вариант, воспользоваться стандартной функцией GradientFill:

uses Math;

procedure TForm1.Button1Click(Sender: TObject);

  function GetWRValue(Color: TColor): word;
  begin
   Result := Round(GetRValue(Color) /255 * 65535)
  end;

  function GetWGValue(Color: TColor): word;
  begin
   Result := Round(GetGValue(Color) / 255 * 65535)
  end;

  function GetWBValue(Color: TColor): word;
  begin
   Result := Round(GetBValue(Color) / 255 * 65535)
  end;

  type
   TRIVERTEX_NEW = packed record
     X,Y:Integer;
     R,G,B,Alpha: Word;
   end;
   TGradDirect = (gdVert, gdHorz);

const
  FColorBegin = clRed; // Начальный цвет
  FColorEnd = clBlue; // Конечный цвет
  FGradDirect = gdHorz; // Направление заливки

var
  _vertex: array [0..1] of TRIVERTEX_NEW;
  _rect  : _GRADIENT_RECT;
  _r     : TRect;
begin
  FillChar(_vertex, SizeOf(TRIVERTEX_NEW)*2, 0);
  _r := GetClientRect;
  AdjustClientRect(_r);
  _vertex[0].x    := _r.Left;
  _vertex[0].y    := _r.Top;
  _vertex[0].R    := GetWRValue(FColorBegin);
  _vertex[0].G    := GetWGValue(FColorBegin);
  _vertex[0].B    := GetWBValue(FColorBegin);
  _vertex[1].x    := _r.Right;
  _vertex[1].y    := _r.Bottom;
  _vertex[1].R    := GetWRValue(FColorEnd);
  _vertex[1].G    := GetWGValue(FColorEnd);
  _vertex[1].B    := GetWBValue(FColorEnd);
  _rect.UpperLeft := 0;
  _rect.LowerRight:= 1;
  GradientFill(Canvas.Handle, PTriVertex(@_vertex)^, 2, @_rect, 1,
               IfThen(FGradDirect = gdVert, GRADIENT_FILL_RECT_V, GRADIENT_FILL_RECT_H));
  Canvas.Brush.Style := bsClear;
  Canvas.Pen.Color   := Font.Color;
  Canvas.Font.Assign(Font);
  Canvas.TextOut(Round(Width/2 - Canvas.TextWidth(Text)/2),
                 Round(Height/2 - Canvas.TextHeight(Text)/2), Text)
end;


Author: Rouse_
Source: http://forum.sources.ru
ID: 03711



Градиент из массива цветов в прямоугольнике[править | править код]

{
  The following code allows you to draw a gradient on a canvas with
  an arbitrary number of colors (minimum 2).
  To draw a gradient on a form's canvas,
  call the DrawGradient() in the OnPaint and OnResize-event handlers.
}

 {
  Mit dieser Prozedur kann man auf einen Canvas einen Farbverlauf mit
  beliebig vielen Farben (min. 2) zeichnen.
  Z.B. wenn auf eine Form ein Farbverlauf gezeichnet werden soll,
  rufe die DrawGradient() Funktion im OnPaint-Ereignis und
  im OnResize-Ereignis der Form auf.
}

procedure DrawGradient(ACanvas: TCanvas; Rect: TRect;
  Horicontal: Boolean; Colors: array of TColor);
type
  RGBArray = array[0..2] of Byte;
var
  x, y, z, stelle, mx, bis, faColorsh, mass: Integer;
  Faktor: double;
  A: RGBArray;
  B: array of RGBArray;
  merkw: integer;
  merks: TPenStyle;
  merkp: TColor;
begin
  mx := High(Colors);
  if mx > 0 then
  begin
    if Horicontal then
      mass := Rect.Right - Rect.Left
    else
      mass := Rect.Bottom - Rect.Top;
    SetLength(b, mx + 1);
    for x := 0 to mx do
    begin
      Colors[x] := ColorToRGB(Colors[x]);
      b[x][0] := GetRValue(Colors[x]);
      b[x][1] := GetGValue(Colors[x]);
      b[x][2] := GetBValue(Colors[x]);
    end;
    merkw := ACanvas.Pen.Width;
    merks := ACanvas.Pen.Style;
    merkp := ACanvas.Pen.Color;
    ACanvas.Pen.Width := 1;
    ACanvas.Pen.Style := psSolid;
    faColorsh := Round(mass / mx);
    for y := 0 to mx - 1 do
    begin
      if y = mx - 1 then
        bis := mass - y * faColorsh - 1
      else
        bis := faColorsh;
      for x := 0 to bis do
      begin
        Stelle := x + y * faColorsh;
        faktor := x / bis;
        for z := 0 to 3 do
          a[z] := Trunc(b[y][z] + ((b[y + 1][z] - b[y][z]) * Faktor));
        ACanvas.Pen.Color := RGB(a[0], a[1], a[2]);
        if Horicontal then
        begin
          ACanvas.MoveTo(Rect.Left + Stelle, Rect.Top);
          ACanvas.LineTo(Rect.Left + Stelle, Rect.Bottom);
        end
        else
        begin
          ACanvas.MoveTo(Rect.Left, Rect.Top + Stelle);
          ACanvas.LineTo(Rect.Right, Rect.Top + Stelle);
        end;
      end;
    end;
    b := nil;
    ACanvas.Pen.Width := merkw;
    ACanvas.Pen.Style := merks;
    ACanvas.Pen.Color := merkp;
  end
  else
    // Please specify at least two colors
   raise EMathError.Create('Es mussen mindestens zwei Farben angegeben werden.');
end;

// Example Calls:
// Aufrufbeispiele:

DrawGradient(Image1.Canvas, Rect(0, 0, 100, 200), False, [clRed, $00FFA9B4]);

DrawGradient(Canvas, GetClientRect, True, [121351, clBtnFace, clBlack, clWhite]);


ID: 03748


Градиент в прямоугольнике с заданным числом оттенков[править | править код]

procedure FillGradientRect(Canvas: TCanvas; Recty: TRect; fbcolor, fecolor: TColor; fcolors: Integer);
var
  i, j, h, w, fcolor: Integer;
  R, G, B: Longword;
  beginRGBvalue, RGBdifference: array[0..2] of Longword;
begin
  beginRGBvalue[0] := GetRvalue(colortoRGB(FBcolor));
  beginRGBvalue[1] := GetGvalue(colortoRGB(FBcolor));
  beginRGBvalue[2] := GetBvalue(colortoRGB(FBcolor));

  RGBdifference[0] := GetRvalue(colortoRGB(FEcolor)) - beginRGBvalue[0];
  RGBdifference[1] := GetGvalue(colortoRGB(FEcolor)) - beginRGBvalue[1];
  RGBdifference[2] := GetBvalue(colortoRGB(FEcolor)) - beginRGBvalue[2];

  Canvas.pen.Style := pssolid;
  Canvas.pen.mode := pmcopy;
  j := 0;
  h := recty.Bottom - recty.Top;
  w := recty.Right - recty.Left;

  for i := fcolors downto 0 do
  begin
    recty.Left  := muldiv(i - 1, w, fcolors);
    recty.Right := muldiv(i, w, fcolors);
    if fcolors1 then
    begin
      R := beginRGBvalue[0] + muldiv(j, RGBDifference[0], fcolors);
      G := beginRGBvalue[1] + muldiv(j, RGBDifference[1], fcolors);
      B := beginRGBvalue[2] + muldiv(j, RGBDifference[2], fcolors);
    end;
    Canvas.Brush.Color := RGB(R, G, B);
    patBlt(Canvas.Handle, recty.Left, recty.Top, Recty.Right - recty.Left, h, patcopy);
    Inc(j);
  end;
end;

// Case 1

procedure TForm1.FormPaint(Sender: TObject);
begin
  FillGradientRect(Form1.Canvas, rect(0, 0, Width, Height), $FF0000, $00000, $00FF);
end;


// Case 2
procedure TForm1.FormPaint(Sender: TObject);
var
  Row, Ht: Word;
  IX: Integer;
begin
  iX := 200;
  Ht := (ClientHeight + 512) div 256;
  for Row := 0 to 512 do
  begin
    with Canvas do
    begin
      Brush.Color := RGB(Ix, 0, row);
      FillRect(Rect(0, Row * Ht, ClientWidth, (Row + 1) * Ht));
      IX := (IX - 1);
    end;
  end;
end;

{
  Note, that the OnResize event should also call the FormPaint
  method if this form is allowed to be resizable.
  This is because if it is not called then when the
  window is resized the gradient will not match the rest of the form.
}


Source: http://www.swissdelphicenter.ch
ID: 03749



Градиент на заданном битмапе[править | править код]

{***********************************************************}

{ 2. Another function }

procedure TForm1.Gradient(Col1, Col2: TColor; Bmp: TBitmap);
type
  PixArray = array [1..3] of Byte;
var
  i, big, rdiv, gdiv, bdiv, h, w: Integer;
  ts: TStringList;
  p: ^PixArray;
begin
  rdiv := GetRValue(Col1) - GetRValue(Col2);
  gdiv := GetgValue(Col1) - GetgValue(Col2);
  bdiv := GetbValue(Col1) - GetbValue(Col2);

  bmp.PixelFormat := pf24Bit;

  for h := 0 to bmp.Height - 1 do
  begin
    p := bmp.ScanLine[h];
    for w := 0 to bmp.Width - 1 do
    begin
      p^[1] := GetBvalue(Col1) - Round((w / bmp.Width) * bdiv);
      p^[2] := GetGvalue(Col1) - Round((w / bmp.Width) * gdiv);
      p^[3] := GetRvalue(Col1) - Round((w / bmp.Width) * rdiv);
      Inc(p);
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  BitMap1: TBitMap;
begin
  BitMap1 := TBitMap.Create;
  try
    Bitmap1.Width := 300;
    bitmap1.Height := 100;
    Gradient(clred, clBlack, bitmap1);
    // So konnte man das Bild dann zB in einem TImage anzeigen
    // To show the image in a TImage:
    Image1.Picture.Bitmap.Assign(bitmap1);
  finally
    Bitmap1.Free;
  end;
end;


Source: http://www.swissdelphicenter.ch
ID: 03750