Ir al contenido


Foto

TQRCodeImage, un codificador de codigo QR


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

#1 escafandra

escafandra

    Advanced Member

  • Administrador
  • 4.107 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 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.

Archivos adjuntos


  • 2

#2 escafandra

escafandra

    Advanced Member

  • Administrador
  • 4.107 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.448 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

  • Administrador
  • 4.107 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

  • Administrador
  • 4.107 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


  • 3

#6 escafandra

escafandra

    Advanced Member

  • Administrador
  • 4.107 mensajes
  • LocationMadrid - España

Escrito 16 enero 2020 - 04:39

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

Saludos.
  • 3

#7 enecumene

enecumene

    Webmaster

  • Administrador
  • 7.419 mensajes
  • LocationRepública Dominicana

Escrito 20 enero 2020 - 12:24

Excelente!! gracias amigo!!!


  • 0

#8 lledesma

lledesma

    Newbie

  • Miembros
  • Pip
  • 1 mensajes

Escrito 28 diciembre 2020 - 07:11

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.

Buenas, en caso de utilizar report Builder como se podria hacer? los reportes los tengo en esa herramienta. Gracias


  • 0

#9 escafandra

escafandra

    Advanced Member

  • Administrador
  • 4.107 mensajes
  • LocationMadrid - España

Escrito 29 diciembre 2020 - 05:48

Buenas, en caso de utilizar report Builder como se podria hacer? los reportes los tengo en esa herramienta. Gracias


No utilizo Report Builder pero date cuenta que la clase presentada TQRCodeImage es un TImage puesto que se deriva de esa clase. Su Bitmap puede ser usado como te apetezca y por supuesto lo podrás volcar en el equivalente imagen de ReportBuilder. Puedes crear un TQRCodeImage en tiempo de ejecución para usar su Bitmap con lo que no será visible hasta que lo coloques en tu reporte. Si te fijas en este tema publico dos componentes, uno derivado del TImage y otro derivado de TQRImage (QReport) siendo muy similares pues ambos cargan el código QR en un Bitmap. Quizás es mas liosa la nomenclarura de las clases puesto que las clases QReport empiezan sus nombres con "TQR" y se confunde con el nombre "Código QR" pero evidentemente son cosas distintas.
 
 
Este método es el que genera la imagen desde el buffer QRTextBuffer (buffer que ya contiene el Código QR):


delphi
  1. procedure TQRCodeImage.DrawToCanvas(Canvas: TCanvas);
  2. var
  3. C: TColor;
  4. Size, x, y: integer;
  5. begin
  6. Size:= GetQRSize;
  7. for y:= 0 to Size-1 do
  8. begin
  9. for x:= 0 to Size-1 do
  10. begin
  11. C:= clWhite;
  12. if _qrcodegen_getModule(@QRTextBuffer[0], x, y) then C:= clBlack;
  13. Canvas.Pixels[x, y]:= C;
  14. end;
  15. end;
  16. end;

El buffer (QRTextBuffer) se genera con este método a partir de una cadena de texto a codificar:


delphi
  1. function TQRCodeImage.EncodeText(Text: AnsiString): boolean;
  2. begin
  3. FText:= Text;
  4. FIsOK:= _qrcodegen_encodeText(PAnsiChar(FText),
  5. @QRTempBuffer[0], @QRTextBuffer[0], FEcl,
  6. qrcodegen_VERSION_MIN, qrcodegen_VERSION_MAX,
  7. qrcodegen_Mask_AUTO, true);
  8.  
  9. Result:= FIsOK;
  10. end;

Con esto tienes las siguientes opciones:

1- Crear tu propio componente en Report Builder.

2- Usar la clase TQRCodeImage para asignar el Bitmap generado al objeto Imagen apropiado de tu reporte.

3- Utilizar el método DrawToCanvas de TQRCodeImage, que es público, para dibujar el código QR en donde quieras.

 

 

Saludos.


  • 2

#10 superborg

superborg

    Newbie

  • Miembros
  • Pip
  • 1 mensajes

Escrito 10 febrero 2021 - 09:43

Hola

Lo probé y anda perfecto.

El problema es que no es compatible con código de 64bits.

Sera muy complicado adaptarlo?

 

 


  • 0

#11 escafandra

escafandra

    Advanced Member

  • Administrador
  • 4.107 mensajes
  • LocationMadrid - España

Escrito 11 febrero 2021 - 07:49

Hola
Lo probé y anda perfecto.
El problema es que no es compatible con código de 64bits.
Sera muy complicado adaptarlo?


...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.


Para adaptarlo a 64bits hay que recompilar qrcodegen.c, esta vez para 64 bits.

Saludos.
  • 0

#12 matiasaraujo

