瀏覽代碼

Initial commit of functional qr code generation and vcl/fmx wrappers.

Jason Southwell 6 年之前
父節點
當前提交
644938f0ec

+ 155 - 0
demos/fmx/MainForm.fmx

@@ -0,0 +1,155 @@
+object frmQRMain: TfrmQRMain
+  Left = 0
+  Top = 0
+  Caption = 'Form1'
+  ClientHeight = 533
+  ClientWidth = 800
+  FormFactor.Width = 320
+  FormFactor.Height = 480
+  FormFactor.Devices = [Desktop]
+  DesignerMasterStyle = 0
+  object cbECL: TComboBox
+    Items.Strings = (
+      'Auto ECL'
+      'Low'
+      'Medium'
+      'Quartile'
+      'High')
+    ItemIndex = 0
+    Position.X = 8.000000000000000000
+    Position.Y = 8.000000000000000000
+    TabOrder = 0
+    OnChange = txtDataChange
+  end
+  object cbMask: TComboBox
+    Items.Strings = (
+      '0'
+      '1'
+      '2'
+      '3'
+      '4'
+      '5'
+      '6'
+      '7'
+      'Auto Mask')
+    ItemIndex = 8
+    Position.X = 120.000000000000000000
+    Position.Y = 8.000000000000000000
+    TabOrder = 2
+    OnChange = txtDataChange
+  end
+  object cbVersion: TComboBox
+    Items.Strings = (
+      'Auto Version'
+      '1'
+      '2'
+      '3'
+      '4'
+      '5'
+      '6'
+      '7'
+      '8'
+      '9'
+      '10'
+      '11'
+      '12'
+      '13'
+      '14'
+      '15'
+      '16'
+      '17'
+      '18'
+      '19'
+      '20'
+      '21'
+      '22'
+      '23'
+      '24'
+      '25'
+      '26'
+      '27'
+      '28'
+      '29'
+      '30'
+      '31'
+      '32'
+      '33'
+      '34'
+      '35'
+      '36'
+      '37'
+      '38'
+      '39'
+      '40')
+    ItemIndex = 0
+    Position.X = 232.000000000000000000
+    Position.Y = 8.000000000000000000
+    TabOrder = 3
+    OnChange = txtDataChange
+  end
+  object txtData: TEdit
+    Touch.InteractiveGestures = [LongTap, DoubleTap]
+    Anchors = [akLeft, akTop, akRight]
+    TabOrder = 1
+    Text = 'HELLO WORLD'
+    Position.X = 344.000000000000000000
+    Position.Y = 8.000000000000000000
+    Size.Width = 305.000000000000000000
+    Size.Height = 21.000000000000000000
+    Size.PlatformDefault = False
+    OnChangeTracking = txtDataChange
+    Left = 271
+    Top = 8
+  end
+  object chkGrid: TCheckBox
+    Anchors = [akTop, akRight]
+    Position.X = 664.000000000000000000
+    Position.Y = 8.000000000000000000
+    Size.Width = 57.000000000000000000
+    Size.Height = 19.000000000000000000
+    Size.PlatformDefault = False
+    TabOrder = 4
+    Text = 'Grid'
+    OnChange = txtDataChange
+  end
+  object txtWidth: TNumberBox
+    Touch.InteractiveGestures = [LongTap, DoubleTap]
+    Anchors = [akTop, akRight]
+    TabOrder = 5
+    Cursor = crIBeam
+    Min = 1.000000000000000000
+    Max = 50000.000000000000000000
+    Value = 500.000000000000000000
+    Position.X = 720.000000000000000000
+    Position.Y = 8.000000000000000000
+    Size.Width = 73.000000000000000000
+    Size.Height = 22.000000000000000000
+    Size.PlatformDefault = False
+    OnChangeTracking = txtDataChange
+  end
+  object txtDetails: TMemo
+    Touch.InteractiveGestures = [Pan, LongTap, DoubleTap]
+    DataDetectorTypes = []
+    Anchors = [akTop, akRight, akBottom]
+    Position.X = 496.000000000000000000
+    Position.Y = 40.000000000000000000
+    Size.Width = 297.000000000000000000
+    Size.Height = 481.000000000000000000
+    Size.PlatformDefault = False
+    TabOrder = 6
+    Viewport.Width = 293.000000000000000000
+    Viewport.Height = 477.000000000000000000
+  end
+  object imgQR: TImage
+    MultiResBitmap = <
+      item
+      end>
+    Anchors = [akLeft, akTop, akRight, akBottom]
+    Position.X = 8.000000000000000000
+    Position.Y = 40.000000000000000000
+    Size.Width = 481.000000000000000000
+    Size.Height = 489.000000000000000000
+    Size.PlatformDefault = False
+    WrapMode = Original
+  end
+end

+ 179 - 0
demos/fmx/MainForm.pas

@@ -0,0 +1,179 @@
+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.

+ 14 - 0
demos/fmx/QREncoderFMX.dpr

@@ -0,0 +1,14 @@
+program QREncoderFMX;
+
+uses
+  System.StartUpCopy,
+  FMX.Forms,
+  MainForm in 'MainForm.pas' {frmQRMain};
+
+{$R *.res}
+
+begin
+  Application.Initialize;
+  Application.CreateForm(TfrmQRMain, frmQRMain);
+  Application.Run;
+end.

文件差異過大導致無法顯示
+ 1144 - 0
demos/fmx/QREncoderFMX.dproj


二進制
demos/fmx/QREncoderFMX.res


+ 36 - 0
demos/simplefmx/SimpleMain.fmx

@@ -0,0 +1,36 @@
+object Form2: TForm2
+  Left = 0
+  Top = 0
+  Caption = 'Form2'
+  ClientHeight = 438
+  ClientWidth = 401
+  FormFactor.Width = 320
+  FormFactor.Height = 480
+  FormFactor.Devices = [Desktop]
+  OnResize = txtDataChangeTracking
+  DesignerMasterStyle = 0
+  object txtData: TEdit
+    Touch.InteractiveGestures = [LongTap, DoubleTap]
+    Anchors = [akLeft, akTop, akRight]
+    TabOrder = 0
+    Text = 'https://bitbucket.org/sivv/qr'
+    Position.X = 8.000000000000000000
+    Position.Y = 8.000000000000000000
+    Size.Width = 385.000000000000000000
+    Size.Height = 22.000000000000000000
+    Size.PlatformDefault = False
+    OnChangeTracking = txtDataChangeTracking
+  end
+  object imgQR: TImage
+    MultiResBitmap = <
+      item
+      end>
+    Anchors = [akLeft, akTop, akRight, akBottom]
+    Position.X = 8.000000000000000000
+    Position.Y = 40.000000000000000000
+    Size.Width = 385.000000000000000000
+    Size.Height = 385.000000000000000000
+    Size.PlatformDefault = False
+    WrapMode = Original
+  end
+end

+ 43 - 0
demos/simplefmx/SimpleMain.pas

@@ -0,0 +1,43 @@
+unit SimpleMain;
+
+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.Edit, FMX.Objects;
+
+type
+  TForm2 = class(TForm)
+    txtData: TEdit;
+    imgQR: TImage;
+    procedure txtDataChangeTracking(Sender: TObject);
+  private
+    { Private declarations }
+  public
+    { Public declarations }
+  end;
+
+var
+  Form2: TForm2;
+
+implementation
+
+uses qr.code.fmx;
+
+{$R *.fmx}
+
+procedure TForm2.txtDataChangeTracking(Sender: TObject);
+var
+  bmp : TQRBitmap;
+begin
+  bmp := TQRBitmap.Create(txtData.Text, imgQR.Width, imgQR.Height);
+  try
+    bmp.ShowBorder := True;
+    imgQR.Bitmap := bmp;
+  finally
+    bmp.Free;
+  end;
+end;
+
+end.

+ 108 - 0
demos/simplefmx/SimpleQRFMX.deployproj

@@ -0,0 +1,108 @@
+<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
+    <Import Condition="Exists('$(BDS)\bin\CodeGear.Deployment.targets')" Project="$(BDS)\bin\CodeGear.Deployment.targets"/>
+    <ProjectExtensions>
+        <ProjectFileVersion>12</ProjectFileVersion>
+    </ProjectExtensions>
+    <PropertyGroup>
+        <DeviceId Condition="'$(Platform)'=='Android'"/>
+        <DeviceId Condition="'$(Platform)'=='iOSDevice32'"/>
+        <DeviceId Condition="'$(Platform)'=='iOSDevice64'"/>
+        <DeviceId Condition="'$(Platform)'=='iOSSimulator'">iPhone5</DeviceId>
+    </PropertyGroup>
+    <ItemGroup Condition="'$(Platform)'=='iOSDevice64'"/>
+    <ItemGroup Condition="'$(Platform)'=='Win64'"/>
+    <ItemGroup Condition="'$(Platform)'=='iOSDevice32'"/>
+    <ItemGroup Condition="'$(Platform)'=='Win32'">
+        <DeployFile Include="Win32\Debug\SimpleQRFMX.exe" Condition="'$(Config)'=='Debug'">
+            <RemoteDir>SimpleQRFMX\</RemoteDir>
+            <RemoteName>SimpleQRFMX.exe</RemoteName>
+            <DeployClass>ProjectOutput</DeployClass>
+            <Operation>0</Operation>
+            <LocalCommand/>
+            <RemoteCommand/>
+            <Overwrite>True</Overwrite>
+            <Required>True</Required>
+        </DeployFile>
+    </ItemGroup>
+    <ItemGroup Condition="'$(Platform)'=='Linux64'"/>
+    <ItemGroup Condition="'$(Platform)'=='OSX32'">
+        <DeployFile Include="$(BDS)\Redist\osx32\libcgunwind.1.0.dylib">
+            <RemoteDir>SimpleQRFMX.app\Contents\MacOS\</RemoteDir>
+            <RemoteName>libcgunwind.1.0.dylib</RemoteName>
+            <DeployClass>DependencyModule</DeployClass>
+            <Operation>1</Operation>
+            <LocalCommand/>
+            <RemoteCommand/>
+            <Overwrite>True</Overwrite>
+        </DeployFile>
+    </ItemGroup>
+    <ItemGroup Condition="'$(Platform)'=='Android'"/>
+    <ItemGroup Condition="'$(Platform)'=='OSX64'">
+        <DeployFile Include="..\..\bin\OSX64\SimpleQRFMX.info.plist" Condition="'$(Config)'=='Debug'">
+            <RemoteDir>SimpleQRFMX.app\Contents\</RemoteDir>
+            <RemoteName>Info.plist</RemoteName>
+            <DeployClass>ProjectOSXInfoPList</DeployClass>
+            <Operation>1</Operation>
+            <LocalCommand/>
+            <RemoteCommand/>
+            <Overwrite>True</Overwrite>
+        </DeployFile>
+        <DeployFile Include="$(BDS)\bin\delphi_PROJECTICNS.icns" Condition="'$(Config)'=='Debug'">
+            <RemoteDir>SimpleQRFMX.app\Contents\Resources\</RemoteDir>
+            <RemoteName>SimpleQRFMX.icns</RemoteName>
+            <DeployClass>ProjectOSXResource</DeployClass>
+            <Operation>1</Operation>
+            <LocalCommand/>
+            <RemoteCommand/>
+            <Overwrite>True</Overwrite>
+        </DeployFile>
+        <DeployFile Include="..\..\bin\OSX64\SimpleQRFMX.entitlements" Condition="'$(Config)'=='Debug'">
+            <RemoteDir>SimpleQRFMX.app\..\</RemoteDir>
+            <RemoteName>SimpleQRFMX.entitlements</RemoteName>
+            <DeployClass>ProjectOSXEntitlements</DeployClass>
+            <Operation>1</Operation>
+            <LocalCommand/>
+            <RemoteCommand/>
+            <Overwrite>True</Overwrite>
+        </DeployFile>
+        <DeployFile Include="..\..\bin\OSX64\SimpleQRFMX" Condition="'$(Config)'=='Debug'">
+            <RemoteDir>SimpleQRFMX.app\Contents\MacOS\</RemoteDir>
+            <RemoteName>SimpleQRFMX</RemoteName>
+            <DeployClass>ProjectOutput</DeployClass>
+            <Operation>1</Operation>
+            <LocalCommand/>
+            <RemoteCommand/>
+            <Overwrite>True</Overwrite>
+            <Required>True</Required>
+        </DeployFile>
+        <DeployFile Include="..\..\bin\OSX64\SimpleQRFMX.dSYM" Condition="'$(Config)'=='Debug'">
+            <RemoteDir>SimpleQRFMX.app\..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF\</RemoteDir>
+            <RemoteName>SimpleQRFMX</RemoteName>
+            <DeployClass>ProjectOSXDebug</DeployClass>
+            <Operation>1</Operation>
+            <LocalCommand/>
+            <RemoteCommand/>
+            <Overwrite>True</Overwrite>
+        </DeployFile>
+    </ItemGroup>
+    <ItemGroup Condition="'$(Platform)'=='iOSSimulator'">
+        <DeployFile Include="$(BDS)\Redist\iossimulator\libcgunwind.1.0.dylib">
+            <RemoteDir>SimpleQRFMX.app\</RemoteDir>
+            <RemoteName>libcgunwind.1.0.dylib</RemoteName>
+            <DeployClass>DependencyModule</DeployClass>
+            <Operation>1</Operation>
+            <LocalCommand/>
+            <RemoteCommand/>
+            <Overwrite>True</Overwrite>
+        </DeployFile>
+        <DeployFile Include="$(BDS)\Redist\iossimulator\libpcre.dylib">
+            <RemoteDir>SimpleQRFMX.app\</RemoteDir>
+            <RemoteName>libpcre.dylib</RemoteName>
+            <DeployClass>DependencyModule</DeployClass>
+            <Operation>1</Operation>
+            <LocalCommand/>
+            <RemoteCommand/>
+            <Overwrite>True</Overwrite>
+        </DeployFile>
+    </ItemGroup>
+</Project>

+ 14 - 0
demos/simplefmx/SimpleQRFMX.dpr

@@ -0,0 +1,14 @@
+program SimpleQRFMX;
+
+uses
+  System.StartUpCopy,
+  FMX.Forms,
+  SimpleMain in 'SimpleMain.pas' {Form2};
+
+{$R *.res}
+
+begin
+  Application.Initialize;
+  Application.CreateForm(TForm2, Form2);
+  Application.Run;
+end.

文件差異過大導致無法顯示
+ 1175 - 0
demos/simplefmx/SimpleQRFMX.dproj


二進制
demos/simplefmx/SimpleQRFMX.res


+ 38 - 0
demos/simplevcl/SimpleMain.dfm

@@ -0,0 +1,38 @@
+object Form1: TForm1
+  Left = 0
+  Top = 0
+  Caption = 'Simple QR Example'
+  ClientHeight = 414
+  ClientWidth = 385
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'Tahoma'
+  Font.Style = []
+  OldCreateOrder = False
+  OnCreate = FormCreate
+  OnResize = txtDataChange
+  DesignSize = (
+    385
+    414)
+  PixelsPerInch = 96
+  TextHeight = 13
+  object imgQR: TImage
+    Left = 8
+    Top = 35
+    Width = 369
+    Height = 369
+    Anchors = [akLeft, akTop, akRight, akBottom]
+  end
+  object txtData: TEdit
+    Left = 8
+    Top = 8
+    Width = 369
+    Height = 21
+    Anchors = [akLeft, akTop, akRight]
+    TabOrder = 0
+    Text = 'https://bitbucket.org/sivv/qr'
+    OnChange = txtDataChange
+  end
+end

+ 48 - 0
demos/simplevcl/SimpleMain.pas

@@ -0,0 +1,48 @@
+unit SimpleMain;
+
+interface
+
+uses
+  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
+  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls;
+
+type
+  TForm1 = class(TForm)
+    txtData: TEdit;
+    imgQR: TImage;
+    procedure txtDataChange(Sender: TObject);
+    procedure FormCreate(Sender: TObject);
+  private
+    { Private declarations }
+  public
+    { Public declarations }
+  end;
+
+var
+  Form1: TForm1;
+
+implementation
+
+uses qr.code.vcl;
+
+{$R *.dfm}
+
+procedure TForm1.FormCreate(Sender: TObject);
+begin
+  txtDataChange(nil);
+end;
+
+procedure TForm1.txtDataChange(Sender: TObject);
+var
+  bmp : TQRBitmap;
+begin
+  bmp := TQRBitmap.Create(txtData.Text, imgQR.Width, imgQR.Height);
+  try
+    bmp.ShowBorder := True;
+    imgQR.Picture.Graphic := bmp;
+  finally
+    bmp.Free;
+  end;
+end;
+
+end.

+ 14 - 0
demos/simplevcl/SimpleQRVCL.dpr

@@ -0,0 +1,14 @@
+program SimpleQRVCL;
+
+uses
+  Vcl.Forms,
+  SimpleMain in 'SimpleMain.pas' {Form1};
+
+{$R *.res}
+
+begin
+  Application.Initialize;
+  Application.MainFormOnTaskbar := True;
+  Application.CreateForm(TForm1, Form1);
+  Application.Run;
+end.

文件差異過大導致無法顯示
+ 852 - 0
demos/simplevcl/SimpleQRVCL.dproj


二進制
demos/simplevcl/SimpleQRVCL.res


+ 155 - 0
demos/vcl/MainForm.dfm

@@ -0,0 +1,155 @@
+object frmQRMain: TfrmQRMain
+  Left = 0
+  Top = 0
+  Caption = 'frmQRMain'
+  ClientHeight = 494
+  ClientWidth = 784
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'Tahoma'
+  Font.Style = []
+  OldCreateOrder = False
+  DesignSize = (
+    784
+    494)
+  PixelsPerInch = 96
+  TextHeight = 13
+  object imgQR: TImage
+    Left = 24
+    Top = 48
+    Width = 420
+    Height = 420
+    Anchors = [akLeft, akTop, akRight]
+  end
+  object txtData: TEdit
+    Left = 271
+    Top = 8
+    Width = 377
+    Height = 21
+    TabOrder = 1
+    Text = 'HELLO WORLD'
+    OnChange = txtDataChange
+  end
+  object cbECL: TComboBox
+    Left = 24
+    Top = 8
+    Width = 65
+    Height = 21
+    Style = csDropDownList
+    TabOrder = 0
+    OnChange = txtDataChange
+    Items.Strings = (
+      'Auto ECL'
+      'Low'
+      'Medium'
+      'Quartile'
+      'High')
+  end
+  object txtWidth: TEdit
+    Left = 701
+    Top = 8
+    Width = 57
+    Height = 21
+    TabOrder = 2
+    Text = '500'
+    OnChange = txtDataChange
+  end
+  object chkGrid: TCheckBox
+    Left = 654
+    Top = 8
+    Width = 41
+    Height = 17
+    Caption = 'Grid'
+    TabOrder = 3
+    OnClick = txtDataChange
+  end
+  object txtDetails: TMemo
+    Left = 450
+    Top = 48
+    Width = 308
+    Height = 420
+    Anchors = [akTop, akRight, akBottom]
+    Lines.Strings = (
+      'Memo1')
+    ReadOnly = True
+    ScrollBars = ssBoth
+    TabOrder = 4
+    WordWrap = False
+  end
+  object cbMask: TComboBox
+    Left = 95
+    Top = 8
+    Width = 82
+    Height = 21
+    Style = csDropDownList
+    ItemIndex = 8
+    TabOrder = 5
+    Text = 'Auto Mask'
+    OnChange = txtDataChange
+    Items.Strings = (
+      '0'
+      '1'
+      '2'
+      '3'
+      '4'
+      '5'
+      '6'
+      '7'
+      'Auto Mask')
+  end
+  object cbVersion: TComboBox
+    Left = 183
+    Top = 8
+    Width = 82
+    Height = 21
+    Style = csDropDownList
+    ItemIndex = 0
+    TabOrder = 6
+    Text = 'Auto Version'
+    OnChange = txtDataChange
+    Items.Strings = (
+      'Auto Version'
+      '1'
+      '2'
+      '3'
+      '4'
+      '5'
+      '6'
+      '7'
+      '8'
+      '9'
+      '10'
+      '11'
+      '12'
+      '13'
+      '14'
+      '15'
+      '16'
+      '17'
+      '18'
+      '19'
+      '20'
+      '21'
+      '22'
+      '23'
+      '24'
+      '25'
+      '26'
+      '27'
+      '28'
+      '29'
+      '30'
+      '31'
+      '32'
+      '33'
+      '34'
+      '35'
+      '36'
+      '37'
+      '38'
+      '39'
+      '40')
+  end
+end

+ 184 - 0
demos/vcl/MainForm.pas

@@ -0,0 +1,184 @@
+unit MainForm;
+
+interface
+
+uses
+  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
+  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, System.Generics.Collections, System.UITypes,
+  Vcl.ExtCtrls, qr.code, Vcl.ComCtrls;
+
+{$SCOPEDENUMS ON}
+
+type
+  TfrmQRMain = class(TForm)
+    txtData: TEdit;
+    cbECL: TComboBox;
+    imgQR: TImage;
+    txtWidth: TEdit;
+    chkGrid: TCheckBox;
+    txtDetails: TMemo;
+    cbMask: TComboBox;
+    cbVersion: TComboBox;
+    procedure txtDataChange(Sender: TObject);
+  private
+    FQR : TQRCode;
+  protected
+  public
+    procedure AfterConstruction; override;
+    procedure BeforeDestruction; override;
+  end;
+
+var
+  frmQRMain: TfrmQRMain;
+
+implementation
+
+{$R *.dfm}
+
+
+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.Lock;
+        try
+          bmp.Canvas.Brush.Color := clWhite;
+          bmp.Canvas.Pen.Color := clWhite;
+          bmp.Canvas.FillRect(TRect.Create(0,0,bmp.Width, bmp.Height));
+
+          bmp.Canvas.Brush.Color := clBlack;
+          bmp.Canvas.Pen.Color := clBlack;
+
+          for R in BlackRects do
+          begin
+            bmp.Canvas.FillRect(R);
+          end;
+
+          if chkGrid.Checked then
+          begin
+            bmp.Canvas.Pen.Color := clLtGray;
+            bmp.Canvas.Pen.Style := TPenStyle.psDot;
+            for x := 0 to bmp.Width -1 do
+              if x mod FQR.PixelsPerModule = 0 then
+              begin
+                bmp.Canvas.MoveTo(x,0);
+                bmp.Canvas.LineTo(x,bmp.Height-1);
+              end;
+            for y := 0 to bmp.Height-1 do
+            begin
+              if y mod FQR.PixelsPerModule = 0 then
+              begin
+                bmp.Canvas.MoveTo(0,y);
+                bmp.Canvas.LineTo(bmp.Height-1, y);
+              end;
+            end;
+          end;
+
+          bmp.Canvas.Brush.Color := clBlack;
+          bmp.Canvas.Pen.Color := clBlack;
+
+          bmp.Canvas.FrameRect(TRect.Create(0,0,bmp.Width, bmp.Height));
+        finally
+          bmp.Canvas.Unlock;
+        end;
+
+        imgQR.Picture.Graphic := 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.
+

+ 14 - 0
demos/vcl/QREncoderVCL.dpr

@@ -0,0 +1,14 @@
+program QREncoderVCL;
+
+uses
+  Vcl.Forms,
+  MainForm in 'MainForm.pas' {frmQRMain};
+
+{$R *.res}
+
+begin
+  Application.Initialize;
+  Application.MainFormOnTaskbar := True;
+  Application.CreateForm(TfrmQRMain, frmQRMain);
+  Application.Run;
+end.

文件差異過大導致無法顯示
+ 876 - 0
demos/vcl/QREncoderVCL.dproj


二進制
demos/vcl/QREncoderVCL.res


+ 274 - 0
qr.code.fmx.pas

