Ejemplos de rutinas gráficas con Firemonkey

A continuación veremos ejemplos de código de algunas de las rutinas gráficas que incorpora Firemonkey:



Partimos de un componente TImage, lo primero que hago es establecer el tamaño del bitmap:

  Imagen1.bitmap.SetSize(Round(510), Round(510));
  Imagen1.bitmap.Clear(tAlphacolors.White);

 creo unas variables de la siguiente forma:

VAR
  DstRect,SourceRect: TRectF;
  punto,p1,p2: TPointF;
  Opacidad, x, y: Double;

y quiero hacer lo siguiente:



- Dibujar un círculo de color sólido (con opacidad = 0.2) en la posición X, Y y con un borde de color rojo de 10 puntos de ancho

  

punto := TPointF.Create(x - 50, y - 50);

  //100 es el ancho y el alto
  DstRect := TRectF.Create(punto, 100, 100);

  Imagen1.bitmap.Canvas.BeginScene;
  Imagen1.bitmap.Canvas.fill.color := tAlphacolors.blue;

//Definimos el borde de la elipse (color y anchura)
  Imagen1.bitmap.Canvas.Stroke.Kind := TBrushKind.Solid;
  Imagen1.bitmap.Canvas.Stroke.color := tAlphacolors.black;
  Imagen1.bitmap.Canvas.StrokeThickness := 10;

//0.2 es la opacidad
//si es igual a 1: opacidad total
//si es igual a 0: la elipse es totalmente transparente
  Imagen1.bitmap.Canvas.FillEllipse(DstRect, 0.2);
  Imagen1.bitmap.Canvas.DrawEllipse(DstRect, 0.2);
  Imagen1.bitmap.Canvas.EndScene;

Resultado:

- Copiar imagen2 sobre imagen1 en la posición X,Y

  
  punto := TPointF.Create(x, y);
  DstRect := TRectF.Create(punto, imagen2.width, imagen2.height);
  SourceRect := Imagen2.bitmap.BoundsF;
  Imagen1.bitmap.Canvas.BeginScene;
  Imagen1.bitmap.Canvas.DrawBitmap(Imagen2.bitmap, SourceRect, DstRect, 1, false);
  Imagen1.bitmap.Canvas.EndScene;

- Dibujar un arco con un ancho de linea de 5 puntos de color rojo

  // Define el centro del arco
  p1 := TPointF.Create(x, y);
  // Define el radio del arco
  p2 := TPointF.Create(100, 100);
  Imagen1.Bitmap.Canvas.BeginScene;
  // establece el ancho y el color de la línea
  Imagen1.Bitmap.Canvas.fill.color := tAlphacolors.blue;
  Imagen1.Bitmap.Canvas.Stroke.Kind := TBrushKind.Solid;
  Imagen1.Bitmap.Canvas.Stroke.color := tAlphacolors.Red;
  Imagen1.Bitmap.Canvas.StrokeThickness := 5;
  Imagen1.Bitmap.Canvas.DrawArc(p1, p2, 90, 330, 20);
  Imagen1.Bitmap.Canvas.EndScene;

Resultado:

- Crear un thumbnail de 20x20 de una imagen 

var
  MyBitmap: TBitmap;
begin
  // Carga la imagen
  if OpenDialog1.Execute then
    MyBitmap := TBitmap.CreateFromFile(OpenDialog1.Files[0]);
  // Dibuja el bitmap
  Imagen1.Bitmap :=  MyBitmap.CreateThumbnail(20,20);

- Dibujar un rectángulo con diferentes tipos de bordes ( en este caso he seleccionadoTCornerType.InnerRound )

  MyRect := TRectF.Create(50, 40, 200, 270);
  Imagen1.Bitmap.Canvas.BeginScene;
  Imagen1.Bitmap.Canvas.Stroke.Kind := TBrushKind.Solid;
  Imagen1.Bitmap.Canvas.Stroke.color := tAlphacolors.Red;
  Imagen1.Bitmap.Canvas.StrokeThickness := 5;
  Imagen1.Bitmap.Canvas.DrawRectSides(MyRect, 40, 10, AllCorners, 30, AllSides, TCornerType.InnerRound);
  Imagen1.Bitmap.Canvas.EndScene;

Resultado:

- Dibujar líneas:

 
PROCEDURE TForm1.Button1Click(Sender: TObject);
VAR
  p1, p2: tpointf;
  i: integer;
