Ir al contenido



Foto

TQRCodeImage, un codificador de codigo QR


  • Por favor identifícate para responder
6 respuestas en este tema

#1 escafandra

escafandra

    Advanced Member

  • Moderadores
  • PipPipPip
  • 3.878 mensajes
  • LocationMadrid - España

Escrito 02 enero 2020 - 10:04

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.
 


delphi
  1. //https://www.nayuki.io/page/qr-code-generator-library
  2.  
  3. unit qrcodegen_obj;
  4.  
  5. interface
  6.  
  7.  
  8. function __ltolower(C: integer): integer; cdecl; external 'msvcrt.dll' name '_tolower';
  9. function __ltoupper(C: integer): integer; cdecl; external 'msvcrt.dll' name '_toupper';
  10. function __ltowlower(C: integer): integer; cdecl; external 'msvcrt.dll' name 'towlower';
  11. function __ltowupper(C: integer): integer; cdecl; external 'msvcrt.dll' name 'towupper';
  12. function _strlen(str: PAnsiChar): integer; cdecl external 'crtdll' name 'strlen';
  13. function _strchr(s: PAnsiChar; c: AnsiChar): PAnsiChar; cdecl external 'crtdll' name 'strchr';
  14. function _strcmp(str1, str2: PAnsiChar): integer; cdecl external 'crtdll' name 'strcmp';
  15. function _stricmp(str1, str2: PAnsiChar): integer; cdecl external 'crtdll' name '_stricmp';
  16. function _strnicmp(str1, str2: PAnsiChar; n: integer): integer; cdecl external 'crtdll' name '_strnicmp';
  17. function _strdup(str: PAnsiChar): integer; cdecl external 'crtdll' name '_strdup';
  18. function _strlwr(str: PAnsiChar): PAnsiChar; cdecl external 'crtdll' name '_strlwr';
  19. function _strnset(s: PAnsiChar; c: AnsiChar; n: integer): PAnsiChar; cdecl external 'crtdll' name '_strnset';
  20. function _strset(s: PAnsiChar; c: AnsiChar): PAnsiChar; cdecl external 'crtdll' name '_strset';
  21. function _strrev(s: PAnsiChar): PAnsiChar; cdecl external 'crtdll' name '_strrev';
  22. function _strupr(s: PAnsiChar): PAnsiChar; cdecl external 'crtdll' name '_strupr';
  23.  
  24. procedure __assert(str: integer); cdecl external 'crtdll.dll' name '_assert';
  25. function _memset(s: Pointer; c: integer; n: Cardinal): pointer; cdecl external 'crtdll.dll' name 'memset';
  26. function _memmove(d: Pointer; const s: Pointer; n: Cardinal): pointer; cdecl external 'crtdll.dll' name 'memmove';
  27. function _memcpy(d: Pointer; const s: Pointer; n: Cardinal): pointer; cdecl external 'crtdll.dll' name 'memcpy';
  28. function _labs(x: LONGINT): LONGINT; cdecl external 'crtdll.dll' name 'labs';
  29.  
  30.  
  31. type
  32. TECL = (
  33. LOW = 0 , // The QR Code can tolerate about 7% erroneous codewords
  34. MEDIUM , // The QR Code can tolerate about 15% erroneous codewords
  35. QUARTILE, // The QR Code can tolerate about 25% erroneous codewords
  36. HIGH // The QR Code can tolerate about 30% erroneous codewords
  37. );
  38.  
  39. function _qrcodegen_encodeText(const text: PAnsiChar; tempBuffer, qrcode: PBYTE;
  40. ecl: TECL; minVersion, maxVersion, mask: integer; boostEcl: boolean): boolean; cdecl;
  41. function _qrcodegen_getSize(const qrcode: PBYTE): integer; cdecl;
  42. function _qrcodegen_getModule(const qrcode: PBYTE; x, y: integer): boolean; cdecl;
  43.  
  44. const qrcodegen_VERSION_MIN = 1; // The minimum version number supported in the QR Code Model 2 standard
  45. const qrcodegen_VERSION_MAX = 40; // The maximum version number supported in the QR Code Model 2 standard
  46. const qrcodegen_Mask_AUTO = -1;
  47.  
  48. implementation
  49.  
  50. uses
  51. SysUtils;
  52.  
  53. {$LINK 'qrcodegen.obj'}
  54.  
  55. function _qrcodegen_encodeText(const text: PAnsiChar; tempBuffer, qrcode: PBYTE;
  56. ecl: TECL; minVersion, maxVersion, mask: integer; boostEcl: boolean): boolean; cdecl; external;
  57. function _qrcodegen_getSize(const qrcode: PBYTE): integer; cdecl; external;
  58. function _qrcodegen_getModule(const qrcode: PBYTE; x, y: integer): boolean; cdecl; external;
  59.  
  60. 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:
 


