DESCARGAR MECANET...
Curso MecaNet - Descargar
Sitio Oficial del Curso de mecanografía MecaNet
MecaNet Descargar gratis el curso MecaNet
MecaNet Build date: 20.04.24


Icono
"Pintar un degradado de colores"

 



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".

Unit1.pas
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.
Puede descargar el código fuente anterior con este enlace:
codigo-fuente-gradiente.zip
Puede encontrar una versión Portable de Delphi en esta dirección:
http://www.andyaska.com/?act=download&id=34&mode=detail

O puede descargar la versión gratuita Delphi Starter directamente desde su web oficial: https://www.embarcadero.com/products/delphi/starter/free-download
SITIO SEGURO...

Certificados de sitio web seguro

Haga clic para verificar

Norton Sitio seguro. Click para verificar Google Sitio seguro. Click para verificar Web Inspector Sitio seguro. Click para verificar VirusTotal Sitio seguro. Click para verificar URLVoid Sitio seguro. Click para verificar IsItHacked Sitio seguro. Click para verificar Sucuri SiteCheck Qualys SSL Digicert SSL Certificado de seguridad del sitio
 
DESCARGAR...
Delphi Source Code
Gradiente de color



Descargar Gradiente de color Windows 10 Compatible


MECANET.OFFICE...
MecaNet + LibreOffice + OpenOffice



DESCARGAR MECANET...
MecaNet.Office - Descargar
MecaNet.Office
Necesitará 1.7 GB de espacio libre en disco para la descarga e instalación
MecaNet DVD Descargar MecaNet.Office
Puede descargar los archivos individuales de cada una de las modalidades del curso
Collection Plus Portable Basic Teclado

DESCARGAR...
logo-MecaNet
Certificado de seguridad del sitio













Los autores del curso MecaNet le agradecemos mucho que acepte la publicidad en nuestro sitio web.

Nuestra publicidad "NO ES INTRUSIVA" y le permite poder utilizar nuestro software GRATIS y sin restricciones.

GRACIAS por su colaboración

cursomecanet.com
Política de cookies