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 una línea:
  p1 := TPointF.Create(0, 510);
  p2 := TPointF.Create(510, 0);
  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.DrawLine(p1, p2, 1);
  Imagen1.Bitmap.Canvas.EndScene;

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);



También te puede interesar

Rotaciones en 3D con RAD Studio 
Una app para visualizar moléculas en 3D  
Angulo creado por 3 segmentos en 3D
Modelado 3D con Delphi  
Ejemplo de uso de Kinect con Delphi



Listar sesiones web activas con uniGUI

Hoy veremos cómo podemos obtener información sobre las sesiones activas de las aplicaciones web desarrolladas con el framework uniGUI.
Para los que no conozcan uniGUI, diríamos que quizás es la plataforma más avanzada del mercado para el desarrollo de aplicaciones web.
Utiliza la librería javascript Sencha Ext JS junto a toda la potencia de Delphi y permite crear, depurar y diseñar desde el IDE del Delphi  módulos ISAPI (dll) para Internet Information Server, Servicios Windows, o Servidores independientes (Standalone) y se puede utilizar desde Delphi 2006 hasta Delphi 10.2 Tokyo.
El que el código javascript se encapsule en componentes Delphi, no implica que no podamos inyectar nuestro propio código, ya que uniGUI dispone de funciones que nos permiten hacerlo, también dispone de módulos para hacer pruebas de stress para probar el funcionamiento de nuestra aplicación web en entornos de máxima concurrencia.
Soporta los principales navegadores del mercado desde IE9+, MIcrosoft Edge, Firefox, Chrome, Safari y Opera.
Tienen más información desde su página web.
Antes de iniciar la explicación supongo que han instalado uniGUI en su entorno Delphi favorito (les recomiendo el siguiente post de Emilio Pérez)
Volviendo al asunto de este artículo, vamos a ver cómo mostrar las sesiones activas cuando se ejecuta una aplicación web realizada con uniGUI.

- Abrimos Delphi y vamos a File-New-Other

-
Seleccionamos UniGUI for Delphi - Application Wizard y pulsamos OK
y en la siguiente pantalla

marcamos la opción "Standalone Server" y pulsamos OK
Si todo ha ido bien, habremos creado en la vista del proyecto tres units:
Main.pas, MainModule.pas, ServerController.pas

- Ahora tenemos que añadir componentes e insertar código.

Desde la unit Main.pas:

Añadimos dos componentes tuniButton y tuniListBox, y cambiamos las siguientes propiedades:
uniButton1.caption = 'Listar sesiones'
uniButton.Align = alTop
UniListBox1.Align = alClient
Nos quedará de la siguiente forma:


Ahora pasamos a insertar el código para el evento onclic del uniButton, que nos permita obtener información de las sesiones activas (id de sesión, ip, hora de último acceso y variable) que los guardaremos en una estructura tipo record llamada TInfoSesionesRec.

Para acceder a estos datos tenemos que hacerlo mediante el método SessionManager del ServerModule.

VAR
 S : TUniGUISessions;
...
  S := UniServerModule.SessionManager.Sessions;

Lo siguiente es fácil, hacemos un bucle y en cada vuelta leemos los datos de la sesión. Hay que tener en cuenta que estos datos se están actualizando constantemente por lo que tendremos que bloquear el acceso utilizando los métodos Lock / unLock y además este bloqueo tendrá que ser lo más corto posible:

...
type
  TInfoSesionesRec = record
    SesionID : string;
    IP : string;
    Variable : string;
    LastTime: TDateTime;
  end;
...
public
    ListaDeSesiones : array of TInfoSesionesRec;
end;
...

procedure TMainForm.UniButton1Click(Sender: TObject);
var
  S : TUniGUISessions;
  U : TUniGUISession;
  I : Integer;
begin
  S := UniServerModule.SessionManager.Sessions;
  S.Lock; //la utilización de Lock debe ser lo más corta posible
  try
    SetLength(ListaDeSesiones, S.SessionList.Count);
    UniListBox1.Clear;
    //Recorremos las sesiones activas
    for I := 0 to S.SessionList.Count - 1  do
    begin
      U := S.SessionList[I];
      ListaDeSesiones[I].SesionID := U.SessionId;
      ListaDeSesiones[I].IP := U.RemoteIP;
      ListaDeSesiones[I].LastTime := U.LastTimeStamp;
      if U.UniMainModule <> nil then // Comprobamos si el MainModule está activo
        ListaDeSesiones[I].Variable := (U.UniMainModule as TUniMainModule).MiString;
        WITH ListaDeSesiones[I] DO
          BEGIN
            UniListBox1.items.add(U.SessionID + ' # ' + U.RemoteIP + ' # ' + DateTimeToSTr(U.LastTimeStamp));
          END;
    end;
  finally
    S.Unlock; // liberamos el lock
  end;
end;

Recordar que hay que añadir en el USES la unit uniGUISessionManager y en el MainModule en el apartado PUBLIC la variable  MiString
Ahora sólo queda ir al menú RUN para compilar e iniciar nuestra aplicación web y si todo es correcto veremos en la esquina inferior derecha el siguiente icono
Lo pulsamos con el botón derecho del ratón y accedemos al menú RESTORE
A continuación abrimos nuestro navegador y y tecleamos en la url
localhost:8077
Para hacer pruebas he generado 3 pestañas y en todas ellas he puesto en la URL localhost:8077
con lo que al pulsar el botón "listar sesiones" de la aplicación nos aparecerán 3 líneas. 
vemos la siguiente imagen:

Cada línea corresponde a una de las 3 sesiones abiertas y para cada una de ellas nos muestra la cookie de sesión, la ip, y la hora en la que ha accedido.

Recordar que tendremos que ir al menú Shutdown del icono que está en la esquina inferior derecha de la pantalla para cerrar y en su caso volver a compilar una nueva versión de la aplicación.

Si no lo hacemos así tendremos un error (bind socket already use)

Espero que os haya sido útil, en próximos artículos veremos más utilidades de este framework.