I would like to process a generated QR-code synchronously, something like the example from the manual for Barcodes, but for QR-Codes:
procedure TForm1.Button1Click(Sender: TObject);
var
bmp: TTMSFNCBitmap;
begin
//Save into a file, for example:
bmp := TMSFNCWXBarcode1.GetBarcode('codetocreate');
try
bmp.SaveToFile('path_to\my_code.png')
How can I achieve this with TMSFNCWXQRCode?
Thanks for a hint
Dani
Hi,
The underlying JavaScript library does not make it possible to get the QR code synchronously. You can do something similar to this instead but only if you are not targeting mobile or WEB:
unit Unit30;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, VCL.TMSFNCTypes, VCL.TMSFNCUtils,
VCL.TMSFNCGraphics, VCL.TMSFNCGraphicsTypes, VCL.TMSFNCCustomControl,
VCL.TMSFNCWebBrowser, VCL.TMSFNCCustomWEBControl, VCL.TMSFNCWXQRCode,
Vcl.ExtCtrls;
type
TForm30 = class(TForm)
TMSFNCWXQRCode1: TTMSFNCWXQRCode;
Image1: TImage;
procedure FormCreate(Sender: TObject);
procedure TMSFNCWXQRCode1GetQRCode(Sender: TObject; ABitmap: TTMSFNCBitmap);
private
{ Private declarations }
FReceived: Boolean;
FQRBitmap: TPicture;
public
{ Public declarations }
end;
var
Form30: TForm30;
implementation
{$R *.dfm}
procedure TForm30.FormCreate(Sender: TObject);
begin
FQRBitmap := TPicture.Create;
FReceived := False;
TMSFNCWXQRCode1.Text := 'Hello World';
while not FReceived do
begin
Application.ProcessMessages;
Sleep(1);
end;
Image1.Picture.Assign(FQRBitmap);
end;
procedure TForm30.TMSFNCWXQRCode1GetQRCode(Sender: TObject;
ABitmap: TTMSFNCBitmap);
begin
FQRBitmap.Assign(ABitmap);
FReceived := True;
end;
end.
Hi Tünde,
is where a workaround to generate the QR-Code inside a unit?
E.g. for a report generator it's not possible to use the Application.ProcessMessages;.
Thanks.
At this moment, there is with the WX Pack not a way to do this in a console app or where there is no access to application.processmessages.
At the moment I'm writing a Unit for FMX apps that can made a pdf report from a script with parameters. (a littlebit like latex)
One script command should be a qrcode. But I don't have an idea how to get the qr without an callback at the main form. Normally it should work inside the class.
Hi,
I see two issues here:
The WX components need a window handle to be able to initialize which is something you cannot do from a unit unless you pass a parent (that has a window handle) to the WX control when you create it programmatically. Are you doing that already?
As for the callback, unfortunately there is no way to avoid it. If you have access to Application.ProcessMessages then you can implement the sample above with the difference being TTMSFNCQRCode created programmatically and the event is then also assigned programmatically:
//UNIT:
uses
SysUtils, FMX.Forms, FMX.Types, FMX.TMSFNCWXQRCode, FMX.TMSFNCTypes;
type
TMyClass = class
private
FQR: TTMSFNCWXQRCode;
FQRResult: TTMSFNCBitmap;
FReady: Boolean;
FInitialized: Boolean;
procedure QRGenerated(Sender: TObject; ABitmap: TTMSFNCBitmap);
procedure QRInitialized(Sender: TObject);
public
constructor Create(AParent: TFMXObject);
destructor Destroy; override;
function GetQRCode(AText: string): TTMSFNCBitmap;
end;
implementation
{ TMyClass }
constructor TMyClass.Create(AParent: TFMXObject);
begin
FQRResult := TTMSFNCBitmap.Create;
FInitialized := False;
FQR := TTMSFNCWXQRCode.Create(AParent);
FQR.Visible := False;
FQR.OnGetQRCode := QRGenerated;
FQR.OnInitialized := QRInitialized;
FQR.Parent := AParent;
end;
destructor TMyClass.Destroy;
begin
FQR.Free;
FQRResult.Free;
inherited;
end;
function TMyClass.GetQRCode(AText: string): TTMSFNCBitmap;
begin
Result := TTMSFNCBitmap.Create;
if not FInitialized then
Exit;
FReady := False;
FQR.Text := AText;
while not FReady do
begin
Application.ProcessMessages;
Sleep(1);
end;
Result.Assign(FQRResult);
end;
procedure TMyClass.QRGenerated(Sender: TObject; ABitmap: TTMSFNCBitmap);
begin
FQRResult.Assign(ABitmap);
FReady := True;
end;
procedure TMyClass.QRInitialized(Sender: TObject);
begin
FInitialized := True;
end;
//FORM:
procedure TForm1.Button1Click(Sender: TObject);
var
bmp: TTMSFNCBitmap;
begin
bmp := FMyClass.GetQRCode('test');
try
//do something with bmp
finally
bmp.free;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FMyClass := TMyClass.Create(Self);
end;
Dear Tünde,
thanks. That hint helped me a lot.
I modified it some and put it in a separate Unit. At the end I will use it inside a report generator.
At the main form is just a Button and the PDF object.
The only disadvantage is, that the Object needs to be created in the FormCreate. Otherweise the initialisation of the qr Module doesn't works.
unit UnitMain;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
FMX.Controls.Presentation, FMX.StdCtrls, UnitQRCode;
type
TForm_Main = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private-Deklarationen }
var PDF:TPDF;
public
{ Public-Deklarationen }
end;
var
Form_Main: TForm_Main;
implementation
{$R *.fmx}
procedure TForm_Main.Button1Click(Sender: TObject);
begin
PDF.GetQRCode('Test');
end;
procedure TForm_Main.FormCreate(Sender: TObject);
begin
PDF:=TPDF.Create(Self);
end;
procedure TForm_Main.FormDestroy(Sender: TObject);
begin
FreeAndNil(PDF);
end;
end.
unit UnitQRCode;
interface
uses FMX.TMSFNCTypes, FMX.TMSFNCWXQRCode, System.SysUtils, FMX.Types, FMX.Forms;
type
TPDF = class(TObject)
private
FQR: TTMSFNCWXQRCode;
FQRResult: TTMSFNCBitmap;
FReady: Boolean;
FInitialized: Boolean;
procedure QRGenerated(Sender: TObject; ABitmap: TTMSFNCBitmap);
procedure QRInitialized(Sender: TObject);
protected
{ protected declarations }
public
constructor Create(AParent: TFMXObject);
destructor Destroy; override;
function GetQRCode(AText: string): TTMSFNCBitmap;
published
end;
implementation
constructor TPDF.Create(AParent: TFMXObject);
begin
inherited Create;
FQRResult := TTMSFNCBitmap.Create;
FInitialized := False;
FQR := TTMSFNCWXQRCode.Create(AParent);
FQR.Visible := False;
FQR.OnGetQRCode := QRGenerated;
FQR.OnInitialized := QRInitialized;
FQR.Parent := AParent;
end;
destructor TPDF.Destroy;
begin
FreeAndNil(FQR);
FreeAndNil(FQRResult);
inherited Destroy;
end;
function TPDF.GetQRCode(AText: string): TTMSFNCBitmap;
begin
Result := TTMSFNCBitmap.Create;
if FInitialized then
begin
FReady := False;
FQR.Text := AText;
while not FReady do
begin
Application.ProcessMessages;
Sleep(1);
end;
Result.Assign(FQRResult);
FQRResult.SaveToFile('c:\temp\QR.BMP');
end;
end;
procedure TPDF.QRGenerated(Sender: TObject; ABitmap: TTMSFNCBitmap);
begin
FQRResult.Assign(ABitmap);
FReady := True;
end;
procedure TPDF.QRInitialized(Sender: TObject);
begin
FInitialized := True;
end;
end.
UnitMain.pas (904 Bytes)
UnitQRCode.pas (1.7 KB)