BGRABitmap tutorial 3/es

│ Deutsch (de) │ English (en) │ español (es) │ français (fr) │

Home | Tutorial 1 | Tutorial 2 | Tutorial 3 | Tutorial 4 | Tutorial 5 | Tutorial 6 | Tutorial 7 | Tutorial 8 | Tutorial 9 | Tutorial 10 | Tutorial 11 | Tutorial 12 | Edit

Esta tutoría muestra como dibujar en un bitmap con el mouse.

Crear un nuevo proyecto

Crea un nuevo proyecto y añade referencia a BGRABitmap, de la misma forma que en la primer tutoría.

Crea una nueva imágen

Añade una variable privada a la forma principal para almacenar la imágen :

  TForm1 = class(TForm)
  private
    { private declarations }
    image: TBGRABitmap;
  public
    { public declarations }
  end;

Crea la imágen cuando la forma es creada. Para hacer esto, haz doble clic en la forma, un procedimiento debe aparecer en el editor de código. Añade la instrucción de creación :

procedure TForm1.FormCreate(Sender: TObject);
begin
  image := TBGRABitmap.Create(640,480,BGRAWhite);  //crea una imágen de 640x480
end;

Dibuja el bitmap

Añade un manejador OnPaint. Para hacer esto, selecciona la forma principal, luego ve al inspector de objetos, en la pestaña de eventos haz doble clic en la línea OnPaint. Luego agrega el código de dibujo :

procedure TForm1.FormPaint(Sender: TObject);
begin
  PaintImage;
end;

Añade el procedimiento PaintImage :

procedure TForm1.PaintImage;
begin
  image.Draw(Canvas,0,0,True);
end;

Luego de escribir esto, pon el cursor en PaintImage y presiona Ctrl-Shift-C para agregar la declaración a 'interface'.

Manejar el mouse

Con el inspector de objetos, agrega manejadores para los eventos MouseDown y MouseMove :

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then DrawBrush(X,Y);
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if ssLeft in Shift then DrawBrush(X,Y);
end;

Agrega el procedimiento DrawBrush :

procedure TForm1.DrawBrush(X, Y: Integer);
const radius = 5;
begin
  image.GradientFill(X-radius,Y-radius, X+radius,Y+radius,
    BGRABlack,BGRAPixelTransparent, gtRadial,
    PointF(X,Y), PointF(X+radius,Y), dmDrawWithTransparency);

  PaintImage;
end;

Luego de escribir esto, pon el cursor en DrawBrush y presiona Ctrl-Shift-C para agregar la declaración a 'interface'.

Este procedimiento dibuja un gradiente radial (gtRadial) :

• el borde rectangular es (X-radius,Y-radius, X+radius,Y+radius).
• el centro es negro, el borde es transparente
• el centro está en (X,Y) y el borde está en (X+radius,Y)

Código

unit UMain;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  BGRABitmap, BGRABitmapTypes;

type
  { TForm1 }

  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure FormPaint(Sender: TObject);
  private
    { private declarations }
    image: TBGRABitmap;
    procedure DrawBrush(X, Y: Integer);
    procedure PaintImage;
  public
    { public declarations }
  end; 

var
  Form1: TForm1; 

implementation

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  image := TBGRABitmap.Create(640,480,BGRAWhite);
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then DrawBrush(X,Y);
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if ssLeft in Shift then DrawBrush(X,Y);
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  PaintImage;
end;

procedure TForm1.DrawBrush(X, Y: Integer);
const radius = 20;
begin
  image.GradientFill(X-radius,Y-radius, X+radius,Y+radius,
    BGRABlack,BGRAPixelTransparent,gtRadial,
    PointF(X,Y), PointF(X+radius,Y), dmDrawWithTransparency);

  PaintImage;
end;

procedure TForm1.PaintImage;
begin
  image.Draw(Canvas,0,0,True);
end;

initialization
  {$I UMain.lrs}

end.

Ejecuta el programa

Deberías poder dibujar en la forma.

Dibujo contínuo

Para tener un dibujo contínuo, necesitamos agregar variables adicionales :

  TForm1 = class(TForm)
    ...
  private
    { private declarations }
    image: TBGRABitmap;
    mouseDrawing: boolean;
    mouseOrigin: TPoint;

mouseDrawing va a ser 'True' durante el dibujado (con el botón izquierdo presionado) y mouseOrigin el punto inicial del segmento que está siendo dibujado.

El manejador de clic lo convierte en algo un poco mas complicado :

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
  begin
    mouseDrawing := True;
    mouseOrigin := Point(X,Y);
    DrawBrush(X,Y,True);
  end;
end;

Esto inicializa el dibujado con la posición actual. Luego, esto dibuja un segmento cerrado (fíjate en el nuevo parámetro para DrawBrush). De todas formas, en el principio, el segmento está cerrado y tiene una longitud cero, que nos da un disco :

De a poco, agregaremos una nueva parte, que es un segmento abierto :

Es por esto que necesitamos un nuevo parámetro para la función DrawBrush, que se convierte en :

procedure TForm1.DrawBrush(X, Y: Integer; Closed: Boolean);
const brushRadius = 20;
begin
  image.DrawLineAntialias(X,Y,mouseOrigin.X,mouseOrigin.Y,BGRA(0,0,0,128),brushRadius,Closed);
  mouseOrigin := Point(X,Y);

  PaintImage;
end;

Transmitimos el parámetro Closed a DrawLineAntialias, para indicar cuando el segmento está cerrado o no. Mira el orden de las coordenadas. La posición inicial y la posición final están intercambiadas. De todas formas, para DrawLineAntialias, es la parte final que esta abierta, en este caso, necesitamos que la parte inicial esté abierta.

La definición DrawBrush debe ser actualizada en la 'interface'.

El manejador MouseMove se convierte en :

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if mouseDrawing then DrawBrush(X,Y,False);
end;

Finalmente, necesitamos agregar un manejador MouseUp para actualizar mouseDrawing :

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
    mouseDrawing := False;
end;

Código

unit UMain;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  BGRABitmap, BGRABitmapTypes;

type
  { TForm1 }

  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormPaint(Sender: TObject);
  private
    { private declarations }
    image: TBGRABitmap;
    mouseDrawing: boolean;
    mouseOrigin: TPoint;
    procedure DrawBrush(X, Y: Integer; Closed: boolean);
    procedure PaintImage;
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  image := TBGRABitmap.Create(640,480,BGRAWhite);
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
  begin
    mouseDrawing := True;
    mouseOrigin := Point(X,Y);
    DrawBrush(X,Y,True);
  end;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if mouseDrawing then DrawBrush(X,Y,False);
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
    mouseDrawing := False;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  PaintImage;
end;

procedure TForm1.DrawBrush(X, Y: Integer; Closed: Boolean);
const brushRadius = 20;
begin
  image.DrawLineAntialias(X,Y,mouseOrigin.X,mouseOrigin.Y,BGRA(0,0,0,128),brushRadius,Closed);
  mouseOrigin := Point(X,Y);

  PaintImage;
end;

procedure TForm1.PaintImage;
begin
  image.Draw(Canvas,0,0,True);
end;

initialization
  {$I UMain.lrs}

end.

Ejecuta el programa

Ahora el dibujo es en su mayoría contínuo :

Tutoría anterior (cargar imágen) | Siguiente tutoría (acceso directo a píxeles)