@@ -0,0 +1,274 @@
+//Copyright (c) 2019 by Jason Southwell
+//
+//Permission is hereby granted, free of charge, to any person obtaining a copy
+//of this software and associated documentation files (the "Software"), to deal
+//in the Software without restriction, including without limitation the rights
+//to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+//copies of the Software, and to permit persons to whom the Software is
+//furnished to do so, subject to the following conditions:
+//
+//The above copyright notice and this permission notice shall be included in all
+//copies or substantial portions of the Software.
+//
+//THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+//IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+//FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+//AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+//LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+//OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+//SOFTWARE.
+
+unit qr.code.fmx;
+
+interface
+
+uses
+  System.SysUtils, System.Classes, FMX.Graphics, qr.code;
+
+type
+  TQRBitmap = class(TBitmap)
+  private
+    FQR : TQRCode;
+    FShowBorder: boolean;
+    FShowModuleGrid: boolean;
+    function GetData: TArray<Byte>;
+    function GetECL: TErrorCorrectionLevel;
+    function GetMask: TMask;
+    function GetText: string;
+    function GetVersion: TVersion;
+    procedure SetData(const Value: TArray<Byte>);
+    procedure SetECL(const Value: TErrorCorrectionLevel);
+    procedure SetMask(const Value: TMask);
+    procedure SetText(const Value: string);
+    procedure SetVersion(const Value: TVersion);
+    procedure SetShowBorder(const Value: boolean);
+    procedure SetShowModuleGrid(const Value: boolean);
+  public
+    constructor Create(AText : string; AWidth, AHeight : Single); overload;
+    constructor Create(AText : string); overload;
+    constructor Create(AText : string; APixelsPerModule : integer); overload;
+    constructor Create(AData : TArray<Byte>; AWidth, AHeight : Single); overload;
+    constructor Create(AData : TArray<Byte>); overload;
+    constructor Create(AData : TArray<Byte>; APixelsPerModule : integer); overload;
+    constructor Create; overload; override;
+    destructor Destroy; override;
+
+    procedure BeginUpdate;
+    procedure EndUpdate;
+
+    property Text : string read GetText write SetText;
+    property Data : TArray<Byte> read GetData write SetData;
+
+    property Version : TVersion read GetVersion write SetVersion;
+    property ECL : TErrorCorrectionLevel read GetECL write SetECL;
+    property Mask : TMask read GetMask write SetMask;
+
+    property ShowModuleGrid : boolean read FShowModuleGrid write SetShowModuleGrid;
+    property ShowBorder : boolean read FShowBorder write SetShowBorder;
+  end;
+
+implementation
+
+uses System.Math, System.Types, System.UITypes;
+
+{ TQRCodeBitmap }
+
+procedure TQRBitmap.BeginUpdate;
+begin
+  FQR.BeginUpdate;
+end;
+
+constructor TQRBitmap.Create;
+begin
+  inherited Create;
+  FQR := TQRCode.Create;
+  FQR.OnPaint :=
+    procedure(Width, Height : Integer; BlackRects : TArray<TRect>)
+    var
+      R : TRect;
+      x, y : integer;
+    begin
+      Self.Width := Width;
+      Self.Height := Height;
+
+      Self.Canvas.BeginScene;
+      try
+        Self.Canvas.Fill.Color := TAlphaColorRec.White;
+        Self.Canvas.Stroke.Color := TAlphaColorRec.White;
+        Self.Canvas.FillRect(TRect.Create(0,0,Self.Width, Self.Height), 0, 0, [],1);
+
+        Self.Canvas.Fill.Color := TAlphaColorRec.Black;
+        Self.Canvas.Stroke.Color := TAlphaColorRec.Black;
+
+        for R in BlackRects do
+        begin
+          Self.Canvas.FillRect(R, 0, 0, [], 1);
+        end;
+
+        if FShowModuleGrid then
+        begin
+          Self.Canvas.Stroke.Color := TAlphaColorRec.LtGray;
+          Self.Canvas.Stroke.Dash := TStrokeDash.Dot;
+          for x := 0 to Self.Width -1 do
+            if x mod FQR.PixelsPerModule = 0 then
+            begin
+              Self.Canvas.DrawLine(TPointF.Create(x,0), TPointF.Create(x,Self.Height-1),1);
+            end;
+          for y := 0 to Self.Height-1 do
+          begin
+            if y mod FQR.PixelsPerModule = 0 then
+            begin
+              Self.Canvas.DrawLine(TPointF.Create(0,y), TPointF.Create(Self.Height-1, y), 1);
+            end;
+          end;
+        end;
+
+        if FShowBorder then
+        begin
+          Self.Canvas.Fill.Color := TAlphaColorRec.Black;
+          Self.Canvas.Stroke.Color := TAlphaColorRec.Black;
+          Self.Canvas.Stroke.Dash := TStrokeDash.Solid;
+          Self.Canvas.DrawRect(TRect.Create(0,0,Self.Width, Self.Height),0,0,[],1);
+        end;
+      finally
+        Self.Canvas.EndScene;
+      end;
+
+    end;
+end;
+
+constructor TQRBitmap.Create(AText: string; APixelsPerModule: integer);
+begin
+  Create;
+  FQR.BeginUpdate;
+  try
+    FQR.Text := AText;
+    FQR.PixelsPerModule := APixelsPerModule;
+  finally
+    FQR.EndUpdate;
+  end;
+end;
+
+constructor TQRBitmap.Create(AData: TArray<Byte>; AWidth, AHeight: Single);
+begin
+  Create;
+  FQR.BeginUpdate;
+  try
+    FQR.Data := AData;
+    FQR.RenderSize := Round(Min(AWidth, AHeight));
+  finally
+    FQR.EndUpdate;
+  end;
+end;
+
+constructor TQRBitmap.Create(AData: TArray<Byte>; APixelsPerModule: integer);
+begin
+  Create;
+  FQR.BeginUpdate;
+  try
+    FQR.Data := AData;
+    FQR.PixelsPerModule := APixelsPerModule;
+  finally
+    FQR.EndUpdate;
+  end;
+end;
+
+constructor TQRBitmap.Create(AData: TArray<Byte>);
+begin
+  Create;
+  FQR.Data := AData;
+end;
+
+constructor TQRBitmap.Create(AText: string);
+begin
+  Create;
+  FQR.Text := AText;
+end;
+
+constructor TQRBitmap.Create(AText: string; AWidth, AHeight: Single);
+begin
+  Create;
+  FQR.BeginUpdate;
+  try
+    FQR.Text := AText;
+    FQR.RenderSize := Round(Min(AWidth, AHeight));
+  finally
+    FQR.EndUpdate;
+  end;
+end;
+
+destructor TQRBitmap.Destroy;
+begin
+  FQR.Free;
+  inherited;
+end;
+
+procedure TQRBitmap.EndUpdate;
+begin
+  FQR.EndUpdate;
+end;
+
+function TQRBitmap.GetData: TArray<Byte>;
+begin
+  Result := FQR.Data;
+end;
+
+function TQRBitmap.GetECL: TErrorCorrectionLevel;
+begin
+  Result := FQR.ECL;
+end;
+
+function TQRBitmap.GetMask: TMask;
+begin
+  Result := FQR.Mask;
+end;
+
+function TQRBitmap.GetText: string;
+begin
+  Result := FQR.Text;
+end;
+
+function TQRBitmap.GetVersion: TVersion;
+begin
+  Result := FQR.Version;
+end;
+
+procedure TQRBitmap.SetData(const Value: TArray<Byte>);
+begin
+  FQR.Data := Value;
+end;
+
+procedure TQRBitmap.SetECL(const Value: TErrorCorrectionLevel);
+begin
+  FQR.ECL := Value;
+end;
+
+procedure TQRBitmap.SetMask(const Value: TMask);
+begin
+  FQR.Mask := Value;
+end;
+
+procedure TQRBitmap.SetShowBorder(const Value: boolean);
+begin
+  FShowBorder := Value;
+  FQR.Redraw;
+end;
+
+procedure TQRBitmap.SetShowModuleGrid(const Value: boolean);
+begin
+  FShowModuleGrid := Value;
+  FQR.Redraw;
+end;
+
+procedure TQRBitmap.SetText(const Value: string);
+begin
+  FQR.Text := Value;
+end;
+
+procedure TQRBitmap.SetVersion(const Value: TVersion);
+begin
+  FQR.Version := Value;
+end;
+
+end.
+