BEGIN

  p1 := tpointf.Create(0, random(400));
  p2 := tpointf.Create(random(400), 0);

  IF Image1.Bitmap.Canvas.BeginScene THEN
    TRY
      Image1.Bitmap.Canvas.Fill.Color := tAlphacolors.Red;
      Image1.Bitmap.Canvas.Stroke.Color := tAlphacolors.black;
      FOR i := 1 TO 5 DO
      BEGIN
        p1 := tpointf.Create(0, random(400));
        p2 := tpointf.Create(random(400), 0);
        Image1.Bitmap.Canvas.DrawLine(p1, p2, $FF);
      END;
    FINALLY
      Image1.Bitmap.Canvas.EndScene;
    END;
END;

Resultado:

- Dibujar un rectángulo con bordes redondeados:

  MyRect := TRectF.Create(50, 40, 200, 270);
  Imagen1.Bitmap.Canvas.BeginScene;
  Imagen1.Bitmap.Canvas.Stroke.Kind := TBrushKind.Solid;
  Imagen1.Bitmap.Canvas.Stroke.color := tAlphacolors.Red;
  Imagen1.Bitmap.Canvas.StrokeThickness := 5;
  Imagen1.Bitmap.Canvas.DrawRect(MyRect, 30, 60, AllCorners, 100);
  Imagen1.Bitmap.Canvas.EndScene;

Resultado:

 

- Obtener las dimensiones reales de una imagen

 

VAR
  miBitmap: tbitmap;
  Ancho,Alto:integer
BEGIN
  miBitmap := tbitmap.Create;
  TRY
    miBitmap.LoadFromFile(pathImagen);
    Ancho:=mibitmap.Width;
    Alto:=mibitmap.Height;
  FINALLY
     miBitmap.Free;
  END;

- Cargar un archivo y obtener un thumbnail de la dimension indicada

 

VAR
  ancho, alto: integer;
  miBitmap: tbitmap;

BEGIN
    miBitmap := tbitmap.Create;
  TRY
      miBitmap.LoadThumbnailFromFile(pathImagen,1000, 1000,false);
      mibitmap.SaveToFile(pathImagen);
  FINALLY
      miBitmap.Free;
  END;

- Recortar un bitmap

 

PROCEDURE Tform1.CropBitmap(InBitmap, OutBitMap: TBitmap; X, Y, W, H: Word);
VAR
  iRect: TRect;
BEGIN
  // OutBitMap.PixelFormat := InBitmap.PixelFormat;
  OutBitMap.Width := W;
  OutBitMap.Height := H;
  iRect.Left := 0;
  iRect.Top := 0;
  iRect.Width := W;
  iRect.Height := H;
  OutBitMap.CopyFromBitmap(InBitmap, iRect, 0, 0);
END;

- Leer un bitmap pixel a pixel

procedure TForm1.LeerBitmapPixelAPixel;
var
  vBitMapData : TBitmapData;
  vPixelColor : TAlphaColor;  // Note: FireMonkey colors are different from VCL TColor
  x,y         : Integer;
begin
  memo1.Lines.Clear;
                    // dump bitmap pixels
  if image1.Bitmap.Map(TMapAccess.maRead, vBitMapData) then // lock bitmap and get pixels
     begin
     for y := 0 to trunc(image1.Bitmap.height)-1 do     // loop through image lines
       begin
       Memo1.Lines.Add('======================');
       memo1.Lines.Add('Line # ' + IntToStr(Y));
       Memo1.Lines.Add('======================');
       for x := 0 to trunc(image1.Bitmap.width)-1 do  // loop through pixels on the line
           begin
           vPixelColor := vBitmapData.GetPixel(x,y);  // get the pixel colour
 
           memo1.Lines.Add(                           // dump pixel info to screen
                    'line='    + IntToStr(Y)
                  + ' row='    + IntToStr(X)
                  + ' Colour=' + IntToStr(vBitmapData.GetPixel(x,y))
                  + ' Red='    + IntToStr (TAlphaColorRec(vPixelColor).R) // red
                  + ' Green='  + IntToStr (TAlphaColorRec(vPixelColor).G) // blue
                  + ' Blue='   + IntToStr (TAlphaColorRec(vPixelColor).B) // green
                  )
           end;
       end;
     image1.Bitmap.Unmap(vBitMapData);      // unlock the bitmap
     end;
end;

- Modificar un pixel de un bitmap

procedure TForm1.EscribirEnUnPixelDeUnBitmap;
 // example of setting a single pixel in a TImage bitmap.
 // the image must already be loaded in the TImage
var
  vBitMapData  : TBitmapData;
  vPixelColor  : TAlphaColor; // note: FireMonkey colors are different from VCL TColor
