freie QR-Code Komponente mit Error Correction Level M

[Rollo62]

Hallo jus,

das ist nur ein QuickandDirsty Test, funktioniert aber.
Der Barcode wird mit GetBarcode ausgelesen, und dann als JPG ausgegeben,
wichtig war dabei die DPI anzugeben, damit es im richtigen Masstab gedruckt wird.
Ich habe gesehen das die QR-Code Größe (W x H) sprunghaft anwächst, nicht linear, wenn der Text größer wird.
Innerhalb der Sprünge scheint eine feste Größe stehen zu bleiben.
Deshalb habe ich meine Links versucht kurz zu halten, um unterschiedliche Codegrößem zu Vermeiden.

Code:

procedure TForm1.ActionQrGenerateSingleExecute(Sender: TObject);
var
  strX: string;
  strB: String;
  strX1: string;
  iPos: Integer;
  strL: String;
  bmpQr: TBitmap;
  picQr: TJpegImage;
begin
 //



 ZintBarcodeComponent1.Barcode.Scale := SpinEditScale.Value / 100.0;

 if FSelected < 0 then
   FSelected := 0; // Start

 if FLang < 0 then
   FLang := 0; // Start

 strB := EditBaseFolder.Text;
 if strB <> '' then
   S4Str_LastChar_Force(strB, '/');

 strX1 := MemoQrList.Lines.Strings[FSelected];
 strX  := strX1;

 strL  := S4Str_Extract( EditLanguages.Text, FLang); // Get Language

 if (Length(strX) > 0) and ((strX[1] = '\') or (strX[1] = '/')) then
   Delete(strX, 1, 1); // Remove 1st

 strX := strB + strX + strL;

 MemoQrList.SelStart  := Pos(strX1, MemoQrList.Text) - 1;
 MemoQrList.SelLength := Length(strX1);

 if strX <> '' then
   S4Str_LastChar_Force(strX, '/');

 if (Pos('.htm', strX) <> 0) or (Pos('.html', strX) <> 0) and (S4Str_LastChar(strX) = '/') then
   begin
     // S4Str_LastChar_Set;
     iPos := Length(strX);
     if iPos <> 0 then
       Delete(strX, iPos, 1);
   end;

 LabelQRCode.Caption := 'QR-Code: ' + strX;

 ZintBarcodeComponent1.Barcode.Data := strX;
 ZintBarcodeComponent1.Refresh;

 //
 // Get Barcode
 //
 bmpQr := TBitmap.Create;
 picQr := TJpegImage.Create;

 try

   strX := S4Str_EndsForce(SaveDialog1.InitialDir, '\');

   ZintBarcodeComponent1.Barcode.GetBarcode(bmpQr);

   picQr.Assign(bmpQr);
   picQr.CompressionQuality := 80;
   picQr.SaveToFile( strX + strX1 + strL + '.jpg'); // Save as JPEG

 finally

   FreeAndNil(picQr);
   FreeAndNil(bmpQr);

 end;


 if CheckBoxGenAll.Checked then
 begin
   JvTimerList1.Events[0].Enabled := True;  // Enable Automatic Animate
 end;


 Inc(FLang);

 strL  := S4Str_Extract( EditLanguages.Text, FLang); // Get Language
 if strL = '' then
 begin
   FLang := -1; // Start Languages from begin

   Inc(FSelected);

   if FSelected < MemoQrList.Lines.Count then
     Exit;

   FSelected := -1;

   JvTimerList1.Events[0].Enabled := False;  // Stop Automatic Animate

 end;


end;