文件差異過大導致無法顯示
+ 2973 - 0
qr.code.pas


+ 274 - 0
qr.code.vcl.pas

@@ -0,0 +1,274 @@
+//Copyright (c) 2019 by Jason Southwell
+//
+//Permission is hereby granted, free of charge, to any person obtaining a copy
+//of this software and associated documentation files (the "Software"), to deal
+//in the Software without restriction, including without limitation the rights
+//to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+//copies of the Software, and to permit persons to whom the Software is
+//furnished to do so, subject to the following conditions:
+//
+//The above copyright notice and this permission notice shall be included in all
+//copies or substantial portions of the Software.
+//
+//THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+//IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+//FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+//AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+//LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+//OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+//SOFTWARE.
+
+unit qr.code.vcl;
+
+interface
+
+uses
+  System.SysUtils, System.Classes, VCL.Graphics, qr.code;
+
+type
+  TQRBitmap = class(TBitmap)
+  private
+    FQR : TQRCode;
+    FShowBorder: boolean;
+    FShowModuleGrid: boolean;
+    function GetData: TArray<Byte>;
+    function GetECL: TErrorCorrectionLevel;
+    function GetMask: TMask;
+    function GetText: string;
+    function GetVersion: TVersion;
+    procedure SetData(const Value: TArray<Byte>);
+    procedure SetECL(const Value: TErrorCorrectionLevel);
+    procedure SetMask(const Value: TMask);
+    procedure SetText(const Value: string);
+    procedure SetVersion(const Value: TVersion);
+    procedure SetShowBorder(const Value: boolean);
+    procedure SetShowModuleGrid(const Value: boolean);
+  public
+    constructor Create(AText : string; AWidth, AHeight : integer); overload;
+    constructor Create(AText : string); overload;
+    constructor Create(AText : string; APixelsPerModule : integer); overload;
+    constructor Create(AData : TArray<Byte>; AWidth, AHeight : integer); overload;
+    constructor Create(AData : TArray<Byte>); overload;
+    constructor Create(AData : TArray<Byte>; APixelsPerModule : integer); overload;
+    constructor Create; overload; override;
+    destructor Destroy; override;
+
+    procedure BeginUpdate;
+    procedure EndUpdate;
+
+    property Text : string read GetText write SetText;
+    property Data : TArray<Byte> read GetData write SetData;
+
+    property Version : TVersion read GetVersion write SetVersion;
+    property ECL : TErrorCorrectionLevel read GetECL write SetECL;
+    property QRMask : TMask read GetMask write SetMask;
+
+    property ShowModuleGrid : boolean read FShowModuleGrid write SetShowModuleGrid;
+    property ShowBorder : boolean read FShowBorder write SetShowBorder;
+  end;
+
+implementation
+
+uses System.Math, System.Types;
+
+{ TQRCodeBitmap }
+
+procedure TQRBitmap.BeginUpdate;
+begin
+  FQR.BeginUpdate;
+end;
+
+constructor TQRBitmap.Create;
+begin
+  inherited Create;
+  FQR := TQRCode.Create;
+  FQR.OnPaint :=
+    procedure(Width, Height : Integer; BlackRects : TArray<TRect>)
+    var
+      R : TRect;
+      x, y : integer;
+    begin
+      Self.Width := Width;
+      Self.Height := Height;
+
+      Self.Canvas.Lock;
+      try
+        Self.Canvas.Brush.Color := clWhite;
+        Self.Canvas.Pen.Color := clWhite;
+        Self.Canvas.FillRect(TRect.Create(0,0,Self.Width, Self.Height));
+
+        Self.Canvas.Brush.Color := clBlack;
+        Self.Canvas.Pen.Color := clBlack;
+
+        for R in BlackRects do
+        begin
+          Self.Canvas.FillRect(R);
+        end;
+
+        if FShowModuleGrid then
+        begin
+          Self.Canvas.Pen.Color := clLtGray;
+          Self.Canvas.Pen.Style := TPenStyle.psDot;
+          for x := 0 to Self.Width -1 do
+            if x mod FQR.PixelsPerModule = 0 then
+            begin
+              Self.Canvas.MoveTo(x,0);
+              Self.Canvas.LineTo(x,Self.Height-1);
+            end;
+          for y := 0 to Self.Height-1 do
+          begin
+            if y mod FQR.PixelsPerModule = 0 then
+            begin
+              Self.Canvas.MoveTo(0,y);
+              Self.Canvas.LineTo(Self.Height-1, y);
+            end;
+          end;
+        end;
+
+        if FShowBorder then
+        begin
+          Self.Canvas.Brush.Color := clBlack;
+          Self.Canvas.Pen.Color := clBlack;
+          Self.Canvas.FrameRect(TRect.Create(0,0,Self.Width, Self.Height));
+        end;
+      finally
+        Self.Canvas.Unlock;
+      end;
+
+    end;
+end;
+
+constructor TQRBitmap.Create(AText: string; APixelsPerModule: integer);
+begin
+  Create;
+  FQR.BeginUpdate;
+  try
+    FQR.Text := AText;
+    FQR.PixelsPerModule := APixelsPerModule;
+  finally
+    FQR.EndUpdate;
+  end;
+end;
+
+constructor TQRBitmap.Create(AData: TArray<Byte>; AWidth, AHeight: integer);
+begin
+  Create;
+  FQR.BeginUpdate;
+  try
+    FQR.Data := AData;
+    FQR.RenderSize := Min(AWidth, AHeight);
+  finally
+    FQR.EndUpdate;
+  end;
+end;
+
+constructor TQRBitmap.Create(AData: TArray<Byte>; APixelsPerModule: integer);
+begin
+  Create;
+  FQR.BeginUpdate;
+  try
+    FQR.Data := AData;
+    FQR.PixelsPerModule := APixelsPerModule;
+  finally
+    FQR.EndUpdate;
+  end;
+end;
+
+constructor TQRBitmap.Create(AData: TArray<Byte>);
+begin
+  Create;
+  FQR.Data := AData;
+end;
+
+constructor TQRBitmap.Create(AText: string);
+begin
+  Create;
+  FQR.Text := AText;
+end;
+
+constructor TQRBitmap.Create(AText: string; AWidth, AHeight: integer);
+begin
+  Create;
+  FQR.BeginUpdate;
+  try
+    FQR.Text := AText;
+    FQR.RenderSize := Min(AWidth, AHeight);
+  finally
+    FQR.EndUpdate;
+  end;
+end;
+
+destructor TQRBitmap.Destroy;
+begin
+  FQR.Free;
+  inherited;
+end;
+
+procedure TQRBitmap.EndUpdate;
+begin
+  FQR.EndUpdate;
+end;
+
+function TQRBitmap.GetData: TArray<Byte>;
+begin
+  Result := FQR.Data;
+end;
+
+function TQRBitmap.GetECL: TErrorCorrectionLevel;
+begin
+  Result := FQR.ECL;
+end;
+
+function TQRBitmap.GetMask: TMask;
+begin
+  Result := FQR.Mask;
+end;
+
+function TQRBitmap.GetText: string;
+begin
+  Result := FQR.Text;
+end;
+
+function TQRBitmap.GetVersion: TVersion;
+begin
+  Result := FQR.Version;
+end;
+
+procedure TQRBitmap.SetData(const Value: TArray<Byte>);
+begin
+  FQR.Data := Value;
+end;
+
+procedure TQRBitmap.SetECL(const Value: TErrorCorrectionLevel);
+begin
+  FQR.ECL := Value;
+end;
+
+procedure TQRBitmap.SetMask(const Value: TMask);
+begin
+  FQR.Mask := Value;
+end;
+
+procedure TQRBitmap.SetShowBorder(const Value: boolean);
+begin
+  FShowBorder := Value;
+  FQR.Redraw;
+end;
+
+procedure TQRBitmap.SetShowModuleGrid(const Value: boolean);
+begin
+  FShowModuleGrid := Value;
+  FQR.Redraw;
+end;
+
+procedure TQRBitmap.SetText(const Value: string);
+begin
+  FQR.Text := Value;
+end;
+
+procedure TQRBitmap.SetVersion(const Value: TVersion);
+begin
+  FQR.Version := Value;
+end;
+
+end.

