Moviendo sprites con el teclado y el ratón

Basándome en el ejemplo del artículo anterior que mostraba como realizar el movimiento de sprites con fondo vamos a ver como el usuario puede mover los sprites usando el teclado y el ratón.

CAPTURANDO LOS EVENTOS DEL TECLADO

La clase TForm dispone de dos eventos para controlar las pulsaciones de teclado: OnKeyDown y OnKeyUp. Necesitamos ambos eventos porque no sólo me interesa saber cuando un usuario ha pulsado una tecla sino también cuando la ha soltado (para controlar las diagonales).

Para hacer esto voy a crear cuatro variables booleanas en la sección private el formulario que me van a informar de cuando están pulsadas las teclas del cursor:

type
  private
    { Private declarations }
    Sprite: TSprite;
    Buffer, Fondo: TImage;
    bDerecha, bIzquierda, bArriba, bAbajo: Boolean;

Estas variables las voy a actualizar en el evento OnKeyDown:

procedure TFormulario.FormKeyDown( Sender: TObject; var Key: Word; Shift: TShiftState );
begin
  case key of
    VK_LEFT: bIzquierda := True;
    VK_DOWN: bAbajo := True;
    VK_UP: bArriba := True;
    VK_RIGHT: bDerecha := True;
  end;
end;

y en el evento OnKeyUp:

procedure TFormulario.FormKeyUp( Sender: TObject; var Key: Word; Shift: TShiftState );
begin
  case key of
    VK_LEFT: bIzquierda := False;
    VK_DOWN: bAbajo := False;
    VK_UP: bArriba := False;
    VK_RIGHT: bDerecha := False;
  end;
end;

Al igual que hice con el ejemplo anterior voy a utilizar un temporizador (TTimer) llamado TmpTeclado con un intervalo que va a ser también de 10 milisegundos y cuyo evento OnTimer va a encargarse de dibujar el sprite en pantalla:

procedure TFormulario.TmpTecladoTimer( Sender: TObject );
begin
  // ¿Ha pulsado la tecla izquierda?
  if bIzquierda then
    if Sprite.x > 0 then
      Dec( Sprite.x );

  // ¿Ha pulsado la tecla arriba?
  if bArriba then
    if Sprite.y > 0 then
      Dec( Sprite.y );

  // ¿Ha pulsado la tecla derecha?
  if bDerecha then
    if Sprite.x + Sprite.Imagen.Width < ClientWidth then
      Inc( Sprite.x );

  // ¿Ha pulsado la tecla abajo?
  if bAbajo then
    if Sprite.y + Sprite.Imagen.Height < ClientHeight then
      Inc( Sprite.y );

  DibujarSprite;
end;

Este evento comprueba la pulsación de todas las teclas controlando que el sprite no se salga del formulario. El procedimiento de DibujarSprite sería el siguiente:

procedure TFormulario.DibujarSprite;
var
  Origen, Destino: TRect;
begin
  // Copiamos el fondo de pantalla al buffer
  Origen.Left := Sprite.x;
  Origen.Top := Sprite.y;
  Origen.Right := Sprite.x + Sprite.Imagen.Width;
  Origen.Bottom := Sprite.y + Sprite.Imagen.Height;
  Destino.Left := 0;
  Destino.Top := 0;
  Destino.Right := Sprite.Imagen.Width;
  Destino.Bottom := Sprite.Imagen.Height;
  Buffer.Canvas.CopyMode := cmSrcCopy;
  Buffer.Canvas.CopyRect( Destino, Fondo.Canvas, Origen );

  // Dibujamos el sprite en el buffer encima del fondo copiado
  Sprite.Dibujar( 0, 0, Buffer.Canvas );

  // Dibujamos el contenido del buffer a la pantalla
  Canvas.Draw( Sprite.x, Sprite.y, Buffer.Picture.Graphic );
end;

Prácticamente es el mismo visto en el artículo anterior. Ya sólo hace falta poner el marcha el mecanismo que bien podría ser en el evento OnCreate del formulario:

begin
  TmpTeclado.Enabled := True;
  Sprite.x := 250;
  Sprite.y := 150;
end;

CAPTURANDO LOS EVENTOS DEL RATON

Para capturar las coordenadas del ratón vamos a utilizar el evento OnMouseMove del formulario:

procedure TFormulario.FormMouseMove( Sender: TObject; Shift: TShiftState; X, Y: Integer );
begin
  Sprite.x := X;
  Sprite.y := Y;
end;

Para controlar los eventos del ratón voy a utilizar un temporizador distinto al del teclado llamado TmpRaton con un intervalo de 10 milisegundos. Su evento OnTimer sería sencillo:

procedure TFormulario.TmpRatonTimer( Sender: TObject );
begin
  DibujarSprite;
end;

Aquí nos surge un problema importante: como los movimientos del ratón son más bruscos que los del teclado volvemos a tener el problema de que el sprite nos va dejando manchas en pantalla. Para solucionar el problema tenemos que restaurar el fondo de la posición anterior del sprite antes de dibujarlo en la nueva posición..

Para ello voy a guardar en la clase TSprite las coordenadas anteriores:

type
  TSprite = class
  public
    x, y, xAnterior, yAnterior: Integer;
    ColorTransparente: TColor;
    Imagen, Mascara: TImage;
    constructor Create;
    destructor Destroy; override;
    procedure Cargar( sImagen: string );
    procedure Dibujar( x, y: Integer; Canvas: TCanvas );
  end;

Al procedimiento DibujarSprite le vamos a añadir que restaure el fondo del sprite de la posición anterior:

procedure TFormulario.DibujarSprite;
var
  Origen, Destino: TRect;
begin
  // Restauramos el fondo de la posición anterior del sprite
  if ( Sprite.xAnterior <> Sprite.x ) or ( Sprite.yAnterior <> Sprite.y ) then
  begin
    Origen.Left := Sprite.xAnterior;
    Origen.Top := Sprite.yAnterior;
    Origen.Right := Sprite.xAnterior + Sprite.Imagen.Width;
    Origen.Bottom := Sprite.yAnterior + Sprite.Imagen.Height;
    Destino := Origen;
    Canvas.CopyMode := cmSrcCopy;
    Canvas.CopyRect( Destino, Fondo.Canvas, Origen );
  end;

  // Copiamos el fondo de pantalla al buffer
  Origen.Left := Sprite.x;
  Origen.Top := Sprite.y;
  Origen.Right := Sprite.x + Sprite.Imagen.Width;
  Origen.Bottom := Sprite.y + Sprite.Imagen.Height;
  Destino.Left := 0;
  Destino.Top := 0;
  Destino.Right := Sprite.Imagen.Width;
  Destino.Bottom := Sprite.Imagen.Height;
  Buffer.Canvas.CopyMode := cmSrcCopy;
  Buffer.Canvas.CopyRect( Destino, Fondo.Canvas, Origen );

  // Dibujamos el sprite en el buffer encima del fondo copiado
  Sprite.Dibujar( 0, 0, Buffer.Canvas );

  // Dibujamos el contenido del buffer a la pantalla
  Canvas.Draw( Sprite.x, Sprite.y, Buffer.Picture.Graphic );

  Sprite.xAnterior := Sprite.x;
  Sprite.yAnterior := Sprite.y;
end;

Y finalmente activamos el temporizador que controla el ratón y ocultamos el cursor del ratón para que no se superponga encima de nuestro sprite:

begin
  TmpRaton.Enabled := True;
  Sprite.x := 250;
  Sprite.y := 150;
  ShowCursor( False );
end;

Al ejecutar el programa podeis ver como se mueve el sprite como si fuera el cursor del ratón.

Aunque se pueden hacer cosas bonitas utilizando el Canvas no os hagais muchas ilusiones ya que si por algo destaca la librería GDI de Windows (el Canvas) es por su lentitud y por la diferencia de velocidad entre ordenadores.

Para hacer cosas serías habría que irse a la librerías SDL (mi favorita), OpenGL o DirectX ( aunque hay decenas de motores gráficos 2D y 3D para Delphi en Internet que simplifican el trabajo).

Pruebas realizadas en Delphi 7.

Mover sprites con doble buffer

En el artículo anterior creamos la clase TSprite encargada de dibujar figuras en pantalla. Hoy vamos a reutilizarla para mover sprites, pero antes vamos a hacer una pequeña modificación:

type
  TSprite = class
  public
    x, y: Integer;
    ColorTransparente: TColor;
    Imagen, Mascara: TImage;
    constructor Create;
    destructor Destroy; override;
    procedure Cargar( sImagen: string );
    procedure Dibujar( x, y: Integer; Canvas: TCanvas );
  end;

Sólo hemos modificado el evento Dibujar añadiendo las coordenadas de donde se va a dibujar (independientemente de las que tenga el sprite). La implementación de toda la clase TSprite quedaría de esta manera:

{ TSprite }

constructor TSprite.Create;
begin
  inherited;
  Imagen := TImage.Create( nil );
  Imagen.AutoSize := True;
  Mascara := TImage.Create( nil );
  ColorTransparente := RGB( 255, 0, 255 );
end;

destructor TSprite.Destroy;
begin
  Mascara.Free;
  Imagen.Free;
  inherited;
end;

procedure TSprite.Cargar( sImagen: string );
var
  i, j: Integer;
begin
  Imagen.Picture.LoadFromFile( sImagen );
  Mascara.Width := Imagen.Width;
  Mascara.Height := Imagen.Height;

  for j := 0 to Imagen.Height - 1 do
    for i := 0 to Imagen.Width - 1 do
      if Imagen.Canvas.Pixels[i, j] = ColorTransparente then
      begin
        Imagen.Canvas.Pixels[i, j] := 0;
        Mascara.Canvas.Pixels[i, j] := RGB( 255, 255, 255 );
      end
      else
        Mascara.Canvas.Pixels[i, j] := RGB( 0, 0, 0 );
end;

procedure TSprite.Dibujar( x, y: Integer; Canvas: TCanvas );
begin
  Canvas.CopyMode := cmSrcAnd;
  Canvas.Draw( x, y, Mascara.Picture.Graphic );
  Canvas.CopyMode := cmSrcPaint;
  Canvas.Draw( x, y, Imagen.Picture.Graphic );
end;

CREANDO EL DOBLE BUFFER

Cuando se mueven figuras gráficas en un formulario aparte de producirse parpadeos en el sprite se van dejando rastros de las posiciones anteriores. Sucede algo como esto:


Para evitarlo hay muchísimas técnicas tales como el doble o triple buffer. Aquí vamos a ver como realizar un doble buffer para mover sprites. El formulario va a tener el siguiente fondo:


El fondo tiene unas dimensiones de 500x300 pixels. Para ajustar el fondo al formulario configuramos las siguientes propiedades en el inspector de objetos:

Formulario.ClientWidth = 500
Formulario.ClientHeight = 300

Se llama doble buffer porque vamos a crear dos imágenes:

Fondo, Buffer: TImage;

El Fondo guarda la imagen de fondo mostrada anteriormente y el Buffer va a encargarse de mezclar el sprite con el fondo antes de llevarlo a la pantalla.

Los pasos para dibujar el sprite serían los siguientes:


1º Se copia un trozo del fondo al buffer.

2º Se copia el sprite sin fondo encima del buffer.

3º Se lleva el contenido del buffer a pantalla.

Lo primero que vamos a hacer es declarar en la sección private del formulario los objetos:

  private
    { Private declarations }
    Sprite: TSprite;
    Buffer, Fondo: TImage;

Después los creamos en el evento OnCreate del formulario:

procedure TFormulario.FormCreate( Sender: TObject );
begin
  Sprite := TSprite.Create;
  Sprite.Cargar( ExtractFilePath( Application.ExeName ) + 'sprite.bmp' );
  Buffer := TImage.Create( nil );
  Buffer.Width := Sprite.Imagen.Width;
  Buffer.Height := Sprite.Imagen.Height;
  Fondo := TImage.Create( nil );
  Fondo.Picture.LoadFromFile( ExtractFilePath( Application.ExeName ) + 'fondo.bmp' );
end;

El fondo también lo he creado como imagen BMP en vez de JPG para poder utilizar la función CopyRect del Canvas. Nos aseguramos de que en el evento OnDestroy del formulario se liberen de memoria:

procedure TFormulario.FormDestroy( Sender: TObject );
begin
  Sprite.Free;
  Buffer.Free;
  Fondo.Free;
end;

Aunque podemos mover el sprite utilizando un bucle for esto podría dejar nuestro programa algo pillado. Lo mejor es moverlo utilizando un objeto de la clase TTimer. Lo introducimos en nuestro formulario con el nombre Temporizador. Por defecto hay que dejarlo desactivado (Enabled = False) y vamos a hacer que se mueva el sprite cada 10 milisegundos (Invertal = 10).

En el evento OnTimer hacemos que se mueva el sprite utilizando los pasos mencionados:

procedure TFSprites.TemporizadorTimer( Sender: TObject );
var
  Origen, Destino: TRect;
begin
  if Sprite.x < 400 then
  begin
    Inc( Sprite.x );

    // Copiamos el fondo de pantalla al buffer
    Origen.Left := Sprite.x;
    Origen.Top := Sprite.y;
    Origen.Right := Sprite.x + Sprite.Imagen.Width;
    Origen.Bottom := Sprite.y + Sprite.Imagen.Height;
    Destino.Left := 0;
    Destino.Top := 0;
    Destino.Right := Sprite.Imagen.Width;
    Destino.Bottom := Sprite.Imagen.Height;
    Buffer.Canvas.CopyMode := cmSrcCopy;
    Buffer.Canvas.CopyRect( Destino, Fondo.Canvas, Origen );

    // Dibujamos el sprite en el buffer encima del fondo copiado
    Sprite.Dibujar( 0, 0, Buffer.Canvas );

    // Dibujamos el contenido del buffer a la pantalla
    Canvas.Draw( Sprite.x, Sprite.y, Buffer.Picture.Graphic );
  end
  else
    Temporizador.Enabled := False;
end;

En el evento OnPaint del formulario tenemos que hacer que se dibuje el fondo:

procedure TFormulario.FormPaint( Sender: TObject );
begin
  Canvas.Draw( 0, 0, Fondo.Picture.Graphic );
end;

Esto es necesario por si el usuario minimiza y vuelve a mostrar la aplicación, ya que sólo se refresca la zona por donde está moviéndose el sprite.

Por fin hemos conseguido el efecto deseado:

Pruebas realizadas en Delphi 7.

Como dibujar sprites transparentes

Un Sprite es una figura gráfica móvil utilizada en los videojuegos de dos dimensiones. Por ejemplo, un videojuego de naves espaciales consta de los sprites de la nave, los meteoritos, los enemigos, etc., es decir, todo lo que sea móvil en pantalla y que no tenga que ver con los paisajes de fondo.

Anteriormente vimos como copiar imágenes de una superficie a otra utilizando los métodos Draw o CopyRect que se encuentran en la clase TCanvas. También se vió como modificar el modo de copiar mediante la propiedad CopyMode la cual permitia los valores cmSrcCopy, smMergePaint, etc.

El problema radica en que por mucho que nos empeñemos en dibujar una imagen transparente ningún tipo de copia funciona: o la hace muy transparente o se estropea el fondo.

DIBUJAR SPRITES MEDIANTE MASCARAS

Para dibujar sprites transparentes hay que tener dos imágenes: la original cuyo color de fondo le debemos dar alguno como común (como el negro) y la imagen de la máscara que es igual que la original pero como si fuera un negativo.

Supongamos que quiero dibujar este sprite (archivo BMP):


Es conveniente utilizar de color transparente un color de uso como común. En este caso he elegido el color rosa cuyos componentes RGB son (255,0,255). La máscara de esta imagen sería la siguiente:


Esta máscara no es necesario crearla en ningún programa de dibujo ya que la vamos a crear nosotros internamente. Vamos a encapsular la creación del sprite en la siguiente clase:

type
  TSprite = class
  public
    x, y: Integer;
    ColorTransparente: TColor;
    Imagen, Mascara: TImage;
    constructor Create;
    destructor Destroy; override;
    procedure Cargar( sImagen: string );
    procedure Dibujar( Canvas: TCanvas );
  end;

Esta clase consta de las coordenadas del sprite, el color que definimos como transparente y las imágenes a dibujar incluyendo su máscara. En el constructor de la clase creo dos objetos de la clase TImage en memoria:

