lazarus-ccr/components/lazbarcodes/examples/qrcodegenerator/main.pas

unit main;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls,
  ComCtrls, LCLIntf,
  fpimage, fpWriteGIF,
  ubarcodes;

type
  TMyGifImage = class(TGifImage)
  protected
    class function GetWriterClass: TFPCustomImageWriterClass; override;
  end;

  { TMainForm }

  TMainForm = class(TForm)
    btnCreateQR: TButton;
    btnSaveAsGIF: TButton;
    btnSaveAsBMP: TButton;
    btnSaveAsSVG: TButton;
    btnSaveAsPNG: TButton;
    btnSaveAsJPEG: TButton;
    btnSaveAsEPS: TButton;
    edText: TEdit;
    Label1: TLabel;
    StatusBar: TStatusBar;
    procedure btnCreateQRClick(Sender: TObject);
    procedure btnSaveAsEPSClick(Sender: TObject);
    procedure btnSaveAsGIFClick(Sender: TObject);
    procedure btnSaveAsBMPClick(Sender: TObject);
    procedure btnSaveAsPNGClick(Sender: TObject);
    procedure btnSaveAsSVGClick(Sender: TObject);
    procedure edTextChange(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    QRCode: TBarcodeQR;
    procedure EnableButtons(Enable: Boolean);
    procedure SaveQRCodeToImage(AFileName: String; AImageClass: TFPImageBitmapClass);

  public

  end;

var
  MainForm: TMainForm;

implementation

{$R *.lfm}

class function TMyGifImage.GetWriterClass: TFPCustomImageWriterClass;
begin
  Result := TFPWriterGIF;
end;

{ TMainForm }

procedure TMainForm.btnCreateQRClick(Sender: TObject);
begin
  QRCode.Free;
  QRCode := TBarcodeQR.Create(self);
  QRCode.Text := edText.Text;
  QRCode.Top := btnCreateQR.Top;
  QRCode.Left := btnCreateQR.Left + btnCreateQR.Width + 10;
  QRCode.Width := 168;
  QRCode.Height := 168;
  QRCode.Generate;
  QRCode.Parent := self;

  EnableButtons(true);
  StatusBar.simpleText := 'QRCode generated.';
end;

procedure TMainForm.btnSaveAsEPSClick(Sender: TObject);
var
  fn: String;
begin
  if QRCode = nil then
    exit;
  fn := 'qrcode.eps';
  QRCode.SaveToEpsFile(fn);
  StatusBar.SimpleText := 'QRCode saved to "' + fn + '".';
end;

procedure TMainForm.btnSaveAsGIFClick(Sender: TObject);
begin
  SaveQRCodeToImage('qrcode', TMyGifImage);
end;

procedure TMainForm.btnSaveAsBMPClick(Sender: TObject);
begin
  SaveQRCodeToImage('qrcode', TBitmap);
end;

procedure TMainForm.btnSaveAsPNGClick(Sender: TObject);
begin
  SaveQRCodeToImage('qrcode', TPortableNetworkGraphic);
end;

procedure TMainForm.btnSaveAsSVGClick(Sender: TObject);
var
  fn: String;
begin
  if QRCode = nil then
    exit;
  fn := 'qrcode.svg';
  QRCode.SaveToSvgFile(fn);
  StatusBar.SimpleText := 'QRCode saved to "' + fn + '".';
end;

procedure TMainForm.edTextChange(Sender: TObject);
begin
  EnableButtons(false);
end;

procedure TMainForm.FormActivate(Sender: TObject);
begin
  ClientHeight := btnSaveAsEPS.Top + btnSaveAsEPS.Height + StatusBar.Height + 16;
end;

procedure TMainForm.EnableButtons(Enable: Boolean);
begin
  btnSaveAsGIF.Visible := Enable;
  btnSaveAsBMP.Visible := Enable;
  btnSaveAsPNG.Visible := Enable;
  btnSaveAsJPEG.Visible := Enable;
  btnSaveAsSVG.Visible := Enable;
  btnSaveAsEPS.Visible := Enable;
  if not Enable then StatusBar.SimpleText := '';
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  QRCode.Free;
end;

procedure TMainForm.SaveQRCodeToImage(AFileName: String; AImageClass: TFPImageBitmapClass);
var
  ext: String;
begin
  if QRCode = nil then
    exit;

  if AImageClass = TBitmap then
    ext := '.bmp'
  else if AImageClass = TMyGifImage then
    ext := '.gif'
  else if AImageClass = TPortableNetworkGraphic then
    ext := '.png'
  else if AImageClass = TJpegImage then
    ext := '.jpg'
  else
    raise Exception.Create('Image format not supported.');

  AFileName := ChangeFileExt(AFileName, ext);
  QRCode.SaveToFile(AFileName, AImageClass);

  StatusBar.SimpleText := 'QRCode saved to "' + AFileName + '".';
end;

initialization
  TPicture.RegisterFileFormat('.gif', 'gif', TMyGifImage);
end.