matiasaraujo

    Newbie

  • Miembros
  • Pip
  • 1 mensajes

Escrito 08 marzo 2021 - 03:34

Que tal escafandra, consulta. Se podra aplicar este codigo para Delphi5?, por que todo lo que encontre son pagos y esta muy caro.

 

Gracias!!!


  • 0

#13 escafandra

escafandra

    Advanced Member

  • Administrador
  • 4.107 mensajes
  • LocationMadrid - España

Escrito 08 marzo 2021 - 04:50

Que tal escafandra, consulta. Se podra aplicar este codigo para Delphi5?, por que todo lo que encontre son pagos y esta muy caro.

 

Gracias!!!

No dispongo de delphi 5 y tampoco recuerdo si trae QReport pero si es así, no veo problemas para no poder compilarlo con delphi5. En Delphi6 lo he compilado y probado sin problemas.

 

Saludos.


  • 0

#14 Caral

Caral

    Advanced Member

  • Moderador
  • PipPipPip
  • 4.266 mensajes
  • LocationCosta Rica

Escrito 20 octubre 2021 - 07:52

hola a todos

muy interesante y practico pero me quedan dudas

este me parece que tiene un edit y genera el qr

la duda es

1 como hago por ejemplo 3 lineas asi

a_ texto

b_ imagen texto

c_ imagen texto

d_ como presiono en el texto generado para que haga algo mas.

otra seria generar en qr en base a una imagen jpg o png. e igualmente presionar y que haga algo.

gracias

saludos


  • 0

#15 escafandra

escafandra

    Advanced Member

  • Administrador
  • 4.107 mensajes
  • LocationMadrid - España

Escrito 21 octubre 2021 - 01:44

Para incluir más de una línea en el QR basta con introducir retornos de linea #13#10 en el texto:

delphi
  1. QRCodeImage1.Text:= 'Una línea'#13#10'Otra línea'#13#10'Una más';

No entiendo a qué te refieres con lo de las imágenes. Se pueden codificas a texto con Base 64 y meterlo en el QR pero no tiene mucho sentido pues ocuparán mucho y harán un QR demasiado denso.
 
Como el componente se deriva de TImage, tiene sus priopiedades y, por lo tanto, puedes manejar el evento OnClick. Creo que esto te resuelve la duda de como hacer que reacione a un click.
 
Para que adquiera su funcionalidad completa deberás instalarlo como componente y usarlo desde la paleta de tu delphi. Abre el proyecto dos.dpk y compílalo. Quedará instalado en tu IDE en la paleta Samples y puedes cambiarla a otra si lo deseas.
 
Saludos.
  • 0

#16 Caral

Caral

    Advanced Member

  • Moderador
  • PipPipPip
  • 4.266 mensajes
  • LocationCosta Rica

Escrito 21 octubre 2021 - 08:26

hola
gracias escafandra
lo de las imagenes es por que he visto en algunos qr que ponen una imagen pequeña antes del texto, me imagino que para darle realse o que no se vea solo el texto una vez que se escanea el qr.
tengo que practicar para ver como hacer el evento onclik en el texto mostrado.
si tienes alguna otra consideracion que creas que me puede servir (para novato) te lo agradeceria mucho.
gracias
saludos
  • 0

#17 Caral

Caral

    Advanced Member

  • Moderador
  • PipPipPip
  • 4.266 mensajes
  • LocationCosta Rica

Escrito 22 octubre 2021 - 11:26

hola escafranda
a ver si me explico mejor
estoy tratando de hacer un codigo qr que
a la hora de escanearlo me habra una imagen guardada en documents en el movil con android, directamente o con texto de ver previo.
osea la persona guarda la imagen en documents en su movil y cuando escanea el codigo qr le abre la imagen guardada.
saludos
gracias
  • 0

#18 escafandra

escafandra

    Advanced Member

  • Administrador
  • 4.107 mensajes
  • LocationMadrid - España

Escrito 24 octubre 2021 - 02:54

No he probado el componente en android.

 

Saludos.


  • 0

#19 Caral

Caral

    Advanced Member

  • Moderador
  • PipPipPip
  • 4.266 mensajes
  • LocationCosta Rica

Escrito 25 octubre 2021 - 11:04

hola
no te preocupes, si algun dia haces la prueba me dices.
saludos
  • 0

#20 egostar

egostar

    missing my father, I love my mother.

  • Administrador
  • 14.448 mensajes
  • LocationMéxico

Escrito 26 octubre 2021 - 07:10

Voy a intentar hacer la prueba

 

hola
no te preocupes, si algun dia haces la prueba me dices.
saludos

 

Voy a intentar hacer la prueba en Android, a ver que sale.

 

Saludos


  • 0




IP.Board spam blocked by CleanTalk.