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.