QrCode c�digo de barras bidimensional: Delphi

Neste artigo iremos aprender como criar c�digo de barras 2d QRCode

O QR Code � uma tecnologia que poucas pessoas no Brasil conhecem, � um c�digo de barras 2D que est� sendo cada vez mais utilizado em an�ncios publicit�rios, videoclipes e uma s�rie de outras situaç�es.

Ficou curioso para saber como funciona? Ent�o confira este artigo.

Trata-se de um c�digo de barras 2D capaz de armazenar at� 4.296 caracteres alfanum�ricos de texto.

C�digos QR pode ser lido por um dispositivo que v�o desde leitores de c�digo QR e para qualquer celular que permite ao usu�rio apontar a c�mera para uma figura.

O mais legal � que voc� mesmo pode criar um QR Code !

Ent�o vamos nessa, crie um novo projeto Delphi VCL e iremos adicionar um TImage, TMemo, TButton, 2 TMaskEdit, TComboBox e 3 TLabel, , abaixo temos o layout do formul�rio.

Figura 1. Layout do Formul�rio.

Mudando as propriedades dos componentes no projeto.

Image1: Height e Width mude para 321
Memo1: Lines mude para digite aqui sua mensagem
EditMask1: EditMask mude para !999;1;
EditMask2: EditMask mude para !999;1;
EditMask1: Text mude para 300
EditMask2: Text mude para 300
ComboBox1: Text mude para L - [padr�o] Permite a recuperaç�o de at� 7% de perda de dados
ComboBox1: Items Adicione - L - [padr�o] Permite a recuperaç�o de at� 7% de perda de dados
ComboBox1: Items Adicione - M - Permite a recuperaç�o de at� 15% de perda de dados
ComboBox1: Items Adicione - Q - Permite a recuperaç�o de at� 25% de perda de dados
ComboBox1: Items Adicione - H - Permite a recuperaç�o de at� 30% a perda de dados
ComboBox1: Style mude para csDropDownList
ComboBox1: ItemIndex mude para 0
Button1: Caption mude para Gerar Etiqueta

Codificando o projeto, incluir 3 classes no uses PngImage, HTTPApp, WinInet, procedure WinInet_HttpGet, procedure GetQrCode, constante UrlGoogleQrCode e uma vari�vel enumerada na sess�o Type com o nome TQrImage_ErrCorrLevel.

Observaç�o: vari�vel enumerada � um tipo de vari�vel pr�-definida criada na sess�o Type Exemplo:


Type
TDiaSemana =  (segunda, terça-feira, domingo);

Assim que definir um tipo de dados enumerado, podemos declarar vari�veis para ser desse tipo:

var algumdia: TDiaSemana;

O objetivo principal de um tipo de dados enumerado � deixar claro quais dados o programa ir� manipular. Um tipo enumerado � realmente apenas uma maneira abreviada de atribuiç�o de valores seq�enciais a constantes. Dadas estas declaraç�es, terça-feira � uma constante do tipo TDiaSemana .

Listagem 1.Ficando assim nosso c�digo at� o momento!


unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Image1: TImage;
    Memo1: TMemo;
    Button1: TButton;
    MaskEdit1: TMaskEdit;
    MaskEdit2: TMaskEdit;
    ComboBox1: TComboBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses
  PngImage,
  HTTPApp,
  WinInet;

{$R *.dfm}

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

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');

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;

end.

Listagem 2. No Evento OnClick do Button1 implemente o c�digo abaixo:


procedure TForm1.Button1Click(Sender: TObject);
var
  ImageStream: TMemoryStream;
  PngImage: TPngImage;
begin
  Image1.Picture := nil;
  ImageStream := TMemoryStream.Create;
  PngImage := TPngImage.Create;
  try
    try
      GetQrCode(StrToInt(Trim(MaskEdit1.Text)), StrToInt(Trim(MaskEdit2.Text)),
        TQrImage_ErrCorrLevel(ComboBox1.ItemIndex), Memo1.Lines.Text,
        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;

Listagem 3. No Evento OnCreate do Form1 implemente o c�digo abaixo: