He encontrado un enlace con código C para codificar código de barras 2D tipo QR. Lo he probado y he creado un componente derivado de TImage. En Builder es muy sencillo puesto que el código base está escrito en C, el problema es usarlo en delphi. Delphi no compila C, sin embargo Builder si compila delphi. Para usar el código tenemos dos maneras, o traducirlo a delphi o usar el módulo objeto ".obj" tras compilar con Builder. Para poder hacer esto he tenido que hacer algunos cambios al código original de Nayuki, de forma que el código objeto generado fuese compatible con delphi. Luego he creado una unit que sirve de interface para proyectos delphi, en este caso para crear un componente.
//https://www.nayuki.io/page/qr-code-generator-library unit qrcodegen_obj; interface function __ltolower(C: integer): integer; cdecl; external 'msvcrt.dll' name '_tolower'; function __ltoupper(C: integer): integer; cdecl; external 'msvcrt.dll' name '_toupper'; function __ltowlower(C: integer): integer; cdecl; external 'msvcrt.dll' name 'towlower'; function __ltowupper(C: integer): integer; cdecl; external 'msvcrt.dll' name 'towupper'; function _strlen(str: PAnsiChar): integer; cdecl external 'crtdll' name 'strlen'; function _strchr(s: PAnsiChar; c: AnsiChar): PAnsiChar; cdecl external 'crtdll' name 'strchr'; function _strcmp(str1, str2: PAnsiChar): integer; cdecl external 'crtdll' name 'strcmp'; function _stricmp(str1, str2: PAnsiChar): integer; cdecl external 'crtdll' name '_stricmp'; function _strnicmp(str1, str2: PAnsiChar; n: integer): integer; cdecl external 'crtdll' name '_strnicmp'; function _strdup(str: PAnsiChar): integer; cdecl external 'crtdll' name '_strdup'; function _strlwr(str: PAnsiChar): PAnsiChar; cdecl external 'crtdll' name '_strlwr'; function _strnset(s: PAnsiChar; c: AnsiChar; n: integer): PAnsiChar; cdecl external 'crtdll' name '_strnset'; function _strset(s: PAnsiChar; c: AnsiChar): PAnsiChar; cdecl external 'crtdll' name '_strset'; function _strrev(s: PAnsiChar): PAnsiChar; cdecl external 'crtdll' name '_strrev'; function _strupr(s: PAnsiChar): PAnsiChar; cdecl external 'crtdll' name '_strupr'; procedure __assert(str: integer); cdecl external 'crtdll.dll' name '_assert'; function _memset(s: Pointer; c: integer; n: Cardinal): pointer; cdecl external 'crtdll.dll' name 'memset'; function _memmove(d: Pointer; const s: Pointer; n: Cardinal): pointer; cdecl external 'crtdll.dll' name 'memmove'; function _memcpy(d: Pointer; const s: Pointer; n: Cardinal): pointer; cdecl external 'crtdll.dll' name 'memcpy'; function _labs(x: LONGINT): LONGINT; cdecl external 'crtdll.dll' name 'labs'; type TECL = ( LOW = 0 , // The QR Code can tolerate about 7% erroneous codewords MEDIUM , // The QR Code can tolerate about 15% erroneous codewords QUARTILE, // The QR Code can tolerate about 25% erroneous codewords HIGH // The QR Code can tolerate about 30% erroneous codewords ); function _qrcodegen_encodeText(const text: PAnsiChar; tempBuffer, qrcode: PBYTE; ecl: TECL; minVersion, maxVersion, mask: integer; boostEcl: boolean): boolean; cdecl; function _qrcodegen_getSize(const qrcode: PBYTE): integer; cdecl; function _qrcodegen_getModule(const qrcode: PBYTE; x, y: integer): boolean; cdecl; const qrcodegen_VERSION_MIN = 1; // The minimum version number supported in the QR Code Model 2 standard const qrcodegen_VERSION_MAX = 40; // The maximum version number supported in the QR Code Model 2 standard const qrcodegen_Mask_AUTO = -1; implementation uses SysUtils; {$LINK 'qrcodegen.obj'} function _qrcodegen_encodeText(const text: PAnsiChar; tempBuffer, qrcode: PBYTE; ecl: TECL; minVersion, maxVersion, mask: integer; boostEcl: boolean): boolean; cdecl; external; function _qrcodegen_getSize(const qrcode: PBYTE): integer; cdecl; external; function _qrcodegen_getModule(const qrcode: PBYTE; x, y: integer): boolean; cdecl; external; end.
Las funciones de cadena y de manejo de memoria "C" están importadas de las librerías del Sistema tales como ntdll.dll, msvcrt.dll y crtdll.dll, el código de Nayuki está importado en el archivo qrcodegen.obj, resultado de la compilación del fuente qrcodegen.c con alguna adaptación.
El componente queda como sigue:
unit QRCodeImage; interface uses SysUtils, Classes, Controls, ExtCtrls, Graphics, qrcodegen_obj; type TQRCodeImage = class(TImage) private QRTextBuffer: array [0..3917] of BYTE; QRTempBuffer: array [0..3917] of BYTE; FText: AnsiString; FIsOK: boolean; FEcl: TECL; procedure SetECL(value: TECL); procedure SetHeight(value: integer); procedure SetWidth(value: integer); function GetHeight: integer; function GetWidth: integer; function GetQRSize: integer; protected procedure Resize; override; function CanResize(var NewWidth, NewHeight: Integer): Boolean; override; procedure SetName(const Value: TComponentName); override; //virtual bool __fastcall CanResize(int &NewWidth, int &NewHeight); //virtual void __fastcall SetName(const AnsiString Value); public function EncodeText(Text: AnsiString): boolean; procedure SetText(Text: AnsiString); procedure DrawToCanvas(Canvas: TCanvas); procedure Draw(); constructor Create(AOwner: TComponent); override; published property Text: AnsiString read FText write SetText; property IsOk: boolean read FIsOK; property ErrorCorrectionLevel: TECL read FECL write SetECL; property QRSize: integer read GetQRSize; property Height read GetHeight write SetHeight; property Width read GetWidth write SetWidth; { Published declarations } end; procedure Register; implementation {$R *.res} procedure Register; begin RegisterComponents('Samples', [TQRCodeImage]); end; constructor TQRCodeImage.Create(AOwner: TComponent); begin inherited Create(AOwner); Stretch:= true; FEcl:= MEDIUM; FIsOK:= false; end; procedure TQRCodeImage.SetECL(value: TECL); begin if(value < LOW) or (value > HIGH) then exit; if FEcl <> value then begin FEcl:= value; if FText <> '' then EncodeText(FText); Draw; end; end; procedure TQRCodeImage.SetHeight(Value: integer); begin if Height <> Value then begin inherited Height:= Value; inherited Width:= Value; end; end; procedure TQRCodeImage.SetWidth(Value: integer); begin if Width <> Value then begin inherited Width:= Value; inherited Height:= Value; end; end; function TQRCodeImage.GetHeight: integer; begin Result:= inherited Height; end; function TQRCodeImage.GetWidth: integer; begin Result:= inherited Width; end; procedure TQRCodeImage.Resize; begin inherited; Draw(); end; function TQRCodeImage.CanResize(var NewWidth, NewHeight: Integer): boolean; begin if NewHeight <> NewWidth then NewWidth:= NewHeight; Result:= true; end; function TQRCodeImage.GetQRSize: integer; begin Result:= 0; if FIsOK then Result:= _qrcodegen_getSize(@QRTextBuffer[0]); end; procedure TQRCodeImage.SetName(const Value: TComponentName); begin //TImage::SetName(Value); inherited; if FText <> Value then SetText(Value); end; function TQRCodeImage.EncodeText(Text: AnsiString): boolean; begin FText:= Text; FIsOK:= _qrcodegen_encodeText(PAnsiChar(FText), @QRTempBuffer[0], @QRTextBuffer[0], FEcl, qrcodegen_VERSION_MIN, qrcodegen_VERSION_MAX, qrcodegen_Mask_AUTO, true); Result:= FIsOK; end; procedure TQRCodeImage.SetText(Text: AnsiString); begin if FText <> Text then begin FText:= Text; EncodeText(Text); Draw; end; end; procedure TQRCodeImage.DrawToCanvas(Canvas: TCanvas); var C: TColor; Size, x, y: integer; begin Size:= GetQRSize; for y:= 0 to Size-1 do begin for x:= 0 to Size-1 do begin C:= clWhite; if _qrcodegen_getModule(@QRTextBuffer[0], x, y) then C:= clBlack; Canvas.Pixels[x, y]:= C; end; end; end; procedure TQRCodeImage.Draw(); var Size: integer; begin if FIsOK then begin Size:= GetQRSize; Picture.Bitmap.Width:= Size; Picture.Bitmap.Height:= Size; DrawToCanvas(Picture.Bitmap.Canvas); end; end; end.
El uso es tan sencillo como el de un TImage con una propiedad Text que será objeto de codificación QR mostrado en la Imagen. Dado que usa el TBitmap de la imagen, podrá ser usado como imagine cada uno.
Hay otra propiedad importante que es ErrorCorrectionLevel, la relación de especto siempre será 1-1, cuadrado y el procedimiento DrawToCanvas nos permite pintar el código QR en cualquier canvas. Hay que tener en cuenta que el dibujo será pequeño, del tamaño dado por la pripiedad GetQRSize por lo que habrá que hacer uso de Stretch para visualizarlo. El resultado de Stretch es muy bueno dado que el bitmap es de dos colores.
El código está escrito inicialmente en delphi7 para no perder la compatibilidad. Usa AnsiString y al compilarlo en Berlin saltan avisos de conversión implicita de String (UNICODE) a AnsiString. En los proyectos he anulado ese tipo de aviso pero si creais uno nuevo, pueden aparecer. Si os molestan los anulais o realizais la conversión implicita en el código y se acabó.
Adjunto el codigo completo y ejemplos para delphi7 y Berlín.
Espero que sea de utilidad y como base de ejemlo para usar codigo C en delphi sin tener que pasar por la clásica dll.
Saludos.