constructor TSprite.Create;
begin
  inherited;
  Imagen := TImage.Create( nil );
  Imagen.AutoSize := True;
  Mascara := TImage.Create( nil );
  ColorTransparente := RGB( 255, 0, 255 );
end;

También he definido el color rosa como color transparente. Como puede apreciarse he utilizado el procedimiento RGB que convierte los tres componentes del color al formato de TColor que los guarda al revés BGR. Así podemos darle a Delphi cualquier color utilizando estos tres componentes copiados de cualquier programa de dibujo.

En el destructor de la clase nos aseguramos de que se liberen de memoria ambos objetos:

destructor TSprite.Destroy;
begin
  Mascara.Free;
  Imagen.Free;
  inherited;
end;

Ahora implementamos la función que carga de un archivo la imagen BMP y a continuación crea su máscara:

procedure TSprite.Cargar( sImagen: string );
var
  i, j: Integer;
begin
  Imagen.Picture.LoadFromFile( sImagen );
  Mascara.Width := Imagen.Width;
  Mascara.Height := Imagen.Height;

  for j := 0 to Imagen.Height - 1 do
    for i := 0 to Imagen.Width - 1 do
      if Imagen.Canvas.Pixels[i,j] = ColorTransparente then
      begin
        Imagen.Canvas.Pixels[i,j] := 0;
        Mascara.Canvas.Pixels[i,j] := RGB( 255, 255, 255 );
      end
      else
        Mascara.Canvas.Pixels[i,j] := RGB( 0, 0, 0 );
end;

Aquí nos encargamos de dejar la máscara en negativo a partir de la imagen original.

Para dibujar sprites recomiendo utilizar archivos BMP en lugar de JPG debido a que este último tipo de imágenes pierden calidad y podrían afectar al resultado de la máscara, dando la sensación de que el sprite tiene manchas. Hay otras librerías para Delphi que permiten cargar imágenes PNG que son ideales para la creación de videojuegos, pero esto lo veremos en otra ocasión.

Una vez que ya tenemos nuestro sprite y nuestra máscara asociada al mismo podemos crear el procedimiento encargado de dibujarlo:

procedure TSprite.Dibujar( Canvas: TCanvas );
begin
  Canvas.CopyMode := cmSrcAnd;
  Canvas.Draw( x, y, Mascara.Picture.Graphic )
  Canvas.CopyMode := cmSrcPaint;
  Canvas.Draw( x, y, Imagen.Picture.Graphic );}
end;

El único parámetro que tiene es el Canvas sobre el que se va a dibujar el sprite. Primero utilizamos la máscara para limpiar el terreno y después dibujamos el sprite sin el fondo. Vamos a ver como utilizar nuestra clase para dibujar un sprite en el formulario:

procedure TFormulario.DibujarCoche;
var
  Sprite: TSprite;
begin
  Sprite := TSprite.Create;
  Sprite.x := 100;
  Sprite.y := 100;
  Sprite.Cargar( ExtractFilePath( Application.ExeName ) + 'sprite.bmp' );
  Sprite.Dibujar( Canvas );
  Sprite.Free;
end;

Este sería el resultado en el formulario:


Si el sprite lo vamos a dibujar muchas veces no es necesario crearlo y destruirlo cada vez. Deberíamos crearlo en el evento OnCreate del formulario y en su evento OnDestroy liberarlo (Sprite.Free).

En el próximo artículo veremos como mover el sprite en pantalla utilizando una técnica de doble buffer para evitar parpadeos en el movimiento.

Pruebas realizadas en Delphi 7.

Dibujando con la clase TCanvas (y III)

Vamos a terminar de ver lo más importante de las operaciones que se pueden realizar con el objeto Canvas.

DIBUJAR UN RECTANGULO SIN FONDO

El procedimiento FrameRect permite crear rectángulos sin fondo teniendo en cuenta el valor de la propiedad Brush:

procedure FrameRect( const Rect: TRect );

Veamos un ejemplo:

with Canvas do
begin
  R.Left := 300;
  R.Top := 250;
  R.Right := 350;
  R.Bottom := 300;
  Brush.Color := clGreen;
  FrameRect( R );
end;

Este sería el dibujo resultante:


COMO COPIAR IMAGENES DE UN BITMAP A OTRO

La manera más utilizada de copiar imágenes es mediante el método Draw:

procedure Draw( X, Y: Integer; Graphic: TGraphic );

Vamos a ver un ejemplo de como copiar la imagen de un objeto de la clase TImage a nuestro formulario utilizando el procedimiento Draw:

var
R: TRect;
begin
  with Canvas do
  begin
    R.Left := 300;
    R.Top := 250;
    R.Right := 350;
    R.Bottom := 300;
    Brush.Color := clGreen;
    FrameRect( R );
    Draw( 100, 100, Imagen.Picture.Graphic );
  end;
end;

Hemos supuesto que el objeto de la clase TImage se llama Imagen. Este sería el resultado:


La imagen copiada consta de cuatro iconos y un fondo de color blanco. Otra cosa que podemos hacer es modificar el tamaño de la imagen a copiar utilizando el procedimiento:

procedure StretchDraw( const Rect: TRect; Graphic: TGraphic );

El parámetro Rect determina las nuevas coordenadas así como en ancho y alto de la imagen a copiar. En el siguiente ejemplo voy a copiar la misma imagen pero voy a reducirla un tamaño de 100x100:

var
  R: TRect;
begin
  with Canvas do
  begin
    R.Left := 100;
    R.Top := 100;
    R.Right := 200;
    R.Bottom := 200;
    StretchDraw( R, Imagen.Picture.Graphic );
  end;
end;

Quedaría de la siguiente manera:


También se pueden copiar imágenes utilizando el procedimiento:

procedure CopyRect( const Dest: TRect; Canvas: TCanvas; const Source: TRect );

cuyos parámetros son:

Dest: Coordenadas del rectángulo destino.
Canvas: Referencia al Canvas del origen a copiar.
Source: Coordenadas del rectángulo origen.

Para el ejemplo anterior voy a copiar la imagen en su tamaño original al formulario:

var
  Origen, Destino: TRect;
begin
  with Canvas do
  begin
    Origen.Left := 0;
    Origen.Top := 0;
    Origen.Right := Imagen.Picture.Width;
    Origen.Bottom := Imagen.Picture.Height;
    Destino.Left := 100;
    Destino.Top := 100;
    Destino.Right := 100 + Imagen.Width;
    Destino.Bottom := 100 + Imagen.Height;
    CopyRect( Destino, Imagen.Canvas, Origen );
  end;
end;

Entonces, ¿que diferencia hay entre Draw o StretchDraw y CopyRect? La diferencia es que CopyRect sólo puede utilizarse cuando el objeto TImage ha cargado un bitmap (*.BMP) porque si es un JPG provoca una excepción. En cambio las funciones Draw o StretchDraw siempre funcionan independientemente del tipo de imagen que sea.

LOS MODOS DE COPIA DE UNA IMAGEN

En principio cuando se realiza la copia de una imagen a otra, la copia de los pixels es exacta. Pero si queremos modificar el modo de copiar entonces la clase TCanvas tiene de la propiedad CopyMode que establece que tipo de operación que se va a realizar. Estos son sus posibles valores:

cmBlackness: pinta la imagen destino de color negro, independientemente del origen.

cmDstInvert: Invierte los colores de la imagen según la imagen destino.

cmMergeCopy: mezcla la imagen origen y destino utilizando el operador binario AND.

cmMergePaint: mezcla la imagen origen y destino utilizando el operador binario OR.

cmNotSrcCopy: copia la imagen origen invertida a la imagen destino.

cmNotSrcErase: mezcla las imagenes origen y destino y después las invierte con el operador binario OR.

cmPatCopy: copia la imagen según el valor de la propiedad Brush.Style del Canvas.

cmPatInvert: copia la imagen invertida según el valor de la propiedad Brush.Style del Canvas.

cmPatPaint: combina las imágenes origen y destino utilizando la operación binaria OR para luego invertirlas.

cmSrcAnd: combina la imagen origen con la imagen destino utilizando el operador binario AND.

