Espectacular simulación realizada con OpenGL del movimiento de los electrones cuando atraviesan un campo eléctrico. 
Los códigos QR son una forma eficiente de almacenar y acceder a información. Las ventajas de usarlos son:
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:
(* /*****************************************************************
// Delphi-OpenCV Demo
// Copyright (C) 2013 Project Delphi-OpenCV
// ****************************************************************
// Contributor:
// Mikhail Grigorev
// email: sleuthhound@gmail.com
// ****************************************************************
// You may retrieve the latest version of this file at the GitHub,
// located at git://github.com/Laex/Delphi-OpenCV.git
// ****************************************************************
// The contents of this file are used with permission, subject to
// the Mozilla Public License Version 1.1 (the "License"); you may
// not use this file except in compliance with the License. You may
// obtain a copy of the License at
// http://www.mozilla.org/MPL/MPL-1_1Final.html
//
// Software distributed under the License is distributed on an
// "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
// implied. See the License for the specific language governing
// rights and limitations under the License.
******************************************************************* *)
// JCL_DEBUG_EXPERT_GENERATEJDBG OFF
// JCL_DEBUG_EXPERT_INSERTJDBG OFF
// JCL_DEBUG_EXPERT_DELETEMAPFILE OFF
program MotionDetect;
{$APPTYPE CONSOLE}
{$POINTERMATH ON}
{$R *.res}
uses
System.SysUtils,
Math,
uLibName in '..\..\..\include\uLibName.pas',
highgui_c in '..\..\..\include\highgui\highgui_c.pas',
imgproc.types_c in '..\..\..\include\imgproc\imgproc.types_c.pas',
imgproc_c in '..\..\..\include\imgproc\imgproc_c.pas',
imgproc in '..\..\..\include\imgproc\imgproc.pas',
core in '..\..\..\include\core\core.pas',
core.types_c in '..\..\..\include\core\Core.types_c.pas',
core_c in '..\..\..\include\core\core_c.pas';
var
storage: pCvMemStorage = nil;
capture: pCvCapture = nil;
frame: pIplImage = nil;
frame_grey: pIplImage = nil;
difference_img: pIplImage = nil;
oldframe_grey: pIplImage = nil;
contours: pCvSeq = nil;
c: pCvSeq = nil;
// rect: TCvRect;
rect2d: TCvBox2D;
key: integer;
first: boolean = true;
begin
try
capture := cvCreateCameraCapture(0);
storage := cvCreateMemStorage(0);
frame := cvQueryFrame(capture);
frame_grey := cvCreateImage(cvSize(frame^.width, frame^.height), IPL_DEPTH_8U, 1);
while true do
begin
frame := cvQueryFrame(capture);
if frame = nil then
break;
cvCvtColor(frame, frame_grey, CV_RGB2GRAY);
if first then
begin
difference_img := cvCloneImage(frame_grey);
oldframe_grey := cvCloneImage(frame_grey);
cvConvertScale(frame_grey, oldframe_grey, 1.0, 0.0);
first := false;
end;
cvAbsDiff(oldframe_grey, frame_grey, difference_img);
cvSmooth(difference_img, difference_img, CV_BLUR);
cvThreshold(difference_img, difference_img, 25, 255, CV_THRESH_BINARY);
contours := AllocMem(SizeOf(TCvSeq));
cvFindContours(difference_img, storage, @contours, SizeOf(TCvContour), CV_RETR_LIST, CV_CHAIN_APPROX_NONE,
cvPoint(0, 0));
c := contours;
while (c <> nil) do
begin
rect2d := cvMinAreaRect2(c);
cvRectangle(frame, cvPoint(Round(rect2d.center.x - rect2d.size.width / 2),
Round(rect2d.center.y - rect2d.size.height / 2)), cvPoint(Round(rect2d.center.x + rect2d.size.width / 2),
Round(rect2d.center.y + rect2d.size.height / 2)), cvScalar(0, 0, 255, 0), 2, 8, 0);
c := c.h_next;
end;
cvShowImage('Output Image', frame);
cvShowImage('Difference Image', difference_img);
cvConvertScale(frame_grey, oldframe_grey, 1.0, 0.0);
cvClearMemStorage(storage);
c := nil;
FreeMem(contours, SizeOf(TCvSeq));
key := cvWaitKey(33);
if (key = 27) then
break;
end;
cvReleaseMemStorage(storage);
cvReleaseCapture(capture);
cvReleaseImage(oldframe_grey);
cvReleaseImage(difference_img);
cvReleaseImage(frame_grey);
cvDestroyAllWindows();
except
on E: Exception do
WriteLn(E.ClassName, ': ', E.Message);
end;
end.
Espectacular simulación realizada con OpenGL del movimiento de los electrones cuando atraviesan un campo eléctrico. Como muestra la image...
