Estava funcionando e agora não funciona mais ACBrDelphiZXingQRCode

[Arturo]

De repente parou de funcionar. O que pode ser?

uses  ACBrDelphiZXingQRCode

QrCodeToCanvas(fmwQrCode.Image1.Width, fmwQrCode.Image1.Height, Memo1.text, fmwQrCode.Image1.Canvas);

procedure QrCodeToCanvas(AWidth, AHeight: Integer; ATexto:String; ACanvas: TCanvas);
var
  bitmap : TBitmap;
  qr     : TDelphiZXingQRCode;
  r      : Integer;
  c      : Integer;
  scala  : Double;
  Rect   : TRect;
begin
  bitmap      := TBitmap.create;
  try
    qr        := TDelphiZXingQRCode.create;
    try
      qr.Data := ATexto;

      // ajuta o tamanho do bitmap para o tamanho do qrcode
      bitmap.SetSize(qr.Rows, qr.Columns);

      fmwVar.wKeybdI1 := qr.Rows;
      fmwVar.wKeybdI2 := qr.Columns;

      // copia o qrcode para o bitmap
      for r := 0 to fmwVar.wKeybdI1 - 1 do
      for c := 0 to fmwVar.wKeybdI2 - 1 do

      if qr.IsBlack[r, c] then
            bitmap.Canvas.Pixels[c, r] := clBlack
      else  bitmap.Canvas.Pixels[c, r] := clWhite;

      // prepara para redimensionar o qrcode para o tamanho do canvas
      if (AWidth < bitmap.Height) then
              scala := (AWidth  / bitmap.Width)
         else scala := (AHeight / bitmap.Height);

         // transfere o bitmap para a imagem
         fmwVar.wKeybdI1          := Trunc(scala * bitmap.Width);
         fmwVar.wKeybdI2          := Trunc(scala * bitmap.Height);
         Rect.Height              := fmwVar.wKeybdI1;
         Rect.Width               := fmwVar.wKeybdI2;
         Rect.left                := 0;
         fmwQrCode.Image1.Canvas.StretchDraw(Rect, bitmap);
    finally
      qr.Free;
    end;
  finally
    bitmap.Free;
  end;
end;          

 

[Daniel Simoes]

Qual é exatamente o problema, ou mensagem de Erro ?

[Arturo]

Nenhuma mensagem de erro. Apenas não gera a imagem, Gera apenas uma linha.

Vide anexos Agora e Antes. O Antes é a partir de um executável anterior e o agora é um executável a partir de nova compilação (O detalhe é que esse programa não foi alterado).

Editado 14 Abril, 2023 por Arturo

[Daniel Simoes]

Não temos relatos semelhantes no fórum, e essa Unit que gera o QRCode não recebe modificações a muito tempo...

Pode ser que seja algum problema no Image, desse formulário...

Consegue reproduzir o problema, no Demo do ACBr ?

@EliasCesar, sabe de algo ?

[Diego Foliene]

4 minutos atrás, Arturo disse:

Nenhuma mensagem de erro. Apenas não gera a imagem, Gera apenas uma linha.

Vide anexos Agora e Antes. O Antes é a partir de um executável anterior e o agora é um executável a partir de nova compilação (O detalhe é que esse programa não foi alterado).

Bom dia.

Você está querendo gerar um QRCodeEstático para PIX, é isso?

No programa exemplo do componente ACBrPIXCD temos um exemplo de como realizar esse processo.

procedure TForm1.PintarQRCodeEstatico;
begin
  mQRE.Lines.Text := ACBrPixCD1.GerarQRCodeEstatico(
                       StrToFloatDef(fleQREValor.Text, 0),
                       edtQREInfoAdicional.Text,
                       edtQRETxId.Text);
  PintarQRCode(mQRE.Lines.Text, imgQRE.Picture.Bitmap, qrUTF8BOM);
end;

[Arturo]

Na verdade emite QrCode Livre e QrCode para PIX.

Pesquisei na Internet e fiz alteração em minha rotina e voltou a funcionar.

Não vou saber o que houve, nem o que alterei, mas segue a rotina que está funcionando. Pode ser útil para outra pessoa que tenha o mesmo problema.

A alteração que efetuei está basicamente no comando  // transfere o bitmap para a imagem

Agradeço vossa atenção.

procedure QrCodeToCanvas(AWidth, AHeight: Integer; ATexto:String; ACanvas: TCanvas);
var
  bitmap: TBitmap;
  qr:        TDelphiZXingQRCode;
  r:         Integer;
         Integer;
  vI1:      Integer;
  vI2:     Integer;
  scala:  Double;
begin
  bitmap := TBitmap.create;
  try
    qr := TDelphiZXingQRCode.create;
  try
    qr.Data := ATexto;

    // ajuta o tamanho do bitmap para o tamanho do qrcode
    bitmap.SetSize(qr.Rows, qr.Columns);

    // copia o qrcode para o bitmap

    vI1   := qr.Rows;
    vI2   := qr.Columns;

    for r := 0 to vI1 - 1 do
    for c := 0 to vI2 - 1 do

    if qr.IsBlack[r, c] then
            bitmap.Canvas.Pixels[c, r] := clBlack
    else bitmap.Canvas.Pixels[c, r] := clWhite;

    // prepara para redimensionar o qrcode para o tamanho do canvas
    if (AWidth < bitmap.Height) then
           scala := (AWidth  / bitmap.Width)
   else scala := (AHeight / bitmap.Height);

   // transfere o bitmap para a imagem
   ACanvas.StretchDraw(Rect(0, 0, Trunc(scala * bitmap.Width),
   Trunc(scala * bitmap.Height)), bitmap);

  finally
     qr.Free;
  end;
  finally
     bitmap.Free;
  end;
end;             

[EliasCesar]

Olá @Arturo,

A unit ACBrImage possui uma procedure chamada "PintarQRCode()"

Nela vc passa como parâmetros:
 - String com o conteúdo;
 - TBitmap onde a imagem será desenhada;
 - TQRCodeEncoding que deverá ser utilizado.

Um exemplo de utilização:

PintarQRCode(wQRCode, imgQRCode.Picture.Bitmap, qrUTF8BOM); 

Onde 'wQRCode' é uma String com o conteúdo Copia e Cola de um pix, 'imgQRCode' é um TImage e qrUTF8BOM é o encoding desejado.

Avalie se seria útil utilizá-la no seu código.