cmSrcCopy: realiza una copia exacta de la imagen origen a la imagen destino (por defecto).

cmSrcErase: invierte la imagen destino y copia el origen utilizando el operador binario AND.

cmSrcInvert: invierte las imágenes origen y destino utilizando el operador binario XOR.

cmSrcPaint: combina las imágenes destino y origen utilizando el operador binario AND.

cmWhiteness: pinta toda la imagen destino de color blanco ignorando la imagen origen.

Por ejemplo voy a crear un efecto fantasma con la imagen origen:

with Canvas do
begin
  CopyMode := cmMergePaint;
  Draw( 100, 100, Imagen.Picture.Graphic );
end;

El efecto sería el siguiente:


COMO ACCEDER A LOS PIXELS DE LA IMAGEN

Si no son suficientes las operaciones que podemos realizar en una imagen también podemos acceder directamente a los pixels de una imagen a traves de su propiedad Pixels:

property Pixels[ X, Y: Integer ]: TColor;

Esta propiedad nos sirve igualmente para leer y para escribir pixels en la imagen. El componente TColor es un tipo entero de 32 bits definido en la unidad Graphics del siguiente modo:

type
 TColor = -$7FFFFFFF-1..$7FFFFFFF;

Dentro del mismo número entero están definidos los colores básicos RGB los
cuales son:

R = Red (Rojo)
G = Green (Verde)
B = Blue (Azul)

Combinando estos tres colores se puede crear cualquier otro color. Estos colores estan dentro del valor TColor del siguiento modo:

$00GGBBRR

Donde GG es el byte en hexadecimal que representa el color verde, BB es el color azul y RR es el color rojo. Aquí tenemos unos ejemplos de los números en hexadecimal:

Rojo   := $000000FF;
Azul   := $0000FF00;
Verde  := $00FF0000;
Blanco := $00FFFFFF;
Negro  := $00000000;

Para no complicarnos mucho la vida Delphi ya dispone de colores predeterminados tales como clRed (Rojo), clBlue (Azul), etc. Sabiendo esto imaginaos que deseo hacer un programa que convierta todos los colores blancos de la imagen en amarillo:

var
  i, j: Integer;
begin
  with Canvas do
  for j := 0 to ClientHeight - 1 do
    for i := 0 to ClientWidth - 1 do
      if Pixels[i,j] = clWhite then
        Pixels[i,j] := clYellow;
end;

Mediante un doble bucle recorro toda la imagen y compruebo si el pixel donde estoy es blanco para sustituirlo por el amarillo. Este sería el resultado:


Con este método se podemos realizar nuestros propios filtros o crear cualquier tipo de efecto.

Con esto finalizamos el apartado dedicado al objeto Canvas.

Pruebas realizadas en Delphi 7.

Dibujando con la clase TCanvas (II)

Una vez que ya sabemos como dibujar las figuras básicas con el objeto Canvas pasemos ahora a ver algunas más complicadas.


DIBUJAR UN POLIGONO SOLO CON LINEAS

Para dibujar un polígono transparente utilizando líneas tenemos el procedimiento:

procedure Polyline( Points: array of TPoint );

Funciona exactamente igual que el procedimiento Polygon salvo que no cierra el polígono automáticamente, es decir, el último punto y el primero tiene que ser el mismo (para crear el polígono, aunque puede realizarse cualquier otra figura). Este procedimiento es equivalente a crear un trazado de líneas utilizando el procedimiento LineTo. Veamos un ejemplo:

with Canvas do
begin
  Pen.Color := clBlack;
  SetLength( Puntos, 4 );
  Puntos[0].x := 200;
  Puntos[0].y := 250;
  Puntos[1].x := 250;
  Puntos[1].y := 300;
  Puntos[2].x := 150;
  Puntos[2].y := 300;
  Puntos[3].x := 200;
  Puntos[3].y := 250;
  PolyLine( Puntos );
end;

Este sería el resultado:


DIBUJAR POLIGONOS BEZIER

Los polígonos de Bezier se dibujan trazando curvas entre todos los puntos del polígono, es decir, son polígonos con las esquinas muy redondeadas. El procedimiento para dibujarlos es el siguiente:

with Canvas do
begin
  Pen.Color := clBlack;
  SetLength( Puntos, 4 );
  Puntos[0].x := 80;
  Puntos[0].y := 250;
  Puntos[1].x := 150;
  Puntos[1].y := 300;
  Puntos[2].x := 10;
  Puntos[2].y := 300;
  Puntos[3].x := 80;
  Puntos[3].y := 250;
  PolyBezier( Puntos );
end;

Este sería el resultado:


Aunque he dado las mismas coordenadas que un triángulo, tiene las esquinas inferiores redondeadas.

ESCRIBIENDO TEXTO

Para escribir texto encima de una imagen con la clase TCanvas tenemos el método:

procedure TextOut( X, Y: Integer; const Text: string );

Este método toma como parámetros las coordenadas donde va a comenzar a escribirse el texto y el texto a escribir. Por ejemplo:

with Canvas do
begin
  TextOut( 10, 10, 'Escribiendo texto mediante el Canvas del formulario' );
end;

Al no especificar fuente ni color quedaría del siguiente modo:


Cuando se escribe texto en un formulario la fuente, el color del texto y el color del fondo vienen predeterminados por las propiedades Brush y Font del Canvas. Supongamos que quiero escribir texto con fuente Tahoma, negrita, 10 y de color azul con fondo transparente:

with Canvas do
begin
  Brush.Style := bsClear;
  Font.Color := clBlue;
  Font.Name := 'Tahoma';
  Font.Size := 10;
  TextOut( 200, 50, 'Otro texto de prueba' );
end;

Aquí tenemos nuestro texto personalizado:


Pero nos puede surgir un pequeño problema. ¿Como podemos averiguar lo que va a ocupar en pixels el texto que vamos a escribir? Pues para ello tenemos la siguiente función:

function TextWidth( const Text: string ): Integer;

Nos devuelve el ancho en pixels del texto que le pasamos como parámetro según como esté la propiedad Font antes de llamar a esta función. Y si queremos saber su altura entonces tenemos esta otra función:

function TextHeight( const Text: string ): Integer;

Lo que afecta a esta función principalmente es la propiedad Font.Size del Canvas. También tenemos esta otra función para obtener simultáneamente el ancho y alto del texto a escribir:

function TextExtent( const Text: string ): TSize;

Donde TSize es una estructura definida en la unidad Types del siguiente modo:

type
  tagSIZE = packed record
    cx: Longint;
    cy: Longint;
  end;
TSize = tagSIZE;

COMO RELLENAR LAS FIGURAS DE UN COLOR

Todos los programas de dibujo incorporan la función de rellenar con pintura una imagen hasta que encuentre bordes. Es como volcar un bote de pintura sobre las superficie hasta que choque con algo. El Canvas del formulario dispone del procedimiento:

procedure FloodFill( X, Y: Integer; Color: TColor; FillStyle: TFillStyle );

Los parámetros X, Y especifican donde se va a comenzar a pintar, el parámetro Color establece el color del borde donde va a chocar la pintura y FillStyle define el modo de pintar. Veamos un ejemplo de cómo pintar un triángulo de rojo con bordes negros:

with Canvas do
begin
  Brush.Color := clRed;
  FloodFill( 200, 270, clBlack, fsBorder );
end;

El último parámetro (FillStyle) se utiliza para decirle a la función si queremos que pinte hasta el borde de un color en concreto (clBlack y fsBorder) o si deseamos que dibuje toda la superficie de un color hasta que encuentre un color distinto. Por ejemplo:

with Canvas do
begin
  Brush.Color := clRed;
  FloodFill( 200, 270, clSilver, fsSurface );
end;

En este caso le he dicho que me pinte de rojo toda la superficie cuyo fondo es de color clSilver. Si encuentra un color que no sea clSilver entonces se para. Esa es la diferencia entre los valores fsBorder (un sólo borde) y fsSurface (cualquier borde pero la misma superficie). En ambos ejemplos he rellenado de color rojo el polígono creado al principio de este artículo:


En el próximo artículo terminaremos de ver las propiedades de la clase TCanvas.

Pruebas realizadas en Delphi 7.

Dibujando con la clase TCanvas (I)

