Crear códigos QR

 

 

Los códigos QR son una forma eficiente de almacenar y acceder a información. Las ventajas de usarlos son:

1. Facilidad de uso: Los códigos QR pueden ser escaneados fácilmente con la mayoría de los smartphones.
2. Versatilidad: Pueden ser utilizados para una amplia gama de propósitos, desde el marketing hasta la identificación de productos.
3. Eficiencia: Permiten un acceso rápido a la información, simplemente escaneando el código con un dispositivo móvil.
4. Ahorro de espacio: Pueden almacenar una gran cantidad de información en un espacio muy pequeño.

Ahora, vamos a ver cómo podríamos generar códigos QR en Delphi. Para este ejemplo, se necesita una biblioteca de terceros para generar códigos QR, como “DelphiZXingQRCode”.

En el archivo adjunto les dejo al archivo  DelphiZXingQRCode.pas en la carpeta "Source"

UNIT DelphiZXingQRCodeTestAppMainForm;

// Demo app for ZXing QRCode port to Delphi, by Debenu Pty Ltd (www.debenu.com)
// Need a PDF SDK? Checkout Debenu Quick PDF Library: http://www.debenu.com/products/development/debenu-pdf-library/

INTERFACE

USES
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, DelphiZXingQRCode, Vcl.ExtCtrls,
  Vcl.StdCtrls, jpeg;

TYPE
  TForm1 = CLASS(TForm)
    edtText: TEdit;
    Label1: TLabel;
    cmbEncoding: TComboBox;
    Label2: TLabel;
    Label3: TLabel;
    edtQuietZone: TEdit;
    Label4: TLabel;
    PaintBox1: TPaintBox;
    Memo1: TMemo;
    Button1: TButton;
    Label5: TLabel;
    PROCEDURE HazCodigoQR(texto: STRING);
    PROCEDURE FormDestroy(Sender: TObject);
    PROCEDURE FormCreate(Sender: TObject);
    PROCEDURE PaintBox1Paint(Sender: TObject);
    PROCEDURE edtTextChange(Sender: TObject);
    PROCEDURE cmbEncodingChange(Sender: TObject);
    PROCEDURE edtQuietZoneChange(Sender: TObject);
    PROCEDURE Button1Click(Sender: TObject);
    PROCEDURE CargarFichero;
  PRIVATE
    QRCodeBitmap: TBitmap;
  PUBLIC
    PROCEDURE Update;
  END;

VAR
  Form1: TForm1;

IMPLEMENTATION

{$R *.dfm}

PROCEDURE TForm1.Button1Click(Sender: TObject);
VAR
  i: integer;
  bmp: TBitmap;
  MyJPEG: TJPEGImage;

BEGIN
  bmp := TBitmap.Create;
  MyJPEG := TJPEGImage.Create;
  TRY
    bmp.Width := PaintBox1.Width;
    bmp.Height := PaintBox1.Height;
    FOR i := 0 TO Memo1.lines.count - 1 DO
    BEGIN
      IF trim(Memo1.lines[i]) <> '' THEN
      BEGIN

        HazCodigoQR(Memo1.lines[i]);
        bmp.Canvas.CopyRect(PaintBox1.ClientRect, PaintBox1.Canvas, PaintBox1.ClientRect);
        WITH MyJPEG DO
        BEGIN
          Assign(bmp);
          SaveToFile('.\imagenes\' + Memo1.lines[i] + '.jpg');
        END;

      END;

    END;

  FINALLY
    bmp.Free;
    MyJPEG.Free;
  END;
END;

PROCEDURE TForm1.cmbEncodingChange(Sender: TObject);
BEGIN
  Update;
END;

PROCEDURE TForm1.edtQuietZoneChange(Sender: TObject);
BEGIN
  Update;
END;

PROCEDURE TForm1.edtTextChange(Sender: TObject);
BEGIN
  Update;
END;

PROCEDURE TForm1.FormCreate(Sender: TObject);
BEGIN
  QRCodeBitmap := TBitmap.Create;
  Update;
  CargarFichero;
END;

PROCEDURE TForm1.CargarFichero;
BEGIN
  Memo1.lines.clear;
  Memo1.lines.loadfromfile('codigos.txt');
  Label5.caption := Memo1.lines.count.Tostring;
END;

PROCEDURE TForm1.FormDestroy(Sender: TObject);
BEGIN
  QRCodeBitmap.Free;
END;

PROCEDURE TForm1.PaintBox1Paint(Sender: TObject);
VAR
  Scale: Double;
BEGIN
  PaintBox1.Canvas.Brush.Color := clWhite;
  PaintBox1.Canvas.FillRect(Rect(0, 0, PaintBox1.Width, PaintBox1.Height));
  IF ((QRCodeBitmap.Width > 0) AND (QRCodeBitmap.Height > 0)) THEN
  BEGIN
    IF (PaintBox1.Width < PaintBox1.Height) THEN
    BEGIN
      Scale := PaintBox1.Width / QRCodeBitmap.Width;
    END
    ELSE
    BEGIN
      Scale := PaintBox1.Height / QRCodeBitmap.Height;
    END;
    PaintBox1.Canvas.StretchDraw(Rect(0, 0, Trunc(Scale * QRCodeBitmap.Width), Trunc(Scale * QRCodeBitmap.Height)), QRCodeBitmap);
  END;
END;

PROCEDURE TForm1.Update;
VAR
  QRCode: TDelphiZXingQRCode;
  Row, Column: integer;
BEGIN
  QRCode := TDelphiZXingQRCode.Create;
  TRY
    QRCode.Data := edtText.Text;
    QRCode.Encoding := TQRCodeEncoding(cmbEncoding.ItemIndex);
    QRCode.QuietZone := StrToIntDef(edtQuietZone.Text, 4);
    QRCodeBitmap.SetSize(QRCode.Rows, QRCode.Columns);
    FOR Row := 0 TO QRCode.Rows - 1 DO
    BEGIN
      FOR Column := 0 TO QRCode.Columns - 1 DO
      BEGIN
        IF (QRCode.IsBlack[Row, Column]) THEN
        BEGIN
          QRCodeBitmap.Canvas.Pixels[Column, Row] := clBlack;
        END
        ELSE
        BEGIN
          QRCodeBitmap.Canvas.Pixels[Column, Row] := clWhite;
        END;
      END;
    END;
  FINALLY
    QRCode.Free;
  END;
  PaintBox1.Repaint;
END;

PROCEDURE TForm1.HazCodigoQR(texto: STRING);
VAR
  QRCode: TDelphiZXingQRCode;
  Row, Column: integer;
BEGIN
  QRCode := TDelphiZXingQRCode.Create;
  TRY
    QRCode.Data := texto;
    QRCode.Encoding := TQRCodeEncoding(cmbEncoding.ItemIndex);
    QRCode.QuietZone := StrToIntDef(edtQuietZone.Text, 4);
    QRCodeBitmap.SetSize(QRCode.Rows, QRCode.Columns);
    FOR Row := 0 TO QRCode.Rows - 1 DO
    BEGIN
      FOR Column := 0 TO QRCode.Columns - 1 DO
      BEGIN
        IF (QRCode.IsBlack[Row, Column]) THEN
        BEGIN
          QRCodeBitmap.Canvas.Pixels[Column, Row] := clBlack;
        END
        ELSE
        BEGIN
          QRCodeBitmap.Canvas.Pixels[Column, Row] := clWhite;
        END;
      END;
    END;
  FINALLY
    QRCode.Free;
  END;
  PaintBox1.Repaint;
END;

END.

 

Una vez compilado el programa se muestra así:

 

No se necesita instalar librerías, ni dlls adicionales, únicamente hay que utilizar la unit DelphiZXingQRCode.pas

Lo que hace el programa es leer las líneas del fichero "codigos.txt"

El fichero contiene números del 100 al 104.

Para cada línea genera su código QR como si fuese una imagen y la guarda en la carpeta "imágenes" siguiendo el esquema:  <linea>.jpg

Y al final el resultado es el siguiente:

 Descargar programa