Simplificacion de la libreria DelphiZXingQRCodeEx

[darkamerico]

Saludos amigos,
Deseo utilizar la librería DelphiZXingQRCodeEx, sin tener un formulario lleno de parámetros, sino definiéndolas directamente en código, realice un pequeño proyecto para este fin, la unidad principal se puede ver a continuación:

Código Delphi [-]
unit uPrincipal;

interface

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

type
  TForm1 = class(TForm)
    pbPreview: TPaintBox;
    btnGenerarQR: TButton;
    lblQRMetrics: TLabel;
    procedure btnGenerarQRClick(Sender: TObject);
    procedure pbPreviewPaint(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FQRCode: TDelphiZXingQRCode;
    FAltFixed: Boolean;
  public
    procedure RemakeQR;
  end;

var
  Form1: TForm1;

implementation

uses QRGraphics, QR_Win1251, QR_URL, jpeg;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  FQRCode := TDelphiZXingQRCode.Create;
  FQRCode.RegisterEncoder(ENCODING_WIN1251, TWin1251Encoder);
  FQRCode.RegisterEncoder(ENCODING_URL, TURLEncoder);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FQRCode.Free
end;

procedure TForm1.pbPreviewPaint(Sender: TObject);
begin
  with pbPreview.Canvas do
  begin
    Pen.Color := clBlack;
    Brush.Color := clBlack;
  end;
  DrawQR(pbPreview.Canvas, pbPreview.ClientRect, FQRCode, 0, TQRDrawingMode(0 div 2), Boolean(1 - 0 mod 2));
end;

procedure TForm1.RemakeQR;
begin
  with FQRCode do
  try
    BeginUpdate;
    Data := 'atg';
    Encoding := 0; // Auto
    ErrorCorrectionOrdinal := TErrorCorrectionOrdinal(1);
    QuietZone := 4;
    EndUpdate(True);
    lblQRMetrics.Caption := IntToStr(Columns) + 'x' + IntToStr(Rows) + ' (' +
      IntToStr(Columns - QuietZone * 2) + 'x' + IntToStr(Rows - QuietZone * 2) +
      ')';
  finally
    pbPreview.Repaint;
  end;
end;

procedure TForm1.btnGenerarQRClick(Sender: TObject);
var
  H: Integer;
begin
  FAltFixed := False;
  FQRCode := nil;

  pbPreview.Repaint;

end;

end.

Podrian ayudarme en hacerlo funcionar cuando presione el botón Generar.

Atte
Americo Torres

[darkamerico]

Encontré un código como el siguiente:

Código Delphi [-]
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;
end;

[darkamerico]

[darkamerico]

Empezado por darkamerico

El proyecto está Aqui

[darkamerico]

Encontré esta solución, ya la compile y va 100%:

Código Delphi [-]
unit uPrincipal;

interface

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

type
  TForm1 = class(TForm)
    btnGenerarQR: TButton;
    Image1: TImage;
    procedure btnGenerarQRClick(Sender: TObject);
  private
  public
  end;

type
  TQrImage_ErrCorrLevel=(L,M,Q,H);

var
  Form1: TForm1;

implementation

uses jpeg, PngImage, HTTPApp, WinInet;

const
  UrlGoogleQrCode='http://chart.apis.google.com/chart?chs=%dx%d&cht=qr&chld=%s&chl=%s';
  QrImgCorrStr   : array [TQrImage_ErrCorrLevel] of string=('L','M','Q','H');

{$R *.dfm}

procedure WinInet_HttpGet(const Url: string;Stream:TStream);
const
BuffSize = 1024*1024;
var
  hInter   : HINTERNET;
  UrlHandle: HINTERNET;
  BytesRead: DWORD;
  Buffer   : Pointer;
begin
  hInter := InternetOpen('', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
  if Assigned(hInter) then
  begin
    Stream.Seek(0,0);
    GetMem(Buffer,BuffSize);
    try
        UrlHandle := InternetOpenUrl(hInter, PChar(Url), nil, 0, INTERNET_FLAG_RELOAD, 0);
        if Assigned(UrlHandle) then
        begin
          repeat
            InternetReadFile(UrlHandle, Buffer, BuffSize, BytesRead);
            if BytesRead>0 then
             Stream.WriteBuffer(Buffer^,BytesRead);
          until BytesRead = 0;
          InternetCloseHandle(UrlHandle);
        end;
    finally
      FreeMem(Buffer);
    end;
    InternetCloseHandle(hInter);
  end
end;

procedure GetQrCode(Width,Height:Word;Correction_Level:TQrImage_ErrCorrLevel;const Data:string;StreamImage: TMemoryStream);
Var
 EncodedURL: string;
begin
  EncodedURL:=Format(UrlGoogleQrCode,[Width,Height,QrImgCorrStr[Correction_Level],HTTPEncode(Data)]);
  WinInet_HttpGet(EncodedURL,StreamImage);
end;

procedure TForm1.btnGenerarQRClick(Sender: TObject);
var
  ImageStream: TMemoryStream;
  PngImage: TPngImage;
begin
 Image1.Picture:=nil;
 ImageStream:=TMemoryStream.Create;
 PngImage   :=TPngImage.Create;
 try
   try
       GetQrCode(169,169,TQrImage_ErrCorrLevel(1),'atg',ImageStream);
       if ImageStream.Size>0 then
       begin
          ImageStream.Position:=0;
          PngImage.LoadFromStream(ImageStream);
          Image1.Picture.Assign(PngImage);
       end;
   except
      on E: exception do
      ShowMessage(E.Message);
   end;
 finally
  ImageStream.Free;
  PngImage.Free;
 end;
end;


end.

Sin embargo, depende de la API de Google, sigo pensando que un código standalone sigue siendo mejor.

Atte

[Neftali [Germán.Estévez]]

Difícil adivinar lo que necesitas sólo con determinadas partes del código que has encontrado por Internet.
Revisando un poco y haciendo alguna prueba se ve que el primero, no corresponde a ese componente o al menos a la misma versión.

De todas formas trasteando un poco con uno de los códigos que has puesto sí se puede conseguir que pinte un código con algo.

Crea un proyecto con un Formulario y dentro un TImage con nombre: QRCodeBitmap
A continuación, en el OnCreate del formulario escribe lo siguiente:

Código Delphi [-]
procedure TForm1.FormCreate(Sender: TObject);
var
  QRCode: TDelphiZXingQRCode;
  Row, Column: Integer;
begin
  QRCode := TDelphiZXingQRCode.Create;
  try
    QRCode.Data := '39217493741947298471293741t4352234v54325f43v25435v324c543523425c982' +
                   '39217493741947298471293741t4352234v54325f43v25435v324c543523425c982' +
                   '39217493741947298471293741t4352234v54325f43v25435v324c543523425c982';
    QRCode.Encoding := qrAuto;
    QRCode.QuietZone := 400;
    QRCodeBitmap.Picture.Bitmap.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;
end;

Con eso debería bastar para dibujar un QR.

[darkamerico]

En efecto, no me explique apropiadamente, debido quizas a que ando con muchas cosas ahora, ese código me sirve, gracias amigo

Empezado por Neftali [Germán.Estévez]

Difícil adivinar lo que necesitas sólo con determinadas partes del código que has encontrado por Internet.
Revisando un poco y haciendo alguna prueba se ve que el primero, no corresponde a ese componente o al menos a la misma versión.

De todas formas trasteando un poco con uno de los códigos que has puesto sí se puede conseguir que pinte un código con algo.

Crea un proyecto con un Formulario y dentro un TImage con nombre: QRCodeBitmap
A continuación, en el OnCreate del formulario escribe lo siguiente:

Código Delphi [-]
procedure TForm1.FormCreate(Sender: TObject);
var
  QRCode: TDelphiZXingQRCode;
  Row, Column: Integer;
begin
  QRCode := TDelphiZXingQRCode.Create;
  try
    QRCode.Data := '39217493741947298471293741t4352234v54325f43v25435v324c543523425c982' +
                   '39217493741947298471293741t4352234v54325f43v25435v324c543523425c982' +
                   '39217493741947298471293741t4352234v54325f43v25435v324c543523425c982';
    QRCode.Encoding := qrAuto;
    QRCode.QuietZone := 400;
    QRCodeBitmap.Picture.Bitmap.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;
end;

Con eso debería bastar para dibujar un QR.