La unidad Graphics dispone de la clase TCanvas dedicada al dibujo de objetos sobre la superficie de un control visual. Los controles estándar de Windows tales como Edit o Listbox no requieren canvas, ya que son dibujados por el sistema operativo.


Un objeto Canvas proporciona propiedades, métodos y eventos para realizar tareas como pueden ser:

- Escribir texto especificando fuente, color y estilo.

- Copiar imágenes de una superficie a otra.

- Dibujar líneas, rectángulos y circulos con distintos patrones de color y estilo.

- Leer y modificar cada pixel de la imagen dibujada.

COMO DIBUJAR UN RECTANGULO

Antes de dibujar una figura se pueden seleccionar los colores del margen y de fondo. Supongamos que quiero hacer un rectángulo con un marco de 3 pixels de ancho y de color rojo. El fondo va a ser de color azul. Para ello nos vamos al evento OnPaint del formulario y escribimos lo siguiente:

procedure TFormulario.FormPaint( Sender: TObject );
begin
  with Canvas do
  begin
    Pen.Color := clRed;
    Pen.Width := 3;
    Brush.Color := clBlue;
    Rectangle( 10, 10, 110, 110 );
  end;
end;

El resultado es el siguiente:


Hemos utilizado la propiedad Pen para seleccionar el color del marco y su ancho. Con la propiedad Brush establecemos el color de fondo del rectángulo. Y mediante el procedimiento Rectangle hemos dibujado un rectángulo en la posición x = 10 e y = 10 teniendo un ancho y alto de 100x100. El procedimiento Rectangle tiene los siguientes parámetros:

procedure Rectangle( X1, Y1, X2, Y2: Integer );
procedure Rectangle( const Rect: TRect );

X1, Y1 -> Son las coordenadas de la esquina superior izquierda del rectángulo
X2, Y2 -> Son las coordenadas de la esquina inferior derecha del rectángulo

También se podría haber utilizado la estructura de datos TRect (rectángulo) para dibujar el rectángulo del siguiente modo:

var
  R: TRect;
begin
  with Canvas do
  begin
    Pen.Color := clRed;
    Pen.Width := 3;
    Brush.Color := clBlue;
    R.Left := 10;
    R.Top := 10;
    R.Right := 110;
    R.Bottom := 110;
    Rectangle( R );
  end;
end;

La estructura TRect esta definida dentro de la unidad Type del siguiente modo:

TRect = packed record
  case Integer of
    0: (Left, Top, Right, Bottom: Integer);
    1: (TopLeft, BottomRight: TPoint);
  end;

donde los valores Left y Top determinan la posición superior izquierda del rectángulo y los valores Right y Bottom la esquina inferior derecha.

También existe otro procedimiento para hacer rectángulos sólo con fondo (sin borde) utilizando el procedimiento:

procedure FillRect( const Rect: TRect );

Si lo hubiésemos utilizado este procedimiento sólo tendríamos un rectángulo con fondo azul. Lo único que tiene en cuenta es la propiedad Brush ignorando el valor de Pen.

Para el caso anterior no es necesario utilizar la estructura TRect, pero si se van a dibujar muchos rectángulos utilizando las mismas rutinas si es interesante utilizarla, evitándonos el tener que declarar las variables x1, y1, x2, y2 para las coordenadas. La estructura TRect es de uso general y no tiene porque estar asociada sólo al dibujo de rectángulos como veremos más adelante.

Las propiedades Pen y Brush son permantentes, es decir, que mientras no se modifiquen todo lo que se dibuje posteriormente tendrá los colores y estilo especificado por ambas. Si las figuras que se van a dibujar tienen mismo color de borde y fondo no es necesario especificar de nuevo el valor de Pen y Brush.

DIBUJANDO UN RECTANGULO CON ESQUINAS REDONDEADAS

Mediante el método RoundRect se pueden crear rectángulos con esquinas suavizadas. Veamos un ejemplo:

with Canvas do
begin
  Pen.Color := clGray;
  Pen.Width := 3;
  Brush.Color := clWhite;
  RoundRect( 300, 150, 380, 200, 30, 30 );
end;

Cuyo resultado sería:

El procedimiento RoundRect tiene los siguientes parámetros:

procedure RoundRect( X1, Y1, X2, Y2, X3, Y3: Integer );

donde:

X1, Y1 -> Son las coordenadas de la esquina superior izquierda
X2, Y2 -> Son las coordenadas de la esquina inferior derecha
X3, Y3 -> Es grado de redondeo de las esquinas (cuanto más grande más redondeado)

COMO DIBUJAR UN CIRCULO

Para dibujar un círculo se utiliza el procedimiento Ellipse. Vamos a dibujar un círculo con un borde de color azul oscuro y un fondo de color amarillo:

with Canvas do
begin
  Pen.Color := clNavy;
  Pen.Width := 5;
  Brush.Color := clYellow;
  Brush.Style := bsDiagCross;
  Ellipse( 160, 10, 260, 110 );
end;

Quedaría así:


A la propiedad Brush le he especificado que me dibuje el fondo amarillo utilizando un patrón de líneas cruzadas diagonales. Al igual que el procedimiento Rectangle, el procedimiento Ellipse utiliza los mismos parámetros:

procedure Ellipse( X1, Y1, X2, Y2: Integer );
procedure Ellipse( const Rect: TRect );

En este otro ejemplo voy a dibujar un círculo chafado horizontalmente (una elipse) con un borde de 1 pixel de color blanco y un fondo gris:

with Canvas do
begin
  Pen.Color := clWhite;
  Pen.Width := 1;
  Brush.Color := clGray;
  Brush.Style := bsSolid;
  Ellipse( 300, 10, 330, 110 );
end;

Este sería el resultado:


He tenido que volver a dejar la propiedad Style del Brush con el valor bsSolid para que vuelva a dibujarme el fondo sólido porque sino me lo hubiera hecho con líneas cruzadas como lo dejé anteriormente.

COMO DIBUJAR LINEAS

La clase TCanvas dispone de un puntero invisible donde dibujará las líneas si no se especifica posición. Para modificar la posición de dicho puntero existe el método MoveTo:

procedure MoveTo( X, Y: Integer );

Si queremos averiguar donde se ha quedado el puntero disponemos de la propiedad PenPos que es de tipo TPoint:

type TPoint = packed record
  X: Longint;
  Y: Longint;
end;

Al igual que la estructura de datos TRect está definida en la unidad Types. Veamos como realizar un triángulo de color negro y sin fondo:

with Canvas do
begin
  Pen.Color := clBlack;
  Pen.Width := 3;
  MoveTo( 50, 150 );
  LineTo( 100, 220 );
  LineTo( 10, 220 );
  LineTo( 50, 150 );
end;

El triángulo quedaría así:

Hemos situado el puntero en un punto y a partir de ahí hemos ido tranzando líneas hasta cerrar el triángulo. En este caso la propiedad Brush no tiene ningún valor para el procedimiento LineTo.

COMO DIBUJAR POLIGONOS

El triángulo que hemos hecho anteriormente también podría haberse realizado mediante un polígono. Además los polígonos permiten especificar el color de fondo mediante la propiedad Brush. Por ejemplo vamos a crear un triángulo con un borde amarillo y fondo de color verde:

var
  Puntos: array of TPoint;
begin
  with Canvas do 
  begin
    Pen.Color := clYellow;
    Pen.Width := 3;
    Brush.Color := clGreen;
    SetLength( Puntos, 3 );
    Puntos[0].x := 150;
    Puntos[0].y := 150;
    Puntos[1].x := 250;
    Puntos[1].y := 200;
    Puntos[2].x := 150;
    Puntos[2].y := 200;
    Polygon( Puntos );
  end;
end;

Quedaría así:


He creado un array dinámico del tipo TPoint con una longitud de 3. Después he ido especificando cada punto del polígono (en este caso un triángulo) y por último le paso dicho array al procedimiento Polygon.

En el próximo artículo seguiremos exprimiendo las características del Canvas.

Pruebas realizadas en Delphi 7.

Aplicar antialiasing a una imagen

El algoritmo antialiasing se suele aplicar a una imagen para evitar los bordes dentados y los degradados bruscos de color. Lo que hace es suavizar toda la imagen.

En este caso el siguiente procedimiento toma un objeto TImage como primer parámetro y como segundo el porcentaje de antialiasing deseado, siendo normal no aplicar más del 10 o 20%:

procedure Antialiasing( Imagen: TImage; iPorcentaje: Integer );
type
  TRGBTripleArray = array[0..32767] of TRGBTriple;
  PRGBTripleArray = ^TRGBTripleArray;
var
  SL, SL2: PRGBTripleArray;
  l, m, p: Integer;
  R, G, B: TColor;
  R1, R2, G1, G2, B1, B2: Byte;
begin
  with Imagen.Canvas do
  begin
    Brush.Style  := bsClear;
    Pixels[1, 1] := Pixels[1, 1];

    for l := 0 to Imagen.Height - 1 do
    begin
      SL := Imagen.Picture.Bitmap.ScanLine[l];

      for p := 1 to Imagen.Width - 1 do
      begin
        R1 := SL[p].rgbtRed;
        G1 := SL[p].rgbtGreen;
        B1 := SL[p].rgbtBlue;

        if (p < 1) then
          m := Imagen.Width
        else
          m := p - 1;

        R2 := SL[m].rgbtRed;
        G2 := SL[m].rgbtGreen;
        B2 := SL[m].rgbtBlue;
       
        if ( R1 <> R2 ) or ( G1 <> G2 ) or ( B1 <> B2 ) then
        begin
          R := Round( R1 + ( R2 - R1 ) * 50 / ( iPorcentaje + 50 ) );
          G := Round( G1 + ( G2 - G1 ) * 50 / ( iPorcentaje + 50 ) );
          B := Round( B1 + ( B2 - B1 ) * 50 / ( iPorcentaje + 50 ) );
          SL[m].rgbtRed := R;
          SL[m].rgbtGreen := G;
          SL[m].rgbtBlue := B;
        end;

        if ( p > Imagen.Width - 2 ) then
          m := 0
        else
          m := p + 1;

        R2 := SL[m].rgbtRed;
        G2 := SL[m].rgbtGreen;
        B2 := SL[m].rgbtBlue;

        if ( R1 <> R2 ) or ( G1 <> G2 ) or ( B1 <> B2 ) then
        begin
          R := Round( R1 + ( R2 - R1 ) * 50 / ( iPorcentaje + 50 ) );
          G := Round( G1 + ( G2 - G1 ) * 50 / ( iPorcentaje + 50 ) );
          B := Round( B1 + ( B2 - B1 ) * 50 / ( iPorcentaje + 50 ) );
          SL[m].rgbtRed := R;
          SL[m].rgbtGreen := G;
          SL[m].rgbtBlue := B;
        end;

        if ( l < 1 ) then
          m := Imagen.Height - 1
        else
          m := l - 1;

        SL2 := Imagen.Picture.Bitmap.ScanLine[m];
        R2  := SL2[p].rgbtRed;
        G2  := SL2[p].rgbtGreen;
        B2  := SL2[p].rgbtBlue;

        if ( R1 <> R2 ) or ( G1 <> G2 ) or ( B1 <> B2 ) then
        begin
          R := Round( R1 + ( R2 - R1 ) * 50 / ( iPorcentaje + 50 ) );
          G := Round( G1 + ( G2 - G1 ) * 50 / ( iPorcentaje + 50 ) );
          B := Round( B1 + ( B2 - B1 ) * 50 / ( iPorcentaje + 50 ) );
          SL2[p].rgbtRed := R;
          SL2[p].rgbtGreen := G;
          SL2[p].rgbtBlue := B;
        end;

        if ( l > Imagen.Height - 2 ) then
          m := 0
        else
          m := l + 1;

        SL2 := Imagen.Picture.Bitmap.ScanLine[m];
        R2  := SL2[p].rgbtRed;
        G2  := SL2[p].rgbtGreen;
        B2  := SL2[p].rgbtBlue;

        if ( R1 <> R2 ) or ( G1 <> G2 ) or ( B1 <> B2 ) then
        begin
          R := Round( R1 + ( R2 - R1 ) * 50 / ( iPorcentaje + 50 ) );
          G := Round( G1 + ( G2 - G1 ) * 50 / ( iPorcentaje + 50 ) );
          B := Round( B1 + ( B2 - B1 ) * 50 / ( iPorcentaje + 50 ) );
          SL2[p].rgbtRed := R;
          SL2[p].rgbtGreen := G;
          SL2[p].rgbtBlue := B;
        end;
      end;
    end;
  end;
end;

Suponiendo que tengamos en un formulario un objeto TImage llamado Image1 llamaríamos a este procedimiento de la siguiente manera:

  Antialiasing( Image1, 10 );

Pruebas realizadas en Delphi 7.

Leer las dimensiones de imágenes JPG, PNG y GIF

Si estáis pensando en crear un visor de fotografías aquí os traigo tres procedimientos que leen al ancho y alto de imagenes con extensión JPG, PNG y GIF leyendo los bytes de su cabecera. No hay para BMP ya que se puede hacer con un componente TImage.

Antes de nada hay que incluir una función que lee los enteros almacenados en formato del procesador motorola, que guarda los formatos enteros en memoria al contrario de los procesadores Intel/AMD:

function LeerPalabraMotorola( F: TFileStream ): Word;
type
  TPalabraMotorola = record
    case Byte of
      0: ( Value: Word );
      1: ( Byte1, Byte2: Byte );
  end;
var
  MW: TPalabraMotorola;
begin
  F.Read( MW.Byte2, SizeOf( Byte ) );
  F.Read( MW.Byte1, SizeOf( Byte ) );
  Result := MW.Value;
end;

El siguiente procedimiento toma como parámetros la ruta y nombre de una imagen JPG, y dos variales enteras donde se almacenará el ancho y alto de la imagen:

procedure DimensionJPG( sArchivo: string; var wAncho, wAlto: Word );
const
  ValidSig: array[0..1] of Byte = ($FF, $D8);
  Parameterless = [$01, $D0, $D1, $D2, $D3, $D4, $D5, $D6, $D7];
var
  Sig: array[0..1] of byte;
  F: TFileStream;
  x: integer;
  Seg: byte;
  Dummy: array[0..15] of byte;
  Len: word;
  iLongitudLinea: LongInt;
