qr/demos/fmx/MainForm.pas

unit MainForm;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.ListBox,
  FMX.EditBox, FMX.NumberBox, FMX.StdCtrls, FMX.Controls.Presentation, FMX.Edit,
  FMX.ScrollBox, FMX.Memo, qr.code, FMX.Objects;

type
  TfrmQRMain = class(TForm)
    cbECL: TComboBox;
    cbMask: TComboBox;
    cbVersion: TComboBox;
    txtData: TEdit;
    chkGrid: TCheckBox;
    txtWidth: TNumberBox;
    txtDetails: TMemo;
    imgQR: TImage;
    procedure txtDataChange(Sender: TObject);
  private
    FQR : TQRCode;
  public
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
  end;

var
  frmQRMain: TfrmQRMain;

implementation

{$R *.fmx}

procedure TfrmQRMain.BeforeDestruction;
begin
  inherited;
  FQR.Free;
end;

procedure TfrmQRMain.AfterConstruction;
begin
  inherited;
  cbECL.ItemIndex := 0;
  cbMask.ItemIndex := 8;
  cbVersion.ItemIndex := 0;
  FQR := TQRCode.Create;
  FQR.OnPaint :=
    procedure(Width, Height : integer; BlackRects : TArray<TRect>)
      function ECLToString : string;
      begin
        case FQR.ECLInUse of
          TErrorCorrectionLevel.Auto:
            Result := 'ERROR (Auto)';
          TErrorCorrectionLevel.Low:
            Result := 'Low';
          TErrorCorrectionLevel.Medium:
            Result := 'Medium';
          TErrorCorrectionLevel.Quartile:
            Result := 'Quartile';
          TErrorCorrectionLevel.High:
            Result := 'High';
        end;
      end;
    var
      bmp : TBitmap;
      R : TRect;
      x, y : integer;
      i: Integer;
      s, s2 : string;
      b : Byte;
    begin
      txtDetails.Lines.BeginUpdate;
      try
        txtDetails.Lines.Clear;
        txtDetails.Lines.Add('Version: '+Integer(FQR.VersionInUse).ToString);
        txtDetails.Lines.Add('ECL: '+ECLToString);
        txtDetails.Lines.Add('Module Size: '+FQR.Size.ToString+' at '+FQR.PixelsPerModule.ToString+' pixels');
        txtDetails.Lines.Add('Mask: '+Integer(FQR.MaskInUse).ToString);
        txtDetails.Lines.Add('');
        for i := 0 to 7 do
        begin
          txtDetails.Lines.Add('Penalty Score for Mask '+i.ToString);
          txtDetails.Lines.Add('  1 = '+FQR.PenaltyScores[i][0].ToString);
          txtDetails.Lines.Add('  2 = '+FQR.PenaltyScores[i][1].ToString);
          txtDetails.Lines.Add('  3 = '+FQR.PenaltyScores[i][2].ToString);
          txtDetails.Lines.Add('  4 = '+FQR.PenaltyScores[i][3].ToString);
          txtDetails.Lines.Add('  T = '+(FQR.PenaltyScores[i][0]+FQR.PenaltyScores[i][1]+FQR.PenaltyScores[i][2]+FQR.PenaltyScores[i][3]).ToString);
          txtDetails.Lines.Add('');
        end;
        txtDetails.Lines.Add('Bits:');
        txtDetails.Lines.Add(FQR.DataBits);
        txtDetails.Lines.Add('');
        txtDetails.Lines.Add('Codewords: ');
        s := '';
        s2 := '';
        for b in FQR.Codewords do
        begin
          s := s+', '+b.ToString;
          s2 := s2+', '+IntToHex(b,2);
        end;
        Delete(s,1,2);
        Delete(s2,1,2);
        txtDetails.Lines.Add(s);
        txtDetails.Lines.Add(s2);
      finally
        txtDetails.Lines.EndUpdate;
      end;
      bmp := TBitmap.Create;
      try
        bmp.Width := Width;
        bmp.Height := Height;

        bmp.Canvas.BeginScene;
        try
          bmp.Canvas.Fill.Color := TAlphaColorRec.White;
          bmp.Canvas.Stroke.Color := TAlphaColorRec.White;
          bmp.Canvas.FillRect(TRect.Create(0,0,bmp.Width, bmp.Height),0,0,[],1);

          bmp.Canvas.Fill.Color := TAlphaColorRec.Black;
          bmp.Canvas.Stroke.Color := TAlphaColorRec.Black;

          for R in BlackRects do
          begin
            bmp.Canvas.FillRect(R,0, 0, [], 1);
          end;

          if chkGrid.IsChecked then
          begin
            bmp.Canvas.Stroke.Color := TAlphaColorRec.LtGray;
            bmp.Canvas.Stroke.Dash := TStrokeDash.Dot;
            for x := 0 to bmp.Width -1 do
              if x mod FQR.PixelsPerModule = 0 then
              begin
                bmp.Canvas.DrawLine(TPointF.Create(x,0), TPointF.Create(x,bmp.Height-1),1);
              end;
            for y := 0 to bmp.Height-1 do
            begin
              if y mod FQR.PixelsPerModule = 0 then
              begin
                bmp.Canvas.DrawLine(TPointF.Create(0,y), TPointF.Create(bmp.Height-1, y),1);
              end;
            end;
          end;

          bmp.Canvas.Fill.Color := TAlphaColorRec.Black;
          bmp.Canvas.Stroke.Color := TAlphaColorRec.Black;

          bmp.Canvas.DrawRect(TRect.Create(0,0,bmp.Width, bmp.Height),0,0,[],1);
        finally
          bmp.Canvas.EndScene;
        end;

        imgQR.Bitmap := nil;
        imgQR.Bitmap := bmp;
      finally
        bmp.Free;
      end;
    end;
  txtDataChange(Self);
end;

procedure TfrmQRMain.txtDataChange(Sender: TObject);
begin
  FQR.BeginUpdate;
  try
    FQR.ECL := TErrorCorrectionLevel(cbECL.ItemIndex);
    FQR.Text := txtData.Text;
    FQR.Mask := TMask(cbMask.ItemIndex);
    FQR.Version := TVersion(cbVersion.ItemIndex);
    FQR.RenderSize := StrToIntDef(txtWidth.Text, 300);
  finally
    FQR.EndUpdate;
  end;

end;

end.