delphi
  1. unit QRCodeImage;
  2.  
  3. interface
  4.  
  5. uses
  6. SysUtils, Classes, Controls, ExtCtrls, Graphics, qrcodegen_obj;
  7.  
  8. type
  9. TQRCodeImage = class(TImage)
  10. private
  11. QRTextBuffer: array [0..3917] of BYTE;
  12. QRTempBuffer: array [0..3917] of BYTE;
  13. FText: AnsiString;
  14. FIsOK: boolean;
  15. FEcl: TECL;
  16.  
  17. procedure SetECL(value: TECL);
  18. procedure SetHeight(value: integer);
  19. procedure SetWidth(value: integer);
  20. function GetHeight: integer;
  21. function GetWidth: integer;
  22. function GetQRSize: integer;
  23.  
  24. protected
  25. procedure Resize; override;
  26. function CanResize(var NewWidth, NewHeight: Integer): Boolean; override;
  27. procedure SetName(const Value: TComponentName); override;
  28. //virtual bool __fastcall CanResize(int &NewWidth, int &NewHeight);
  29. //virtual void __fastcall SetName(const AnsiString Value);
  30.  
  31. public
  32. function EncodeText(Text: AnsiString): boolean;
  33. procedure SetText(Text: AnsiString);
  34. procedure DrawToCanvas(Canvas: TCanvas);
  35. procedure Draw();
  36.  
  37. constructor Create(AOwner: TComponent); override;
  38.  
  39. published
  40. property Text: AnsiString read FText write SetText;
  41. property IsOk: boolean read FIsOK;
  42. property ErrorCorrectionLevel: TECL read FECL write SetECL;
  43. property QRSize: integer read GetQRSize;
  44. property Height read GetHeight write SetHeight;
  45. property Width read GetWidth write SetWidth;
  46. { Published declarations }
  47. end;
  48.  
  49. procedure Register;
  50.  
  51. implementation
  52. {$R *.res}
  53.  
  54. procedure Register;
  55. begin
  56. RegisterComponents('Samples', [TQRCodeImage]);
  57. end;
  58.  
  59. constructor TQRCodeImage.Create(AOwner: TComponent);
  60. begin
  61. inherited Create(AOwner);
  62. Stretch:= true;
  63. FEcl:= MEDIUM;
  64. FIsOK:= false;
  65. end;
  66.  
  67. procedure TQRCodeImage.SetECL(value: TECL);
  68. begin
  69. if(value < LOW) or (value > HIGH) then exit;
  70.  
  71. if FEcl <> value then
  72. begin
  73. FEcl:= value;
  74. if FText <> '' then
  75. EncodeText(FText);
  76. Draw;
  77. end;
  78. end;
  79.  
  80. procedure TQRCodeImage.SetHeight(Value: integer);
  81. begin
  82. if Height <> Value then
  83. begin
  84. inherited Height:= Value;
  85. inherited Width:= Value;
  86. end;
  87. end;
  88.  
  89. procedure TQRCodeImage.SetWidth(Value: integer);
  90. begin
  91. if Width <> Value then
  92. begin
  93. inherited Width:= Value;
  94. inherited Height:= Value;
  95. end;
  96. end;
  97.  
  98. function TQRCodeImage.GetHeight: integer;
  99. begin
  100. Result:= inherited Height;
  101. end;
  102.  
  103. function TQRCodeImage.GetWidth: integer;
  104. begin
  105. Result:= inherited Width;
  106. end;
  107.  
  108. procedure TQRCodeImage.Resize;
  109. begin
  110. inherited;
  111. Draw();
  112. end;
  113.  
  114. function TQRCodeImage.CanResize(var NewWidth, NewHeight: Integer): boolean;
  115. begin
  116. if NewHeight <> NewWidth then
  117. NewWidth:= NewHeight;
  118. Result:= true;
  119. end;
  120.  
  121.  
  122. function TQRCodeImage.GetQRSize: integer;
  123. begin
  124. Result:= 0;
  125. if FIsOK then
  126. Result:= _qrcodegen_getSize(@QRTextBuffer[0]);
  127. end;
  128.  
  129. procedure TQRCodeImage.SetName(const Value: TComponentName);
  130. begin
  131. //TImage::SetName(Value);
  132. inherited;
  133. if FText <> Value then SetText(Value);
  134. end;
  135.  
  136. function TQRCodeImage.EncodeText(Text: AnsiString): boolean;
  137. begin
  138. FText:= Text;
  139. FIsOK:= _qrcodegen_encodeText(PAnsiChar(FText),
  140. @QRTempBuffer[0], @QRTextBuffer[0], FEcl,
  141. qrcodegen_VERSION_MIN, qrcodegen_VERSION_MAX,
  142. qrcodegen_Mask_AUTO, true);
  143.  
  144. Result:= FIsOK;
  145. end;
  146.  
  147. procedure TQRCodeImage.SetText(Text: AnsiString);
  148. begin
  149. if FText <> Text then
  150. begin
  151. FText:= Text;
  152. EncodeText(Text);
  153. Draw;
  154. end;
  155. end;
  156.  
  157. procedure TQRCodeImage.DrawToCanvas(Canvas: TCanvas);
  158. var
  159. C: TColor;
  160. Size, x, y: integer;
  161. begin
  162. Size:= GetQRSize;
  163. for y:= 0 to Size-1 do
  164. begin
  165. for x:= 0 to Size-1 do
  166. begin
  167. C:= clWhite;
  168. if _qrcodegen_getModule(@QRTextBuffer[0], x, y) then C:= clBlack;
  169. Canvas.Pixels[x, y]:= C;
  170. end;
  171. end;
  172. end;
  173.  
  174. procedure TQRCodeImage.Draw();
  175. var
  176. Size: integer;
  177. begin
  178. if FIsOK then
  179. begin
  180. Size:= GetQRSize;
  181. Picture.Bitmap.Width:= Size;
  182. Picture.Bitmap.Height:= Size;
  183. DrawToCanvas(Picture.Bitmap.Canvas);
  184. end;
  185. end;
  186.  
  187. end.