begin
  FillChar( Sig, SizeOf( Sig ), #0 );

  F := TFileStream.Create( sArchivo, fmOpenRead );
  try
    iLongitudLinea := F.Read( Sig[0], SizeOf( Sig ) );

    for x := Low( Sig ) to High( Sig ) do
      if Sig[x] <> ValidSig[x] then
        iLongitudLinea := 0;

    if iLongitudLinea > 0 then
    begin
      iLongitudLinea := F.Read( Seg, 1 );

      while ( Seg = $FF ) and ( iLongitudLinea > 0 ) do
      begin
        iLongitudLinea := F.Read( Seg, 1 );

        if Seg <> $FF then
        begin
          if ( Seg = $C0 ) or ( Seg = $C1 ) then
          begin
            iLongitudLinea := F.Read( Dummy[0], 3 ); // Nos saltamos estos bytes
            wAlto := LeerPalabraMotorola( F );
            wAncho  := LeerPalabraMotorola( F );
          end
          else
          begin
            if not ( Seg in Parameterless ) then
            begin
              Len := LeerPalabraMotorola( F );
              F.Seek( Len - 2, 1 );
              F.read( Seg, 1 );
            end
            else
              Seg := $FF; { Fake it to keep looping. }
          end;
        end;
      end;
    end;
  finally
    F.Free;
  end;
end;

Lo mismo para una imagen PNG:

procedure DimensionPNG( sArchivo: string; var wAncho, wAlto: Word );
type
  TPNGSig = array[0..7] of Byte;
const
  ValidSig: TPNGSig = (137,80,78,71,13,10,26,10);
var
  Sig: TPNGSig;
  F: TFileStream;
  x: Integer;
begin
  FillChar( Sig, SizeOf( Sig ), #0 );
  F := TFileStream.Create( sArchivo, fmOpenRead );
  try
    F.read( Sig[0], SizeOf( Sig ) );

    for x := Low( Sig ) to High( Sig ) do
      if Sig[x] <> ValidSig[x] then
        Exit;

    F.Seek( 18, 0 );
    wAncho := LeerPalabraMotorola( F );
    F.Seek( 22, 0 );
    wAlto := LeerPalabraMotorola( F );
  finally
    F.Free;
  end;
end;

Y para una imagen GIF:

procedure DimensionGIF( sArchivo: string; var wAncho, wAlto: Word );
type
  TCabeceraGIF = record
    Sig: array[0..5] of char;
    ScreenWidth, ScreenHeight: Word;
    Flags, Background, Aspect: Byte;
  end;

  TBloqueImagenGIF = record
    Left, Top, Width, Height: Word;
    Flags: Byte;
  end;
var
  F: file;
  Cabecera: TCabeceraGIF;
  BloqueImagen: TBloqueImagenGIF;
  iResultado: Integer;
  x: Integer;
  c: char;
  bEncontradasDimensiones: Boolean;
begin
  wAncho  := 0;
  wAlto := 0;

  if sArchivo = '' then
    Exit;

  {$I-}
  FileMode := 0;   // Sólo lectura
  AssignFile( F, sArchivo );
  Reset( F, 1);
  if IOResult <> 0 then
    Exit;

  // Lee la cabecera y se asegura de que sea un archivo válido
  BlockRead( F, Cabecera, SizeOf( TCabeceraGIF ), iResultado );

  if ( iResultado <> SizeOf( TCabeceraGIF ) ) or ( IOResult <> 0 ) or
     ( StrLComp( 'GIF', Cabecera.Sig, 3 ) <> 0 ) then
  begin
    Close( F );
    Exit;
  end;

  { Skip color map, if there is one }
  if ( Cabecera.Flags and $80 ) > 0 then
  begin
    x := 3 * ( 1 shl ( ( Cabecera.Flags and 7 ) + 1 ) );
    Seek( F, x );
    if IOResult <> 0 then
    begin
      Close( F );
      Exit;
    end;
  end;

  bEncontradasDimensiones := False;
  FillChar( BloqueImagen, SizeOf( TBloqueImagenGIF ), #0 );

  BlockRead( F, c, 1, iResultado );
  while ( not EOF( F ) ) and ( not bEncontradasDimensiones ) do
  begin
    case c of
      ',': // Encontrada imagen
        begin
          BlockRead( F, BloqueImagen, SizeOf( TBloqueImagenGIF ), iResultado );
          if iResultado <> SizeOf( TBloqueImagenGIF ) then
          begin
            Close( F );
            Exit;
          end;

          wAncho := BloqueImagen.Width;
          wAlto := BloqueImagen.Height;
          bEncontradasDimensiones := True;
        end;
       
      'ÿ': // esquivar esto
        begin
          // Nada
        end;

      // No hacer nada, ignorar
    end;

    BlockRead( F, c, 1, iResultado );
  end;

  Close( F );
  {$I+}
end;

Así no será necesario cargar toda la imagen para averiguar sus dimensiones.

Pruebas realizadas en Delphi 7.

Convertir un icono en imagen BMP

Aunque hay cientos de librerías de iconos por la red que suele utilizar todo el mundo para sus programas, lo ideal sería diseñar nuestros propios iconos utilizando como plantilla los que hay por Internet.

Se que hay decenas de programas de diseño que convierten entre distintos formatos, pero lo ideal sería tener nuestro propio conversor. Para ello tenemos el siguiente procedimiento que convierte un archivo ICO en una imagen BMP para que luego podamos utilizarla en nuestras aplicaciones:

procedure ConvertirImagen( sIcono, sBMP: String );
var
  Bitmap: TBitmap;
  Imagen: TImage;
begin
  Imagen := TImage.Create( nil );
  Imagen.Picture.LoadFromFile( sIcono );
  Bitmap := TBitMap.Create;

  with Bitmap do
  begin
    PixelFormat := pf24bit;
    Height := Application.Icon.Height;
    Width := Application.Icon.Width;
    Canvas.Draw( 0, 0, Imagen.Picture.Graphic );
  end;

  Bitmap.SavetoFile( sBMP );

  Imagen.Free;
end;

El primer parámetro es el icono y el segundo la imagen BMP resultante. Lo que hace el procedimiento es cargar el icono en un objeto TImage, para después copiar su contenido en un bitmap antes de guardarlo en un archivo.

Pruebas realizadas en Delphi 7.

Obtener modos de video

A la hora de realizar un programa hay que tener muy presente la resolución de la pantalla y el área de trabajo donde se pueden colocar las ventanas.

Para ello tenemos el objeto TScreen que nos devuelve no sólo la resolución actual de video sino que además nos da el tamaño del escritorio y el área de trabajo del mismo (si esta fija la barra de tareas hay que respetar su espacio y procurar que nuestra ventana no se superponga a la misma).

Si utilizamos las propiedades Position o WindowsState del formulario no hay que preocuparse por esto, pero si hemos creado nuestra propia piel y pasamos de las ventanas normales de Windows hay que andarse con ojo y no dejar que el usuario se crea que ha desaparecido la barra de tareas.

El siguiente procedimiento vuelca la información de la pantalla actual en un objeto Memo llamado PANTALLA:

procedure TFInformacion.InfoPantalla;
begin
  PANTALLA.Lines.Clear;
  PANTALLA.Lines.Add( Format( 'Resolución: %dx%d ', [Screen.Width, Screen.Height] ) );
  PANTALLA.Lines.Add( Format( 'Escritorio: x: %d y: %d Ancho: %d Alto: %d',
                      [Screen.DesktopLeft, Screen.DesktopTop, Screen.DesktopWidth, Screen.DesktopHeight] ) );
  PANTALLA.Lines.Add( Format( 'Area de trabajo: x: %d y: %d Ancho: %d Alto: %d',
                      [Screen.WorkAreaLeft, Screen.WorkAreaTop, Screen.WorkAreaWidth, Screen.WorkAreaHeight] ) );
end;

Otra información interesante sería saber que resoluciones posibles tiene nuestra tarjeta de video. Vamos a mostrar todos los modos de video posible en un ListBox llamado MODOS:

procedure TFInformacion.InfoModosVideo;
var i: Integer;
    ModoVideo: TDevMode;
begin
  i := 0;
  MODOS.Clear;
  while EnumDisplaySettings( nil, i, ModoVideo ) do
  begin
    with ModoVideo do
      MODOS.Items.Add(Format( '%dx%d %d Colores', [dmPelsWidth, dmPelsHeight, Int64(1) shl dmBitsperPel] ) );

    Inc( i );
  end;
end;

Esta es la típica información que suelen mostrar los programas tipo TuneUp.

Pruebas realizadas en Delphi 7.

Formularios transparentes

Si estais hartos de que vuestros formularios tengan el mismo aspecto soso de siempre podeis crear nuevos temas y skins tales como los reproductores BSPlayer, WinDVD, PowerDVD, etc.

Para ello tenemos aquí un procedimiento que toma como parámetro un formulario y que hará que todo su fondo sea transparente. Si queremos que algo no sea transparente lo ponemos dentro de un bitmap, shape o panel.

procedure TransparentarFormulario( Form: TForm );
var
  Region, RegionTemp: HRGN;
  i: Integer;
  Rect: TRect;
begin
  Region := 0;

  for i := 0 to Form.ControlCount - 1 do
  begin
    Rect := Form.Controls[i].BoundsRect;
    OffsetRect( Rect, Form.ClientOrigin.x - Form.Left, Form.ClientOrigin.y - Form.Top );
    RegionTemp := CreateRectRgnIndirect( Rect );

    if Region = 0 then
      Region := RegionTemp
    else
    begin
      CombineRgn( Region, Region, RegionTemp, RGN_OR );
      DeleteObject( RegionTemp );
    end;
  end;

  RegionTemp := CreateRectRgn( 0, 0, Form.Width,
                               GetSystemMetrics( SM_CYCAPTION )+
                               GetSystemMetrics( SM_CYSIZEFRAME )+
                               GetSystemMetrics( SM_CYMENU ) * Ord( Form.Menu <> nil ) );

  CombineRgn( Region, Region, RegionTemp, RGN_OR );
  DeleteObject( RegionTemp );
  SetWindowRgn( Form.Handle, Region, True );
end;

Quitando los margenes de la ventana con BorderStyle = bsNone ya tenemos un formulario completamente transparente donde sólo hay que insertarle los objetos que van a ser visibles.

Pruebas realizadas en Delphi 7.

Capturar la pantalla de Windows

Vamos a crear un procedimiento que captura un trozo de la pantalla de Windows y la guarda en un bitmap:

procedure CapturarPantalla( x, y, iAncho, iAlto: Integer; Imagen: TBitmap );
var
  DC: HDC;
  lpPal : PLOGPALETTE;
begin
  if ( iAncho = 0 ) OR ( iAlto = 0 ) then
    Exit;

  Imagen.Width := iAncho;
  Imagen.Height := iAlto;
  DC := GetDc( 0 );

  if ( DC = 0 ) then
    Exit;

  if ( GetDeviceCaps( dc, RASTERCAPS) and  RC_PALETTE = RC_PALETTE ) then
  begin
    GetMem( lpPal, SizeOf( TLOGPALETTE ) + ( 255 * SizeOf( TPALETTEENTRY ) ) );
    FillChar( lpPal^, SizeOf( TLOGPALETTE ) + ( 255 * SizeOf( TPALETTEENTRY ) ), #0 );
    lpPal^.palVersion := $300;
    lpPal^.palNumEntries := GetSystemPaletteEntries( DC, 0, 256, lpPal^.palPalEntry );

    if (lpPal^.PalNumEntries <> 0) then
      Imagen.Palette := CreatePalette( lpPal^ );

    FreeMem( lpPal, SizeOf( TLOGPALETTE ) + ( 255 * SizeOf( TPALETTEENTRY ) ) );
  end;

  BitBlt( Imagen.Canvas.Handle, 0, 0, iAncho, iAlto, DC, x, y, SRCCOPY );
  ReleaseDc( 0, DC );
end;

Resumiendo a grandes rasgos lo que hace el procedimiento es crear un dispositivo de contexto donde según el número de bits por pixel reserva una zona de memoria para capturar el escritorio. Después mediante la función BitBlt vuelca la imagen capturada al Canvas de la imagen que le pasamos.

Para capturar toda la pantalla de Windows utilizando este procedimiento hacemos lo siguiente:

var Imagen: TBitmap;
begin
  Imagen := TBitmap.Create;
  CapturarPantalla( 0, 0, Screen.Width, Screen.Height, Imagen );
  Imagen.SaveToFile( ExtractFilePath( Application.ExeName ) + 'captura.bmp' );
  Imagen.Free;
end;

La pantalla capturada la guarda en el archivo captura.bmp al lado de nuestro ejecutable. Sólo faltaría el poder capturar una tecla de Windows desde cualquier aplicación para activar nuestro capturador de pantalla (para que no se capture a si mismo).

Pruebas realizadas en Delphi 7.

Efectos de animación en las ventanas

En este artículo explicaré de forma detallada cómo crear animaciones para las ventanas de delphi con los mismos efectos que disponen los sistemas operativos Windows, y aclararé cuándo aplicarlos y los problemas que tienen.

La función encargada de animar ventanas es la siguiente (api de windows):

AnimateWindow

Y los parámetros que la definen son los siguientes:

hWnd - Manejador o Handle de la ventana, a la cuál se aplica el efecto.
dwTime - Velocidad para reproducir el efecto. A más tiempo, más suave y con más lentitud es el efecto.
dwFlags - Parámetros que definen el tipo de efecto, la orientación y la activación de la ventana.
Se pueden combinar varios parámetros para conseguir efectos personalizados.

Dentro del parámetro dwFlags, se pueden realizar los efectos de animación que detallo:

Tipos de efectos

AW_SLIDE

Esta es una animación de deslizamiento. Este parámetro es ignorado si se utiliza la bandera AW_CENTER. De forma predeterminada, y si no se indica este parámetro, todas las ventanas utilizan el efecto de persiana, o enrollamiento.

AW_BLEND

Aplica un efecto de aparición gradual. Recuerde utilizar este parámetro si la ventana tiene prioridad sobre las demás. Este efecto sólo funciona con Windows 2000 y Windows XP.

AW_HIDE

Oculta la ventana, sin animación. Hay que combinar con otro parámetro para que la ocultación muestre animación. Por ejemplo con AW_SLIDE o AW_BLEND.

AW_CENTER

Este efecto provoca que la ventana aparezca desde el centro de la pantalla o escritorio. Para que funcione, debe ser combinado con el parámetro AW_HIDE para mostrar la ventana, o no utilizar AW_HIDE para ocultarla.

Orientación al mostrar u ocultar

AW_HOR_POSITIVE

Animar la ventana de izquierda a derecha. Este parámetro puede ser combinado con las animaciones de deslizamiento o persiana. Si utiliza AW_CENTER o AW_BLEND, no tendrá efecto.

AW_HOR_NEGATIVE

Animar la ventana de derecha a izquierda. Este parámetro puede ser combinado con las animaciones de deslizamiento o persiana. Si utiliza AW_CENTER o AW_BLEND, no tendrá efecto.

AW_VER_POSITIVE

Animar la ventana de arriba hacia abajo. Este parámetro puede ser combinado con las animaciones de deslizamiento o persiana. Si utiliza AW_CENTER o AW_BLEND, no tendrá efecto.

AW_VER_NEGATIVE

Animar la ventana de abajo hacia arriba. Este parámetro puede ser combinado con las animaciones de deslizamiento o persiana. Si utiliza AW_CENTER o AW_BLEND, no tendrá efecto.


Otros parámetros

AW_ACTIVATE

Este parámetro traspasa el foco de activación a la ventana antes de aplicar el efecto. Recomiendo utilizarlo, sobre todo cuando las ventanas contiene algún tema de Windows XP. No utilizar con la bandera AW_HIDE.


Utilizando la función en Delphi

¿En qué evento utilizar esta función?

Normalmente, y a nivel personal y por experiencias negativas, siempre la utilizo en el evento FormShow de la ventana a la cuál aplicar el efecto. Un ejemplo sería el siguiente:

procedure TFForm1.FormShow(Sender: TObject);
begin
  AnimateWindow( Handle, 400, AW_ACTIVATE or AW_SLIDE or AW_VER_POSITIVE );
end;

(Este efecto va mostrando la ventana de arriba hacia abajo con deslizamiento).


Problemas con los temas de Windows XP y las ventanas de Delphi

Naturalmente, no todo es una maravilla, y entre los problemas que pueden surgir al crear estos efectos, están los siguientes:

- Temas visuales de Windows XP:

Cuando un efecto de animación es mostrado, a veces ciertos controles de la ventana, cómo los TEdit, ComboBox, etc, no terminan de actualizarse, quedando con el aspecto antiguo de Windows 98. Para solucionar este problema, hay que escribir la función "RedrawWindow" a continuación de AnimateWindow:

procedure TFForm1.FormShow(Sender: TObject);
begin
  AnimateWindow( Handle, 400, AW_ACTIVATE or AW_SLIDE or AW_VER_POSITIVE );
  RedrawWindow( Handle, nil, 0, RDW_ERASE or RDW_FRAME or RDW_INVALIDATE or RDW_ALLCHILDREN );
end;

- Ocultando ventanas entre ventanas de Delphi:

Por un problema desconocido de delphi (por lo menos desconozco si Delphi 2006 lo hace), ocultar una ventana con animación, teniendo otras ventanas de delphi (de tu aplicación) detrás, produce un efecto de redibujado fatal, que desmerece totalmente el efecto realizado. Esto no pasa si las ventanas que aparecen detrás no son de Delphi, o de tu propia aplicación. Por ese motivo, personalmente nunca utilizo este efecto de ocultación de ventanas.

Últimos consejos

Por último, permitidme daros un consejo. Estos efectos también son válidos en Windows 2000, pero los efectos pueden no ser tan fluidos como en Windows XP. Por ello, no estaría mal que estos efectos sean una opción de configuración de vuestra aplicación, es decir, permitir al usuario activarlos o desactivarlos.

También recomiendo no abusar de estos efectos, al final terminan siendo un poco molestos. Realizarlos en las ventanas principales es mejor que en todas las ventanas.

Espero que el artículo sea de utilidad, y dé un toque de elegancia a vuestras aplicaciones.

Pruebas realizadas en Delphi 7.