+ 38 - 0
qr.dpk

@@ -0,0 +1,38 @@
+package qr;
+
+{$R *.res}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO OFF}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD ON}
+
+requires
+  rtl;
+
+contains
+  qr.code in 'qr.code.pas',
+  qr.rs in 'qr.rs.pas';
+
+end.

文件差異過大導致無法顯示
+ 808 - 0
qr.dproj


+ 39 - 0
qr.fmx.dpk

@@ -0,0 +1,39 @@
+package qr.fmx;
+
+{$R *.res}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO OFF}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD ON}
+
+requires
+  rtl,
+  qr,
+  fmx;
+
+contains
+  qr.code.fmx in 'qr.code.fmx.pas';
+
+end.

文件差異過大導致無法顯示
+ 809 - 0
qr.fmx.dproj


二進制
qr.fmx.res


二進制
qr.res


+ 115 - 0
qr.rs.pas

@@ -0,0 +1,115 @@
+//Copyright (c) 2019 by Jason Southwell
+//
+//Permission is hereby granted, free of charge, to any person obtaining a copy
+//of this software and associated documentation files (the "Software"), to deal
+//in the Software without restriction, including without limitation the rights
+//to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+//copies of the Software, and to permit persons to whom the Software is
+//furnished to do so, subject to the following conditions:
+//
+//The above copyright notice and this permission notice shall be included in all
+//copies or substantial portions of the Software.
+//
+//THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+//IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+//FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+//AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+//LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+//OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+//SOFTWARE.
+
+unit qr.rs;
+
+interface
+
+uses System.SysUtils, System.Classes;
+
+type
+  EReedSolomonException = exception;
+  TReedSolomonGenerator = class(TObject)
+  private
+    FCoefficients : TArray<Byte>;
+  public
+    constructor Create(Degree : integer);
+    function GetRemaineder(const Data : TArray<Byte>) : TArray<Byte>;
+    function Multiply(x, y : Byte) : Byte;
+  end;
+
+implementation
+
+{ TReedSolomonGenerator }
+
+constructor TReedSolomonGenerator.Create(Degree: integer);
+var
+  i, j : integer;
+  root : Byte;
+begin
+  if (Degree < 1) or (Degree > 255)  then
+    raise EReedSolomonException.Create('Degree out of range');
+  inherited Create;
+  SetLength(FCoefficients,Degree);
+  for i := 0 to degree-2 do
+    FCoefficients[i] := 0;
+  FCoefficients[Degree-1] := 1;
+
+  root := 1;
+
+  for i := 0 to degree-1 do
+  begin
+    for j := 0 to Length(FCoefficients)-1 do
+    begin
+      FCoefficients[j] := Multiply(FCoefficients[j], root);
+      if (j + 1 < length(FCoefficients)) then
+        FCoefficients[j] := FCoefficients[j] xor FCoefficients[j + 1];
+    end;
+    root := Multiply(root, 2);
+  end;
+end;
+
+function TReedSolomonGenerator.GetRemaineder(const Data: TArray<Byte>): TArray<Byte>;
+var
+  i: Integer;
+  ary : TArray<Byte>;
+  b, factor : Byte;
+  j: Integer;
+begin
+  SetLength(Result, Length(FCoefficients));
+  for i := 0 to Length(FCoefficients)-1 do
+    Result[i] := 0;
+
+  ary := Data;
+  for i := 0 to Length(ary)-1 do
+  begin
+    b := ary[i];
+    factor := b xor Result[0];
+    Delete(Result,0,1);
+    SetLength(Result, Length(Result)+1);
+    Result[Length(Result)-1] := 0;
+    for j := 0 to Length(FCoefficients)-1 do
+    begin
+      Result[j] := Result[j] xor Multiply(FCoefficients[j], factor);
+    end;
+  end;
+end;
+
+function TReedSolomonGenerator.Multiply(x, y : Byte): Byte;
+var
+  i : integer;
+  bResult : Byte;
+begin
+  if (x shr 8 <> 0) or (y shr 8 <> 0) then
+    raise EReedSolomonException.Create('Byte out of range.');
+
+  bResult := 0;
+  for i := 7 downto 0 do
+  begin
+    bResult := (bResult shl 1) xor ((bResult shr 7) * $11D);
+    bResult := (bResult xor (((y shr i) and 1) * x));
+  end;
+
+  if bResult shr 8 <> 0 then
+    raise EReedSolomonException.Create('Assertion Error');
+  Result := bResult;
+end;
+
+end.