0d59cb6ad8df61e923a65bd6594176aao.jpg

 

 

El uso es tan sencillo como elde un TImage con una propiedad Text que será objeto de codificación QR y 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 nospermite pintar el código 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 daso que el bitmap es puramente digital 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.

Archivos adjuntos


  • 2

#2 escafandra

escafandra

    Advanced Member

  • Moderadores
  • PipPipPip
  • 3.878 mensajes
  • LocationMadrid - España

Escrito 02 enero 2020 - 10:25

Para el que le interese el tema le dejo un enlace sobre la adaptación a delphi del famoso código ZXing usado en los lectores para smartphone tipo Barcode Scanner. DelphiZXingQRCode: Delphi QR Code Generator

Saludos.


  • 2

#3 egostar

egostar

    missing my father, I love my mother.

  • Administrador
  • 14.019 mensajes
  • LocationMéxico

Escrito 02 enero 2020 - 11:56

Wow!!!

 

Que componente tan interesante amigo escafandra.  :ap:  :ap:  :ap:

 

Saludos


  • 0

#4 escafandra

escafandra

    Advanced Member

  • Moderadores
  • PipPipPip
  • 3.878 mensajes
  • LocationMadrid - España

Escrito 05 enero 2020 - 05:56

He de añadir que el el caso de que se desee usar QReport, se puede derivar de TQRImage en lugar de TImage e inmediatamente ya tenemos nuestro componente adaptado a Reportes QReport

 

Saludos.


  • 2

#5 escafandra

escafandra

    Advanced Member

  • Moderadores
  • PipPipPip
  • 3.878 mensajes
  • LocationMadrid - España

Escrito 06 enero 2020 - 04:27

He de añadir que el el caso de que se desee usar QReport, se puede derivar de TQRImage en lugar de TImage e inmediatamente ya tenemos nuestro componente adaptado a Reportes QReport

Me animo a ello, he creado ese componente que funcionará en delphi 7 si importamos los componentes QReport que están en Delphi7\Bin\dclqrt70.bpl

Saludos.

 

Edito: Actualización del componente TQRCodeQRImage para QReport

Archivos adjuntos


  • 2

#6 escafandra

escafandra

    Advanced Member

  • Moderadores
  • PipPipPip
  • 3.878 mensajes
  • LocationMadrid - España

Escrito 16 enero 2020 - 04:39

Actualizo el componente TQRCodeQRImage para QReport, el enlace de descarga está aquí

Saludos.
  • 2

#7 enecumene

enecumene

    Webmaster

  • Administrador
  • 7.409 mensajes
  • LocationRepública Dominicana

Escrito 20 enero 2020 - 12:24

Excelente!! gracias amigo!!!


  • 0