begin
                              // lock and get the bitmap pixels
  if  image1.Bitmap.Map(TMapAccess.maWrite, vBitMapData) then
      begin
      vPixelColor := TAlphaColorRec.Blue;       // determine colour to use
      vBitmapData.SetPixel(10,20, vPixelColor); // set the pixel colour at x:10, y:20
 
      image1.Bitmap.Unmap(vBitMapData);         // unlock the bitmap
      end;
end;

Hacer que el fondo de un archivo PNG no sea negro.

Hay que modificar los valores A,R,G,B a gusto del usuario

En este ejemplo podemos ver cómo recorrer un bitmap pixel a pixel con Firemonkey

Se puede optimizar el bucle utilizando la funcion "GetScanLine", ya que "scanline" ha desaparecido en firemonkey

procedure ApplyNoAlphaEdge(ABitmap: TBitmap; OpacityThreshold: integer);
var
  bitdata1: TBitmapData;
  I: integer;
  J: integer;
  C: TAlphaColor;
begin
  if (ABitmap.Map(TMapAccess.maReadWrite, bitdata1)) then
    try
      for I := 0 to ABitmap.Width - 1 do
        for J := 0 to ABitmap.Height - 1 do
        begin
          begin
              {$IF DEFINED(VER270) OR DEFINED(VER280) OR DEFINED(VER290)}
              C := PixelToAlphaColor(@PAlphaColorArray(bitdata1.Data)
              [J * (bitdata1.Pitch div PixelFormatBytes[ABitmap.PixelFormat])
               + 1 * I], ABitmap.PixelFormat);
              {$ELSE}
              C := PixelToAlphaColor(@PAlphaColorArray(bitdata1.Data)
              [J * (bitdata1.Pitch div GetPixelFormatBytes(ABitmap.PixelFormat))
               + 1 * I], ABitmap.PixelFormat);
              {$ENDIF}
               if TAlphaColorRec(C).A (menor que) OpacityThreshold then
                begin
                  TAlphaColorRec(C).A := 0;    //es el canal alfa
                  TAlphaColorRec(C).R := 255;  //valor del byte rojo
                  TAlphaColorRec(C).G := 255;  //valor del byte verde
                  TAlphaColorRec(C).B := 255;  //valor del byte azul

              {$IF DEFINED(VER270) OR DEFINED(VER280) OR DEFINED(VER290)}
                  AlphaColorToPixel(C, @PAlphaColorArray(bitdata1.Data)
                    [J * (bitdata1.Pitch div PixelFormatBytes[ABitmap.PixelFormat])
                     + 1 * I], ABitmap.PixelFormat);
              {$ELSE}
                  AlphaColorToPixel(C, @PAlphaColorArray(bitdata1.Data)
                    [J * (bitdata1.Pitch div GetPixelFormatBytes(ABitmap.PixelFormat))
                     + 1 * I], ABitmap.PixelFormat);
              {$ENDIF}
                end;
          end;
        end;
    finally
      ABitmap.Unmap(bitdata1);
    end;
end;

Reducir una imagen al tamaño indicado

En este caso reduce una imagen a un tamaño de 100x100

procedure ReducirImagen(fichinicio,fichfinal:string);
var
  bmpA, bmpB: TBitmap;
  src, trg: TRectF;
begin
  bmpA := nil;
  bmpB := nil;
  try
    bmpA := TBitmap.Create;
    bmpA.LoadFromFile(fichinicio);

    bmpB:= TBitmap.Create;
    bmpB.SetSize(100, 100);

    src := RectF(0, 0, bmpA.Width, bmpA.Height);
    trg := RectF(0, 0, 100, 100);

    bmpB.Canvas.BeginScene;
    bmpB.Canvas.DrawBitmap(bmpA, src, trg, 1);
    bmpB.Canvas.EndScene;

    bmpB.SaveToFile(fichfinal);
  finally
    bmpA.Free;
    bmpB.Free;
  end;
end;

Guardar un timage junto con su efecto

En este caso se le ha aplicado el efecto "ColorKeyAlphaEffect", para ocultar un color de la imagen.

  Image2.bitmap.LoadFromFile(sFoto);
  Image2.bitmap.Assign(Image2.MakeScreenshot);
  // aplica el efecto internamente al bitmap del timage 
  ColorKeyAlphaEffect1.ProcessEffect(Image2.bitmap.Canvas, Image2.bitmap, 1);
  Image2.bitmap.SaveToFile('C:\f1.bmp', NIL);