+ 39 - 0
qr.vcl.dpk

@@ -0,0 +1,39 @@
+package qr.vcl;
+
+{$R *.res}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO OFF}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD ON}
+
+requires
+  rtl,
+  qr,
+  vcl;
+
+contains
+  qr.code.vcl in 'qr.code.vcl.pas';
+
+end.

文件差異過大導致無法顯示
+ 809 - 0
qr.vcl.dproj


二進制
qr.vcl.res


+ 108 - 0
qrcode.groupproj

@@ -0,0 +1,108 @@
+<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
+    <PropertyGroup>
+        <ProjectGuid>{2937F629-EE9D-475F-9085-444FA0C4DA89}</ProjectGuid>
+    </PropertyGroup>
+    <ItemGroup>
+        <Projects Include="qr.dproj">
+            <Dependencies/>
+        </Projects>
+        <Projects Include="qr.vcl.dproj">
+            <Dependencies/>
+        </Projects>
+        <Projects Include="qr.fmx.dproj">
+            <Dependencies/>
+        </Projects>
+        <Projects Include="demos\vcl\QREncoderVCL.dproj">
+            <Dependencies/>
+        </Projects>
+        <Projects Include="demos\fmx\QREncoderFMX.dproj">
+            <Dependencies/>
+        </Projects>
+        <Projects Include="demos\simplevcl\SimpleQRVCL.dproj">
+            <Dependencies/>
+        </Projects>
+        <Projects Include="demos\simplefmx\SimpleQRFMX.dproj">
+            <Dependencies/>
+        </Projects>
+    </ItemGroup>
+    <ProjectExtensions>
+        <Borland.Personality>Default.Personality.12</Borland.Personality>
+        <Borland.ProjectType/>
+        <BorlandProject>
+            <Default.Personality/>
+        </BorlandProject>
+    </ProjectExtensions>
+    <Target Name="qr">
+        <MSBuild Projects="qr.dproj"/>
+    </Target>
+    <Target Name="qr:Clean">
+        <MSBuild Projects="qr.dproj" Targets="Clean"/>
+    </Target>
+    <Target Name="qr:Make">
+        <MSBuild Projects="qr.dproj" Targets="Make"/>
+    </Target>
+    <Target Name="qr_vcl">
+        <MSBuild Projects="qr.vcl.dproj"/>
+    </Target>
+    <Target Name="qr_vcl:Clean">
+        <MSBuild Projects="qr.vcl.dproj" Targets="Clean"/>
+    </Target>
+    <Target Name="qr_vcl:Make">
+        <MSBuild Projects="qr.vcl.dproj" Targets="Make"/>
+    </Target>
+    <Target Name="qr_fmx">
+        <MSBuild Projects="qr.fmx.dproj"/>
+    </Target>
+    <Target Name="qr_fmx:Clean">
+        <MSBuild Projects="qr.fmx.dproj" Targets="Clean"/>
+    </Target>
+    <Target Name="qr_fmx:Make">
+        <MSBuild Projects="qr.fmx.dproj" Targets="Make"/>
+    </Target>
+    <Target Name="QREncoderVCL">
+        <MSBuild Projects="demos\vcl\QREncoderVCL.dproj"/>
+    </Target>
+    <Target Name="QREncoderVCL:Clean">
+        <MSBuild Projects="demos\vcl\QREncoderVCL.dproj" Targets="Clean"/>
+    </Target>
+    <Target Name="QREncoderVCL:Make">
+        <MSBuild Projects="demos\vcl\QREncoderVCL.dproj" Targets="Make"/>
+    </Target>
+    <Target Name="QREncoderFMX">
+        <MSBuild Projects="demos\fmx\QREncoderFMX.dproj"/>
+    </Target>
+    <Target Name="QREncoderFMX:Clean">
+        <MSBuild Projects="demos\fmx\QREncoderFMX.dproj" Targets="Clean"/>
+    </Target>
+    <Target Name="QREncoderFMX:Make">
+        <MSBuild Projects="demos\fmx\QREncoderFMX.dproj" Targets="Make"/>
+    </Target>
+    <Target Name="SimpleQRVCL">
+        <MSBuild Projects="demos\simplevcl\SimpleQRVCL.dproj"/>
+    </Target>
+    <Target Name="SimpleQRVCL:Clean">
+        <MSBuild Projects="demos\simplevcl\SimpleQRVCL.dproj" Targets="Clean"/>
+    </Target>
+    <Target Name="SimpleQRVCL:Make">
+        <MSBuild Projects="demos\simplevcl\SimpleQRVCL.dproj" Targets="Make"/>
+    </Target>
+    <Target Name="SimpleQRFMX">
+        <MSBuild Projects="demos\simplefmx\SimpleQRFMX.dproj"/>
+    </Target>
+    <Target Name="SimpleQRFMX:Clean">
+        <MSBuild Projects="demos\simplefmx\SimpleQRFMX.dproj" Targets="Clean"/>
+    </Target>
+    <Target Name="SimpleQRFMX:Make">
+        <MSBuild Projects="demos\simplefmx\SimpleQRFMX.dproj" Targets="Make"/>
+    </Target>
+    <Target Name="Build">
+        <CallTarget Targets="qr;qr_vcl;qr_fmx;QREncoderVCL;QREncoderFMX;SimpleQRVCL;SimpleQRFMX"/>
+    </Target>
+    <Target Name="Clean">
+        <CallTarget Targets="qr:Clean;qr_vcl:Clean;qr_fmx:Clean;QREncoderVCL:Clean;QREncoderFMX:Clean;SimpleQRVCL:Clean;SimpleQRFMX:Clean"/>
+    </Target>
+    <Target Name="Make">
+        <CallTarget Targets="qr:Make;qr_vcl:Make;qr_fmx:Make;QREncoderVCL:Make;QREncoderFMX:Make;SimpleQRVCL:Make;SimpleQRFMX:Make"/>
+    </Target>
+    <Import Project="$(BDS)\Bin\CodeGear.Group.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Group.Targets')"/>
+</Project>