cursomecanet.com

En esta sección de Código Fuente en Delphi vamos a explicar cómo podemos mostrar un degradado de color en nuestra aplicación.

Para ello, he escrito esta pequeña app de ejemplo.

La función "PintarGradiente" tiene los siguientes parámetros de entrada:

• El objeto tipo TPainBox sobre el que se dibujará el degradado de color
• Los dos colores de inicio y finalización del degradado
• Un parámetro tipo Boolean para indicar si queremos dibujar el degradado horizontal o vertical

Como ejemplo, si tenemos un objeto tipo TPaintBox llamado PaintBox1 en nuestro formulario y llamamos a la función "PintarGradiente(PaintBox1,clRed,clGreen,true);" esto nos dibujará un degradado horizontal comenzando por la izquierda con el color Rojo hasta llegar en la derecha al color Verde

Podéis ver en el código de la función PintarGradiente que la forma de proceder es la siguiente:

Se crea un objeto tipo TBitmap en memoria del mismo tamaño que el objeto TPaintBox recibido como parámetro, y en la propiedad canvas del Bitmap se realiza el dibujo del degradado que posteriormente se copia al TPaintBox

Para dibujar el degradado se utiliza la funció RGB a la que se le pasa la intensidad de los tres colores básicos (Red, Green, Blue), siendo cada una de estas intensidades un valor comprendido entre 0 y 255 que se calcula realizando una "media ponderada" de estas intensidades con los dos colores de inicio y fin y estableciendo como pesos para la ponderación de cada uno de estos dos colores la distancia que hay entre el punto a dibujar y los extremos (la distancia entre los extremos será el ancho , caso de degradado horizontal, o el alto, caso de degradado vertical)

Es decir, que si por ejemplo estamos dibujando un degradado horizontal con un ancho de 100 puntos desde el color Cl1 hasta el color Cl2, el pixel entre medias que está a una distancia de 20 puntos de la izquierda tendrá como color (Cl1*80 + Cl2*20) div 100

Esa es la idea con la que funcionan las líneas del código:

      Cl1 := RGB((GetRValue(colorInicial) * Z div N),
                 (GetGValue(colorInicial) * Z div N),
                 (GetBValue(colorInicial) * Z div N));
      Cl2 := RGB((GetRValue(colorFin) * Y div N),
                 (GetGValue(colorFin) * Y div N),
                 (GetBValue(colorFin) * Y div N));
      Cl  := cl1 + cl2;

En la siguiente imagen puedes ver un ejemplo de uso de esta app.

A continuación, puedes ver el código completo de la app, y si lo deseas puedes descargarlo todo (código y app) en un archivo "zip".

unit Unit1;

interface

uses
  Windows, Messages, SysUtils,  Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;

type
  TForm1 = class(TForm)
    PaintBox1: TPaintBox;
    PaintBox2: TPaintBox;
    PaintBox3: TPaintBox;
    PaintBox4: TPaintBox;
    procedure FormPaint(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


procedure PintarGradiente(control: tPaintBox; colorInicial: integer;
  colorFin: integer; Horizontal: boolean);
var
  Y, Z: integer;
  Cl1, Cl2, Cl: integer;
  N,H,W:    integer;
  Bitmap: TBitmap;
begin
  if Horizontal then
    N := control.Width
  else
    N := control.Height;

  H:= Control.Height;
  W:= Control.Width;

  Bitmap:= TBitmap.Create;
  Bitmap.Width:= W;
  Bitmap.Height:= H;
  for Y := 0 to N - 1 do
    with Bitmap.Canvas do
    begin
      Z   := (N - 1 - Y);
      Cl1 := RGB((GetRValue(colorInicial) * Z div N),
                 (GetGValue(colorInicial) * Z div N),
                 (GetBValue(colorInicial) * Z div N));
      Cl2 := RGB((GetRValue(colorFin) * Y div N),
                 (GetGValue(colorFin) * Y div N),
                 (GetBValue(colorFin) * Y div N));
      Cl  := cl1 + cl2;
      Pen.Color := Cl;
      Brush.Color := cl;
      if Horizontal = False then
        Rectangle(0, (H * Y div N), W,(H * (Y + 1) div N))
      else
        Rectangle((W * Y div N), 0,(W * (Y + 1) div N), H);
    end;

  control.canvas.copyrect(control.clientrect,Bitmap.Canvas,control.clientrect);
  Bitmap.Free;
end;


procedure TForm1.FormPaint(Sender: TObject);
begin
  PintarGradiente(PaintBox1,clRed,clGreen,true);
  PintarGradiente(PaintBox2,clBlue,clYellow,false);
  PintarGradiente(PaintBox3,clLime,clYellow,false);
  PintarGradiente(PaintBox4,clAqua,clGreen,true);

end;

end.