pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

LazBarcode: Major update with many more barcodes.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8205 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-03-09 22:33:06 +00:00
parent 7034ab1715
commit 406e8bbb45
81 changed files with 12418 additions and 1151 deletions
Download Patch File Download Diff File Expand all files Collapse all files

70
components/lazbarcodes/README.txt
View File

@ -5,19 +5,69 @@
LazBarcodes is a set of controls to create 1D and 2D barcodes. LazBarcodes is a set of controls to create 1D and 2D barcodes.
The backend engine is a port of Zint at sourceforge. The backend engine is a port of Zint at sourceforge.
Currently it supports the generation of 2D barcodes : Currently it supports the generation of the following barcode types:
- QR Code [1]
- MicroQR [2] * 1D barcodes
- Aztec Code [3]
- Aztec Rune [4] - Code 11 [https://en.wikipedia.org/wiki/Code_11]
- DataMatrix [5] - Code 128 [https://en.wikipedia.org/wiki/Code_128}
- UPC/EAN-128 [https://en.wikipedia.org/wiki/GS1-128]
- Matrix 2-of-5 [https://en.wikipedia.org/wiki/Matrix_2_of_5]
- DataLogic 2-of-5 [https://en.wikipedia.org/wiki/Matrix_2_of_5]
- IATA 2-of 5 [https://en.wikipedia.org/wiki/Industrial_2_of_5#IATA_2_of_5]
- Industrial 2-of-5 [https://en.wikipedia.org/wiki/Industrial_2_of_5]
- Interleaved 2-of-5 [https://en.wikipedia.org/wiki/Interleaved_2_of_5]
- ITF-14 [https://en.wikipedia.org/wiki/ITF-14]
- Code 3-of-9 (C39) [https://en.wikipedia.org/wiki/Code_39]
- Extended Code 3-of-9 (C39+) [https://en.wikipedia.org/wiki/Code_39#Full_ASCII_Code_39]
- LOGMARS (like C39)
- Code 93 [https://en.wikipedia.org/wiki/Code_93]
- Channel Code
- EAN-8 and EAN-13 [https://en.wikipedia.org/wiki/International_Article_Number]
- EAN-14
- ISBN [https://en.wikipedia.org/wiki/International_Standard_Book_Number]
- NVE-18
- UPC-A [https://en.wikipedia.org/wiki/Universal_Product_Code]
- UPC-E [https://en.wikipedia.org/wiki/Universal_Product_Code#UPC-E]
- Plessey[https://en.wikipedia.org/wiki/Plessey_Code]
- MSI/Plessey [https://en.wikipedia.org/wiki/MSI_Barcode]
- Telepen [https://en.wikipedia.org/wiki/Telepen]
- Telepen numeric
- Medical/pharmaceutical barcodes
- Codabar [https://en.wikipedia.org/wiki/Codabar]
- Code32
- Pharma one-track [https://de.wikipedia.org/wiki/Pharmacode_(Laetus)]
- Pharma two-track
- Pharmazentralnummer (PZN) [https://de.wikipedia.org/wiki/Pharmazentralnummer]
- Postal barcodes
- Australia Post (Customer, Reply Paid, Routing, Redirection)
[https://barcodeguide.seagullscientific.com/Content/Symbologies/Australia_Post_4-State_Barcode.htm]
- DAFT [https://www.neodynamic.com/barcodes/DAFT-4-state-Barcode.aspx]
- Deutsche Post IdentCode [https://barcodeguide.seagullscientific.com/Content/Symbologies/Identcode.htm]
- Deutsche Post LeitCode [https://de.wikipedia.org/wiki/Leitcode]
- FIM (Facing Identification Mark) [https://en.wikipedia.org/wiki/Facing_Identification_Mark]
- Japanese Post [https://barcodeguide.seagullscientific.com/Content/Symbologies/Japanese_Postal.htm]
- Dutch KIX code [https://nl.wikipedia.org/wiki/KIX-code]
- Korea Post [https://www.neodynamic.com/barcodes/Korea-Post-Barcode.aspx]
- PLANET code [https://en.wikipedia.org/wiki/Postal_Alpha_Numeric_Encoding_Technique]
- PostNet code [https://en.wikipedia.org/wiki/POSTNET]
- Royal Mail RM4SCC code [https://en.wikipedia.org/wiki/RM4SCC]
* 2D barcodes
- QR Code [ http://en.wikipedia.org/wiki/Qr_code]
- MicroQR [http://en.wikipedia.org/wiki/Qr_code#Variants]
- Aztec Code [http://en.wikipedia.org/wiki/Aztec_Code]
- Aztec Rune [http://en.wikipedia.org/wiki/Aztec_Code#Encoding]
- DataMatrix [http://en.wikipedia.org/wiki/Data_Matrix]
- PDF417 [https://en.wikipedia.org/wiki/PDF417]
The download contains the packages "lazbarcodes" and "lazbarcodes_runtimeonly". The download contains the packages "lazbarcodes" and "lazbarcodes_runtimeonly".
The first one gives you visual components of the above barcodes and the second The first one gives you visual components of the above barcodes and the second
can be used just to access the ported zint code for advanced barcode generation. can be used just to access the ported zint code for advanced barcode generation.
Author: Author:
Jose Mejuto Jose Mejuto, Werner Pamler
License: License:
BSD 3 as it is being inherited from the zint backend source code. BSD 3 as it is being inherited from the zint backend source code.
@ -26,8 +76,4 @@ wiki Page:
http://wiki.freepascal.org/LazBarcodes http://wiki.freepascal.org/LazBarcodes
References: References:
[1] http://en.wikipedia.org/wiki/Qr_code - see above
[2] http://en.wikipedia.org/wiki/Qr_code#Variants
[3] http://en.wikipedia.org/wiki/Aztec_Code
[4] http://en.wikipedia.org/wiki/Aztec_Code#Encoding
[5] http://en.wikipedia.org/wiki/Data_Matrix

91
components/lazbarcodes/demo/LazBarcodeDemo.lpi Normal file
View File

@ -0,0 +1,91 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="12"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<Title Value="LazBarcodeDemo"/>
<Scaled Value="True"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<XPManifest>
<DpiAware Value="True"/>
</XPManifest>
<Icon Value="0"/>
</General>
<BuildModes>
<Item Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
</RunParams>
<RequiredPackages>
<Item>
<PackageName Value="lazbarcodes"/>
</Item>
<Item>
<PackageName Value="LCL"/>
</Item>
</RequiredPackages>
<Units>
<Unit>
<Filename Value="LazBarcodeDemo.lpr"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="main.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="MainForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="LazBarcodeDemo"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf2Set"/>
</Debugging>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions>
<Item>
<Name Value="EAbort"/>
</Item>
<Item>
<Name Value="ECodetoolError"/>
</Item>
<Item>
<Name Value="EFOpenError"/>
</Item>
<Item>
<Name Value="FPImageException"/>
<Enabled Value="False"/>
</Item>
<Item>
<Name Value="EInvalidGraphic"/>
<Enabled Value="False"/>
</Item>
</Exceptions>
</Debugging>
</CONFIG>

25
components/lazbarcodes/demo/LazBarcodeDemo.lpr Normal file
View File

@ -0,0 +1,25 @@
program LazBarcodeDemo;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}
cthreads,
{$ENDIF}
{$IFDEF HASAMIGA}
athreads,
{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, main
{ you can add units after this };
{$R *.res}
begin
RequireDerivedFormResource:=True;
Application.Scaled:=True;
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);
Application.Run;
end.

600
components/lazbarcodes/demo/main.lfm Normal file
View File

@ -0,0 +1,600 @@
object MainForm: TMainForm
Left = 338
Height = 484
Top = 127
Width = 811
Caption = 'LazBarcode Demo'
ClientHeight = 484
ClientWidth = 811
OnCreate = FormCreate
LCLVersion = '2.3.0.0'
object BarcodesTree: TTreeView
Left = 6
Height = 472
Top = 6
Width = 194
Align = alLeft
BorderSpacing.Left = 6
BorderSpacing.Top = 6
BorderSpacing.Right = 3
BorderSpacing.Bottom = 6
ReadOnly = True
TabOrder = 0
OnChange = BarcodesTreeChange
OnCustomDrawItem = BarcodesTreeCustomDrawItem
Options = [tvoAutoItemHeight, tvoHideSelection, tvoKeepCollapsedNodes, tvoReadOnly, tvoShowButtons, tvoShowLines, tvoShowRoot, tvoToolTips, tvoThemedDraw]
end
object Panel1: TPanel
Left = 211
Height = 472
Top = 6
Width = 594
Align = alClient
BorderSpacing.Left = 3
BorderSpacing.Top = 6
BorderSpacing.Right = 6
BorderSpacing.Bottom = 6
BevelOuter = bvNone
ClientHeight = 472
ClientWidth = 594
TabOrder = 1
object Panel2: TPanel
Left = 0
Height = 336
Top = 0
Width = 594
Align = alTop
BevelOuter = bvNone
ClientHeight = 336
ClientWidth = 594
TabOrder = 0
object lblText: TLabel
AnchorSideLeft.Control = Panel2
AnchorSideTop.Control = edText
AnchorSideTop.Side = asrCenter
Left = 0
Height = 15
Top = 4
Width = 21
Caption = 'Text'
end
object edText: TEdit
AnchorSideLeft.Control = lblText
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Panel2
AnchorSideRight.Control = btnSampleText
Left = 33
Height = 23
Top = 0
Width = 485
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 12
BorderSpacing.Right = 4
OnChange = edTextChange
TabOrder = 0
Text = '012345678'
end
object gbGeometry: TGroupBox
AnchorSideLeft.Control = Panel2
AnchorSideTop.Control = edText
AnchorSideTop.Side = asrBottom
Left = 0
Height = 173
Top = 35
Width = 189
AutoSize = True
BorderSpacing.Top = 12
Caption = 'Geometry'
ClientHeight = 153
ClientWidth = 185
TabOrder = 1
object lblScale: TLabel
AnchorSideLeft.Control = gbGeometry
AnchorSideTop.Control = seScale
AnchorSideTop.Side = asrCenter
Left = 16
Height = 15
Top = 50
Width = 27
BorderSpacing.Left = 16
Caption = 'Scale'
Enabled = False
end
object seScale: TSpinEdit
AnchorSideLeft.Control = seWhiteSpaceWidth
AnchorSideTop.Control = cbRecommendedSymbolSize
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = cbRecommendedSymbolSize
AnchorSideRight.Side = asrBottom
Left = 105
Height = 23
Top = 46
Width = 74
Alignment = taRightJustify
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 8
Enabled = False
MaxValue = 20
OnChange = BarcodeChange
TabOrder = 0
end
object seMargin: TSpinEdit
AnchorSideLeft.Control = seWhiteSpaceWidth
AnchorSideTop.Control = seScale
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = cbRecommendedSymbolSize
AnchorSideRight.Side = asrBottom
Left = 105
Height = 23
Top = 72
Width = 74
Alignment = taRightJustify
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 3
Enabled = False
MaxValue = 20
OnChange = BarcodeChange
TabOrder = 1
Value = 4
end
object lblMargin: TLabel
AnchorSideLeft.Control = gbGeometry
AnchorSideTop.Control = seMargin
AnchorSideTop.Side = asrCenter
Left = 16
Height = 15
Top = 76
Width = 38
BorderSpacing.Left = 16
Caption = 'Margin'
Enabled = False
end
object lblWhiteSpaceWidth: TLabel
AnchorSideLeft.Control = gbGeometry
AnchorSideTop.Control = seWhiteSpaceWidth
AnchorSideTop.Side = asrCenter
Left = 16
Height = 15
Top = 102
Width = 64
BorderSpacing.Left = 16
Caption = 'White space'
Enabled = False
end
object seWhiteSpaceWidth: TSpinEdit
AnchorSideLeft.Control = seSymbolHeight
AnchorSideTop.Control = seMargin
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = cbRecommendedSymbolSize
AnchorSideRight.Side = asrBottom
Left = 105
Height = 23
Top = 98
Width = 74
Alignment = taRightJustify
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 3
Enabled = False
MaxValue = 20
OnChange = BarcodeChange
TabOrder = 2
Value = 8
end
object lblSymbolHeight: TLabel
AnchorSideLeft.Control = gbGeometry
AnchorSideTop.Control = seSymbolHeight
AnchorSideTop.Side = asrCenter
Left = 16
Height = 15
Top = 128
Width = 77
BorderSpacing.Left = 16
Caption = 'Symbol height'
Enabled = False
end
object seSymbolHeight: TSpinEdit
AnchorSideLeft.Control = lblSymbolHeight
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = seWhiteSpaceWidth
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = cbRecommendedSymbolSize
AnchorSideRight.Side = asrBottom
Left = 105
Height = 23
Top = 124
Width = 74
Alignment = taRightJustify
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 12
BorderSpacing.Top = 3
BorderSpacing.Bottom = 6
Enabled = False
MaxValue = 9999
OnChange = BarcodeChange
TabOrder = 3
end
object cbRecommendedSymbolSize: TCheckBox
AnchorSideLeft.Control = gbGeometry
AnchorSideTop.Control = cbAutoSize
AnchorSideTop.Side = asrBottom
Left = 16
Height = 19
Top = 19
Width = 163
BorderSpacing.Left = 16
BorderSpacing.Right = 6
Caption = 'Recommended symbol size'
Checked = True
OnChange = cbRecommendedSymbolSizeChange
State = cbChecked
TabOrder = 4
end
object cbAutoSize: TCheckBox
AnchorSideLeft.Control = gbGeometry
AnchorSideTop.Control = gbGeometry
Left = 16
Height = 19
Top = 0
Width = 66
BorderSpacing.Left = 16
Caption = 'Auto size'
OnChange = cbAutoSizeChange
TabOrder = 5
end
end
object gbShow: TGroupBox
AnchorSideLeft.Control = gbGeometry
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = gbGeometry
Left = 205
Height = 74
Top = 35
Width = 213
AutoSize = True
BorderSpacing.Left = 16
Caption = 'Show...'
ClientHeight = 54
ClientWidth = 209
TabOrder = 2
object cbHumanReadableText: TCheckBox
AnchorSideLeft.Control = gbShow
AnchorSideTop.Control = gbShow
Left = 16
Height = 19
Top = 0
Width = 131
BorderSpacing.Left = 16
Caption = 'Human-readable text'
Checked = True
OnChange = BarcodeChange
State = cbChecked
TabOrder = 0
end
object cmbBearerBarsBox: TComboBox
AnchorSideLeft.Control = gbShow
AnchorSideTop.Control = cbHumanReadableText
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = btnFont
AnchorSideRight.Side = asrBottom
Left = 16
Height = 23
Top = 25
Width = 187
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 16
BorderSpacing.Top = 6
BorderSpacing.Bottom = 6
Enabled = False
ItemHeight = 15
ItemIndex = 0
Items.Strings = (
'none'
'Bearer bars'
'Box'
)
OnChange = BarcodeChange
Style = csDropDownList
TabOrder = 2
Text = 'none'
end
object btnFont: TButton
AnchorSideLeft.Control = cbHumanReadableText
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = cbHumanReadableText
AnchorSideTop.Side = asrCenter
Left = 153
Height = 25
Top = -3
Width = 50
AutoSize = True
BorderSpacing.Left = 6
BorderSpacing.Right = 6
Caption = 'Font'
OnClick = btnFontClick
TabOrder = 1
end
end
object gbChecksum: TGroupBox
AnchorSideLeft.Control = gbShow
AnchorSideTop.Control = gbShow
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = gbShow
AnchorSideRight.Side = asrBottom
Left = 205
Height = 68
Top = 121
Width = 213
Anchors = [akTop, akLeft, akRight]
AutoSize = True
BorderSpacing.Top = 12
Caption = 'Checksum'
ClientHeight = 48
ClientWidth = 209
TabOrder = 6
object cbAddChecksum: TCheckBox
AnchorSideLeft.Control = gbChecksum
AnchorSideTop.Control = gbChecksum
Left = 16
Height = 19
Top = 0
Width = 97
BorderSpacing.Left = 16
Caption = 'Add checksum'
Checked = True
OnChange = BarcodeChange
State = cbChecked
TabOrder = 0
end
object cbDisplayChecksum: TCheckBox
AnchorSideLeft.Control = cbAddChecksum
AnchorSideTop.Control = cbAddChecksum
AnchorSideTop.Side = asrBottom
Left = 16
Height = 19
Top = 23
Width = 113
BorderSpacing.Top = 4
BorderSpacing.Bottom = 6
Caption = 'Display checksum'
OnChange = BarcodeChange
TabOrder = 1
end
end
object gbColors: TGroupBox
AnchorSideLeft.Control = gbGeometry
AnchorSideTop.Control = gbGeometry
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = gbGeometry
AnchorSideRight.Side = asrBottom
Left = 0
Height = 109
Top = 224
Width = 189
Anchors = [akTop, akLeft, akRight]
AutoSize = True
BorderSpacing.Top = 16
Caption = 'Colors'
ClientHeight = 89
ClientWidth = 185
TabOrder = 3
object clbBackground: TColorButton
AnchorSideLeft.Control = gbColors
AnchorSideTop.Control = clbColor
AnchorSideTop.Side = asrBottom
Left = 8
Height = 25
Top = 29
Width = 144
BorderSpacing.Left = 8
BorderSpacing.Top = 4
BorderSpacing.Right = 8
BorderWidth = 2
ButtonColorAutoSize = False
ButtonColorSize = 16
ButtonColor = clWhite
Caption = 'Background color'
OnColorChanged = BarcodeChange
end
object clbForeground: TColorButton
AnchorSideLeft.Control = clbBackground
AnchorSideTop.Control = clbBackground
AnchorSideTop.Side = asrBottom
Left = 8
Height = 25
Top = 58
Width = 144
BorderSpacing.Top = 4
BorderSpacing.Right = 8
BorderSpacing.Bottom = 6
BorderWidth = 2
ButtonColorAutoSize = False
ButtonColorSize = 16
ButtonColor = clBackground
Caption = 'Foreground color'
OnColorChanged = BarcodeChange
end
object clbColor: TColorButton
AnchorSideLeft.Control = gbColors
AnchorSideTop.Control = gbColors
Left = 8
Height = 25
Top = 0
Width = 144
BorderSpacing.Left = 8
BorderSpacing.Right = 8
BorderWidth = 2
ButtonColorAutoSize = False
ButtonColorSize = 16
ButtonColor = clWindow
Caption = 'Control color '
OnColorChanged = BarcodeChange
end
end
object btnSaveToFile: TBitBtn
AnchorSideTop.Control = gbColors
AnchorSideRight.Side = asrBottom
Left = 205
Height = 25
Top = 233
Width = 128
Anchors = [akTop, akLeft, akRight]
AutoSize = True
BorderSpacing.Top = 9
Caption = 'Save to file...'
OnClick = btnSaveToFileClick
TabOrder = 4
end
object btnCopyToClipboard: TBitBtn
AnchorSideLeft.Control = btnSaveToFile
AnchorSideTop.Control = btnSaveToFile
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = btnSaveToFile
AnchorSideRight.Side = asrBottom
Left = 205
Height = 25
Top = 264
Width = 128
Anchors = [akTop, akLeft, akRight]
AutoSize = True
BorderSpacing.Top = 6
Caption = 'Copy to clipboard'
OnClick = btnCopyToClipboardClick
TabOrder = 5
end
object btnSampleText: TSpeedButton
AnchorSideTop.Control = edText
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = Panel2
AnchorSideRight.Side = asrBottom
Left = 522
Height = 19
Top = 2
Width = 72
Anchors = [akTop, akRight]
AutoSize = True
Caption = ' Sample text '
OnClick = btnSampleTextClick
end
object nbOptions: TNotebook
AnchorSideLeft.Control = gbShow
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = gbGeometry
Left = 434
Height = 293
Top = 35
Width = 152
PageIndex = 0
BorderSpacing.Left = 16
TabOrder = 7
object pgOptions_QR: TPage
object rgQR_ECCLevel: TRadioGroup
Left = 0
Height = 137
Top = 0
Width = 152
Align = alTop
AutoFill = True
Caption = 'ECC level'
ChildSizing.LeftRightSpacing = 6
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
ChildSizing.EnlargeVertical = crsHomogenousChildResize
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1
ClientHeight = 117
ClientWidth = 148
ItemIndex = 0
Items.Strings = (
'automatic'
'L'
'M'
'Q'
'H'
)
OnClick = rgQR_ECCLevelClick
TabOrder = 0
end
end
object pgOptions_Plessey: TPage
object rgPlessey_Checkchar: TRadioGroup
Left = 0
Height = 104
Top = 0
Width = 152
Align = alTop
AutoFill = True
Caption = 'Checksum options'
ChildSizing.LeftRightSpacing = 6
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
ChildSizing.EnlargeVertical = crsHomogenousChildResize
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1
ClientHeight = 84
ClientWidth = 148
ItemIndex = 0
Items.Strings = (
'mod-10'
'mod-10 & mod-10'
'mod-11'
'mod-10 & mod-11'
)
OnClick = rgPlessey_CheckcharClick
TabOrder = 0
end
end
end
end
object BarcodePanel: TPanel
Left = 0
Height = 136
Top = 336
Width = 594
Align = alClient
BorderSpacing.InnerBorder = 6
BevelInner = bvRaised
BevelOuter = bvLowered
ClientHeight = 136
ClientWidth = 594
TabOrder = 1
object lblError: TLabel
AnchorSideLeft.Control = BarcodePanel
AnchorSideTop.Control = BarcodePanel
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = BarcodePanel
AnchorSideRight.Side = asrBottom
Left = 2
Height = 15
Top = 61
Width = 590
Alignment = taCenter
Anchors = [akTop, akLeft, akRight]
Caption = 'lblError'
Font.Color = clRed
Font.Style = [fsBold]
ParentFont = False
Visible = False
WordWrap = True
end
end
end
object Splitter1: TSplitter
Left = 203
Height = 484
Top = 0
Width = 5
end
object FontDialog: TFontDialog
MinFontSize = 0
MaxFontSize = 0
Left = 568
Top = 8
end
object SaveDialog1: TSaveDialog
OnTypeChange = SaveDialogTypeChange
Left = 681
Top = 210
end
end

522
components/lazbarcodes/demo/main.pas Normal file
View File

@ -0,0 +1,522 @@
unit main;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ComCtrls, ExtCtrls,
StdCtrls, Spin, Buttons, ExtDlgs, ubarcodes;
type
{ TMainForm }
TMainForm = class(TForm)
BarcodesTree: TTreeView;
btnSaveToFile: TBitBtn;
btnCopyToClipboard: TBitBtn;
btnFont: TButton;
cbHumanReadableText: TCheckBox;
cbAddChecksum: TCheckBox;
cbDisplayChecksum: TCheckBox;
cbAutoSize: TCheckBox;
cbRecommendedSymbolSize: TCheckBox;
clbColor: TColorButton;
clbForeground: TColorButton;
cmbBearerBarsBox: TComboBox;
clbBackground: TColorButton;
edText: TEdit;
FontDialog: TFontDialog;
gbGeometry: TGroupBox;
gbShow: TGroupBox;
gbChecksum: TGroupBox;
gbColors: TGroupBox;
lblWhiteSpaceWidth: TLabel;
lblScale: TLabel;
lblError: TLabel;
lblMargin: TLabel;
lblText: TLabel;
lblSymbolHeight: TLabel;
nbOptions: TNotebook;
pgOptions_Plessey: TPage;
pgOptions_QR: TPage;
Panel1: TPanel;
Panel2: TPanel;
BarcodePanel: TPanel;
rgPlessey_Checkchar: TRadioGroup;
rgQR_ECCLevel: TRadioGroup;
SaveDialog1: TSaveDialog;
seWhiteSpaceWidth: TSpinEdit;
seScale: TSpinEdit;
seMargin: TSpinEdit;
seSymbolHeight: TSpinEdit;
btnSampleText: TSpeedButton;
Splitter1: TSplitter;
procedure BarcodeChange(Sender: TObject);
procedure BarcodesTreeChange(Sender: TObject; Node: TTreeNode);
procedure BarcodesTreeCustomDrawItem(Sender: TCustomTreeView;
Node: TTreeNode; {%H-}State: TCustomDrawState; var DefaultDraw: Boolean);
procedure btnCopyToClipboardClick(Sender: TObject);
procedure btnFontClick(Sender: TObject);
procedure btnSampleTextClick(Sender: TObject);
procedure btnSaveToFileClick(Sender: TObject);
procedure cbAutoSizeChange(Sender: TObject);
procedure cbRecommendedSymbolSizeChange(Sender: TObject);
procedure edTextChange(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure rgPlessey_CheckcharClick(Sender: TObject);
procedure rgQR_ECCLevelClick(Sender: TObject);
procedure SaveDialogTypeChange(Sender: TObject);
private
FBarCode: TLazBarcodeCustomText;
FFileName: String;
procedure PopulateBarcodesTree;
procedure SelectBarCode(ANode: TTreeNode);
procedure UpdateErrorMsg;
public
end;
var
MainForm: TMainForm;
implementation
{$R *.lfm}
uses
TypInfo;
type
TLazBarcodeClass = class of TLazBarcodeCustomText;
TBarcodeAccess = class(TLazBarcodeCustomText);
TSimpleBarcodeAccess = class(TSimpleBarcode);
{ We must register all barcode classes because barcodes will be created in this
application based on a string containing the class name. }
procedure RegisterBarcodes;
begin
RegisterClass(TBarcodeC11);
RegisterClass(TBarcodeC128);
RegisterClass(TBarcode2of5);
RegisterClass(TBarcode3of9);
RegisterClass(TBarcodeEAN);
RegisterClass(TBarcodeChannelCode);
RegisterClass(TBarcodePlessey);
RegisterClass(TBarcodeTelepen);
RegisterClass(TBarcodeMedical);
RegisterClass(TBarcodePostal);
RegisterClass(TBarcodePDF417);
RegisterClass(TBarcodeQR);
RegisterClass(TBarcodeMicroQR);
RegisterClass(TBarcodeAztec);
RegisterClass(TBarcodeAztecRune);
RegisterClass(TBarcodeDatamatrix);
end;
{ TMainForm }
procedure TMainForm.BarcodeChange(Sender: TObject);
begin
if FBarcode = nil then
exit;
if Sender = seScale then
TBarcodeAccess(FBarcode).Scale := seScale.Value
else
if Sender = seMargin then
TBarcodeAccess(FBarcode).Margin := seMargin.Value
else
if Sender = seWhiteSpaceWidth then
TBarcodeAccess(FBarcode).WhiteSpaceWidth := seWhiteSpaceWidth.Value
else
if Sender = seSymbolHeight then
TBarcodeAccess(FBarcode).SymbolHeight := seSymbolHeight.Value
else
if (Sender = cmbBearerBarsBox) then
TBarcodeAccess(FBarcode).BearerBarMode := TBarcodeBearerBarMode(cmbBearerBarsBox.ItemIndex)
else
if Sender = clbColor then
TBarcodeAccess(FBarcode).Color := clbColor.ButtonColor
else
if Sender = clbBackground then
TBarcodeAccess(FBarcode).BackgroundColor := clbBackground.ButtonColor
else
if Sender = clbForeground then
TBarcodeAccess(FBarcode).ForegroundColor := clbForeground.ButtonColor
else
if (Sender = cbHumanReadableText) and (FBarcode is TCustomBarcode) then
TBarcodeAccess(FBarcode).ShowHumanReadableText := cbHumanReadableText.Checked
else
if (Sender = cbAddChecksum) and (FBarcode is TSimpleBarcode) then
begin
TSimpleBarcodeAccess(FBarcode).AddChecksum := cbAddChecksum.Checked;
cbDisplayChecksum.Enabled := cbAddChecksum.Checked;
end
else
if (Sender = cbDisplayChecksum) and (FBarcode is TSimpleBarcode) then
TSimpleBarcodeAccess(FBarcode).DisplayChecksum := cbDisplayChecksum.Checked;
end;
procedure TMainForm.btnSampleTextClick(Sender: TObject);
begin
if FBarCode <> nil then
begin
FBarcode.SampleText;
edText.Text := FBarcode.Text;
end;
end;
procedure TMainForm.BarcodesTreeChange(Sender: TObject; Node: TTreeNode);
begin
SelectBarcode(Node);
end;
procedure TMainForm.BarcodesTreeCustomDrawItem(Sender: TCustomTreeView;
Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);
begin
if (Node.HasChildren) or (Node.Level = 0) then
Sender.Canvas.Font.Style := [fsBold]
else
Sender.Canvas.Font.Style := [];
DefaultDraw := true;
end;
procedure TMainForm.btnCopyToClipboardClick(Sender: TObject);
begin
FBarcode.CopyToClipboard;
end;
procedure TMainForm.btnFontClick(Sender: TObject);
begin
FontDialog.Font.Assign(FBarcode.Font);
if FontDialog.Execute then
FBarcode.Font.Assign(FontDialog.Font);
end;
procedure TMainForm.btnSaveToFileClick(Sender: TObject);
begin
with TSaveDialog.Create(self) do
try
Filter := 'Windows bitmap files (*.bmp)|*.bmp|' +
'Portable network graphic files (*.png)|*.png|' +
'JPEG image files (*.jpg;*.jpeg)|*.jpg;*.jpeg|' +
'TIFF image files (*.tiff; *.tif)|*.tiff;*.tif|'+
'XPM image files (*.xpm)|*.xpm|' +
'Scalable vector graphics files (*.svg)|*.svg|'+
'Encapsulated PostScript files (*.eps;*.ps)|*.eps;*.ps|'+
'All files (*.*)|*.*';
FilterIndex := 2;
DefaultExt := '.png';
InitialDir := ExtractFileName(FFileName);
OnTypeChange := @SaveDialogTypeChange;
if Execute then
begin
FFileName := FileName;
case lowercase(ExtractFileExt(FFileName)) of
'.bmp':
FBarcode.SaveToFile(FFileName, TBitmap);
'.png':
FBarcode.SaveToFile(FFileName, TPortableNetworkGraphic);
'.jpg', '.jpeg':
FBarcode.SaveTofile(FFileName, TJpegImage);
'.tif', '.tiff':
FBarcode.SaveToFile(FFileName, TTiffImage);
'.xpm':
FBarcode.SaveToFile(FFileName, TPixmap);
'.svg':
FBarcode.SaveToSvgFile(FFileName);
'.eps', '.ps':
Fbarcode.SaveToEpsFile(FFileName);
else
raise Exception.Create('Image type not supported.');
end;
end;
finally
Free;
end;
end;
procedure TMainForm.cbAutoSizeChange(Sender: TObject);
begin
if Assigned(FBarcode) then
begin
FBarcode.AutoSize := cbAutoSize.Checked;
if FBarcode.AutoSize then
begin
FBarcode.Align := alNone;
FBarcode.AnchorSideLeft.Control := FBarcode.Parent;
FBarcode.AnchorSideLeft.Side := asrCenter;
FBarcode.AnchorSideTop.Control := FBarcode.Parent;
FBarcode.AnchorSideTop.Side := asrCenter;
end else
begin
FBarcode.AnchorSideLeft.Control := nil;
FBarcode.AnchorSideTop.Control := nil;
FBarcode.Align := alClient;
end;
end;
end;
procedure TMainForm.cbRecommendedSymbolSizeChange(Sender: TObject);
begin
seScale.Enabled := not cbRecommendedSymbolSize.Checked;
lblScale.Enabled := seScale.Enabled;
seMargin.Enabled := not cbRecommendedSymbolSize.Checked;
lblMargin.Enabled := seMargin.Enabled;
seWhitespaceWidth.Enabled := not cbRecommendedSymbolSize.Checked and IsPublishedProp(FBarcode, 'WhiteSpaceWidth');
lblWhitespaceWidth.Enabled := seWhitespaceWidth.Enabled;
seSymbolHeight.Enabled := not cbRecommendedSymbolSize.Checked and IsPublishedProp(FBarcode, 'SymbolHeight');
lblSymbolHeight.Enabled := seSymbolHeight.Enabled;
cmbBearerBarsBox.Enabled := not cbRecommendedSymbolSize.Checked and IsPublishedProp(FBarcode, 'BearerBarMode');
if FBarcode is TSimpleBarcode then
begin
TSimpleBarcode(FBarcode).RecommendedSymbolSize := cbRecommendedSymbolSize.Checked;
if not cbRecommendedSymbolSize.Checked then
begin
TSimpleBarcode(FBarcode).Scale := seScale.Value;
TSimpleBarcodeAccess(FBarcode).SymbolHeight := seSymbolHeight.Value;
TSimpleBarcode(FBarcode).Margin := seMargin.Value;
TSimpleBarcodeAccess(FBarcode).WhitespaceWidth := seWhiteSpaceWidth.Value;
TSimpleBarcodeAccess(FBarcode).BearerBarMode := TBarcodeBearerBarMode(cmbBearerBarsBox.ItemIndex);
end;
end else
if FBarcode is TBarcodePDF417 then
begin
seSymbolHeight.Enabled := not cbRecommendedSymbolSize.Checked;
lblSymbolHeight.Enabled := seSymbolHeight.Enabled;
end;
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
nbOptions.PageIndex := -1;
PopulateBarcodesTree;
end;
procedure TMainForm.rgPlessey_CheckcharClick(Sender: TObject);
begin
if FBarcode is TBarcodePlessey then
TBarcodePlessey(FBarcode).CheckChar := TPlesseyCheckChar(rgPlessey_CheckChar.ItemIndex);
end;
procedure TMainForm.rgQR_ECCLevelClick(Sender: TObject);
begin
if FBarcode is TBarcodeQR then
TBarcodeQR(FBarcode).ECCLevel := TBarcodeQR_ECCLevel(rgQR_ECCLevel.ItemIndex);
end;
procedure TMainForm.SaveDialogTypeChange(Sender: TObject);
var
dlg: TSaveDialog;
L: TStrings;
idx: Integer;
begin
dlg := Sender as TSaveDialog;
L := TStringList.Create;
try
L.StrictDelimiter := true;
L.Delimiter := '|';
L.DelimitedText := dlg.Filter;
idx := (dlg.FilterIndex - 1) * 2 + 1;
dlg.DefaultExt := ExtractfileExt(L[idx]);
finally
L.Free;
end;
end;
procedure TMainForm.edTextChange(Sender: TObject);
begin
FBarcode.Text := edText.Text;
UpdateErrorMsg;
end;
procedure TMainForm.PopulateBarcodesTree;
var
node, child: TTreeNode;
begin
with BarcodesTree do begin
Items.BeginUpdate;
try
Items.Clear;
node := Items.AddChild(nil, '1-dimensional barcodes');
child := Items.AddChildObject(node, 'Code 11', PChar('TBarcodeC11'));
child := Items.AddChildObject(node, 'Code 128 and related', PChar('TBarcodeC128'));
Items.AddChildObject(child, 'Code-128', Pointer(PtrInt(bctCode128)));
Items.AddChildObject(child, 'EAN-128', Pointer(PtrInt(bctEAN128)));
child := Items.AddChildObject(node, '2-of-5 codes', PChar('TBarcode2of5'));
Items.AddChildObject(child, 'Standard 2-of-5', Pointer(PtrInt(bctCode25Standard)));
Items.AddChildObject(child, 'Data Logic 2-of-5', Pointer(PtrInt(bctCode25DataLogic)));
Items.AddChildObject(child, 'IATA 2-of-5', Pointer(PtrInt(bctCode25IATA)));
Items.AddChildObject(child, 'Industrial 2-of-5', Pointer(PtrInt(bctCode25Industrial)));
Items.AddChildObject(child, 'Interleaved 2-of-5', Pointer(PtrInt(bctCode25Interleaved)));
Items.AddChildObject(child, 'ITF-14', Pointer(PtrInt(bctITF14)));
child := Items.AddChildObject(node, '3-of-9 codes', PChar('TBarcode3of9'));
Items.AddChildObject(child, 'Code 3-of-9 (C39)', Pointer(ptrInt(bctCode39)));
Items.AddChildObject(child, 'Code 3-of-9 extended (C39+)', Pointer(PtrInt(bctCode39Ext)));
Items.AddChildObject(child, 'LOGMARS', Pointer(PtrInt(bctLOGMARS)));
Items.AddChildObject(child, 'Code 93', Pointer(PtrInt(bctCode93)));
child := Items.AddChildObject(node, 'Channel code', PChar('TBarcodeChannelCode'));
child := Items.AddChildObject(node, 'UPC/EAN codes', PChar('TBarcodeEAN'));
Items.AddChildObject(child, 'EAN-8, EAN-13', Pointer(PtrInt(bctEAN)));
Items.AddChildObject(child, 'EAN-14', Pointer(PtrInt(bctEAN14)));
Items.AddChildObject(child, 'ISBN', Pointer(PtrInt(bctISBN)));
Items.AddChildObject(child, 'NVE-18', Pointer(PtrInt(bctNVE18)));
Items.AddChildObject(child, 'UPC-A', Pointer(PtrInt(bctUPCA)));
Items.AddChildObject(child, 'UPC-E', Pointer(PtrInt(bctUPCE)));
child := Items.AddChildObject(node, 'MSI/Plessey', PChar('TBarcodePlessey'));
Items.AddChildObject(child, 'Plessey', Pointer(PtrInt(bctPlessey)));
Items.AddChildObject(child, 'MSI/Plessey', Pointer(PtrInt(bctMSIPlessey)));
child := Items.AddChildObject(node, 'Telepen', PChar('TBarcodeTelepen'));
Items.AddChildObject(child, 'Telepen', Pointer(PtrInt(bctTelepen)));
Items.AddChildObject(child, 'Telepen numeric', Pointer(PtrInt(bctTelepenNum)));
child := Items.AddChildObject(node, 'Medical/pharmaceutical', PChar('TBarcodeMedical'));
Items.AddChildObject(child, 'CodaBar', Pointer(PtrInt(bctCodaBar)));
Items.AddChildObject(child, 'Code32', Pointer(PtrInt(bctCode32)));
Items.AddChildObject(child, 'Pharma one-track', Pointer(PtrInt(bctPharmaOne)));
Items.AddChildObject(child, 'Pharma two-track', Pointer(PtrInt(bctPharmaTwo)));
Items.AddChildObject(child, 'Pharmazentralnummer (7-digit)', Pointer(PtrInt(bctPZN7)));
Items.AddChildObject(child, 'Pharmazentralnummer (8-digit)', Pointer(PtrInt(bctPZN8)));
child := Items.AddChildObject(node, 'Postal barcodes', PChar('TBarcodePostal'));
Items.AddChildObject(child, 'Australia Post Customer', Pointer(PtrInt(bctAustraliaPostCustomer)));
Items.AddChildObject(child, 'Australia Post Reply Paid', Pointer(PtrInt(bctAustraliaPostReplyPaid)));
Items.AddChildObject(child, 'Australia Post Routing', Pointer(PtrInt(bctAustraliaPostRoute)));
Items.AddChildObject(child, 'Australia Post Redirection', Pointer(PtrInt(bctAustraliaPostRedirect)));
Items.AddChildObject(child, 'DAFT', Pointer(PtrInt(bctDaft)));
Items.AddChildObject(child, 'Deutsche Post IdentCode', Pointer(PtrInt(bctDeutschePostIdentCode)));
Items.AddChildObject(child, 'Deutsche Post LeitCode', Pointer(PtrInt(bctDeutschePostLeitCode)));
Items.AddChildObject(child, 'FIM (Face Identification Mark)', Pointer(PtrInt(bctFIM)));
Items.AddChildObject(child, 'Japanese Post', Pointer(PtrInt(bctJapanPost)));
Items.AddChildObject(child, 'KIX', Pointer(PtrInt(bctKix)));
Items.AddChildObject(child, 'Korea Post', Pointer(PtrInt(bctKoreaPost)));
Items.AddChildObject(child, 'Planet', Pointer(PtrInt(bctPlanet)));
Items.AddChildObject(child, 'PostNet', Pointer(PtrInt(bctPostNet)));
Items.AddChildObject(child, 'Royal Mail RM4SCC', Pointer(PtrInt(bctRM4SCC)));
node := Items.AddChild(nil, '2-dimensional barcodes');
child := Items.AddChildObject(node, 'QR Code', PChar('TBarcodeQR'));
child := Items.AddChildObject(node, 'Micro QR', PChar('TBarcodeMicroQR'));
child := Items.AddChildObject(node, 'Aztec', PChar('TBarcodeAztec'));
child := Items.AddChildObject(node, 'Aztec Rune', PChar('TBarcodeAztecRune'));
child := Items.AddChildObject(node, 'Data Matrix', PChar('TBarcodeDataMatrix'));
child := Items.AddChildObject(node, 'PDF417 variants', PChar('TBarcodePDF417'));
Items.AddChildObject(child, 'PDF417', Pointer(PtrInt(bctPDF417)));
Items.AddChildObject(child, 'Compact PDF417', Pointer(PtrInt(bctPDF417trunc)));
Items.AddChildObject(child, 'MicroPDF417 (ISO 24728)', Pointer(PtrInt(bctMicroPDF417)));
FullExpand;
finally
Items.EndUpdate;
end;
end;
end;
procedure TMainForm.SelectBarcode(ANode: TTreeNode);
var
barcodeClassName: String;
barcodeClass: TLazBarcodeClass;
barcodeType: Integer;
begin
if (ANode = nil) then
begin
if FBarcode <> nil then FBarcode.Hide;
exit;
end;
FreeAndNil(FBarcode);
// Determine from the node's Data field the class of the barcode to be created
// and/or the value of the BarcodeType property.
if (ANode.Level = 1) and not ANode.HasChildren then
barcodeClassName := PChar(ANode.Data)
else
if (ANode.Level = 2) then
begin
barcodeClassName := PChar(ANode.Parent.Data);
barcodeType := {%H-}PtrInt(ANode.Data);
end else
begin
if FBarcode <> nil then FBarcode.Hide;
exit;
end;
// Create barcode from information provided in the node's Data field.
barcodeClass := TLazBarcodeClass(GetClass(barcodeClassName));
FBarcode := barcodeClass.Create(self);
FBarcode.Parent := BarcodePanel;
// Apply general properties
FBarcode.Text := edText.Text;
TBarcodeAccess(FBarcode).Color := clbColor.ButtonColor;
TBarcodeAccess(FBarcode).BackgroundColor := clbBackground.ButtonColor;
TBarcodeAccess(FBarcode).ForegroundColor := clbForeground.ButtonColor;
TBarcodeAccess(FBarcode).Scale := seScale.Value;
TBarcodeAccess(FBarcode).Margin := seMargin.Value;
TBarcodeAccess(FBarcode).WhiteSpaceWidth := seWhitespaceWidth.Value;
TBarcodeAccess(FBarcode).BearerBarMode := TBarcodeBearerBarMode(cmbBearerBarsBox.ItemIndex);
TBarcodeAccess(FBarcode).SymbolHeight := seSymbolHeight.Value;
TBarcodeAccess(FBarcode).RecommendedSymbolSize := cbRecommendedSymbolSize.Checked;
// Apply specific properties for each barcode class - not very elegant...
if (FBarcode is TCustomBarcode) then
TBarcodeAccess(FBarcode).ShowHumanReadableText := cbHumanReadableText.Checked;
if (FBarcode is TSimpleBarCode) then
begin
TSimpleBarcodeAccess(FBarcode).AddChecksum := cbAddChecksum.Checked;
cbAddChecksum.Enabled := IsPublishedProp(FBarcode, 'AddChecksum');
TSimpleBarcodeAccess(FBarcode).DisplayChecksum := cbDisplayChecksum.Checked;
cbDisplayChecksum.Enabled := cbAddChecksum.Checked and IsPublishedProp(FBarcode, 'DisplayChecksum');
if (ANode.Level = 2) then
TSimpleBarcodeAccess(FBarcode).BarcodeType := TBarcodeType(barcodeType);
end;
cbAutoSizeChange(nil);
// Show options page corresponding to the selected barcode type.
if (FBarcode is TBarcodePlessey) and (TBarcodePlessey(FBarcode).BarcodeType = bctMSIPlessey) then
nbOptions.PageIndex := pgOptions_Plessey.PageIndex
else
if (FBarcode is TBarcodeQR) then
nbOptions.PageIndex := pgOptions_QR.PageIndex
else
nbOptions.PageIndex := -1;
// Enable/disable GUI components
cbHumanReadableText.Enabled := not ((FBarcode is TBarcodeSquare) or (FBarcode is TBarcodePDF417));
btnFont.Enabled := cbHumanReadableText.Enabled;
seWhiteSpaceWidth.Enabled := IsPublishedProp(FBarcode, 'WhiteSpaceWidth') and not cbRecommendedSymbolSize.Checked;
lblWhitespaceWidth.Enabled := seWhiteSpaceWidth.Enabled;
if FBarcode is TBarcodePDF417 then
begin
seSymbolHeight.Enabled := not cbRecommendedSymbolSize.Checked;
lblSymbolHeight.Caption := 'Row height ratio';
end else
begin
seSymbolHeight.Enabled := not cbRecommendedSymbolSize.Checked and IsPublishedProp(FBarcode, 'SymbolHeight');
lblSymbolHeight.Caption := 'Symbol height';
end;
lblSymbolHeight.Enabled := seSymbolHeight.Enabled;
// Show error message from rendering, if available.
UpdateErrorMsg;
end;
procedure TMainForm.UpdateErrorMsg;
begin
lblError.Visible := FBarcode.ErrorString <> '';
lblError.Caption := FBarcode.ErrorString;
if FBarcode <> nil then
FBarcode.Visible := not lblError.Visible;
end;
initialization
RegisterBarcodes;
end.

49
components/lazbarcodes/images/images.txt Normal file
View File

@ -0,0 +1,49 @@
tbarcode2of5.png
tbarcode2of5_150.png
tbarcode2of5_200.png
tbarcode3of9.png
tbarcode3of9_150.png
tbarcode3of9_200.png
tbarcodec11.png
tbarcodec11_150.png
tbarcodec11_200.png
tbarcodec128.png
tbarcodec128_150.png
tbarcodec128_200.png
tbarcodechannelcode.png
tbarcodechannelcode_150.png
tbarcodechannelcode_200.png
tbarcodeean.png
tbarcodeean_150.png
tbarcodeean_200.png
tbarcodemedical.png
tbarcodemedical_150.png
tbarcodemedical_200.png
tbarcodeplessey.png
tbarcodeplessey_150.png
tbarcodeplessey_200.png
tbarcodepostal.png
tbarcodepostal_150.png
tbarcodepostal_200.png
tbarcodetelepen.png
tbarcodetelepen_150.png
tbarcodetelepen_200.png
tbarcodeqr.png
tbarcodeqr_150.png
tbarcodeqr_200.png
tbarcodemicroqr.png
tbarcodemicroqr_150.png
tbarcodemicroqr_200.png
tbarcodeaztec.png
tbarcodeaztec_150.png
tbarcodeaztec_200.png
tbarcodeaztecrune.png
tbarcodeaztecrune_150.png
tbarcodeaztecrune_200.png
tbarcodedatamatrix.png
tbarcodedatamatrix_150.png
tbarcodedatamatrix_200.png
tbarcodepdf417.png
tbarcodepdf417_150.png
tbarcodepdf417_200.png

1
components/lazbarcodes/images/make_res.bat Normal file
View File

@ -0,0 +1 @@
lazres ..\src\lazbarcodes_icons.res @images.txt

BIN
components/lazbarcodes/images/tbarcode2of5.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 540 B

BIN
components/lazbarcodes/images/tbarcode2of5_150.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 847 B

BIN
components/lazbarcodes/images/tbarcode2of5_200.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.1 KiB

BIN
components/lazbarcodes/images/tbarcode3of9.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 536 B

BIN
components/lazbarcodes/images/tbarcode3of9_150.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 851 B

BIN
components/lazbarcodes/images/tbarcode3of9_200.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.1 KiB

BIN
components/lazbarcodes/images/tbarcodeaztec.png
View File

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 203 B

After

Width:  |  Height:  |  Size: 385 B

BIN
components/lazbarcodes/images/tbarcodeaztec_150.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 783 B

BIN
components/lazbarcodes/images/tbarcodeaztec_200.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 640 B

BIN
components/lazbarcodes/images/tbarcodeaztecrune.png
View File

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 138 B

After

Width:  |  Height:  |  Size: 360 B

BIN
components/lazbarcodes/images/tbarcodeaztecrune_150.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 475 B

BIN
components/lazbarcodes/images/tbarcodeaztecrune_200.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 546 B

BIN
components/lazbarcodes/images/tbarcodec11.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 449 B

BIN
components/lazbarcodes/images/tbarcodec11_150.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 680 B

BIN
components/lazbarcodes/images/tbarcodec11_200.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 809 B

BIN
components/lazbarcodes/images/tbarcodec128.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 543 B

BIN
components/lazbarcodes/images/tbarcodec128_150.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 869 B

BIN
components/lazbarcodes/images/tbarcodec128_200.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.2 KiB

BIN
components/lazbarcodes/images/tbarcodechannelcode.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 517 B

BIN
components/lazbarcodes/images/tbarcodechannelcode_150.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 803 B

BIN
components/lazbarcodes/images/tbarcodechannelcode_200.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1022 B

BIN
components/lazbarcodes/images/tbarcodedatamatrix.png
View File

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 189 B

After

Width:  |  Height:  |  Size: 475 B

BIN
components/lazbarcodes/images/tbarcodedatamatrix_150.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 536 B

BIN
components/lazbarcodes/images/tbarcodedatamatrix_200.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 823 B

BIN
components/lazbarcodes/images/tbarcodeean.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 480 B

BIN
components/lazbarcodes/images/tbarcodeean_150.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 769 B

BIN
components/lazbarcodes/images/tbarcodeean_200.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 926 B

BIN
components/lazbarcodes/images/tbarcodemedical.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 669 B

BIN
components/lazbarcodes/images/tbarcodemedical_150.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 993 B

BIN
components/lazbarcodes/images/tbarcodemedical_200.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.4 KiB

BIN
components/lazbarcodes/images/tbarcodemicroqr.png
View File

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 194 B

After

Width:  |  Height:  |  Size: 256 B

BIN
components/lazbarcodes/images/tbarcodemicroqr_150.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 449 B

BIN
components/lazbarcodes/images/tbarcodemicroqr_200.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 397 B

BIN
components/lazbarcodes/images/tbarcodepdf417.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 218 B

BIN
components/lazbarcodes/images/tbarcodepdf417_150.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 484 B

BIN
components/lazbarcodes/images/tbarcodepdf417_200.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 272 B

BIN
components/lazbarcodes/images/tbarcodeplessey.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 453 B

BIN
components/lazbarcodes/images/tbarcodeplessey_150.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 752 B

BIN
components/lazbarcodes/images/tbarcodeplessey_200.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 910 B

BIN
components/lazbarcodes/images/tbarcodepostal.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 462 B

BIN
components/lazbarcodes/images/tbarcodepostal_150.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 719 B

BIN
components/lazbarcodes/images/tbarcodepostal_200.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 974 B

BIN
components/lazbarcodes/images/tbarcodeqr.png
View File

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 199 B

After

Width:  |  Height:  |  Size: 527 B

BIN
components/lazbarcodes/images/tbarcodeqr_150.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 442 B

BIN
components/lazbarcodes/images/tbarcodeqr_200.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 590 B

BIN
components/lazbarcodes/images/tbarcodetelepen.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 560 B

BIN
components/lazbarcodes/images/tbarcodetelepen_150.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 819 B

BIN
components/lazbarcodes/images/tbarcodetelepen_200.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.1 KiB

BIN
components/lazbarcodes/src/lazbarcodes_icons.res Normal file
View File

Binary file not shown.

336
components/lazbarcodes/src/lbc_2of5.pas Normal file
View File

@ -0,0 +1,336 @@
{ lbc_2of5.pas - Handles "two-of-five" code variants
Based on Zint (done by Robin Stuart and the Zint team)
http://github.com/zint/zint
and Pascal adaption by TheUnknownOnes
http://theunknownones.net
Refactoring: W.Pamler
Generated bar codes checked against
https://products.aspose.app/barcode/de/generate/
}
unit lbc_2of5;
{$mode objfpc}{$H+}
interface
uses
zint;
{ Code 2 of 5 Matrix }
function matrix_two_of_five(ASymbol: PZintSymbol; const ASource: String): Integer;
{ Code 2 of 5 IATA }
function iata_two_of_five(ASymbol: PZintSymbol; const ASource: String): Integer;
{ Code 2 of 5 Industrial }
function industrial_two_of_five(ASymbol: PZintSymbol; const ASource: String): Integer;
{ Code 2 of 5 Data Logic }
function logic_two_of_five(ASymbol: PZintSymbol; const ASource: String): Integer;
{ Code 2 of 5 Interleaved }
function interleaved_two_of_five(ASymbol: PZintSymbol; const ASource: String): Integer;
{ ITF-14 }
function itf14(ASymbol: PZintSymbol; const ASource: String): Integer;
{ Deutsche Post Identcode }
function dpident(ASymbol: PZintSymbol; const ASource: String): Integer;
{ Deutsche Post Leitcode }
function dpleit(ASymbol: PZintSymbol; const ASource: String): Integer;
implementation
uses
SysUtils, lbc_helper;
const
C25MatrixTable: array[0..9] of String = (
'113311', '311131', '131131', '331111', '113131',
'313111', '133111', '111331', '311311', '131311'
);
C25IndustTable: array[0..9] of String = (
'1111313111', '3111111131',
'1131111131', '3131111111',
'1111311131', '3111311111',
'1131311111', '1111113131',
'3111113111', '1131113111'
);
C25InterTable: array[0..9] of String = (
'11331', '31113', '13113', '33111', '11313',
'31311', '13311', '11133', '31131', '13131'
);
function check_digit(count: Integer): Char; inline;
begin
Result := itoc((10 - count mod 10) mod 10);
end;
{ Calculates the check digit for ITF-14 It is the same method as used for EAN-13 }
function CheckSum_EAN13(ASource: String): String;
var
i,n, sum: Integer;
begin
sum := 0;
for i := Length(ASource) downto 1 do
begin
n := ctoi(ASource[i]);
inc(sum, n);
if odd(i) then
Inc(sum, 2 * n);
end;
Result := check_digit(sum);
end;
{ Calculates the check sum digit for Deutsche Post codes. }
function CheckSum_DP(ASource: String): String;
var
i, n, sum: Integer;
begin
sum := 0;
for i := Length(ASource) downto 1 do
begin
n := ctoi(ASource[i]);
inc(sum, 4*n);
if not odd(i) then
inc(sum, 5*n);
end;
Result := check_digit(sum);
end;
{ Basic encoder for interleaved two-of-five barcodes - they all work in
the same way, only with different parameters:
MaxLen - maximum length of input string
AllowedChars - a string containing the allowed characters for this barcode type
StartCode - starting code pattern
CharCodes - code pattern for each allowed character
StopCode - ending code pattern.
CheckCharsFunc - function to calculate a checksum
}
function basic_interleaved_two_of_five(ASymbol: PZIntSymbol; const ASource: String;
MaxLen: Integer; const AllowedChars, StartCode: String;
const CharCodes: array of string; const StopCode: String;
CheckSumFunc: TCheckSumFunc): Integer;
var
i, j: Integer;
src, dest, bars, spaces: String;
begin
if Length(ASource) > MaxLen then
begin
ASymbol^.SetErrorText('Input too long (max ' + IntToStr(MaxLen) + ' digits).');
Result := ERROR_TOO_LONG;
exit;
end;
Result := is_sane(AllowedChars, ASource);
if Result = ERROR_INVALID_DATA then
begin
ASymbol^.SetErrorText('Invalid characters in data.');
exit;
end;
src := ASource;
// Add check digit(s) if a calculation function is provided
if CheckSumFunc <> nil then
src := src + CheckSumFunc(src);
// Input must be an even number of characters for Interlaced 2 of 5 to work:
// if an odd number of characters has been entered then add a leading zero.
if odd(Length(src)) then
src := '0' + src;
// START character
dest := StartCode;
// Add encoded input string characters, but in an interleaved way
i := 1;
while i <= Length(src) do
begin
// Look up the bars and the spaces and put them in two strings
bars := '';
lookup(AllowedChars, CharCodes, src[i], bars);
spaces := '';
lookup(AllowedChars, CharCodes, src[i + 1], spaces);
// Then merge (interlace) the strings together
for j := 1 to 5 do
dest := dest + bars[j] + spaces[j];
Inc(i, 2);
end;
// STOP character
dest := dest + StopCode;
// Create symbol
expand(ASymbol, dest);
// Store human-readable text
ASymbol^.SetText(src);
end;
{-------------------------------------------------------------------------------
Code 2 of 5 Standard (Code 2 of 5 Matrix)
-------------------------------------------------------------------------------}
function matrix_two_of_five(ASymbol: PZintSymbol; const ASource: String): Integer;
begin
Result := basic_encoder(ASymbol, ASource,
80, NEON, '411111', C25MatrixTable, '41111', nil, false
);
end;
{-------------------------------------------------------------------------------
Code 2 of 5 Industrial
-------------------------------------------------------------------------------}
function industrial_two_of_five(ASymbol: PZintSymbol; const ASource: String): Integer;
begin
Result := basic_encoder(ASymbol, ASource,
45, NEON, '313111', C25IndustTable, '31113', nil, false
);
end;
{-------------------------------------------------------------------------------
Code 2 of 5 IATA
-------------------------------------------------------------------------------}
function iata_two_of_five(ASymbol: PZintSymbol; const ASource: string): Integer;
begin
Result := basic_encoder(ASymbol, ASource,
45, NEON, '1111', C25IndustTable, '311', nil, false
);
end;
{-------------------------------------------------------------------------------
Code 2 of 5 Data Logic
-------------------------------------------------------------------------------}
function logic_two_of_five(ASymbol: PZintSymbol; const ASource: String): Integer;
begin
Result := basic_encoder(ASymbol, ASource,
80, NEON, '1111', C25MatrixTable, '311', nil, false
);
end;
{-------------------------------------------------------------------------------
Code 2 of 5 Interleaved
-------------------------------------------------------------------------------}
function interleaved_two_of_five(ASymbol: PZintSymbol; const ASource: String): Integer;
begin
Result := basic_interleaved_two_of_five(ASymbol, ASource,
89, NEON, '1111', C25InterTable, '311', nil);
end;
{-------------------------------------------------------------------------------
ITF-14
-------------------------------------------------------------------------------}
function itf14(ASymbol: PZintSymbol; const ASource: String): Integer;
const
MaxLength = 13;
var
n: Integer; // number of filler zeros
src: String;
begin
if Length(ASource) < MaxLength then
begin
n := MaxLength - Length(ASource);
src := StringOfChar('0', n) + ASource;
end else
src := ASource;
Result := basic_interleaved_two_of_five(ASymbol, src,
MaxLength, NEON, '1111', C25InterTable, '311', @CheckSum_EAN13);
end;
{-------------------------------------------------------------------------------
Deutsche Post Leitcode
Deutsche Post Leitcode encodes a string of 14 digits, as follows:
- Five-digit postal code
- Three-digit street identifier
- Three-digit house number
- Two-digit product code
- One-digit check digit
(https://barcodeguide.seagullscientific.com/Content/Symbologies/Leitcode.htm)
-------------------------------------------------------------------------------}
function dpleit(ASymbol: PZintSymbol; const ASource: String): Integer;
const
MaxLength = 13;
var
n: Integer; // Number of filler zeros
s: String;
begin
if Length(ASource) < MaxLength then
begin
n := MaxLength - Length(ASource);
s := StringOfChar('0', n) + ASource;
end else
s := ASource;
Result := basic_interleaved_two_of_five(ASymbol, s,
MaxLength, NEON, '1111', C25InterTable, '311', @CheckSum_DP);
// Grouped output: "12345678901234" --> "12345.678.901.23 4"
if (Result = 0) and (ASymbol^.Option and OPTION_GROUPED_CHARS = OPTION_GROUPED_CHARS) then
begin
s := ASymbol^.GetText;
Insert(' ', s, 14);
Insert('.', s, 12);
Insert('.', s, 9);
Insert('.', s, 6);
ASymbol^.SetText(s);
end;
end;
{-------------------------------------------------------------------------------
Deutsche Post Identcode
Deutsche Post Identcode encodes a string of (11 or) 12 digits, as follows:
- Two-digit mail center distribution identifier
- Three-digit customer code
- Six-digit delivery identifier
- One-digit check digit (optional - here it is always included.)
(https://barcodeguide.seagullscientific.com/Content/Symbologies/Identcode.htm)
-------------------------------------------------------------------------------}
function dpident(ASymbol: PZintSymbol; const ASource: string): Integer;
const
MaxLength = 11;
var
n: Integer; // Number of filler zeros
s: String;
begin
if Length(ASource) < MaxLength then
begin
n := MaxLength - Length(ASource);
s := StringOfChar('0', n) + ASource;
end else
s := ASource;
Result := basic_interleaved_two_of_five(ASymbol, s,
MaxLength, NEON, '1111', C25InterTable, '311', @CheckSum_DP);
// Grouped output: "12345678901" --> "12.345 678.901 2"
if (Result = 0) and (ASymbol^.Option and OPTION_GROUPED_CHARS = OPTION_GROUPED_CHARS) then
begin
s := ASymbol^.GetText;
Insert(' ', s, 12);
Insert('.', s, 9);
Insert(' ', s, 6);
Insert('. ', s, 3);
ASymbol^.SetText(s);
end;
end;
end.

242
components/lazbarcodes/src/lbc_auspost.pas Normal file
View File

@ -0,0 +1,242 @@
{ lbc_auspost.pas - Handles Australian post barcodes.
Based on Zint (done by Robin Stuart and the Zint team)
http://github.com/zint/zint
and Pascal adaption by TheUnknownOnes
http://theunknownones.net
Refactoring: W. Pamler
}
unit lbc_auspost;
{$IFDEF FPC}
{$mode objfpc}{$H+}
{$ENDIF}
interface
uses
Types, SysUtils, zint;
function australia_post(ASymbol: PZintSymbol; ASource: String): Integer;
implementation
uses
lbc_reedsolomon, lbc_helper;
const
GDSET: String = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz #';
AusNTable: array[0..9] of String = (
'00', '01', '02', '10', '11', '12', '20', '21', '22', '30'
);
AusCTable: array[0..63] of String = (
'222', '300', '301', '302', '310', '311', '312', '320', '321', '322',
'000', '001', '002', '010', '011', '012', '020', '021', '022', '100',
'101', '102', '110', '111', '112', '120', '121', '122', '200', '201',
'202', '210', '211', '212', '220', '221', '023', '030', '031', '032',
'033', '103', '113', '123', '130', '131', '132', '133', '203', '213',
'223', '230', '231', '232', '233', '303', '313', '323', '330', '331',
'332', '333', '003', '013'
);
AusBarTable: array[0..63] of String = (
'000', '001', '002', '003', '010', '011', '012', '013', '020', '021',
'022', '023', '030', '031', '032', '033', '100', '101', '102', '103',
'110', '111', '112', '113', '120', '121', '122', '123', '130', '131',
'132', '133', '200', '201', '202', '203', '210', '211', '212', '213',
'220', '221', '222', '223', '230', '231', '232', '233', '300', '301',
'302', '303', '310', '311', '312', '313', '320', '321', '322', '323',
'330', '331', '332', '333'
);
function convert_pattern(data: Char; shift: Integer): Byte; inline;
begin
Result := (Ord(data) - Ord('0')) shl shift;
end;
{ Adds Reed-Solomon error correction to auspost }
procedure rs_error_correction(var data_pattern: String);
var
i, triple_writer: Integer;
triple: TByteDynArray = nil;
inv_triple: TByteDynArray = nil;
res : TByteDynArray = nil;
begin
triple_writer := 0;
SetLength(triple, 31);
SetLength(inv_triple, 31);
SetLength(res, 5);
i := 3;
while i <= Length(data_pattern) do
begin
triple[triple_writer] :=
convert_pattern(data_pattern[i ], 4) +
convert_pattern(data_pattern[i + 1], 2) +
convert_pattern(data_pattern[i + 2], 0);
Inc(i, 3);
Inc(triple_writer);
end;
for i := 0 to triple_writer - 1 do
inv_triple[i] := triple[(triple_writer - 1) - i];
rs_init_gf($43);
rs_init_code(4, 1);
rs_encode(triple_writer, @inv_triple[0], @res[0]);
for i := 3 downto 0 do
data_pattern := data_pattern + AusBarTable[res[i]];
rs_free();
end;
{ Handles Australia Posts's 4 State Codes }
function australia_post(ASymbol: PZintSymbol; ASource: String): Integer;
{ Customer Standard Barcode, Barcode 2 or Barcode 3 system determined automatically
(i.e. the FCC doesn't need to be specified by the user) dependent
on the length of the input string }
{ The contents of data_pattern conform to the following standard:
0 := Tracker, Ascender and Descender
1 := Tracker and Ascender
2 := Tracker and Descender
3 := Tracker only }
var
i, len, writer: Integer;
data_pattern: String;
fcc: String;
dpid: String;
localstr: String;
begin
Result := 0;
localstr := ASource;
// Do all of the _length checking first to avoid stack smashing
if (ASymbol^.symbology = BARCODE_AUSPOST) then
begin
// Format control code (FCC)
case Length(ASource) of
8 : fcc := '11';
16: begin
Result := is_sane(NEON, ASource);
fcc := '59';
end;
13: fcc := '59';
23: begin
Result := is_sane(NEON, ASource);
fcc := '62';
end;
18: fcc := '62';
else
ASymbol^.SetErrorText('Auspost input is wrong length');
Result := ERROR_TOO_LONG;
exit;
end;
if (Result = ERROR_INVALID_DATA) then
begin
ASymbol^.SetErrorText('Invalid characters in data');
exit;
end;
end
else
begin
if (Length(ASource) > 8) then
begin
ASymbol^.SetErrorText('Auspost input is too long');
Result := ERROR_TOO_LONG;
exit;
end;
case ASymbol^.symbology of
BARCODE_AUSREPLY:
fcc := '45';
BARCODE_AUSROUTE:
fcc := '87';
BARCODE_AUSREDIRECT:
fcc := '92';
end;
//Add leading zeros as required
localstr := StringOfChar('0', 8 - Length(ASource)) + localstr;
end;
Result := is_sane(GDSET, localstr);
if (Result = ERROR_INVALID_DATA) then
begin
ASymbol^.SetErrorText('Invalid characters in data');
exit;
end;
// Verifiy that the first 8 characters are numbers
dpid := copy(localstr, 1, 8);
Result := is_sane(NEON, dpid);
if (Result = ERROR_INVALID_DATA) then
begin
ASymbol^.SetErrorText('Invalid characters in DPID');
exit;
end;
// START character
data_pattern := '13';
// Encode the FCC
for i := 1 to 2 do
lookup(NEON, AusNTable, fcc[i], data_pattern);
// Delivery Point Identifier (DPID)
for i := 1 to 8 do
lookup(NEON, AusNTable, dpid[i], data_pattern);
// Customer Information
len := Length(localstr);
if (len > 8) then
begin
if (len = 13) or (len = 18) then
begin
for i := 9 to len do
lookup(GDSET, AusCTable, localstr[i], data_pattern);
end
else if (len = 16) or (len = 23) then
begin
for i := 9 to len do
lookup(NEON, AusNTable, localstr[i], data_pattern);
end;
end;
// Filler bar
len := Length(data_pattern);
if (len = 22) or (len = 37) or (len = 52) then
data_pattern := data_pattern + '3';
// Reed Solomon error correction
rs_error_correction(data_pattern);
// STOP character
data_pattern := data_pattern + '13';
// Turn the symbol into a bar pattern ready for plotting
writer := 0;
len := Length(data_pattern);
for i := 1 to len do
begin
if ((data_pattern[i] = '1') or (data_pattern[i] = '0')) then
set_module(ASymbol, 0, writer);
set_module(ASymbol, 1, writer);
if ((data_pattern[i] = '2') or (data_pattern[i] = '0')) then
set_module(ASymbol, 2, writer);
Inc(writer, 2);
end;
// Store parameters in Zint symbol
ASymbol^.rows := 3;
ASymbol^.row_height[0] := 3;
ASymbol^.row_height[1] := 2;
ASymbol^.row_height[2] := 3;
ASymbol^.width := writer - 1;
ASymbol^.SetText(localstr);
end;
end.

2
components/lazbarcodes/src/lbc_aztec.pas
View File

@ -2627,7 +2627,7 @@ begin
input_value := 0; input_value := 0;
if length > 3 then if length > 3 then
begin begin
strcpy (symbol^.errtxt, 'Input too large'); strcpy (symbol^.errtxt, 'Input too large (max 3 numeric characters)');
exit (ERROR_INVALID_DATA); exit (ERROR_INVALID_DATA);
end; end;
error_number := is_sane (NEON, source, length); error_number := is_sane (NEON, source, length);

2
components/lazbarcodes/src/lbc_basic.pas
View File

@ -42,7 +42,7 @@ begin
symbol^.show_hrt := 1; symbol^.show_hrt := 1;
symbol^.input_mode := DATA_MODE; symbol^.input_mode := DATA_MODE;
strcpy (symbol^.primary, ''); strcpy (symbol^.primary, '');
FillByte (symbol^.encoded_data[0][0], SizeOf (symbol^.encoded_data),0); FillByte(symbol^.encoded_data, SizeOf(symbol^.encoded_data), 0);
i := 0; i := 0;
while i < 178 do while i < 178 do
begin begin

603
components/lazbarcodes/src/lbc_code.pas Normal file
View File

@ -0,0 +1,603 @@
{ lbc_code.pas - Handles Code 11, 39, 39+ and 93, as well as channel_code
Based on Zint (done by Robin Stuart and the Zint team)
http://github.com/zint/zint
and Pascal adaption by TheUnknownOnes
http://theunknownones.net
Refactoring: W.Pamler
}
unit lbc_code;
{$mode objfpc}{$H+}
interface
uses
SysUtils, zint;
function code_11(ASymbol: PZintSymbol; const ASource: String): Integer;
function c39(ASymbol: PZintSymbol; const ASource: String): Integer;
function pharmazentral(ASymbol: PZintSymbol; const ASource: String): Integer;
function ec39(ASymbol: PZIntSymbol; const ASource: String): Integer;
function c93(ASymbol: PZintSymbol; const ASource: String): Integer;
function channel_code(ASymbol: PZintSymbol; const ASource: String): Integer;
implementation
uses
lbc_helper;
const
C11Table: array[0..10] of String = (
'111121', '211121', '121121', '221111', '112121',
'212111', '122111', '111221', '211211', '211111',
'112111'
);
{ Code 39 tables checked against ISO/IEC 16388:2007 }
C39Table: array[0..42] of String = (
// bar-space-bar-space-bar-space-..., given in width units
'1112212111', '2112111121', '1122111121', '2122111111', '1112211121', // '0', '1', ...
'2112211111', '1122211111', '1112112121', '2112112111', '1122112111',
'2111121121', '1121121121', '2121121111', '1111221121', '2111221111', // 'A', 'B', ...
'1121221111', '1111122121', '2111122111', '1121122111', '1111222111',
'2111111221', '1121111221', '2121111211', '1111211221', '2111211211',
'1121211211', '1111112221', '2111112211', '1121112211', '1111212211',
'2211111121', '1221111121', '2221111111', '1211211121', '2211211111',
'1221211111', '1211112121', '2211112111', '1221112111', '1212121111', // 'Z', '-', ..
'1212111211', '1211121211', '1112121211'
); // Code 39 character assignments (Table 1)
{ Encoding the full ASCII character set in Code 39 (Table A2) }
const EC39Ctrl: array[0..127] of String = (
'%U', '$A', '$B', '$C', '$D', '$E', '$F', '$G', '$H', '$I',
'$J', '$K', '$L', '$M', '$N', '$O', '$P', '$Q', '$R', '$S',
'$T', '$U', '$V', '$W', '$X', '$Y', '$Z', '%A', '%B', '%C',
'%D', '%E', ' ', '/A', '/B', '/C', '/D', '/E', '/F', '/G',
'/H', '/I', '/J', '/K', '/L', '-', '.', '/O', '0', '1',
'2', '3', '4', '5', '6', '7', '8', '9', '/Z', '%F',
'%G', '%H', '%I', '%J', '%V', 'A', 'B', 'C', 'D', 'E',
'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O',
'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y',
'Z', '%K', '%L', '%M', '%N', '%O', '%W', '+A', '+B', '+C',
'+D', '+E', '+F', '+G', '+H', '+I', '+J', '+K', '+L', '+M',
'+N', '+O', '+P', '+Q', '+R', '+S', '+T', '+U', '+V', '+W',
'+X', '+Y', '+Z', '%P', '%Q', '%R', '%S', '%T'
);
const C93Ctrl: array[0..127] of String = (
'bU', 'aA', 'aB', 'aC', 'aD', 'aE', 'aF', 'aG', 'aH', 'aI',
'aJ', 'aK', 'aL', 'aM', 'aN', 'aO', 'aP', 'aQ', 'aR', 'aS',
'aT', 'aU', 'aV', 'aW', 'aX', 'aY', 'aZ', 'bA', 'bB', 'bC',
'bD', 'bE', ' ', 'cA', 'cB', 'cC', 'cD', 'cE', 'cF', 'cG',
'cH', 'cI', 'cJ', 'cK', 'cL', 'cM', 'cN', 'cO', '0', '1',
'2', '3', '4', '5', '6', '7', '8', '9', 'cZ', 'bF',
'bG', 'bH', 'bI', 'bJ', 'bV', 'A', 'B', 'C', 'D', 'E',
'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O',
'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y',
'Z', 'bK', 'bL', 'bM', 'bN', 'bO', 'bW', 'dA', 'dB', 'dC',
'dD', 'dE', 'dF', 'dG', 'dH', 'dI', 'dJ', 'dK', 'dL', 'dM',
'dN', 'dO', 'dP', 'dQ', 'dR', 'dS', 'dT', 'dU', 'dV', 'dW',
'dX', 'dY', 'dZ', 'bP', 'bQ', 'bR', 'bS', 'bT'
);
const C93Table: array[0..46] of String = (
'131112', '111213', '111312', '111411', '121113', '121212', // '0'..'5'
'121311', '111114', '131211', '141111', '211113', '211212', // '6'..'B'
'211311', '221112', '221211', '231111', '112113', '112212', // 'C'..'H'
'112311', '122112', '132111', '111123', '111222', '111321', // 'I'..'N'
'121122', '131121', '212112', '212211', '211122', '211221', // 'O'..'T'
'221121', '222111', '112122', '112221', '122121', '123111', // 'U'..'Z'
'121131', '311112', '311211', '321111', '112131', '113121', // '-', '.', ' ', '$', '/', '+'
'211131', '121221', '312111', '311121', '122211' // '%', 'a', 'b', 'c', 'c'
);
{-------------------------------------------------------------------------------
Code 11
Allowed characters:
numeric digits (0-9), the hyphen character (-)
(Code 11 derives its name from these 11 characters).
Length:
basically unlimited (function errors after 121 characters, though).
-------------------------------------------------------------------------------}
function CheckSum_C11(ASource: String): String;
var
i, len: Integer;
c_digit, c_weight, c_count: Integer;
k_digit, k_weight, k_count: Integer;
weight: array of Integer = nil;
begin
len := Length(ASource);
SetLength(weight, len + 1);
// Determine weights
for i := 0 to len-1 do
begin
if ASource[i+1] = '-' then
weight[i] := 10
else
weight[i] := ctoi(ASource[i+1]);
end;
// Calculate C checksum
c_weight := 1;
c_count := 0;
for i := len-1 downto 0 do
begin
inc(c_count, c_weight * weight[i]);
inc(c_weight);
if (c_weight > 10) then
c_weight := 1;
end;
c_digit := c_count mod 11;
weight[len] := c_digit;
// weight is 0-based and has been allocated for len+1 elements.
// Calculate K checksum
k_weight := 1;
k_count := 0;
for i := len downto 0 do
begin
inc(k_count, k_weight * weight[i]);
inc(k_weight);
if (k_weight > 9) then
k_weight := 1;
end;
k_digit := k_count mod 11;
// Convert checksum to string
Result := itoc(c_digit) + itoc(k_digit);
if (Result[1] = 'A') then Result[1] := '-';
if (Result[2] = 'A') then Result[2] := '-';
end;
function code_11(ASymbol: PZintSymbol; const ASource: String): Integer;
begin
Result := basic_encoder(ASymbol, ASource,
121, SODIUM, '112211', C11Table, '11221', @CheckSum_C11, false);
end;
{-------------------------------------------------------------------------------
Code 39
-------------------------------------------------------------------------------}
function CheckSum_C39(ASource: String): String;
var
i, sum: Integer;
begin
sum := 0;
for i := 1 to Length(ASource) do
inc(sum, pos(ASource[i], SILVER) - 1);
sum := sum mod 43;
if (sum < 10) then
Result := itoc(sum)
else
begin
if (sum < 36) then
Result := Char((sum - 10) + Ord('A'))
else
case sum of
36: Result := '-';
37: Result := '.';
38: Result := ' ';
39: Result := '$';
40: Result := '/';
41: Result := '+';
42: Result := #37;
else
Result := ' ';
end;
end;
{ Display a space check digit as _, otherwise it looks like an error }
if (Result = ' ') then
Result := '_';
end;
{ LOGMARS uses wider 'wide' bars than normal Code 39 }
procedure WiderBars(var s: String);
var
i: Integer;
begin
for i := 1 to Length(s) do
if s[i]='2' then s[i] := '3';
end;
function c39(ASymbol: PZintSymbol; const ASource: String): Integer;
var
i, maxlen: Integer;
startcode, stopcode: String;
charcodes: array[0..42] of String;
checkSumFunc: TCheckSumFunc;
begin
startcode := '1211212111';
stopcode := '121121211';
charcodes := C39Table;
checkSumFunc := nil;
maxlen := 74;
if (ASymbol^.symbology = BARCODE_LOGMARS) or (ASymbol^.symbology = BARCODE_HIBC_39) then
begin
WiderBars(startcode);
WiderBars(stopcode);
for i := Low(charcodes) to High(charcodes) do
WiderBars(charcodes[i]);
end;
if (ASymbol^.symbology = BARCODE_LOGMARS) or
(ASymbol^.option_2 = 1) or
(ASymbol^.option and OPTION_ADD_CHECKSUM = OPTION_ADD_CHECKSUM) then
begin
checkSumFunc := @CheckSum_C39;
ASymbol^.Option := ASymbol^.Option or OPTION_ADD_CHECKSUM;
end;
if (ASymbol^.symbology = BARCODE_LOGMARS) then
maxlen := 59;
Result := basic_encoder(ASymbol, Uppercase(ASource),
maxlen, SILVER, startcode, charcodes, stopcode, checkSumFunc, false);
if ASymbol^.symbology = BARCODE_CODE39 then
ASymbol^.SetText('*' + ASymbol^.GetText + '*');
end;
{-------------------------------------------------------------------------------
Pharmazentral Nummer (PZN)
-------------------------------------------------------------------------------}
function pharmazentral(ASymbol: PZintSymbol; const ASource: String): Integer;
var
i, i0, error_number, zeros, digits, maxDigits, sum, src_len: Integer;
localstr: String = '';
check_digit: byte;
begin
digits := ASymbol^.option_3;
if not (digits in [7, 8]) then
raise Exception.Create('[pharmazentral] Number of digits can only be 7 or 8');
maxDigits := digits - 1; // check-digit included
src_len := Length(ASource);
if (src_len > maxDigits) then
begin
ASymbol^.SetErrorText('Wrong input length');
Result := ERROR_TOO_LONG;
exit;
end;
error_number := is_sane(NEON, ASource);
if (error_number = ERROR_INVALID_DATA) then
begin
ASymbol^.SetErrorText('Invalid characters in data');
Result := error_number;
exit;
end;
zeros := maxDigits - src_len;
localstr := '-' + StringOfChar('0', zeros) + ASource;
i0 := 7 - MaxDigits;
sum := 0;
for i := 1 to maxDigits do
inc(sum, (i + i0) * ctoi(localstr[i+1]));
// wp: i+1 is correct because '-' was added to localStr
check_digit := sum mod 11;
localstr := localstr + itoc(check_digit);
if check_digit = ord('A') then
begin
ASymbol^.SetErrorText('Invalid PZN Data');
Result := ERROR_INVALID_DATA;
exit;
end;
Result := c39(ASymbol, localstr);
ASymbol^.SetText('PZN' + localstr);
end;
{-------------------------------------------------------------------------------
Extended Code 39 - ISO/IEC 16388:2007 Annex A
-------------------------------------------------------------------------------}
function ec39(ASymbol: PZintSymbol; const ASource: String): Integer;
var
i: Integer;
buffer: string;
check: char;
begin
if (Length(ASource) > 74) then
begin
ASymbol^.SetErrorText('Input too long (max 74 characters).');
Result := ERROR_TOO_LONG;
exit;
end;
{ Creates a buffer string and places control characters into it }
buffer := '';
for i := 1 to Length(ASource) do
begin
if ASource[i] > #127 then
begin
{ Cannot encode extended ASCII }
ASymbol^.SetErrorText('Invalid character in input data');
Result := ERROR_INVALID_DATA;
exit;
end;
buffer := buffer + EC39Ctrl[byte(ASource[i])];
end;
{ Then send the buffer to the C39 function }
Result := c39(ASymbol, buffer);
if ASymbol^.Option and OPTION_DISPLAY_CHECKSUM = OPTION_DISPLAY_CHECKSUM then
begin
// Retrieve appended check character
buffer := ASymbol^.GetText;
check := buffer[Length(buffer)];
ASymbol^.SetText(aSource + check);
end else
ASymbol^.SetText(ASource);
end;
{-------------------------------------------------------------------------------
Code 93
An advancement on Code 39 and the definition is a lot tighter
SILVER includes the extra characters a, b, c and d to represent Code 93 specific
shift characters 1, 2, 3 and 4 respectively. These characters are never used by
c39() and ec39()
-------------------------------------------------------------------------------}
function CheckSum_C93(ASource: String): String;
var
values: Array of Integer = nil;
i: Integer;
c, k, weight, len: Integer;
begin
len := Length(ASource);
SetLength(values, len + 1); // Allocate one more element for check digit C
for i := 1 to len do
values[i-1] := pos(ASource[i], SILVER) - 1;
{ Check digit C }
c := 0;
weight := 1;
for i := len-1 downto 0 do
begin
Inc(c, values[i] * weight);
Inc(weight);
if (weight = 21) then
weight := 1;
end;
c := c mod 47;
values[len] := c; // Element at index len has been allocated above!
{ Check digit K }
k := 0;
weight := 1;
for i := len downto 0 do // Use len (rather than len-1) because of extra allocation
begin
Inc(k, values[i] * weight);
Inc(weight);
if (weight = 16) then
weight := 1;
end;
k := k mod 47;
Result := SILVER[c+1] + SILVER[k+1];
end;
function c93(ASymbol: PZintSymbol; const ASource: String): Integer;
var
i: Integer;
buffer: String;
check: String;
begin
if Length(ASource) > 107 then
begin
ASymbol^.SetErrorText('Input too long (max 107 characters).');
Result := ERROR_TOO_LONG;
exit;
end;
// Prepare message content
buffer := '';
for i := 1 to Length(ASource) do
begin
if ASource[i] > #127 then
begin
// Cannot encode extended ASCII
ASymbol^.SetErrorText('Invalid characters in input data.');
Result := ERROR_INVALID_DATA;
exit;
end;
buffer := buffer + C93Ctrl[byte(ASource[i])];
end;
Result := basic_encoder(ASymbol, buffer,
107, SILVER, '111141', C93Table, '1111411', @CheckSum_C93, false
);
// Show the original input string as human-readable text
if (Result = 0) then
begin
// If input string contains #0 replace it by space
buffer := ASource;
for i := 1 to Length(buffer) do
if buffer[i] = #0 then buffer[i] := ' ';
if (ASymbol^.Option and OPTION_DISPLAY_CHECKSUM <> 0) then
begin
// Extract check chars from generated symbol code...
check := Copy(ASymbol^.GetText, Length(ASymbol^.GetText)-1, 2);
// ... and append to original input string
ASymbol^.SetText(buffer + check);
end else
ASymbol^.SetText(buffer);
end;
end;
{-------------------------------------------------------------------------------
channel_code
NextS() and NextB() are from ANSI/AIM BC12-1998 and are Copyright (c) AIM 1997
They are used here on the understanding that they form part of the
specification for Channel Code and therefore their use is permitted under the
following terms set out in that document:
"It is the intent and understanding of AIM [t]hat the symbology presented in
this specification is entirely in the public domain and free of all use
restrictions, licenses and fees. AIM USA, its member companies, or individual
officers assume no liability for the use of this document."
-------------------------------------------------------------------------------}
procedure CheckCharacter(var APattern: String; const AValue, ATarget_Value: Integer;
const S, B: array of Integer);
var
i: Integer;
begin
if (AValue = ATarget_value) then
begin
{ Target reached - save the generated pattern }
APattern := '11110';
for i := 0 to 10 do
APattern := APattern + itoc(S[i]) + itoc(B[i]);
end;
end;
procedure NextS(Chan, i, MaxS, MaxB: Integer; var S, B: array of Integer;
var AValue, ATarget_value: Integer; var APattern: String); forward;
procedure NextB(chan, i, MaxB, MaxS: Integer; var S, B: array of Integer;
var AValue, ATarget_value: Integer; var APattern: String);
var
_b: Integer;
begin
if (S[i] + B[i-1] + S[i-1] + B[i-2] > 4) then
_b := 1
else
_b := 2;
if (i < Chan + 2) then
begin
while _b <= MaxB do
begin
B[i] := _b;
NextS(Chan, i + 1, MaxS, MaxB + 1 - _b, S, B, AValue, ATarget_value, APattern);
Inc(_b);
end;
end else
if (_b <= MaxB) then
begin
B[i] := MaxB;
CheckCharacter(APattern, AValue, ATarget_value, S, B);
Inc(AValue);
end;
end;
procedure NextS(Chan, i, MaxS, MaxB: Integer; var S, B: Array of Integer;
var AValue, ATarget_value: Integer; var APattern: String);
var
_s: Integer;
begin
if (i < Chan + 2) then
_s := 1
else
_s := MaxS;
while _s <= MaxS do
begin
S[i] := _s;
NextB(Chan, i, MaxB, MaxS + 1 - _s, S, B, AValue, ATarget_value, APattern);
Inc(_s);
end;
end;
{ Channel Code - According to ANSI/AIM BC12-1998 }
function channel_code(ASymbol: PZintSymbol; const ASource: String): Integer;
var
S: array[0..10] of Integer = (0,0,0,0,0,0,0,0,0,0,0);
B: array[0..10] of Integer = (0,0,0,0,0,0,0,0,0,0,0);
pattern: String = '';
value, target_value: Integer;
channels, i: Integer;
error_number, zeros, src_len: Integer;
outOfRange: Boolean;
begin
src_len := Length(ASource);
if (src_len > 7) then
begin
ASymbol^.SetErrorText('Input too long');
Result := ERROR_TOO_LONG;
exit;
end;
error_number := is_sane(NEON, ASource);
if (error_number = ERROR_INVALID_DATA) then
begin
ASymbol^.SetErrorText('Invalid characters in data');
Result := error_number;
exit;
end;
if (ASymbol^.option_2 < 3) or (ASymbol^.option_2 > 8) then
channels := 0
else
channels := ASymbol^.option_2;
if (channels = 0) then
channels := src_len + 1;
if (channels = 2) then
channels := 3;
target_value := 0;
for i := 1 to src_len do
target_value := target_value * 10 + ctoi(ASource[i]);
outOfRange := false;
case channels of
3: if (target_value > 26) then outOfRange := true;
4: if (target_value > 292) then outOfRange := true;
5: if (target_value > 3493) then outOfRange := true;
6: if (target_value > 44072) then outOfRange := true;
7: if (target_value > 576688) then outOfRange := true;
8: if (target_value > 7742862) then outOfRange := true;
else outOfRange := true;
end;
if outOfRange then
begin
ASymbol^.SetErrorText('Value out of range');
Result := ERROR_INVALID_DATA;
exit;
end;
B[0] := 1;
S[1] := 1;
B[1] := 1;
S[2] := 1;
B[2] := 1;
value := 0;
NextS(channels, 3, channels, channels, S, B, value, target_value, pattern);
expand(ASymbol, pattern);
zeros := channels - 1 - src_len;
ASymbol^.SetText(StringOfChar('0', zeros) + ASource);
Result := error_number;
end;
end.

1218
components/lazbarcodes/src/lbc_code128.pas Normal file
View File

File diff suppressed because it is too large Load Diff

86
components/lazbarcodes/src/lbc_common.pas Normal file
View File

@ -0,0 +1,86 @@
unit lbc_common;
{$mode objfpc}{$H+}
interface
uses
SysUtils, Types, zint;
function ustrlen(const AData: TByteDynArray): NativeInt;
procedure ustrcpy(var ATarget: TByteDynArray; const ASource: TByteDynArray);
procedure ustrcpy(var ATarget: TByteDynArray; const ASource: String);
procedure uconcat(var ADest: TByteDynArray; const ASource: TByteDynArray);
procedure uconcat(var ADest: TByteDynArray; const ASource: TCharDynArray);
procedure uconcat(var ADest: TByteDynArray; const ASource: String);
implementation
{ Local replacement for strlen() with uint8_t strings }
function ustrlen(const AData: TByteDynArray): NativeInt;
var
i: NativeInt;
begin
Result := High(AData) - Low(AData) + 1;
for i := Low(AData) to High(AData) do
if AData[i] = 0 then
begin
Result := i - Low(AData);
break;
end;
end;
{ Local replacement for strcpy() with uint8_t strings }
procedure ustrcpy(var ATarget: TByteDynArray; const ASource: TByteDynArray);
var
len: NativeInt;
begin
len := ustrlen(ASource);
if len > 0 then
begin
Move(ASource[0], ATarget[0], Len+1);
ATarget[len] := 0; // Be sure we have zero terminal
end;
end;
procedure ustrcpy(var ATarget: TByteDynArray; const ASource: String);
var
len: NativeInt;
begin
len := Length(ASource);
if len > 0 then
begin
Move(ASource[1], ATarget[0], Len+1);
ATarget[len] := 0;
end;
end;
{ Concatinates dest[] with the contents of source[], copying /0 as well }
procedure uconcat(var ADest: TByteDynArray; const ASource: TByteDynArray);
var
j, n: NativeInt;
begin
j := ustrlen(ADest);
n := ustrlen(ASource);
Move(ASource[0], ADest[j], n);
ADest[j+n] := 0;
end;
procedure uconcat(var ADest: TByteDynArray; const ASource: TCharDynArray);
var
j, n: NativeInt;
begin
j := ustrlen(ADest);
n := System.strlen(PChar(ASource));
Move(ASource[0], ADest[j], n);
ADest[j+n] := 0;
end;
procedure uconcat(var ADest: TByteDynArray; const ASource: String);
begin
uconcat(ADest, PChar(ASource));
end;
end.

335
components/lazbarcodes/src/lbc_gs1.pas Normal file
View File

@ -0,0 +1,335 @@
unit lbc_gs1;
{
Based on Zint (done by Robin Stuart and the Zint team)
http://github.com/zint/zint
and translation by TheUnknownOnes
http://theunknownones.net
}
{$IFDEF FPC}
{$mode objfpc}{$H+}
{$ENDIF}
interface
uses
SysUtils, Types,
zint;
function gs1_verify(ASymbol: PZintSymbol; ASource: PByte; const src_len: Integer;
var reduced: TCharDynArray): Integer;
function ugs1_verify(ASymbol: PZintSymbol; ASource: PByte; src_len: Integer;
var reduced: TByteDynArray): Integer;
implementation
uses
lbc_helper;
{ This code does some checks on the integrity of GS1 data. It is not intended
to be bulletproof, nor does it report very accurately what problem was found
or where, but should prevent some of the more common encoding errors.
wp: simplified a lot...}
procedure itostr(var ai_string: String; ai_value: Integer);
begin
ai_string := FormatFloat('(00)', ai_value);
end;
function gs1_verify(ASymbol: PZintSymbol; ASource: PByte; const src_len: Integer;
var reduced: TCharDynArray): Integer;
var
i, j, last_ai, ai_latch : Integer;
ai_string: String;
bracket_level, max_bracket_level, ai_length, max_ai_length, min_ai_length: Integer;
ai_value, ai_location, data_location, data_length: array[0..99] of Integer;
ai_count: Integer;
error_latch: Integer;
P: PByte;
ch: Char;
begin
{ Detect extended ASCII characters }
P := PByte(ASource);
for i := 0 to src_len - 1 do
begin
if P^ >= 128 then
begin
ASymbol^.SetErrorText('Extended ASCII characters are not supported by GS1');
Result := ERROR_INVALID_DATA;
exit;
end;
if P^ < 32 then
begin
ASymbol^.SetErrorText('Control characters are not supported by GS1');
Result := ERROR_INVALID_DATA;
exit;
end;
inc(P);
end;
if ASource^ <> Ord('[') then
begin
ASymbol^.SetErrorText('Data does not start with an Application identifier');
Result := ERROR_INVALID_DATA;
exit;
end;
{ Check the position of the brackets }
bracket_level := 0;
max_bracket_level := 0;
ai_length := 0;
max_ai_length := 0;
min_ai_length := 5;
j := 0;
ai_latch := 0;
P := ASource;
for i := 0 to src_len - 1 do
begin
Inc(ai_length, j);
if ((j = 1) and (P^ <> Ord(']'))) and
((P^ < Ord('0')) or (P^ > Ord('9')))
then
ai_latch := 1;
if (P^ = Ord('[')) then begin
Inc(bracket_level);
j := 1;
end;
if (P^ = Ord(']')) then
begin
Dec(bracket_level);
if (ai_length < min_ai_length) then min_ai_length := ai_length;
j := 0;
ai_length := 0;
end;
if (bracket_level > max_bracket_level) then
max_bracket_level := bracket_level;
if (ai_length > max_ai_length) then
max_ai_length := ai_length;
inc(P);
end;
Dec(min_ai_length);
if (bracket_level <> 0) then
begin
{ Not all brackets are closed }
ASymbol^.SetErrorText('Malformed Application Identifier in input data (brackets don''t match)');
Result := ERROR_INVALID_DATA;
exit;
end;
if (max_bracket_level > 1) then
begin
{ Nested brackets }
ASymbol^.SetErrorText('Found nested brackets in input data');
Result := ERROR_INVALID_DATA;
exit;
end;
if (max_ai_length > 4) then
begin
{ AI is too long }
ASymbol^.SetErrorText('Invalid Application Identifier (AI) in input data (AI too long - max 4 characters)');
Result := ERROR_INVALID_DATA;
exit;
end;
if (min_ai_length <= 1) then
begin
{ AI is too short }
ASymbol^.SetErrorText('Invalid Application Identifier (AI) in input data (AI too short, at least 2 characters)');
result := ERROR_INVALID_DATA;
exit;
end;
if (ai_latch = 1) then
begin
{ Non-numeric data in AI }
ASymbol^.SetErrorText('Invalid Application Identifier (AI) in input data (non-numeric characters in AI)');
result := ERROR_INVALID_DATA;
exit;
end;
ai_count := 0;
i := 1;
while i < src_len do
begin
if char(ASource[i-1]) = '[' then
begin
ai_location[ai_count] := i;
ch := char(ASource[i]);
ai_string := '';
while ch <> ']' do
begin
ai_string := ai_string + ch;
inc(i);
ch := char(ASource[i]);
end;
ai_value[ai_count] := StrToInt(ai_string);
inc(ai_count);
end else
inc(i);
end;
for i := 0 to ai_count - 1 do
begin
data_location[i] := ai_location[i] + 3;
if (ai_value[i] >= 100) then Inc(data_location[i]);
if (ai_value[i] >= 1000) then Inc(data_location[i]);
data_length[i] := 0;
repeat
inc(data_length[i]);
until not ((ASource[data_location[i] + data_length[i] - 1] <> Ord('[')) and
(ASource[data_location[i] + data_length[i] - 1] <> 0));
dec(data_length[i]);
end;
for i := 0 to ai_count - 1 do
begin
if (data_length[i] = 0) then
begin
{ No data for given AI }
strcpy(ASymbol^.errtxt, 'Empty data field in input data');
Result := ERROR_INVALID_DATA;
exit;
end;
end;
error_latch := 0;
ai_string := '';
for i := 0 to ai_count - 1 do
begin
case ai_value[i] of
0:
if (data_length[i] <> 18) then error_latch := 1;
1, 2, 3:
if (data_length[i] <> 14) then error_latch := 1;
4:
if (data_length[i] <> 16) then error_latch := 1;
11, 12, 13, 14, 15, 16, 17, 18, 19:
if(data_length[i] <> 6) then error_latch := 1;
20:
if(data_length[i] <> 2) then error_latch := 1;
23, 24, 25, 39, 40, 41, 42, 70, 80, 81:
error_latch := 2;
end;
if ( ((ai_value[i] >= 100) and (ai_value[i] <= 179) ) or
((ai_value[i] >= 1000) and (ai_value[i] <= 1799)) or
((ai_value[i] >= 200) and (ai_value[i] <= 229)) or
((ai_value[i] >= 2000) and (ai_value[i] <= 2299)) or
((ai_value[i] >= 300) and (ai_value[i] <= 309)) or
((ai_value[i] >= 3000) and (ai_value[i] <= 3099)) or
((ai_value[i] >= 31) and (ai_value[i] <= 36)) or
((ai_value[i] >= 310) and (ai_value[i] <= 369))
)
then
error_latch := 2;
if (ai_value[i] >= 3100) and (ai_value[i] <= 3699) then
begin
if (data_length[i] <> 6) then
error_latch := 1;
end;
if ( ((ai_value[i] >= 370) and (ai_value[i] <= 379)) or
((ai_value[i] >= 3700) and (ai_value[i] <= 3799)) )
then
error_latch := 2;
if (ai_value[i] >= 410) and (ai_value[i] <= 415) then
begin
if (data_length[i] <> 13) then
error_latch := 1;
end;
if ( ((ai_value[i] >= 4100) and (ai_value[i] <= 4199)) or
((ai_value[i] >= 700) and (ai_value[i] <= 703)) or
((ai_value[i] >= 800) and (ai_value[i] <= 810)) or
((ai_value[i] >= 900) and (ai_value[i] <= 999)) or
((ai_value[i] >= 9000) and (ai_value[i] <= 9999)) )
then
error_latch := 2;
if ((error_latch < 4) and (error_latch > 0)) then
begin
{ error has just been detected: capture AI }
itostr(ai_string, ai_value[i]);
Inc(error_latch, 4);
end;
end;
if (error_latch = 5) then
begin
ASymbol^.SetErrorText('Invalid data length for Application Identifier ' + ai_string);
Result := ERROR_INVALID_DATA;
exit;
end;
if (error_latch = 6) then
begin
ASymbol^.SetErrorText('Invalid Application Identifier value ' + ai_string);
result := ERROR_INVALID_DATA;
exit;
end;
{ Resolve AI data - put resulting string in 'reduced' }
j := 0;
//last_ai := 0;
ai_latch := 1;
for i := 0 to src_len - 1 do
begin
if ((ASource[i] <> Ord('[')) and (ASource[i] <> Ord(']'))) then
begin
reduced[j] := Char(ASource[i]);
Inc(j);
end;
if (ASource[i] = Ord('[')) then
begin
{ Start of an AI string }
if(ai_latch = 0) then
begin
reduced[j] := '[';
Inc(j);
end;
ai_string := Char(ASource[i+1]) + Char(ASource[i+2]);
last_ai := StrToInt(ai_string);
ai_latch := 0;
{ The following values from "GS-1 General Specification version 8.0 issue 2, May 2008"
figure 5.4.8.2.1 - 1 "Element Strings with Pre-Defined Length Using Application Identifiers" }
if (last_ai in [0..4, 11..20, 23, 31..36, 41]) then
ai_latch := 1;
end;
{ The ']' character is simply dropped from the input }
end;
reduced[j] := #0;
{ the character '[' in the reduced string refers to the FNC1 character }
Result := 0;
end;
function ugs1_verify(ASymbol: PZintSymbol; ASource: PByte; src_len: Integer;
var reduced: TByteDynArray): Integer;
var
temp: TCharDynArray = nil;
begin
SetLength(temp, src_len + 5);
Result := gs1_verify(ASymbol, ASource, src_len, temp);
if (Result <> 0) then
exit;
if (strlen(temp) < src_len + 5) then begin
strcpy(PChar(@reduced[0]), PChar(@temp[0]));
Result := 0;
exit;
end;
ASymbol^.SetErrorText('ugs1_verify overflow');
result := ERROR_INVALID_DATA;
end;
end.

530
components/lazbarcodes/src/lbc_helper.pas
View File

@ -4,11 +4,24 @@ unit lbc_helper;
interface interface
uses sysutils,zint; uses
sysutils, types, zint;
const RHODIUM = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ $%*+-./:'; type
const NEON = '0123456789'; TCheckSumFunc = function(ASource: String): String;
const
RHODIUM = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ $%*+-./:';
SILVER = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-. $/+%abcd'; // 47 chars
NEON = '0123456789';
SODIUM = '0123456789-';
OPTION_ADD_CHECKSUM = 1;
OPTION_DISPLAY_CHECKSUM = 2;
OPTION_GROUPED_CHARS = 4;
NO_PADDING = #0;
function IsTrue(aBoolean: Boolean): Boolean; function IsTrue(aBoolean: Boolean): Boolean;
function IsTrue(aInteger: Integer): Boolean; function IsTrue(aInteger: Integer): Boolean;
function iif(const aBoolean: integer; const aCh1,aCh2: pchar): pchar; function iif(const aBoolean: integer; const aCh1,aCh2: pchar): pchar;
@ -18,11 +31,16 @@ procedure concat(const aText: pchar; const aChar: char);
procedure concat(const aText: pchar; const aText2: pchar); procedure concat(const aText: pchar; const aText2: pchar);
procedure concat(var aText: array of char; const aText2: pchar); procedure concat(var aText: array of char; const aText2: pchar);
procedure strcpy(const aText: pchar; const aText2: pchar); procedure strcpy(const aText: pchar; const aText2: pchar);
procedure strcpy(var aText: array of char; const aText2: pchar); overload; procedure strcpy(const aText: pchar; const aText2: TByteDynArray);
procedure strcpy(var aText: array of char; const aText2: pchar);
procedure strcpy(var aText: array of byte; const aText2: pchar);
procedure strcpy(var AText: array of byte; const aText2: TByteDynArray);
function posn(const aText: pchar; const aChar: Char): integer; function posn(const aText: pchar; const aChar: Char): integer;
function strlen(const aText: array of char): integer; function strlen(const aText: array of char): integer;
function is_sane(test_string: PChar; source: PBYTE; length: Integer): Integer; function is_sane(test_string: PChar; source: PByte; length: Integer): Integer; overload;
function utf8toutf16(symbol: PointerTo_zint_symbol; source: PBYTE; vals: PInteger; length: PInteger): Integer; function is_sane(test_string: PChar; const source: TByteDynArray; length: Integer): Integer; overload;
function is_sane(const AllowedChars, ASource: String): Integer; overload;
function utf8toutf16(symbol: PointerTo_zint_symbol; source: PByte; vals: PInteger; length: PInteger): Integer;
procedure set_module(symbol: PointerTo_zint_symbol; y_coord: Integer; x_coord: Integer); procedure set_module(symbol: PointerTo_zint_symbol; y_coord: Integer; x_coord: Integer);
procedure unset_module(symbol: PointerTo_zint_symbol; y_coord: Integer; x_coord: Integer); procedure unset_module(symbol: PointerTo_zint_symbol; y_coord: Integer; x_coord: Integer);
function module_is_set(symbol: PointerTo_zint_symbol; y_coord: Integer; x_coord: Integer): Boolean; function module_is_set(symbol: PointerTo_zint_symbol; y_coord: Integer; x_coord: Integer): Boolean;
@ -37,10 +55,37 @@ function ctoi(c: char): integer;
function ctoi(c: BYTE): integer; function ctoi(c: BYTE): integer;
function BooleanNot(const aValue: integer): Boolean; function BooleanNot(const aValue: integer): Boolean;
procedure memset(const p: Pointer; const aValue: BYTE; const aSize: integer); procedure memset(const p: Pointer; const aValue: BYTE; const aSize: integer);
function istwodigits(source: PBYTE; position: Integer): Boolean; function istwodigits(source: PByte; position: Integer): Boolean;
procedure to_upper(a: PByte);
procedure to_upper(const a: TByteDynArray);
procedure Lookup(const Set_String: PChar; const ATable: array of String; const AData: Char; var ADest: TCharDynArray);
procedure Lookup(const Set_String: PChar; const ATable: array of String; const AData: Byte; var ADest: TCharDynArray);
procedure Lookup(const Set_String: String; const ATable: array of String; const AData: Char; var ADest: String);
{
procedure lookup(const set_string : TArrayOfChar; const table : array of String; const data : Char; var dest : TArrayOfChar); overload;
procedure lookup(const set_string : TArrayOfChar; const table : array of String; const data : Byte; var dest : TArrayOfChar); overload;
procedure lookup(const ASet_string : String; const ATable : array of String; const AData : Byte; var ADest : TArrayOfChar); overload;
procedure lookup(const ASet_string : String; const ATable : array of String; const AData : Char; var ADest : TArrayOfChar); overload;
}
function itoc(AValue: Integer): Char;
procedure expand(ASymbol: PointerTo_zint_symbol; AData: TCharDynArray);
procedure expand(ASymbol: PointerTo_zint_symbol; const AData: string);
function CharArrayToStr(AData: TCharDynArray): String;
function StrToCharArray(AText: String): TCharDynArray;
function basic_encoder(ASymbol: PZIntSymbol; const ASource: String;
MaxLen: Integer; const AllowedChars, StartCode: String;
const CharCodes: array of string; const StopCode: String;
CheckSumFunc: TCheckSumFunc; SourceInverted: Boolean): Integer;
implementation implementation
uses
Math;
function istwodigits(source: PBYTE; position: Integer): Boolean; function istwodigits(source: PBYTE; position: Integer): Boolean;
begin begin
if (Char(source[position]) in ['0'..'9']) and (Char(source[position+1]) in ['0'..'9']) then begin if (Char(source[position]) in ['0'..'9']) and (Char(source[position+1]) in ['0'..'9']) then begin
@ -115,7 +160,7 @@ end;
procedure concat(var aText: array of char; const aText2: pchar); procedure concat(var aText: array of char; const aText2: pchar);
begin begin
concat(pchar(@aText[0]),aText2); concat(pchar(@aText[0]), aText2);
end; end;
procedure strcpy(const aText: pchar; const aText2: pchar); procedure strcpy(const aText: pchar; const aText2: pchar);
@ -123,11 +168,32 @@ begin
move(aText2^,aText^,sysutils.strlen(aText2)+1); move(aText2^,aText^,sysutils.strlen(aText2)+1);
end; end;
procedure strcpy(const aText: pchar; const aText2: TByteDynArray);
var
len: Integer;
begin
len := sysutils.strlen(PChar(@aText2[0]));
move(aText2[0], aText^, len+1);
end;
procedure strcpy(var aText: array of char; const aText2: pchar); procedure strcpy(var aText: array of char; const aText2: pchar);
begin begin
move(aText2^,aText[0],sysutils.strlen(aText2)+1); move(aText2^,aText[0],sysutils.strlen(aText2)+1);
end; end;
procedure strcpy(var AText: array of byte; const aText2: PChar);
begin
Move(aText2^, aText[0], sysUtils.strLen(aText2)+1);
end;
procedure strcpy(var AText: array of byte; const aText2: TByteDynArray);
var
len: Integer;
begin
len := sysUtils.strLen(PChar(@aText2[0]));
Move(aText2[0], aText[0], len+1);
end;
function posn(const aText: pchar; const aChar: Char): integer; function posn(const aText: pchar; const aChar: Char): integer;
var var
p: Pchar; p: Pchar;
@ -151,7 +217,22 @@ begin
Result:=sysutils.strlen(pchar(@aText[0])); Result:=sysutils.strlen(pchar(@aText[0]));
end; end;
function is_sane(test_string: PChar; source: PBYTE; length: Integer): Integer; { Checks whether each character of ASource is contained in string AllowedChars.
Returns 0 if successful, otherwise error code ERROR_INVALID_DATA. }
function is_sane(const AllowedChars, ASource: String): Integer;
var
i: Integer;
begin
for i := 1 to Length(ASource) do
if pos(ASource[i], AllowedChars) = 0 then
begin
Result := ERROR_INVALID_DATA;
exit;
end;
Result := 0;
end;
function is_sane(test_string: PChar; source: PByte; length: Integer): Integer;
var var
latch: Boolean; latch: Boolean;
j: Cardinal; j: Cardinal;
@ -182,6 +263,11 @@ begin
exit (0); exit (0);
end; end;
function is_sane(test_string: PChar; const source: TByteDynArray; Length: Integer): Integer;
begin
Result := is_sane(test_string, PByte(@source[0]), Length);
end;
function utf8toutf16(symbol: PointerTo_zint_symbol; source: PBYTE; vals: PInteger; length: PInteger): Integer; function utf8toutf16(symbol: PointerTo_zint_symbol; source: PBYTE; vals: PInteger; length: PInteger): Integer;
var var
error_number: Integer; error_number: Integer;
@ -235,100 +321,37 @@ begin
length^ := jpos; length^ := jpos;
exit (error_number); exit (error_number);
end; end;
function module_is_set(symbol: PointerTo_zint_symbol; y_coord: Integer; x_coord: Integer): Boolean; function module_is_set(symbol: PointerTo_zint_symbol; y_coord, x_coord: Integer): Boolean;
var
x_sub: Integer;
x_char: Integer;
begin begin
x_char := x_coord div 7; Result := symbol^.encoded_data[y_coord, x_coord];
x_sub := x_coord mod 7;
{$PUSH}{$R-}
Result:=((symbol^.encoded_data[y_coord][x_coord div 7] shr (x_coord mod 7)) and 1)<>0;
{$POP}
exit;
Result:=false;
case x_sub of
0: if Boolean((symbol^.encoded_data[y_coord][x_char] and $01) <> 0) then
begin
result := true;
end;
1: if Boolean((symbol^.encoded_data[y_coord][x_char] and $02) <> 0) then
begin
result := true;
end;
2: if Boolean((symbol^.encoded_data[y_coord][x_char] and $04) <> 0) then
begin
result := true;
end;
3: if Boolean((symbol^.encoded_data[y_coord][x_char] and $08) <> 0) then
begin
result := true;
end;
4: if Boolean((symbol^.encoded_data[y_coord][x_char] and $10) <> 0) then
begin
result := true;
end;
5: if Boolean((symbol^.encoded_data[y_coord][x_char] and $20) <> 0) then
begin
result := true;
end;
6: if Boolean((symbol^.encoded_data[y_coord][x_char] and $40) <> 0) then
begin
result := true;
end;
else
result:=false;
end;
end; end;
procedure set_module(symbol: PointerTo_zint_symbol; y_coord: Integer; x_coord: Integer); procedure set_module(symbol: PointerTo_zint_symbol; y_coord, x_coord: Integer);
var
x_sub: Integer;
x_char: Integer;
begin begin
x_char := x_coord div 7; symbol^.encoded_data[y_coord, x_coord] := true;
x_sub := x_coord mod 7;
case x_sub of
0: symbol^.encoded_data[y_coord][x_char] := symbol^.encoded_data[y_coord][x_char] + $01;
1: symbol^.encoded_data[y_coord][x_char] := symbol^.encoded_data[y_coord][x_char] + $02;
2: symbol^.encoded_data[y_coord][x_char] := symbol^.encoded_data[y_coord][x_char] + $04;
3: symbol^.encoded_data[y_coord][x_char] := symbol^.encoded_data[y_coord][x_char] + $08;
4: symbol^.encoded_data[y_coord][x_char] := symbol^.encoded_data[y_coord][x_char] + $10;
5: symbol^.encoded_data[y_coord][x_char] := symbol^.encoded_data[y_coord][x_char] + $20;
6: symbol^.encoded_data[y_coord][x_char] := symbol^.encoded_data[y_coord][x_char] + $40;
end;
end; end;
procedure unset_module(symbol: PointerTo_zint_symbol; y_coord: Integer; x_coord: Integer); procedure unset_module(symbol: PointerTo_zint_symbol; y_coord, x_coord: Integer);
var
x_sub: Integer;
x_char: Integer;
begin begin
x_char := x_coord div 7; symbol^.encoded_data[y_coord, x_coord] := false;
x_sub := x_coord mod 7;
case x_sub of
0: symbol^.encoded_data[y_coord][x_char] := symbol^.encoded_data[y_coord][x_char] - $01;
1: symbol^.encoded_data[y_coord][x_char] := symbol^.encoded_data[y_coord][x_char] - $02;
2: symbol^.encoded_data[y_coord][x_char] := symbol^.encoded_data[y_coord][x_char] - $04;
3: symbol^.encoded_data[y_coord][x_char] := symbol^.encoded_data[y_coord][x_char] - $08;
4: symbol^.encoded_data[y_coord][x_char] := symbol^.encoded_data[y_coord][x_char] - $10;
5: symbol^.encoded_data[y_coord][x_char] := symbol^.encoded_data[y_coord][x_char] - $20;
6: symbol^.encoded_data[y_coord][x_char] := symbol^.encoded_data[y_coord][x_char] - $40;
end;
end; end;
procedure to_upper(a: PBYTE); procedure to_upper(a: PByte);
begin begin
while a^<>0 do begin while a^<>0 do begin
if char(a^) in ['a'..'z'] then begin if char(a^) in ['a'..'z'] then begin
a^:=BYTE(upCase(char(a^))); a^:=Byte(upCase(char(a^)));
end; end;
inc(a); inc(a);
end; end;
end; end;
procedure to_upper(const a: TByteDynArray);
begin
to_upper(PByte(@a[0]));
end;
function ctoi(c: char): integer; function ctoi(c: char): integer;
begin begin
if c in ['0'..'9'] then begin if c in ['0'..'9'] then begin
@ -355,90 +378,41 @@ end;
function is_extendable(symbology: Integer): Boolean; function is_extendable(symbology: Integer): Boolean;
begin begin
if symbology = BARCODE_EANX then Result := true;
begin if symbology = BARCODE_EANX then exit;
exit (true); if symbology = BARCODE_UPCA then exit;
end; if symbology = BARCODE_UPCE then exit;
if symbology = BARCODE_UPCA then if symbology = BARCODE_ISBNX then exit;
begin if symbology = BARCODE_UPCA_CC then exit;
exit (true); if symbology = BARCODE_UPCE_CC then exit;
end; if symbology = BARCODE_EANX_CC then exit;
if symbology = BARCODE_UPCE then Result := false;
begin
exit (true);
end;
if symbology = BARCODE_ISBNX then
begin
exit (true);
end;
if symbology = BARCODE_UPCA_CC then
begin
exit (true);
end;
if symbology = BARCODE_UPCE_CC then
begin
exit (true);
end;
if symbology = BARCODE_EANX_CC then
begin
exit (true);
end;
exit (false);
end; end;
function is_stackable(symbology: Integer): Boolean; function is_stackable(symbology: Integer): Boolean;
begin begin
if symbology < BARCODE_PDF417 then Result := true;
begin if symbology < BARCODE_PDF417 then exit;
exit (true); if symbology = BARCODE_CODE128B then exit;
end; if symbology = BARCODE_ISBNX then exit;
if symbology = BARCODE_CODE128B then if symbology = BARCODE_EAN14 then exit;
begin if symbology = BARCODE_NVE18 then exit;
exit (true); if symbology = BARCODE_KOREAPOST then exit;
end; if symbology = BARCODE_PLESSEY then exit;
if symbology = BARCODE_ISBNX then if symbology = BARCODE_TELEPEN_NUM then exit;
begin if symbology = BARCODE_ITF14 then exit;
exit (true); if symbology = BARCODE_CODE32 then exit;
end; Result := false;
if symbology = BARCODE_EAN14 then
begin
exit (true);
end;
if symbology = BARCODE_NVE18 then
begin
exit (true);
end;
if symbology = BARCODE_KOREAPOST then
begin
exit (true);
end;
if symbology = BARCODE_PLESSEY then
begin
exit (true);
end;
if symbology = BARCODE_TELEPEN_NUM then
begin
exit (true);
end;
if symbology = BARCODE_ITF14 then
begin
exit (true);
end;
if symbology = BARCODE_CODE32 then
begin
exit (true);
end;
exit (false);
end; end;
function NotBoolean(const aValue: integer): Boolean; function NotBoolean(const aValue: integer): Boolean;
begin begin
if aValue=0 then Result:=true else Result:=false; Result := (aValue = 0);
end; end;
function NotBoolean(const aValue: Boolean): Boolean; function NotBoolean(const aValue: Boolean): Boolean;
begin begin
if aValue=false then Result:=true else Result:=false; Result := not aValue;
end; end;
function latin1_process(symbol: PointerTo_zint_symbol; source: PBYTE; preprocessed: PBYTE; length: PInteger): Integer; function latin1_process(symbol: PointerTo_zint_symbol; source: PBYTE; preprocessed: PBYTE; length: PInteger): Integer;
@ -482,4 +456,244 @@ begin
exit (0); exit (0);
end; end;
{ Replaces huge switch statements for looking up in tables }
procedure Lookup(const Set_String: PChar; const ATable: array of String;
const AData: Char; var ADest: TCharDynArray);
var
i, n: integer;
begin
n := System.Strlen(Set_String);
for i := 0 to n-1 do
if AData = Set_String[i] then
concat(ADest, PChar(ATable[i]));
end;
procedure Lookup(const Set_String: PChar; const ATable: array of String;
const AData: Byte; var ADest: TCharDynArray);
begin
LookUp(set_string, ATable, char(AData), ADest);
end;
{ Set_string is a string with the allowed characters.
ATable is the bar-space pattern for each of these allowed characters.
AData is the character to be encoded.
ADest is the output string.
The routines searches the character in the list of allowed characters and
appends its bar-space pattern to ADest. }
procedure Lookup(const Set_String: String; const ATable: array of String;
const AData: Char; var ADest: String);
var
i: Integer;
begin
i := pos(AData, Set_String);
if i > 0 then
ADest := ADest + ATable[i-1];
end;
{ Converts an integer value to its hexadecimal character }
function itoc(AValue: Integer): Char;
begin
if (AValue >= 0) and (AValue <= 9) then
Result := Char(Ord('0') + AValue)
else
Result := Char(Ord('A') + (AValue - 10));
end;
{ Expands from a width pattern to a bit pattern */ }
procedure expand(ASymbol: PointerTo_zint_symbol; const AData: String);
var
reader, writer, i: Integer;
latch: boolean;
begin
writer := 0;
latch := true;
for reader := 1 to Length(AData) do
begin
for i := 1 to ctoi(AData[reader]) do
begin
if latch then
set_module(ASymbol, ASymbol^.rows, writer);
inc(writer);
end;
latch := not latch;
end;
if ASymbol^.symbology <> BARCODE_PHARMA then
begin
if writer > ASymbol^.width then
ASymbol^.width := writer;
end else
begin
{ Pharmacode One ends with a space - adjust for this }
if (writer > ASymbol^.width + 2) then
ASymbol^.width := writer - 2;
end;
ASymbol^.rows := ASymbol^.rows + 1;
end;
procedure expand(ASymbol: PointerTo_zint_symbol; AData: TCharDynArray);
var
reader, n : Cardinal;
writer, i : Integer;
latch : Char;
begin
n := strlen(AData);
writer := 0;
latch := '1';
for reader := 0 to n - 1 do
begin
for i := 0 to ctoi(AData[reader]) - 1 do
begin
if (latch = '1') then
set_module(ASymbol, ASymbol^.rows, writer);
Inc(writer);
end;
if latch = '1' then latch := '0' else latch := '1';
end;
if(ASymbol^.symbology <> BARCODE_PHARMA) then
begin
if(writer > ASymbol^.width) then
ASymbol^.width := writer;
end else
begin
{ Pharmacode One ends with a space - adjust for this }
if(writer > ASymbol^.width + 2) then
ASymbol^.width := writer - 2;
end;
ASymbol^.rows := ASymbol^.rows + 1;
end;
function CharArrayToStr(AData: TCharDynArray): String;
var
len: Integer;
begin
Result := '';
len := Length(AData);
SetLength(Result, len);
if len > 0 then
Move(AData[0], Result[1], len*SizeOf(Char));
end;
function StrToCharArray(AText: String): TCharDynArray;
var
len: Integer;
begin
Result := nil;
len := Length(AText);
SetLength(Result, len + 1);
if len > 0 then
Move(AText[1], Result[0], len*SizeOf(Char));
Result[len] := #0;
end;
{ Basic encoding routine for barcodes - most of them work all in the same way
only with different parameters:
MaxLen - maximum length of input string
AllowedChars - a string containing the allowed characters for this barcode type.
If empty, all characters are allowed (any check musts be done by the caller).
StartCode - starting code pattern
CharCodes - code pattern for each allowed character
StopCode - ending code pattern
CheckSumFunc - function to calculate a checksum which is appended to the
input string
SourceInverted - input string is encoded from last to first char
}
function basic_encoder(ASymbol: PZIntSymbol; const ASource: String;
MaxLen: Integer; const AllowedChars, StartCode: String;
const CharCodes: array of string; const StopCode: String;
CheckSumFunc: TCheckSumFunc; SourceInverted: Boolean): Integer;
var
i: Integer;
src, dest: String;
check: String;
begin
Result := 0;
if Length(ASource) > MaxLen then
begin
ASymbol^.SetErrorText('Input too long (max ' + IntToStr(MaxLen) + ' digits).');
Result := ERROR_TOO_LONG;
exit;
end;
src := ASource;
// START character
dest := StartCode;
// Check whether all characters of the input string are allowed.
if AllowedChars <> '' then
begin
Result := is_sane(AllowedChars, ASource);
if Result = ERROR_INVALID_DATA then
begin
ASymbol^.SetErrorText('Invalid characters in data.');
exit;
end;
// Add encoded input string characters to destination string
if SourceInverted then
for i := Length(src) downto 1 do
lookup(AllowedChars, CharCodes, src[i], dest)
else
for i := 1 to Length(src) do
lookup(AllowedChars, CharCodes, src[i], dest);
// Add check digit(s) if a calculation function is provided
if (ASymbol^.Option and OPTION_ADD_CHECKSUM = OPTION_ADD_CHECKSUM) and
(CheckSumFunc <> nil) then
begin
check := CheckSumFunc(src);
src := src + check;
for i := 1 to Length(check) do
lookup(AllowedChars, CharCodes, check[i], dest);
end;
end
else
// All characters are allowed -> lookup not needed
begin
// Add encoded input string characters to destination string
if SourceInverted then
for i := Length(src) downto 1 do
dest := dest + CharCodes[ord(src[i])]
else
for i := 1 to Length(src) do
dest := dest + CharCodes[ord(src[i])];
// Add check digit(s) if a calculation function is provided
if (ASymbol^.Option and OPTION_ADD_CHECKSUM = OPTION_ADD_CHECKSUM) and
(ChecksumFunc <> nil) then
begin
check := CheckSumFunc(src);
src := src + check;
for i := 1 to Length(check) do
dest := dest + CharCodes[ord(check[i])];
end;
end;
// STOP character
dest := dest + StopCode;
// Expand the RLE-encoded bar/space widths to modules
// Example: '121' --> 1001 where 1 = black, 0 = white
// This information is stored in the ZintSymbol.
expand(ASymbol, dest);
// Store human-readable text
if ASymbol^.Option and OPTION_DISPLAY_CHECKSUM = OPTION_DISPLAY_CHECKSUM then
ASymbol^.SetText(src)
else
ASymbol^.SetText(ASource);
end;
end. end.

334
components/lazbarcodes/src/lbc_medical.pas Normal file
View File

@ -0,0 +1,334 @@
{ lbc_medical.pas - Handles Pharmacode One-Track and Two-Track,
CodaBar as well as Code 32
Based on Zint (done by Robin Stuart and the Zint team)
http://github.com/zint/zint
and Pascal adaption by TheUnknownOnes
http://theunknownones.net
Refactoring: W. Pamler
}
unit lbc_medical;
{$mode objfpc}{$H+}
interface
uses
SysUtils, zint;
function pharma_one(ASymbol: PZintSymbol; const ASource: String): Integer;
function pharma_two(ASymbol: PZintSymbol; const ASource: String): Integer;
function codabar(ASymbol: PZintSymbol; const ASource: String): Integer;
function code32(Asymbol: PZintSymbol; const ASource: String): Integer;
implementation
uses
math,
lbc_code, lbc_helper;
{ 'Pharmacode can represent only a single integer from 3 to 131070. Unlike other
commonly used one-dimensional barcode schemes, pharmacode does not store the
data in a form corresponding to the human-readable digits; the number is
encoded in binary, rather than decimal.
Pharmacode is read from right to left: with n as the bar position starting
at 0 on the right, each narrow bar adds 2n to the value and each wide bar
adds 2(2^n).
The minimum barcode is 2 bars and the maximum 16, so the smallest number
that could be encoded is 3 (2 narrow bars) and the biggest is 131070
(16 wide bars).'
- http://en.wikipedia.org/wiki/Pharmacode
This code uses the One Track Pharamacode calculating algorithm as recommended
by the specification at http://www.laetus.com/laetus.php?request=file&id=69 }
function pharma_one(ASymbol: PZintSymbol; const ASource: string): Integer;
var
tester, counter, error_number, src_len: Integer;
inter: String;
dest: String;
begin
src_len := Length(ASource);
if (src_len > 6) then
begin
ASymbol^.SetErrorText('Input too long (max 6 characters)');
Result := ERROR_TOO_LONG;
exit;
end;
error_number := is_sane(NEON, ASource);
if (error_number = ERROR_INVALID_DATA) then
begin
ASymbol^.SetErrorText('Invalid characters in data');
Result := error_number;
exit;
end;
tester := StrToIntDef(ASource, 0);
if (tester < 3) or (tester > 131070) then
begin
ASymbol^.SetErrorText('Data out of range');
Result := ERROR_INVALID_DATA;
exit;
end;
inter := '';
repeat
if tester and 1 = 0 then
begin
inter := inter + 'W';
tester := (tester - 2) div 2;
end else
begin
inter := inter + 'N';
tester := (tester - 1) div 2;
end;
until (tester = 0);
dest := '';
for counter := Length(inter) downto 1 do
begin
if (inter[counter] = 'W') then
dest := dest + '32'
else
dest := dest + '12';
end;
expand(ASymbol, dest);
ASymbol^.SetText(PChar(ASource));
Result := error_number;
end;
{ This code uses the Two Track Pharmacode defined in the document at
http://www.laetus.com/laetus.php?request=file&id=69 and using a modified
algorithm from the One Track system. This standard accepts integet values
from 4 to 64570080. }
function pharma_two_calc(ASymbol: PZintSymbol; const ASource: string;
var dest: string): Integer;
var
tester, counter: Integer;
inter: String;
error_number: Integer;
begin
tester := StrToIntDef(ASource, 0);
if (tester < 4) or (tester > 64570080) then
begin
ASymbol^.SetErrorText('Data out of range');
Result := ERROR_INVALID_DATA;
exit;
end;
error_number := 0;
inter := '';
repeat
case tester mod 3 of
0: begin
inter := inter + '3';
tester := (tester - 3) div 3;
end;
1: begin
inter := inter + '1';
tester := (tester - 1) div 3;
end;
2: begin
inter := inter + '2';
tester := (tester - 2) div 3;
end;
end;
until tester = 0;
dest := '';
for counter := Length(inter) downto 1 do
dest := dest + inter[counter];
Result := error_number;
end;
{ Draws the patterns for two track pharmacode }
function pharma_two(ASymbol: PZintSymbol; const ASource: String): Integer;
var
height_pattern: string = '';
i, src_len, writer, error_number: Integer;
begin
src_len := Length(ASource);
if (src_len > 8) then
begin
ASymbol^.SetErrorText('Input too long (max 8 characters).');
Result := ERROR_TOO_LONG;
exit;
end;
error_number := is_sane(NEON, ASource);
if (error_number = ERROR_INVALID_DATA) then
begin
ASymbol^.SetErrorText('Invalid characters in data');
Result := error_number;
exit;
end;
error_number := pharma_two_calc(ASymbol, ASource, height_pattern);
if (error_number <> 0) then
begin
Result := error_number;
exit;
end;
writer := 0;
for i := 1 to Length(height_pattern) do
begin
if ((height_pattern[i] = '2') or (height_pattern[i] = '3')) then
begin
set_module(ASymbol, 0, writer);
end;
if ((height_pattern[i] = '1') or (height_pattern[i] = '3')) then
begin
set_module(ASymbol, 1, writer);
end;
Inc(writer, 2);
end;
ASymbol^.rows := 2;
ASymbol^.width := writer - 1;
ASymbol^.SetText(ASource);
Result := error_number;
end;
{ The Codabar system consisting of simple substitution }
//chaosben: some changes where made based on the article at http://en.wikipedia.org/wiki/Codabar}
function codabar(ASymbol: PZintSymbol; const ASource: String): Integer;
const
CALCIUM =
'0123456789-$:/.+ABCD';
CODA_TABLE: array[0..19] of string = (
'11111221', '11112211', '11121121', '22111111', '11211211',
'21111211', '12111121', '12112111', '12211111', '21121111',
'11122111', '11221111', '21112121', '21211121', '21212111',
'11212121', '11221211', '12121121', '11121221', '11122211'
);
CODABAR_DELIMITERS: array[0..7] of Char = (
'A', 'B', 'C', 'D', 'T', 'N', '*', 'E'
);
var
i, j: Integer;
localSource: String;
begin
localSource := Uppercase(ASource);
// Replace alternate delimiters
for i := 1 to Length(localSource) do
for j := 4 to 7 do
if localSource[i] = CODABAR_DELIMITERS[j] then
localSource[i] := CODABAR_DELIMITERS[j - 4];
// Check correct usage of delimiters
for i := 2 to Length(localSource) - 1 do
begin
for j := Low(CODABAR_DELIMITERS) to High(CODABAR_DELIMITERS) do
begin
if localSource[i] = CODABAR_DELIMITERS[j] then
begin
ASymbol^.SetErrorText('The character "' + ASource[i] + '" can only be used as first and/or last character.');
Result := ERROR_INVALID_DATA;
exit;
end;
end;
end;
Result := basic_encoder(ASymbol, localsource,
60, CALCIUM, '', CODA_TABLE, '', nil, false);
if Result = 0 then
ASymbol^.SetText(ASource);
end;
{ Italian Pharmacode }
function code32(ASymbol: PZintSymbol; const ASource: String): Integer;
const
TABLE = '0123456789BCDFGHJKLMNPQRSTUVWXYZ';
var
i, j, error_number, checksum, checkpart: Integer;
localstr: String = '';
resultstr: String = '';
pharmacode, divisor: Integer;
remainder: Integer = 0;
codeword: array[0..5] of Integer = (0, 0, 0, 0, 0, 0);
begin
{ Validate the input }
if (Length(ASource) > 8) then
begin
ASymbol^.SetErrorText('Input too long (max 8 characters)');
Result := ERROR_TOO_LONG;
exit;
end;
error_number := is_sane(NEON, ASource);
if (error_number = ERROR_INVALID_DATA) then
begin
ASymbol^.SetErrorText('Invalid characters in data');
Result := error_number;
exit;
end;
{ Add leading zeros as required }
localstr := StringOfChar('0', 8 - Length(ASource)) + ASource;
{ Calculate the check digit }
checksum := 0;
for i := 0 to 3 do
begin
j := i * 2 + 1;
checkpart := StrToInt(localstr[j]);
Inc(checksum, checkpart);
checkpart := 2 * StrToInt(localstr[j + 1]);
if (checkpart >= 10) then
inc(checksum, (checkpart - 10) + 1)
else
inc(checksum, checkpart);
end;
{ Add check digit to data string }
localstr := localstr + IntToStr(checksum mod 10);
{ Convert string into an integer value }
pharmacode := StrToIntDef(localstr, 0);
{ Convert from decimal to base-32 }
divisor := 33554432;
for i := 5 downto 0 do
begin
DivMod(pharmacode, divisor, codeword[i], remainder);
pharmacode := remainder;
divisor := divisor div 32;
end;
{ Look up values in 'Tabella di conversione' }
SetLength(resultstr, 6);
for i := 5 downto 0 do
resultstr[5 - i + 1] := TABLE[codeword[i]+1];
{ Plot the barcode using Code 39 }
error_number := c39(ASymbol, resultstr);
if (error_number <> 0) then
begin
Result := error_number;
exit;
end;
{ Override the normal text output with the Pharmacode number }
ASymbol^.SetText('A' + localstr);
Result := error_number;
end;
end.

1555
components/lazbarcodes/src/lbc_pdf417.pas Normal file
View File

File diff suppressed because it is too large Load Diff

249
components/lazbarcodes/src/lbc_plessey.pas Normal file
View File

@ -0,0 +1,249 @@
{ lbc_plessey - Handles plessey bar codes
Based on Zint (done by Robin Stuart and the Zint team)
http://github.com/zint/zint
and Pascal adaption by TheUnknownOnes
http://theunknownones.net
Refactoring: W.Pamler
The results were checked against https://www.free-barcode-generator.net/msi/
}
unit lbc_plessey;
{$mode objfpc}{$H+}
interface
uses
SysUtils, zint;
function plessey(ASymbol: PZintSymbol; const ASource: String): Integer;
function msi_plessey(ASymbol: PZintSymbol; const ASource: String): Integer;
implementation
uses
lbc_helper;
const
SSET = '0123456789ABCDEF';
// Idea: These are the bits in a nibble: 13 = 0, 31 = 1, LSB at left
PlesseyTable: array[0..15] of String = (
'13131313', '31131313', '13311313', '31311313', '13133113',
'31133113', '13313113', '31313113', '13131331', '31131331',
'13311331', '31311331', '13133131', '31133131', '13313131',
'31313131'
);
MSITable: array[0..9] of String = (
'12121212', '12121221', '12122112', '12122121', '12211212',
'12211221', '12212112', '12212121', '21121212', '21121221'
);
{-------------------------------------------------------------------------------
Not MSI/Plessey, but the older Plessey standard
-------------------------------------------------------------------------------}
function CheckSum_Plessey(ASource: String): String;
const
grid: array[0..8] of Byte = (1,1,1,1,0,1,0,0,1);
var
i, j, check: Integer;
checkptr: array of byte = nil;
begin
SetLength(checkptr, Length(ASource)* 4 + 8);
for i := 0 to Length(ASource) - 1 do
begin
j := i+1;
check := pos(ASource[j], SSET) - 1;
checkptr[4*i] := check and 1;
checkptr[4*i+1] := (check shr 1) and 1;
checkptr[4*i+2] := (check shr 2) and 1;
checkptr[4*i+3] := (check shr 3) and 1;
end;
// CRC check digit code adapted from code by Leonid A. Broukhis
// used in GNU Barcode
for i := 0 to 4 * Length(ASource) - 1 do
begin
if (checkptr[i] <> 0) then
for j := 0 to 8 do
checkptr[i+j] := checkptr[i+j] xor grid[j];
end;
check := 0;
for i := 0 to 7 do
if checkptr[Length(ASource) * 4 + i] = 1 then
check := check or (1 shl i);
Result := SSET[succ(check and $0F)] + SSET[succ((check and $F0) shr 4)];
end;
function plessey(ASymbol: PZintSymbol; const ASource: String): Integer;
begin
Result := basic_encoder(ASymbol, ASource,
65, SSET, '31311331', PlesseyTable, '331311313', @CheckSum_Plessey, false);
if Result = 0 then
ASymbol^.SetText(ASource);
end;
{-------------------------------------------------------------------------------
MSI Plessey Modulo 10 and Modulo 11 check digit calculation routines
Algorithm from Barcode Island, http://www.barcodeisland.com/
(wp: page no longer available)
-------------------------------------------------------------------------------}
function PartialString(ASource: String; OddIndices: boolean): String;
var
i: Integer;
begin
Result := '';
if OddIndices then i := 1 else i := 2;
while i <= Length(ASource) do
begin
Result := Result + ASource[i];
inc(i, 2);
end;
end;
function SumOfDigits(s: String): Integer;
var
i: Integer;
begin
Result := 0;
for i := 1 to Length(s) do
Result := Result + StrToInt(s[i]);
end;
function SumOfDigits(s: String; OddIndices: Boolean): Integer;
var
i: Integer;
begin
Result := 0;
if OddIndices then i := 1 else i := 2;
while i <= Length(s) do
begin
Result := Result + StrToInt(s[i]);
inc(i, 2);
end;
end;
{ Calculation of a mod 10 check digit.
Algorithm from Barcode Island, http://www.barcodeisland.com/
(wp: page no longer available) }
function CheckSum_Plessey_Mod10(ASource: String): String;
var
s: String;
sum: Integer;
check: Integer;
begin
s := PartialString(ASource, odd(Length(ASource)));
s := IntToStr(StrToInt(s)*2);
sum := SumOfDigits(s) + SumOfDigits(ASource, not odd(Length(ASource)));
check := 10 - sum mod 10;
if check = 10 then check := 0;
Result := IntToStr(check);
end;
{ Calculation of two mod 10 check digits.
Based on above Barcode Island code. }
function CheckSum_Plessey_Mod10_Mod10(ASource: String): String;
var
s: String;
sum: Integer;
check: Integer;
begin
// Calculate first check digit
Result := CheckSum_Plessey_Mod10(ASource);
// Calculate second check digit
s := PartialString(ASource, not odd(Length(ASource))) + Result;
s := IntToStr(StrToInt(s)*2);
sum := SumOfDigits(s) + SumOfDigits(ASource, odd(Length(ASource)));
check := 10 - sum mod 10;
if check = 10 then check := 0;
Result := Result + IntToStr(check);
end;
{ Calculates a Modulo 11 check digit using the system discussed on Wikipedia -
see http://en.wikipedia.org/wiki/Talk:MSI_Barcode
Uses the IBM weight system }
function CheckSum_Plessey_Mod11(ASource: String): String;
var
i, sum, weight, check: Integer;
begin
sum := 0;
weight := 2;
for i := Length(ASource) downto 1 do
begin
inc(sum, weight * StrToInt(ASource[i]));
inc(weight);
if weight > 7 then weight := 2;
end;
check := (11 - sum mod 11) mod 11;
Result := IntToStr(check);
end;
{ Calculates a Modulo 11 and a Modulo 10 check digit.
Combines the Barcode Island and Wikipedia code
Verified against http://www.bokai.com/BarcodeJSP/applet/BarcodeSampleApplet.htm
Weighted using the IBM system }
function Checksum_Plessey_Mod11_Mod10(ASource: String): String;
var
ch1, ch2: string;
begin
// Calculate first digit (mod 11)
ch1 := Checksum_Plessey_Mod11(ASource);
// Calculated second digit (mod 10);
ch2 := CheckSum_Plessey_Mod10(ASource + ch1);
Result := ch1 + ch2;
end;
{ ------------------------------------------------------------------------------
Main MSI/Plessey routine
-------------------------------------------------------------------------------}
function msi_plessey(ASymbol: PZintSymbol; const ASource: String): Integer;
var
maxlen: Integer;
checkSumFunc: TCheckSumFunc;
begin
case ASymbol^.Option_2 of
1: begin // one mod 10 check digit
checkSumFunc := @CheckSum_Plessey_Mod10;
maxlen := 18;
end;
2: begin // two mod 10 check digits
checksumfunc := @CheckSum_Plessey_Mod10_Mod10;
maxlen := 18;
end;
3: begin // one mod 11 check digit
checksumfunc := @Checksum_Plessey_Mod11;
maxlen := 55;
end;
4: begin // a mod 11 and a mod 10 check digit
checksumfunc := @Checksum_Plessey_Mod11_Mod10;
maxLen := 18;
end;
else
begin // no check digits
checkSumFunc := nil;
maxLen := 55;
end;
end;
Result := basic_encoder(ASymbol, ASource,
maxlen, NEON, '21', MSITable, '121', checksumFunc, false);
end;
end.

701
components/lazbarcodes/src/lbc_postal.pas Normal file
View File

@ -0,0 +1,701 @@
{ lbc_postal - Handles postal bar codes
Based on Zint (done by Robin Stuart and the Zint team)
http://github.com/zint/zint
and Pascal adaption by TheUnknownOnes
http://theunknownones.net
Refactoring: W. Pamler
}
unit lbc_postal;
{$mode objfpc}{$H+}
interface
uses
SysUtils, zint;
function post_plot(ASymbol: PZintSymbol; const ASource: String): Integer;
function planet_plot(ASymbol: PZintSymbol; const ASource: String): Integer;
function korea_post(ASymbol: PZintSymbol; const ASource: String): Integer;
function fim(ASymbol: PZintSymbol; const ASource: String): Integer;
function royal_plot(ASymbol: PZintSymbol; const ASource: String): Integer;
function kix_code(ASymbol: PZintSymbol; const ASource: String): Integer;
function daft_code(ASymbol: PZintSymbol; const ASource: String): Integer;
function flattermarken(ASymbol: PZintSymbol; const ASource: String): Integer;
function japan_post(ASymbol: PZintSymbol; const ASource: String): Integer;
implementation
uses
lbc_helper;
const
DAFTSET = 'DAFT';
KRSET = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
KASUTSET = '1234567890-abcdefgh';
CHKASUTSET = '0123456789-abcdefgh';
SHKASUTSET = '1234567890-ABCDEFGHIJKLMNOPQRSTUVWXYZ';
{ PostNet number encoding table - In this table L is long as S is short }
PNTable: array[0..9] of string = (
'LLSSS', 'SSSLL', 'SSLSL', 'SSLLS', 'SLSSL',
'SLSLS', 'SLLSS', 'LSSSL', 'LSSLS', 'LSLSS'
);
PLTable: array[0..9] of string = (
'SSLLL', 'LLLSS', 'LLSLS', 'LLSSL', 'LSLLS',
'LSLSL', 'LSSLL', 'SLLLS','SLLSL', 'SLSLL'
);
RoyalValues: array[0..35] of string = (
'11', '12', '13', '14', '15', '10', '21', '22', '23', '24',
'25', '20', '31', '32', '33', '34', '35', '30', '41', '42',
'43', '44', '45', '40', '51', '52', '53', '54', '55', '50',
'01', '02', '03', '04', '05', '00'
);
{ 0 = Full, 1 = Ascender, 2 = Descender, 3 = Tracker }
RoyalTable: array[0..35] of string = (
'3300', '3210', '3201', '2310', '2301',
'2211', '3120', '3030', '3021', '2130',
'2121', '2031', '3102', '3012', '3003',
'2112', '2103', '2013', '1320', '1230',
'1221', '0330', '0321', '0231', '1302',
'1212', '1203', '0312', '0303', '0213',
'1122', '1032', '1023', '0132', '0123',
'0033'
);
FlatTable: array[0..9] of string = (
'0504', '18', '0117', '0216', '0315',
'0414', '0513', '0612', '0711', '0810'
);
KoreaTable: array[0..9] of string = (
'1313150613', '0713131313', '0417131313', '1506131313', '0413171313',
'17171313', '1315061313', '0413131713', '17131713', '13171713'
);
JapanTable: array[0..18] of string = (
'114', '132', '312', '123', '141', '321', '213', '231', '411', '144',
'414', '324', '342', '234', '432', '243', '423', '441', '111'
);
{ ------------------------------------------------------------------------------
PostNet
Handles the PostNet system used for Zip codes in the US
-------------------------------------------------------------------------------}
function postnet(ASymbol: PZintSymbol; const ASource: String;
var ADest: String): Integer;
var
i, sum, check_digit, src_len: Integer;
error_number: Integer;
begin
src_len := Length(ASource);
if (src_len > 38) then
begin
ASymbol^.SetErrorText('Input too long');
Result := ERROR_TOO_LONG;
exit;
end;
error_number := is_sane(NEON, ASource);
if (error_number = ERROR_INVALID_DATA) then
begin
ASymbol^.SetErrorText('Invalid characters in data');
Result := error_number;
exit;
end;
sum := 0;
// START character
ADest := 'L';
for i := 1 to src_len do
begin
lookup(NEON, PNTable, ASource[i], ADest);
Inc(sum, ctoi(ASource[i]));
end;
check_digit := (10 - sum mod 10) mod 10;
ADest := ADest + PNTable[check_digit];
// STOP character
ADest := ADest + 'L';
Result := error_number;
end;
{ Puts PostNet barcodes into the pattern matrix }
function post_plot(ASymbol: PZintSymbol; const ASource: String): Integer;
var
height_pattern: String = '';
i, writer: Integer;
error_number: Integer;
begin
error_number := postnet(ASymbol, ASource, height_pattern);
if (error_number <> 0) then
begin
Result := error_number;
exit;
end;
writer := 0;
for i := 1 to Length(height_pattern) do
begin
if height_pattern[i] = 'L' then
set_module(ASymbol, 0, writer);
set_module(ASymbol, 1, writer);
inc(writer, 3);
end;
ASymbol^.rows := 2;
ASymbol^.row_height[0] := 6;
ASymbol^.row_height[1] := 6;
ASymbol^.width := writer - 1;
ASymbol^.SetText(ASource);
Result := error_number;
end;
{ ------------------------------------------------------------------------------
USPS Planet
Handles the PLANET system used for item tracking in the US
-------------------------------------------------------------------------------}
function planet(ASymbol: PZintSymbol; const ASource: String;
var ADest: String): Integer;
var
i, sum, check_digit, src_len: Integer;
error_number: Integer;
begin
src_len := Length(ASource);
if src_len > 38 then
begin
ASymbol^.SetErrorText('Input too long');
Result := ERROR_TOO_LONG;
exit;
end;
error_number := is_sane(NEON, ASource);
if (error_number = ERROR_INVALID_DATA) then
begin
ASymbol^.SetErrorText('Invalid characters in data');
Result := error_number;
exit;
end;
// START character
ADest := 'L';
sum := 0;
for i := 1 to src_len do
begin
lookup(NEON, PLTable, ASource[i], ADest);
inc(sum, ctoi(ASource[i]));
end;
check_digit := (10 - sum mod 10) mod 10;
ADest := ADest + PLTable[check_digit];
// STOP character
ADest := ADest + 'L';
Result := error_number;
end;
{ Puts PLANET barcodes into the pattern matrix }
function planet_plot(ASymbol: PZintSymbol; const ASource: String): Integer;
var
height_pattern: string = '';
i, writer: Integer;
error_number: Integer;
begin
error_number := planet(ASymbol, ASource, height_pattern);
if (error_number <> 0) then
begin
Result := error_number;
exit;
end;
writer := 0;
for i := 1 to Length(height_pattern) do
begin
if height_pattern[i] = 'L' then
set_module(ASymbol, 0, writer);
set_module(ASymbol, 1, writer);
inc(writer, 3);
end;
ASymbol^.rows := 2;
ASymbol^.row_height[0] := 6;
ASymbol^.row_height[1] := 6;
ASymbol^.width := writer - 1;
ASymbol^.SetText(ASource);
Result := error_number;
end;
{-------------------------------------------------------------------------------
Korean Postal Authority
-------------------------------------------------------------------------------}
function CheckSum_Korea(ASource: String): String;
var
i, sum, check: Integer;
begin
sum := 0;
for i := 1 to Length(ASource) do
inc(sum, ctoi(ASource[i]));
check := 10 - sum mod 10;
if check = 10 then check := 0;
Result := itoc(check);
end;
function korea_post(ASymbol: PZintSymbol; const ASource: String): Integer;
const
MaxLength = 6;
var
n: Integer;
src: String;
begin
if Length(ASource) < MaxLength then
begin
n := MaxLength - Length(ASource);
src := StringOfChar('0', n) + ASource;
end else
src := ASource;
ASymbol^.Option := OPTION_ADD_CHECKSUM or OPTION_DISPLAY_CHECKSUM;
Result := basic_encoder(ASymbol, src,
MaxLength, NEON, '', KoreaTable, '', @CheckSUM_Korea, true
);
end;
{-------------------------------------------------------------------------------
FIM (facing identification mark)
Was developed by the United States Postal Service (USPS) to allow automatic
facing, or orientation, of the mail piece for cancellation. It also
identifies reply mail that uses a preprinted USPS POSTNET barcode symbol.
Mail that uses a FIM can be routed to a high-speed sorter.
The simplest barcode symbology ever! Supported by MS Word, so here it is!
Glyphs from http://en.wikipedia.org/wiki/Facing_Identification_Mark
-------------------------------------------------------------------------------}
function fim(ASymbol: PZintSymbol; const ASource: String): Integer;
var
src_len: Integer;
dest: String;
begin
src_len := Length(ASource);
if (src_len > 1) then
begin
ASymbol^.SetErrorText('Input too long');
Result := ERROR_TOO_LONG;
exit;
end;
case ASource[1] of
'a', 'A': dest := '111515111';
'b', 'B': dest := '13111311131';
'c', 'C': dest := '11131313111';
'd', 'D': dest := '1111131311111';
else
ASymbol^.SetErrorText('Invalid characters in data');
Result := ERROR_INVALID_DATA;
exit;
end;
expand(ASymbol, dest);
Result := 0;
end;
{-------------------------------------------------------------------------------
UK Royal Mail 4-State Customer Code (RM4SCC)
Handles the 4 State barcodes used in the UK by Royal Mail
-------------------------------------------------------------------------------}
function rm4scc(const ASource: String; var ADest: string): Char;
var
i, j: Integer;
top, bottom, row, column, check_digit: Integer;
values: string;
begin
top := 0;
bottom := 0;
// START character }
ADest := '1';
for i := 1 to Length(ASource) do
begin
lookup(KRSET, RoyalTable, ASource[i], ADest);
j := Pos(ASource[i], KRSET);
values := RoyalValues[j - 1]; // -1 because RoyalValues is a string
Inc(top, ctoi(values[1]));
Inc(bottom, ctoi(values[2]));
end;
// Calculate the check digit
row := top mod 6 - 1;
column := bottom mod 6 - 1;
if (row = -1) then row := 5;
if (column = -1) then column := 5;
check_digit := 6 * row + column;
ADest := ADest + RoyalTable[check_digit];
// STOP character
ADest := ADest + '0';
result := KRSET[check_digit + 1]; // +1 because KRSET is a string
end;
{ Puts RM4SCC into the data matrix }
function royal_plot(ASymbol: PZintSymbol; const ASource: String): Integer;
var
height_pattern: string = '';
localStr: String;
i, writer, error_number, src_len: Integer;
begin
src_len := Length(ASource);
if (src_len > 120) then
begin
ASymbol^.SetErrorText('Input too long');
Result := ERROR_TOO_LONG;
exit;
end;
localStr := Uppercase(ASource);
error_number := is_sane(KRSET, localStr);
if (error_number = ERROR_INVALID_DATA) then
begin
ASymbol^.SetErrorText('Invalid characters in data');
Result := error_number;
exit;
end;
rm4scc(localStr, height_pattern);
writer := 0;
for i := 1 to Length(height_pattern) do
begin
if (height_pattern[i] in ['1', '0']) then
set_module(ASymbol, 0, writer);
set_module(ASymbol, 1, writer);
if (height_pattern[i] in ['2', '0']) then
set_module(ASymbol, 2, writer);
Inc(writer, 2);
end;
ASymbol^.rows := 3;
ASymbol^.row_height[0] := 3;
ASymbol^.row_height[1] := 2;
ASymbol^.row_height[2] := 3;
ASymbol^.width := writer - 1;
Result := error_number;
end;
{-------------------------------------------------------------------------------
KIX barcode (Klant index)
Used for mail sorting by the postal service of the Netherlands,
Koninklijke TNT Post (Royal TNT Post)
The same as RM4SCC but without check digit
Specification at
http://www.tntpost.nl/zakelijk/klantenservice/downloads/kIX_code/download.aspx
https://support.honeywellaidc.com/s/article/What-is-KIX-code-and-is-it-supported-on-Honeywell-barcode-readers
"The structure of the information in the KIX will be (from left to right):
special prefix (optional) two letters fixed length
postcode 4 digits, 2 alpha char's. fixed length
house number, P.O.Box number maximal 5 digits variable length
separator (optional) alpha char: "X" fixed length
house number extension (optional) maximal 6 characters variable length"
-------------------------------------------------------------------------------}
function kix_code(ASymbol: PZintSymbol; const ASource: String): Integer;
var
height_pattern: string = '';
localstr: string;
writer, i, error_number, src_len: Integer;
begin
src_len := Length(ASource);
if (src_len > 18) then
begin
ASymbol^.SetErrorText('Input too long (max 18 characters).');
Result := ERROR_TOO_LONG;
exit;
end;
localStr := Uppercase(ASource);
error_number := is_sane(KRSET, localStr);
if (error_number = ERROR_INVALID_DATA) then
begin
ASymbol^.SetErrorText('Invalid characters in data');
Result := error_number;
exit;
end;
{ Encode data }
for i := 1 to 18 do
lookup(KRSET, RoyalTable, localstr[i], height_pattern);
writer := 0;
for i := 1 to Length(height_pattern) do
begin
if (height_pattern[i] in ['1', '0']) then
set_module(ASymbol, 0, writer);
set_module(ASymbol, 1, writer);
if (height_pattern[i] in ['2', '0']) then
set_module(ASymbol, 2, writer);
Inc(writer, 2);
end;
ASymbol^.rows := 3;
ASymbol^.row_height[0] := 3;
ASymbol^.row_height[1] := 2;
ASymbol^.row_height[2] := 3;
ASymbol^.width := writer - 1;
ASymbol^.SetText(localStr);
Result := error_number;
end;
{-------------------------------------------------------------------------------
DAFT symbol
Handles DAFT Code symbols
Presumably 'daft' doesn't mean the same thing in Germany as it does in the UK!
-------------------------------------------------------------------------------}
function daft_code(ASymbol: PZintSymbol; const ASource: String): Integer;
var
localStr, height_pattern: String;
writer, i, error_number, src_len: Integer;
begin
src_len := Length(ASource);
if (src_len > 50) then
begin
ASymbol^.SetErrorText('Input too long (max 50 characters)');
Result := ERROR_TOO_LONG;
exit;
end;
localStr := Uppercase(ASource);
error_number := is_sane(DAFTSET, localStr);
if (error_number = ERROR_INVALID_DATA) then
begin
ASymbol^.SetErrorText('Invalid characters in data');
Result := error_number;
exit;
end;
height_pattern := '';
for i := 1 to src_len do
case localStr[i] of
'D': height_pattern := height_pattern + '2';
'A': height_pattern := height_pattern + '1';
'F': height_pattern := height_pattern + '0';
'T': height_pattern := height_pattern + '3';
else ;
end;
writer := 0;
for i := 1 to Length(height_pattern) do
begin
if (height_pattern[i] in ['1', '0']) then
set_module(ASymbol, 0, writer);
set_module(ASymbol, 1, writer);
if (height_pattern[i] in ['2', '0']) then
set_module(ASymbol, 2, writer);
Inc(writer, 2);
end;
ASymbol^.rows := 3;
ASymbol^.row_height[0] := 3;
ASymbol^.row_height[1] := 2;
ASymbol^.row_height[2] := 3;
ASymbol^.width := writer - 1;
Result := error_number;
end;
{-------------------------------------------------------------------------------
Flattermarken
Flattermarken (a German plural; the singular is "flattermarke") are the marks
used on the edge of printed material such as sections of books to facilitate
their being arranged in the proper order. The symbology allows for the coding
of any sequence of numbers through the position of bars. The bars themselves
are of the same size and shape, but their position varies.
-------------------------------------------------------------------------------}
function flattermarken(ASymbol: PZintSymbol; const ASource: String): Integer;
var
i, error_number, src_len: Integer;
dest: string;
begin
src_len := Length(ASource);
if (src_len > 90) then
begin
ASymbol^.SetErrorText('Input too long (max 90 characters).');
Result := ERROR_TOO_LONG;
exit;
end;
error_number := is_sane(NEON, ASource);
if (error_number = ERROR_INVALID_DATA) then
begin
ASymbol^.SetErrorText('Invalid characters in data');
Result := error_number;
exit;
end;
dest := '';
for i := 1 to src_len do
lookup(NEON, FlatTable, ASource[i], dest);
expand(ASymbol, dest);
Result := error_number;
end;
{-------------------------------------------------------------------------------
Japanese Postal Code (Kasutama Barcode)
-------------------------------------------------------------------------------}
function japan_post(ASymbol: PZintSymbol; const ASource: String): Integer;
var
writer, inter_posn, i, j, sum, check, error_number, src_len: Integer;
check_char: Char;
pattern: String;
inter: String;
localStr: string;
begin
src_len := Length(ASource);
localStr := Uppercase(ASource);
error_number := is_sane(SHKASUTSET, localStr);
if (error_number = ERROR_INVALID_DATA) then
begin
ASymbol^.SetErrorText('Invalid characters in data');
Result := error_number;
exit;
end;
// Pad character CC4
inter := StringOfChar('d', 20);
i := 1;
inter_posn := 1;
repeat
if (localStr[i] in ['0'..'9', '-']) then
begin
inter[inter_posn] := localStr[i];
Inc(inter_posn);
end else
begin
if (localStr[i] in ['A'..'J']) then
begin
inter[inter_posn] := 'a';
inter[inter_posn + 1] := Char(ord(localStr[i]) - ord('A') + Ord('0'));
Inc(inter_posn, 2);
end;
if (localStr[i] in ['K'..'T']) then
begin
inter[inter_posn] := 'b';
inter[inter_posn + 1] := Char(ord(localStr[i]) - Ord('K') + Ord('0'));
Inc(inter_posn, 2);
end;
if (localStr[i] in ['U'..'Z']) then
begin
inter[inter_posn] := 'c';
inter[inter_posn + 1] := Char(ord(localStr[i]) - Ord('U') + Ord('0'));
Inc(inter_posn, 2);
end;
end;
Inc(i);
until (i > src_len) or (inter_posn > 20);
// START character
pattern := '13';
sum := 0;
for i := 1 to 20 do
begin
j := pos(inter[i], KASUTSET) - 1; // -1 to become 0-based again because inter is a string
pattern := pattern + JapanTable[j];
j := pos(inter[i], CHKASUTSET) - 1;
inc(sum, j);
end;
// Calculate check digit
check := 19 - sum mod 19;
if (check = 19) then check := 0;
if (check <= 9) then
check_char := Char(check + Ord('0'))
else
if (check = 10) then
check_char := '-'
else
check_char := Char((check - 11) + Ord('a'));
j := pos(check_char, KASUTSET) - 1;
pattern := pattern + JapanTable[j];
// STOP character
pattern := pattern + '31';
// Resolve pattern to 4-state symbols
writer := 0;
for i := 1 to Length(pattern) do
begin
if (pattern[i] in ['2', '1']) then
set_module(ASymbol, 0, writer);
set_module(ASymbol, 1, writer);
if (pattern[i] in ['3', '1']) then
set_module(ASymbol, 2, writer);
Inc(writer, 2);
end;
ASymbol^.rows := 3;
ASymbol^.row_height[0] := 3;
ASymbol^.row_height[1] := 2;
ASymbol^.row_height[2] := 3;
ASymbol^.width := writer - 1;
ASymbol^.SetText(localStr);
Result := error_number;
end;
end.

673
components/lazbarcodes/src/lbc_render.pas
View File

File diff suppressed because it is too large Load Diff

103
components/lazbarcodes/src/lbc_svg.pas Normal file
View File

@ -0,0 +1,103 @@
unit lbc_svg;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,
zint;
procedure svg_plot(AStream: TStream; ASymbol: PointerTo_zint_symbol);
implementation
{ Writes the symbol to a stream.
To avoid duplication of the bar calculation, the coordinates are taken from
the rendered data, i.e. the coordinates are in pixels. We want to draw in mm
--> we must divide by GL_CONST. }
procedure svg_plot(AStream: TStream; ASymbol: PointerTo_zint_symbol);
const
factor = 1.0/GL_CONST;
var
line: PointerTo_zint_render_line;
str: PointerTo_zint_render_string;
fs: TFormatSettings;
L: TStrings;
w, h: Single;
fgcolor, bgcolor: String;
begin
if (ASymbol = nil) then
raise Exception.Create('[svg_plot] Symbol is nil');
if (ASymbol^.rendered = nil) then
raise Exception.Create('[svg_plot] Barcode has not yet been rendered.');
// rendered size in mm
w := ASymbol^.rendered^.exact_width*factor;
h := ASymbol^.rendered^.height*factor;
// Make sure that floats are written with point as decimal separator
fs := FormatSettings;
fs.DecimalSeparator := '.';
bgcolor := StrPas(ASymbol^.bgColour);
fgcolor := StrPas(ASymbol^.fgColour);
L := TStringList.Create;
try
L.Add(
'<?xml version="1.0" standalone="no"?>'
);
L.Add(
'<!DOCTYPE svg PUBLIC "-//W3C/DTD SVG 1.1/EN" "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">'
);
L.Add(Format(
'<svg width="%.3fmm" height="%.3fmm" version="1.1" xmlns="http://www.w3.org/2000/svg">', [w, h], fs));
if system.strlen(PChar(@ASymbol^.text[0])) <> 0 then
L.Add(' <desc>%s</desc>', [PChar(@ASymbol^.text[0])])
else
L.Add(' <desc>Symbol generated by Zint and LazBarcodes</desc>');
L.Add(Format(
' <rect width="100%%" height="100%%" fill="#%s"/>', [bgcolor]));
L.Add(
' <g id="barcode">');
line := ASymbol^.rendered^.lines;
while Assigned(line) do
begin
L.Add(Format(
' <rect x="%.3fmm" y="%.3fmm" width="%.3fmm" height="%.3fmm" fill="#%s" />', [
line^.x*factor, line^.y*factor,
line^.width*factor, line^.length*factor,
fgcolor
], fs));
line := line^.next;
end;
str := ASymbol^.rendered^.strings;
while Assigned(str) do
begin
L.Add(Format(
' <text x="%.3fmm" y="%.3fmm" text-anchor="middle" font-family="Helvetica" font-size="%.1f" fill="#%s">%s</text>', [
str^.x*factor, (str^.y + ASymbol^.font_height)*factor, 1.0*ASymbol^.font_height,
fgcolor,
PChar(@ASymbol^.text[0])
], fs));
str := str^.next;
end;
// to do: Add support of rings and hexagons
L.Add(' </g>');
L.Add('</svg>');
L.SaveToStream(AStream);
finally
L.Free;
end;
end;
end.

159
components/lazbarcodes/src/lbc_telepen.pas Normal file
View File

@ -0,0 +1,159 @@
{ lbc_telepen.pas - Handles telepen alpha, and telepen numeric barcodes.
Based on Zint (done by Robin Stuart and the Zint team)
http://github.com/zint/zint
and Pascal adaption by TheUnknownOnes
http://theunknownones.net
Refactoring: W.Pamler
Fixes: Usage of character 'X' in input string.
}
unit lbc_telepen;
{$mode objfpc}{$H+}
interface
uses
SysUtils, zint;
function telepen(ASymbol: PZintSymbol; const ASource: String): Integer;
function telepen_num(ASymbol: PZintSymbol; const ASource: String): Integer;
implementation
uses
lbc_helper;
const TeleTable: array[0..126] of String = (
'1111111111111111', '1131313111', '33313111', '1111313131', '3111313111',
'11333131', '13133131', '111111313111', '31333111', '1131113131',
'33113131', '1111333111', '3111113131', '1113133111', '1311133111',
'111111113131', '3131113111', '11313331', '333331', '111131113111',
'31113331', '1133113111', '1313113111', '1111113331', '31131331',
'113111113111', '3311113111', '1111131331', '311111113111', '1113111331',
'1311111331', '11111111113111', '31313311', '1131311131', '33311131',
'1111313311', '3111311131', '11333311', '13133311', '111111311131',
'31331131', '1131113311', '33113311', '1111331131', '3111113311',
'1113131131', '1311131131', '111111113311', '3131111131', '1131131311',
'33131311', '111131111131', '3111131311', '1133111131', '1313111131',
'111111131311', '3113111311', '113111111131', '3311111131', '111113111311',
'311111111131', '111311111311', '131111111311', '11111111111131', '3131311111',
'11313133', '333133', '111131311111', '31113133', '1133311111',
'1313311111', '1111113133', '313333', '113111311111', '3311311111',
'11113333', '311111311111', '11131333', '13111333', '11111111311111',
'31311133', '1131331111', '33331111', '1111311133', '3111331111',
'11331133', '13131133', '111111331111', '3113131111', '1131111133',
'33111133', '111113131111', '3111111133', '111311131111', '131111131111',
'111111111133', '31311313', '113131111111', '3331111111', '1111311313',
'311131111111', '11331313', '13131313', '11111131111111', '3133111111',
'1131111313', '33111313', '111133111111', '3111111313', '111313111111',
'131113111111', '111111111313', '313111111111', '1131131113', '33131113',
'11113111111111', '3111131113', '113311111111', '131311111111', '111111131113',
'3113111113', '11311111111111', '331111111111', '111113111113', '31111111111111',
'111311111113', '131111111113'
);
function CheckSum_telepen(ASource: String): String;
var
i, sum: Integer;
check_digit: Integer;
begin
sum := 0;
for i := 1 to Length(ASource) do
inc(sum, ord(ASource[i]));
check_digit := 127 - sum mod 127;
if (check_digit = 127) then check_digit := 0;
Result := char(check_digit);
end;
function telepen(ASymbol: PZintSymbol; const ASource: String): Integer;
var
i: Integer;
begin
for i := 1 to Length(ASource) do
if ASource[i] > #126 then
begin
// Cannot encode extended ASCII
ASymbol^.SetErrorText('Invalid characters in input data.');
Result := ERROR_INVALID_DATA;
exit;
end;
Result := basic_encoder(ASymbol, ASource,
30, '', TeleTable[ord('_')], TeleTable, TeleTable[ord('z')], @CheckSum_telepen, false);
end;
function telepen_num(ASymbol: PZintSymbol; const ASource: String): Integer;
const
VALID_CHARS = NEON + 'X';
var
src, dest: String;
i, pair, checksum: Integer;
begin
if Length(ASource) > 60 then
begin
ASymbol^.SetErrorText('Input too long (max 60 characters).');
Result := ERROR_TOO_LONG;
exit;
end;
src := UpperCase(ASource);
Result := is_sane(VALID_CHARS, src);
if Result = ERROR_INVALID_DATA then
begin
ASymbol^.SetErrorText('Invalid characters in data.');
exit;
end;
// Add a leading zero if required (the input string length must be even).
if odd(Length(src)) then
src := '0' +src;
// START character
dest := TeleTable[ord('_')];
// Extract pairs of digits. Their numerical value is encoded. An 'X' is
// allowed to identify single-digit numbers; it must be the LAST character of
// a pair.
// Example: 466X33 is valid (pairs 46, 6X, 33)
// 46X333 is not valid (pairs 46, X3, 33)
i := 1;
checksum := 0;
while i < Length(src) do
begin
if src[i] = 'X' then
begin
ASymbol^.SetErrorText('Invalid position of X in Telepen data.');
Result := ERROR_INVALID_DATA;
exit;
end;
if src[i+1] = 'X' then
pair := StrToInt(src[i]) + 17
else
pair := StrToInt(src[i] + src[i+1]) + 27;
dest := dest + TeleTable[pair];
inc(checksum, pair);
inc(i, 2);
end;
checksum := 127 - checksum mod 127;
if checksum = 127 then checksum := 0;
dest := dest + TeleTable[checksum];
// STOP character
dest := dest + TeleTable[ord('z')];
// Expand to modules
expand(ASymbol, dest);
// Store human-readable text.
ASymbol^.SetText(src);
end;
end.

790
components/lazbarcodes/src/lbc_upcean.pas Normal file
View File

@ -0,0 +1,790 @@
{ lbc_upcean.pas - Handles EAN-based codes
Based on Zint (done by Robin Stuart and the Zint team)
http://github.com/zint/zint
and Pascal adaption by TheUnknownOnes
http://theunknownones.net
Refactoring: W. Pamler
}
unit lbc_upcean;
{$mode objfpc}{$H+}
interface
uses
zint;
function eanx(ASymbol: PZintSymbol; const ASource: String): Integer;
implementation
uses
SysUtils, lbc_helper;
const
SODIUM = '0123456789+';
EAN2 = 102;
EAN5 = 105;
{ UPC and EAN tables checked against EN 797:1996 }
const
{ Number set for UPC-E symbol (EN Table 4) }
UPCParity0: array[0..9] of String = (
'BBBAAA', 'BBABAA', 'BBAABA', 'BBAAAB', 'BABBAA',
'BAABBA', 'BAAABB', 'BABABA', 'BABAAB', 'BAABAB'
);
{ Not covered by BS EN 797:1995 }
UPCParity1: array[0..9] of String = (
'AAABBB', 'AABABB', 'AABBAB', 'AABBBA', 'ABAABB',
'ABBAAB', 'ABBBAA', 'ABABAB', 'ABABBA', 'ABBABA');
{ Number sets for 2-digit add-on (EN Table 6) }
EAN2Parity: array[0..3] of String = (
'AA', 'AB', 'BA', 'BB'
);
{ Number set for 5-digit add-on (EN Table 7) }
EAN5Parity: Array[0..9] of String = (
'BBAAA', 'BABAA', 'BAABA', 'BAAAB', 'ABBAA',
'AABBA', 'AAABB', 'ABABA', 'ABAAB', 'AABAB'
);
{ Left hand of the EAN-13 symbol (EN Table 3) }
EAN13Parity: Array[0..9] of String = (
'AAAAA', 'ABABB', 'ABBAB', 'ABBBA', 'BAABB',
'BBAAB', 'BBBAA', 'BABAB', 'BABBA', 'BBABA'
);
{ Representation set A and C (EN Table 1) }
EANsetA: Array[0..9] of String = (
'3211', '2221', '2122', '1411', '1132',
'1231', '1114', '1312', '1213', '3112'
);
{ Representation set B (EN Table 1) }
EANsetB: Array [0..9] of String = (
'1123', '1222', '2212', '1141', '2311',
'1321', '4111', '2131', '3121', '2113'
);
{-------------------------------------------------------------------------------
UPC-A, UPC-E
-------------------------------------------------------------------------------}
{ Calculate the correct check digit for a UPC barcode }
function upc_checksum(const ASource: String): String;
var
i, n, sum, check_digit: Integer;
begin
sum := 0;
for i := 1 to Length(ASource) do
begin
n := StrToInt(ASource[i]);
inc(sum, n);
if odd(i) then
inc(sum, 2 * n);
end;
check_digit := 10 - sum mod 10;
if (check_digit = 10) then check_digit := 0;
Result := IntToStr(check_digit);
end;
{ UPC A is usually used for 12 digit numbers, but this function takes a
source of any length }
procedure upca_draw(const ASource: String; var dest: String);
var
i, half_way: Cardinal;
begin
// START character
dest := '111';
half_way := Length(ASource) div 2 + 1;
for i := 1 to Length(ASource) do
begin
if (i = half_way) then
begin
{ middle character - separates manufacturer no. from product no. }
{ also inverts right hand characters }
dest := dest + '11111';
end;
lookup(NEON, EANsetA, ASource[i], dest);
end;
// STOP character
dest := dest + '111';
end;
{ Make a UPC A barcode when we haven't been given the check digit }
procedure upca(ASymbol: PZintSymbol; const ASource: String; var dest: String);
var
gtin: String;
begin
gtin := ASource + upc_checksum(ASource);
upca_draw(gtin, dest);
ASymbol^.SetText(gtin);
end;
{ UPC E is a zero-compressed version of UPC A }
procedure upce(ASymbol: PZintSymbol; ASource: String; var dest: String);
var
i, num_system: Cardinal;
emode: char;
check: Integer;
check_digit: String;
equivalent: String;
parity: String = '';
temp: String = '';
hrt: String = ''; // "human-readable text"
begin
{ Two number systems can be used - system 0 and system 1 }
if Length(ASource) = 7 then
begin
case ASource[1] of
'0': num_system := 0;
'1': num_system := 1;
else
num_system := 0;
ASource[1] := '0';
end;
temp := ASource;
hrt := ASource;
for i := 2 to 8 do
ASource[i-1] := temp[i];
end
else
begin
num_system := 0;
hrt := '0' + ASource;
end;
{ Expand the zero-compressed UPCE code to make a UPCA equivalent (EN Table 5) }
emode := ASource[6];
equivalent := StringOfChar('0', 11);
if (num_system = 1) then equivalent[1] := temp[1];
equivalent[2] := ASource[1];
equivalent[3] := ASource[2];
case emode of
'0',
'1',
'2': begin
equivalent[4] := emode;
equivalent[9] := ASource[3];
equivalent[10] := ASource[4];
equivalent[11] := ASource[5];
end;
'3': begin
equivalent[4] := ASource[3];
equivalent[10] := ASource[4];
equivalent[11] := ASource[5];
if (ASource[3] in ['0', '1', '2']) then
{ Note 1 - 'X3 shall not be equal to 0, 1 or 2' }
ASymbol^.SetErrorText('Invalid UPC-E data');
end;
'4': begin
equivalent[4] := ASource[3];
equivalent[5] := ASource[4];
equivalent[11] := ASource[5];
if (ASource[4] = '0') then
{ Note 2 - 'X4 shall not be equal to 0' }
ASymbol^.SetErrorText('Invalid UPC-E data');
end;
'5',
'6',
'7',
'8',
'9': begin
equivalent[4] := ASource[3];
equivalent[5] := ASource[4];
equivalent[6] := ASource[5];
equivalent[11] := emode;
if (ASource[5] = '0') then
{ Note 3 - 'X5 shall not be equal to 0' }
ASymbol^.SetErrorText('Invalid UPC-E data');
end;
end;
// Get the check digit from the expanded UPCA code
check_digit := upc_checksum(equivalent);
check := StrToInt(check_digit);
// Use the number system and check digit information to choose a parity scheme
if (num_system = 1) then
parity := UPCParity1[check]
else
parity := UPCParity0[check];
// Take all this information and make the barcode pattern
// START character
dest := '111';
for i := 1 to Length(ASource) do
case parity[i] of
'A': lookup(NEON, EANsetA, ASource[i], dest);
'B': lookup(NEON, EANsetB, ASource[i], dest);
end;
// STOP character
dest := dest + '111111';
hrt := hrt + check_digit;
ASymbol^.SetText(hrt);
end;
{ EAN-2 and EAN-5 add-on codes }
procedure add_on(const ASource: String; var dest: String; mode: Integer);
var
parity: String;
code_type: Integer;
code_value: Integer;
parity_bit: Integer;
parity_sum: Integer;
i: Integer;
begin
// If an add-on then append with space
if (mode <> 0) then
dest := dest + '9';
// START character
dest := dest + '112';
// Determine EAN2 or EAN5 add-on
if Length(ASource) = 2 then
code_type := EAN2
else
code_type := EAN5;
// Calculate parity for EAN2
if (code_type = EAN2) then
begin
code_value := StrToInt(copy(ASource, 1, 2));
parity_bit := code_value mod 4;
parity := EAN2Parity[parity_bit];
end else
// Calculate parity for EAN5
if (code_type = EAN5) then
begin
parity_sum :=
3 * (StrToInt(ASource[1]) + StrToInt(ASource[3]) + StrToInt(ASource[5])) +
9 * (StrToInt(ASource[2]) + StrToInt(ASource[4]));
parity_bit := parity_sum mod 10;
parity := EAN5Parity[parity_bit];
end;
for i := 1 to Length(ASource) do
begin
case parity[i] of
'A': lookup(NEON, EANsetA, ASource[i], dest);
'B': lookup(NEON, EANsetB, ASource[i], dest);
end;
{ Glyph separator }
if i <> Length(ASource) then
dest := dest + '11';
end;
end;
{-------------------------------------------------------------------------------
EAN-13
-------------------------------------------------------------------------------}
{ Calculate the correct check digit for an EAN-13 barcode }
function ean_checksum(const ASource: String): String;
var
i, sum, check_digit, char_val: Integer;
begin
sum := 0;
for i := Length(ASource) downto 1 do
begin
char_val := StrToInt(ASource[i]);
inc(sum, char_val);
if not odd(i) then
inc(sum, 2 * char_val);
end;
check_digit := 10 - sum mod 10;
if (check_digit = 10) then check_digit := 0;
Result := IntToStr(check_digit);
end;
procedure ean13(ASymbol: PZintSymbol; const ASource: String; var dest: String);
var
i, half_way: Integer;
gtin: String;
parity: String;
begin
// Add the appropriate check digit
gtin := ASource + ean_checksum(ASource);
// Get parity for first half of the symbol
parity := '';
lookup(SODIUM, EAN13Parity, gtin[1], parity);
// Now get on with the cipher
half_way := 8;
// START character
dest := '111';
for i := 2 to Length(gtin) do
begin
if (i = half_way) then
begin
// middle character - separates manufacturer no. from product no.
// also inverses right hand characters
dest := dest + '11111';
end;
if (i > 2) and (i < 8) and (parity[i - 2] = 'B') then
lookup(NEON, EANsetB, gtin[i], dest)
else
lookup(NEON, EANsetA, gtin[i], dest)
end;
// STOP character
dest := dest + '111';
ASymbol^.SetText(gtin);
end;
{-------------------------------------------------------------------------------
EAN-8
Make an EAN-8 barcode when we haven't been given the check digit.
EAN-8 is basically the same as UPC-A but with fewer digits
-------------------------------------------------------------------------------}
procedure ean8(ASymbol: PZintSymbol; const ASource: String; var dest: String);
var
gtin: String;
begin
gtin := ASource + upc_checksum(ASource);
upca_draw(gtin, dest);
ASymbol^.SetText(gtin);
end;
{-------------------------------------------------------------------------------
ISBN
-------------------------------------------------------------------------------}
{ For ISBN(13) only }
function isbn13_checksum(const ASource: String): String;
var
i, weight, sum, check: Integer;
begin
sum := 0;
weight := 1;
for i := 1 to Length(ASource)-1 do // Do no include check digit in calculation
begin
inc(sum, StrToInt(ASource[i]) * weight);
if weight = 1 then
weight := 3
else
weight := 1;
end;
check := sum mod 10;
check := 10 - check;
if (check = 10) then check := 0;
Result := IntToStr(check);
end;
{ For ISBN(10) and SBN only }
function isbn_checksum(const ASource: String): String;
var
i, weight, sum, check: Integer;
begin
sum := 0;
weight := 1;
for i := 1 to Length(ASource)-1 do // do not include check digit in calculation
begin
inc(sum, StrToInt(ASource[i]) * weight);
inc(weight);
end;
check := sum mod 11;
if check = 10 then
Result := 'X'
else
Result := IntToStr(check);
end;
{ Make an EAN-13 barcode from an SBN or ISBN }
function isbn(ASymbol: PZintSymbol; var ASource: String; var dest: String): Integer;
var
check_digit: String;
s: String;
begin
// Input must be 9, 10 or 13 characters
if not (Length(ASource) in [9, 10, 13]) then
begin
ASymbol^.SetErrorText('Wrong input length (9, 10, or 13 characters)');
Result := ERROR_TOO_LONG;
exit;
end;
Result := is_sane('0123456789Xx', ASource);
if (Result = ERROR_INVALID_DATA) then
begin
ASymbol^.SetErrorText('Invalid characters in input');
exit;
end;
case Length(ASource) of
13: begin // Using 13 character ISBN
s := copy(ASource, 1, 3);
if not ((s = '978') or (s = '979')) then
begin
ASymbol^.SetErrorText('Invalid ISBN');
Result := ERROR_INVALID_DATA;
exit;
end;
check_digit := isbn13_checksum(ASource);
if ASource[Length(ASource)] <> check_digit[1] then
begin
ASymbol^.SetErrorText('Incorrect ISBN checksum');
Result := ERROR_INVALID_CHECK;
exit;
end;
Delete(ASource, Length(ASource), 1); // Remove check digit for EAN13
ean13(ASymbol, ASource, dest);
end;
10: begin // Using 10 digit ISBN
check_digit := isbn_checksum(ASource);
if check_digit[1] <> ASource[Length(ASource)] then
begin
ASymbol^.SetErrorText('Incorrect ISBN checksum');
Result := ERROR_INVALID_CHECK;
exit;
end;
ASource := '978' + ASource;
Delete(ASource, Length(ASource), 1); // Remove check digit for EAN13
ean13(ASymbol, ASource, dest);
end;
9: begin // Using 9 digit SBN
// Add leading zero
ASource := '0' + ASource;
// Verify check digit
check_digit := isbn_checksum(ASource);
if check_digit[1] <> ASource[Length(ASource)] then
begin
ASymbol^.SetErrorText('Incorrect SBN checksum');
Result := ERROR_INVALID_CHECK;
exit;
end;
// Convert to EAN-13 number
ASource := '978' + ASource;
// Remove check digit for EAN13
Delete(ASource, Length(ASource), 1);
// Encode
ean13(ASymbol, ASource, dest);
end;
end;
end;
{ Add leading zeroes to EAN and UPC strings }
procedure ean_leading_zeroes(ASymbol: PZintSymbol;
const ASource: String; var local_source: String);
var
first_part: string;
second_part: string;
zfirst_part: string;
zsecond_part: string;
with_addon: Boolean;
first_len, second_len: Integer;
zfirst_len: Integer = 0;
zsecond_len: Integer = 0;
p, len: Integer;
begin
len := Length(ASource);
// Split input at '+' into two strings
p := pos('+', ASource);
with_addon := p > 0;
if with_addon then
begin
first_len := p-1;
second_len := len - p;
first_part := copy(ASource, 1, first_len);
second_part := copy(ASource, p+1, second_len);
end else
begin
first_len := len;
second_len := 0;
first_part := ASource;
second_part := '';
end;
{ Calculate target lengths }
if (second_len <= 5) then zsecond_len := 5;
if (second_len <= 2) then zsecond_len := 2;
if (second_len = 0) then zsecond_len := 0;
case ASymbol^.symbology of
BARCODE_EANX,
BARCODE_EANX_CC:
begin
if (first_len <= 12) then zfirst_len := 12;
if (first_len <= 7) then zfirst_len := 7;
if (second_len = 0) then
begin
if (first_len <= 5) then zfirst_len := 5;
if (first_len <= 2) then zfirst_len := 2;
end;
end;
BARCODE_UPCA,
BARCODE_UPCA_CC:
zfirst_len := 11;
BARCODE_UPCE,
BARCODE_UPCE_CC:
begin
if (first_len = 7) then zfirst_len := 7;
if (first_len <= 6) then zfirst_len := 6;
end;
BARCODE_ISBNX:
if (first_len <= 9) then zfirst_len := 9;
end;
// Add leading zeros
zfirst_part := StringOfChar('0', zfirst_len - first_len) + first_part;
zsecond_part := StringOfChar('0', zsecond_len - second_len) + second_part;
// Copy adjusted data back to local_source }
local_source := zfirst_part;
if zsecond_len <> 0 then
local_source := local_source + '+' + zsecond_part;
end;
function eanx(ASymbol: PZintSymbol; const ASource: String): integer;
var
i, p: Integer;
src_len: Integer;
local_source: String = '';
first_part, second_part: String;
dest: String = '';
with_addon: Boolean;
begin
src_len := Length(ASource);
if (src_len > 19) then
begin
ASymbol^.SetErrorText('Input too long');
Result := ERROR_TOO_LONG;
Exit;
end;
if (ASymbol^.symbology <> BARCODE_ISBNX) then
begin
{ ISBN has it's own checking routine }
Result := is_sane('0123456789+', ASource);
if (Result = ERROR_INVALID_DATA) then
begin
ASymbol^.SetErrorText('Invalid characters in data');
exit;
end;
end else
begin
Result := is_sane('0123456789Xx+', ASource);
if (Result = ERROR_INVALID_DATA) then
begin
ASymbol^.SetErrorText('Invalid characters in input');
exit;
end;
end;
// Add leading zeroes
ean_leading_zeroes(ASymbol, ASource, local_source);
if (ASymbol^.symbology = BARCODE_ISBNX) then
local_source := Uppercase(local_source);
// Split string to parts before and after '+' parts}
p := pos('+', local_source);
with_addon := p > 0;
if with_addon then
begin
first_part := copy(local_source, 1, p - 1);
second_part := copy(local_source, p + 1);
end else
begin
first_part := local_source;
second_part := '';
end;
case ASymbol^.symbology of
BARCODE_EANX:
case Length(first_part) of
2: begin // EAN-2
add_on(first_part, dest, 0);
ASymbol^.SetText(first_part);
end;
5: begin // EAN-5
add_on(first_part, dest, 0);
ASymbol^.SetText(first_part);
end;
7: ean8(ASymbol, first_part, dest);
12: ean13(ASymbol, first_part, dest);
else
ASymbol^.SetErrorText('Invalid input length');
Result := ERROR_TOO_LONG;
exit;
end;
BARCODE_EANX_CC:
case Length(first_part) of
// Adds vertical separator bars according to ISO/IEC 24723 section 11.4
7: begin
set_module(ASymbol, ASymbol^.rows, 1);
set_module(ASymbol, ASymbol^.rows, 67);
set_module(ASymbol, ASymbol^.rows + 1, 0);
set_module(ASymbol, ASymbol^.rows + 1, 68);
set_module(ASymbol, ASymbol^.rows + 2, 1);
set_module(ASymbol, ASymbol^.rows + 1, 67);
ASymbol^.row_height[ASymbol^.rows] := 2;
ASymbol^.row_height[ASymbol^.rows + 1] := 2;
ASymbol^.row_height[ASymbol^.rows + 2] := 2;
Inc(ASymbol^.rows, 3);
ean8(ASymbol, first_part, dest);
end;
12: begin
set_module(ASymbol, ASymbol^.rows, 1);
set_module(ASymbol, ASymbol^.rows, 95);
set_module(ASymbol, ASymbol^.rows + 1, 0);
set_module(ASymbol, ASymbol^.rows + 1, 96);
set_module(ASymbol, ASymbol^.rows + 2, 1);
set_module(ASymbol, ASymbol^.rows + 2, 95);
ASymbol^.row_height[ASymbol^.rows] := 2;
ASymbol^.row_height[ASymbol^.rows + 1] := 2;
ASymbol^.row_height[ASymbol^.rows + 2] := 2;
Inc(ASymbol^.rows, 3);
ean13(ASymbol, first_part, dest);
end;
else
ASymbol^.SetErrorText('Invalid EAN input length');
Result := ERROR_TOO_LONG;
exit;
end;
BARCODE_UPCA:
if Length(first_part) = 11 then
upca(ASymbol, first_part, dest)
else
begin
ASymbol^.SetErrorText('Wrong input length');
Result := ERROR_TOO_LONG;
Exit;
end;
BARCODE_UPCA_CC:
if Length(first_part) = 11 then
begin
set_module(ASymbol, ASymbol^.rows, 1);
set_module(ASymbol, ASymbol^.rows, 95);
set_module(ASymbol, ASymbol^.rows + 1, 0);
set_module(ASymbol, ASymbol^.rows + 1, 96);
set_module(ASymbol, ASymbol^.rows + 2, 1);
set_module(ASymbol, ASymbol^.rows + 2, 95);
ASymbol^.row_height[ASymbol^.rows] := 2;
ASymbol^.row_height[ASymbol^.rows + 1] := 2;
ASymbol^.row_height[ASymbol^.rows + 2] := 2;
Inc(ASymbol^.rows, 3);
upca(ASymbol, first_part, dest);
end
else
begin
ASymbol^.SetErrorText('Wrong UPC-A input length');
Result := ERROR_TOO_LONG;
Exit;
end;
BARCODE_UPCE:
if Length(first_part) in [6, 7] then
upce(ASymbol, first_part, dest)
else
begin
ASymbol^.SetErrorText('Input wrong length');
Result := ERROR_TOO_LONG;
Exit;
end;
BARCODE_UPCE_CC:
if Length(first_part) in [6, 7] then
begin
set_module(ASymbol, ASymbol^.rows, 1);
set_module(ASymbol, ASymbol^.rows, 51);
set_module(ASymbol, ASymbol^.rows + 1, 0);
set_module(ASymbol, ASymbol^.rows + 1, 52);
set_module(ASymbol, ASymbol^.rows + 2, 1);
set_module(ASymbol, ASymbol^.rows + 2, 51);
ASymbol^.row_height[ASymbol^.rows] := 2;
ASymbol^.row_height[ASymbol^.rows + 1] := 2;
ASymbol^.row_height[ASymbol^.rows + 2] := 2;
Inc(ASymbol^.rows, 3);
upce(ASymbol, first_part, dest);
end
else
begin
ASymbol^.SetErrorText('Wrong UPC-E input length');
Result := ERROR_TOO_LONG;
Exit;
end;
BARCODE_ISBNX:
begin
Result := isbn(ASymbol, first_part, dest);
if (Result > 4) then
Exit;
end;
end;
case Length(second_part) of
0: ;
2: begin
add_on(second_part, dest, 1);
ASymbol^.SetText(ASymbol^.GetText + '+' + second_part);
end;
5: begin
add_on(second_part, dest, 1);
ASymbol^.SetText(ASymbol^.GetText + '+' + second_part);
end;
else
ASymbol^.SetErrorText('Invalid length input');
Result := ERROR_TOO_LONG;
Exit;
end;
expand(ASymbol, dest);
case ASymbol^.symbology of
BARCODE_EANX_CC,
BARCODE_UPCA_CC,
BARCODE_UPCE_CC:
begin
{ shift the symbol to the right one space to allow for separator bars }
for i := (ASymbol^.width + 1) downto 1 do
begin
if module_is_set(ASymbol, ASymbol^.rows - 1, i - 1) then
set_module(ASymbol, ASymbol^.rows - 1, i)
else
unset_module(ASymbol, ASymbol^.rows - 1, i);
end;
unset_module(ASymbol, ASymbol^.rows - 1, 0);
Inc(ASymbol^.width, 2);
end;
end;
if (Result = 0) and (ASymbol^.GetErrorText <> '') and (ASymbol^.GetErrorText[1] = 'w') then
Result := 1; { flag UPC-E warnings }
end;
end.

10
components/lazbarcodes/src/tbarcodeaztec.lrs
View File

@ -1,10 +0,0 @@
LazarusResources.Add('tbarcodeaztec','PNG',[
#137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#21#0#0#0#21#8#2#0#0#0'&u2'#193#0#0
+#0#146'IDATx'#156#165#145#11#10#128'0'#12'C{'#255'K+'#226#152#237'kR'#17#3
+#142#209#207#242'1'#142#127#136#235#139'u'#222#216#21'\P\g'#30#202'sv'#161'r'
+#8#182#168#0#1'u'#201#134'4'#146'_'#164#255#238#211'9'#167#216#238'y'#6'_A<'
+#210#237#148'b'#31#26'R'#212#254#231#228'dK'#235#135#194#225'd~'#162#161#248
+#179#199#226#31'>'#157#255#137#31'l.'#127'J'#19#165#17'4'#229#168#228#14'Z/'
+#250'e'#28'Z'#255#158#176'>'#235#254'3'#211#151'K'#219#252#11#193#223'5;]'
+#165#168#226#251#128#19#236#248#12#31'X'#10'[q'#0#0#0#0'IEND'#174'B`'#130
]);

8
components/lazbarcodes/src/tbarcodeaztecrune.lrs
View File

@ -1,8 +0,0 @@
LazarusResources.Add('tbarcodeaztecrune','PNG',[
#137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#21#0#0#0#21#8#2#0#0#0'&u2'#193#0#0
+#0'QIDATx'#156#189#148'I'#14#0' '#8#3#249#255#167#245#214#152#176#148'Hu'#142
+#208'!p'#193#214#12#211#248#230'@='#214#16#200'|'#202#27#159#31#28#250'h'#212
+#187#156'1'#169'_$'#178#233'R'#223'''P'#28#249#180#251#204#15#249#226#215#16
+#191#143#218#239#224#15#20#253#159'k6'#235#244#3'('#147#160'.|'#0#0#0#0'IEND'
+#174'B`'#130
]);

10
components/lazbarcodes/src/tbarcodedatamatrix.lrs
View File

@ -1,10 +0,0 @@
LazarusResources.Add('tbarcodedatamatrix','PNG',[
#137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#21#0#0#0#21#8#2#0#0#0'&u2'#193#0#0
+#0#132'IDATx'#156#165#146#11#10#128'0'#12'C{'#255'KO'#196#129'5'#191'!'#13'8'
+':'#182#152#246'i'#173#153#234'~*'#173#135#163#190'y'#234'ns'#219#183#128#156
+#174#254'Rw'#138#7#178#29#167#143#31#156'0'#142#13#176#131#197#201'u>gB/P'#8
+#191#228#23#16'j?S'#228#238','#127#246#232'd'#200#31#249'a'#21#156'I'#130#159
+#196#230'p'#166'|'#219'-'#255#26#1'o'#230#130#249#185#17#6#132#243#243#189'#'
+#203#244#253#224#30#143#169#243#127'i'#251''''#186#0#208#138#166'v0'#27'oM'#0
+#0#0#0'IEND'#174'B`'#130
]);

10
components/lazbarcodes/src/tbarcodemicroqr.lrs
View File

@ -1,10 +0,0 @@
LazarusResources.Add('tbarcodemicroqr','PNG',[
#137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#21#0#0#0#21#8#2#0#0#0'&u2'#193#0#0
+#0#137'IDATx'#156#181#145#139#10#128'0'#8'E'#253#255#159'^D'#209#244'>'#28
+#163#18#138#161'^'#31#199#24#239','#206#207#216#21#130'?:s'#160#20#142'Y'#26
+'z'#148'Z'#144#202#25'O'#185#236#153'i'#189#30'4b'#192#127#245#240#200'[l'
+#243#3#10'E'#223#220'O'#234#11#191#222#220'E'#238'(o'#200#171'.'#248#201#152
+';'#7'f'#230#152#235#198#3#174#251#243#170'0'#151#237#207#8#154#1#245#229'%'
+#209'A'#128'?'#210'3'#213'F,'#248'3'#30#30#164#211'K`'#2'u'#245#216#253#183
+#236#0#242#191#30#13'!j_/'#0#0#0#0'IEND'#174'B`'#130
]);

10
components/lazbarcodes/src/tbarcodeqr.lrs
View File

@ -1,10 +0,0 @@
LazarusResources.Add('TBarcodeQR','PNG',[
#137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#21#0#0#0#21#8#2#0#0#0'&u2'#193#0#0
+#0#142'IDATx'#156#165#147#1#10#128'0'#12#3#253#255#167'''"L'#151'\2'#193#130
+'"k'#218'&'#233'<'#198#191'8'#174#199#194#15'#'#236'N,-_h'#249#0#24#22'L'#196
+'<L'#176'M='#20#164'z'#231'/'#169#198#31#221#242'7'#251#199#139'Yq'#17'&>'
+#149'm'#137#151':'#223#167#185#249#172'_lK'#132'y;'#146#198'^'#133'H'#219#127
+'j'#202#243#157'm'#241#255#233'2'#200#234#164#194#137'l'#238#159#162#189'{'
+#215#191#141#252'c'#216']`Q'#157#191'k'#225#253#185#127#238'%'#187#251']*'
+#198#9'Nm'#27#16' W'#213#132#0#0#0#0'IEND'#174'B`'#130
]);

3443
components/lazbarcodes/src/ubarcodes.pas
View File

File diff suppressed because it is too large Load Diff

345
components/lazbarcodes/src/udrawers.pas Normal file
View File

@ -0,0 +1,345 @@
unit udrawers;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Graphics, Forms;
type
{ TBasicBarcodeDrawer }
TBasicBarcodeDrawer = class
private
FBackColor: TColor;
FBarColor: TColor;
FTextColor: TColor;
FFontName: String;
FFontSize: Integer;
FFontStyle: TFontStyles;
FWidth: Double;
FHeight: Double;
public
constructor Create(AWidth, AHeight: Double);
procedure BeginDrawing; virtual; abstract;
procedure EndDrawing; virtual; abstract;
procedure DrawBar(x1, y1, x2, y2: Double); virtual; abstract;
procedure DrawCenteredText(x, y: Double; const AText: String); virtual; abstract;
property BackColor: TColor read FBackColor write FBackColor;
property BarColor: TColor read FBarColor write FBarColor;
property TextColor: TColor read FTextColor write FTextColor;
property FontName: String read FFontName write FFontName;
property FontSize: Integer read FFontSize write FFontSize;
property FontStyle: TFontStyles read FFontStyle write FFontStyle;
property Width: Double read FWidth;
property Height: Double read FHeight;
end;
{ TCanvasBarcodeDrawer }
TCanvasBarcodeDrawer = class(TBasicBarcodeDrawer)
private
FCanvas: TCanvas;
protected
property Canvas: TCanvas read FCanvas;
public
constructor Create(ACanvas: TCanvas; AWidth, AHeight: Double);
procedure BeginDrawing; override;
procedure EndDrawing; override;
procedure DrawBar(x1, y1, x2, y2: double); override;
procedure DrawCenteredText(x, y: double; const AText: String); override;
end;
{ TTextBarcodeDrawer }
TTextBarcodeDrawer = class(TBasicBarcodeDrawer)
protected
FList: TStrings;
FTitle: String;
FFormatSettings: TFormatSettings;
public
constructor Create(AWidth, AHeight: Double; const ATitle: String);
destructor Destroy; override;
procedure SaveToFile(const AFileName: String);
procedure SaveToStream(const AStream: TStream);
end;
{ TSvgBarcodeDrawer }
TSvgBarcodeDrawer = class(TTextBarcodeDrawer)
private
function SvgColor(AColor: TColor): String;
public
procedure BeginDrawing; override;
procedure EndDrawing; override;
procedure DrawBar(x1, y1, x2, y2: double); override;
procedure DrawCenteredText(x, y: double; const AText: String); override;
end;
{ TEpsBarcodeDrawer }
TEpsBarcodeDrawer = class(TTextBarcodeDrawer)
private
FStoredColor: TColor;
procedure EpsColor(AColor: TColor; out R,G,B: Double);
public
procedure BeginDrawing; override;
procedure EndDrawing; override;
procedure DrawBar(x1, y1, x2, y2: Double); override;
procedure DrawCenteredText(x, y: Double; const AText: String); override;
end;
implementation
{ TBasicBarcodeDrawer }
constructor TBasicBarcodeDrawer.Create(AWidth, AHeight: Double);
begin
inherited Create;
FWidth := AWidth;
FHeight := AHeight;
FBarColor := clBlack;
FTextColor := clBlack;
FFontName := Screen.MenuFont.Name;
FFontSize := 10;
FFontStyle := [];
end;
{ TCanvasBarcodeDrawer }
constructor TCanvasBarcodeDrawer.Create(ACanvas: TCanvas; AWidth, AHeight: Double);
begin
inherited Create(AWidth, AHeight);
FCanvas := ACanvas;
end;
// Fill the background
procedure TCanvasBarcodeDrawer.BeginDrawing;
begin
FCanvas.Brush.Color := FBackColor;
FCanvas.Brush.Style := bsSolid;
FCanvas.FillRect(0, 0, round(FWidth), round(FHeight));
end;
procedure TCanvasBarcodeDrawer.EndDrawing;
begin
// Nothing to do in this drawer
end;
procedure TCanvasBarcodeDrawer.DrawBar(x1, y1, x2, y2: double);
begin
FCanvas.Brush.Color := FBarColor;
FCanvas.Brush.Style := bsSolid;
FCanvas.FillRect(round(x1), round(y1), round(x2), round(y2));
end;
procedure TCanvasBarcodeDrawer.DrawCenteredText(x, y: double; const AText: String);
var
w: Integer;
begin
FCanvas.Font.Name := FFontName;
FCanvas.Font.Size := FFontSize;
FCanvas.Font.Style := FFontStyle;
FCanvas.Font.Color := FTextColor;
FCanvas.Brush.Style := bsClear;
w := FCanvas.TextWidth(AText);
FCanvas.TextOut(round(x - w/2), round(y), AText);
end;
{ TTextBarcodeDrawer }
constructor TTextBarcodeDrawer.Create(AWidth, AHeight: Double; const ATitle: String);
begin
inherited Create(AWidth, AHeight);
FTitle := ATitle;
FList := TStringList.Create;
FFormatSettings := DefaultFormatSettings;
FFormatSettings.DecimalSeparator := '.';
end;
destructor TTextBarcodeDrawer.Destroy;
begin
FList.Free;
inherited;
end;
procedure TTextBarcodeDrawer.SaveToFile(const AFileName: String);
begin
FList.SaveToFile(AFileName);
end;
procedure TTextBarcodeDrawer.SaveToStream(const AStream: TStream);
begin
FList.SaveToStream(AStream);
end;
{ TSvgBarcodeDrawer
Units are millimeters. }
procedure TSvgBarcodeDrawer.BeginDrawing;
begin
// svg header
FList.Add(
'<?xml version="1.0" standalone="no"?>'
);
FList.Add(
'<!DOCTYPE svg PUBLIC "-//W3C/DTD SVG 1.1/EN" "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">'
);
FList.Add(Format(
'<svg width="%.3fmm" height="%.3fmm" version="1.1" xmlns="http://www.w3.org/2000/svg">', [
FWidth, FHeight],
FFormatSettings
));
if FTitle <> '' then
FList.Add(' <desc>%s</desc>', [FTitle])
else
FList.Add(' <desc>Symbol generated by LazBarcodes</desc>');
// Background
FList.Add(
' <rect width="100%%" height="100%%" fill="#%s"/>', [SvgColor(FBackColor)]);
// Begin group for symbol and text
FList.Add(
' <g id="barcode">');
end;
procedure TSvgBarcodeDrawer.EndDrawing;
begin
FList.Add(' </g>');
FList.Add('</svg>');
end;
procedure TSvgBarcodeDrawer.DrawBar(x1, y1, x2, y2: Double);
begin
FList.Add(Format(
' <rect x="%.3fmm" y="%.3fmm" width="%.3fmm" height="%.3fmm" fill="#%s" />', [
x1, y1, x2-x1, y2-y1, SvgColor(FBarColor)],
FFormatSettings
));
end;
procedure TSvgBarcodeDrawer.DrawCenteredText(x, y: Double; const AText: String);
begin
// Move the text start point by a font height because svg vertical position
// refers to the font baseline while LCL refers to the top.
y := y + FFontSize / 72 * 25.4; // Convert Fontsize (pts) to mm
FList.Add(Format(
' <text x="%.3fmm" y="%.3fmm" text-anchor="middle" font-family="%s" font-size="%.1fpt" fill="#%s">%s</text>', [
x, y, FFontName, 1.0*FFontSize, SvgColor(FTextColor), AText],
FFormatSettings
));
end;
function TSvgBarcodeDrawer.SvgColor(AColor: TColor): String;
type
TRgb = packed record
R, G, B: Byte;
end;
var
rgb: TRgb absolute AColor;
begin
Result := Format('%.2x%.2x%.2x', [rgb.R, rgb.G, rgb.B]);
end;
{ TEpsBarcodeDrawer
Units are poins (1 pt = 1/72 inch)
Check generated eps files with https://www.fviewer.com/de/view-eps. }
procedure TEpsBarcodeDrawer.BeginDrawing;
var
R, G, B: Double;
begin
// Start writing the header
FList.Add('%!PS-Adobe-3.0 EPSF-3.0');
FList.Add('%%Creator: LazBarcodes');
if FTitle <> '' then
FList.Add('%%%%Title: %s', [FTitle])
else
FList.Add('%%Title: Symbol generated by LazBarcodes');
FList.Add('%%Pages: 1');
FList.Add(Format('%%%%BoundingBox: 0 0 %.2f %.2f', [FWidth, FHeight], FFormatSettings));
FList.Add('%%EndComments');
// Background
EpsColor(FBackColor, R,G,B);
FList.Add(Format('%.2f %.2f %.2f setrgbcolor', [R, G, B], FFormatSettings));
FList.Add(Format('%.2f %.2f %.2f %.2f rectfill', [0.0, 0.0, 1.0*FWidth, 1.0*FHeight], FFormatSettings));
// Set bar color
EpsColor(FBarColor, R,G,B);
FList.Add(Format('%.2f %.2f %.2f setrgbcolor', [R, G, B], FFormatSettings));
FStoredColor := FBarColor;
// Set font
// Todo: Find out how the real font name can be used. Most of the Windows
// fonts are not accepted.
FList.Add(Format('/mainfont /%s findfont %.2f scalefont def', ['Helvetica', 1.0*FFontSize], FFormatSettings));
Flist.Add('mainfont setfont');
end;
procedure TEpsBarcodeDrawer.EndDrawing;
begin
FList.Add('');
FList.Add('showpage');
end;
procedure TEpsBarcodeDrawer.DrawBar(x1, y1, x2, y2: Double);
var
R, G, B: Double;
begin
if FStoredColor <> FBarColor then
begin
EpsColor(FBarColor, R,G,B);
FList.Add(Format('%.2f %.2f %.2f setrgbcolor', [R, G, B], FFormatSettings));
FStoredColor := FBarColor;
end;
FList.Add(Format('%0:.2f %1:.2f moveto %0:.2f %2:.2f lineto %3:.2f setlinewidth stroke',
[(x1 + x2) / 2, FHeight-y1, FHeight-y2, abs(x2 - x1)], FFormatSettings));
end;
procedure TEpsBarcodeDrawer.DrawCenteredText(x, y: Double; const AText: String);
var
R, G, B: Double;
begin
if FStoredColor <> FTextColor then
begin
EpsColor(FTextColor, R,G,B);
FList.Add(Format('%.2f %.2f %.2f setrgbcolor', [R, G, B], FFormatSettings));
FStoredColor := FTextColor;
end;
FList.Add(Format('%.2f %.2f moveto', [x, FHeight-y], FFormatSettings));
FList.Add(Format('(%s) dup stringwidth pop 2 div neg -%.2f rmoveto show', [AText, 1.0*FFontSize], FFormatSettings));
end;
procedure TEpsBarcodeDrawer.EpsColor(AColor: TColor; out R,G,B: Double);
type
TRgb = packed record
R, G, B: Byte;
end;
var
rgb: TRgb absolute AColor;
begin
R := rgb.R / 255;
G := rgb.G / 255;
B := rgb.B / 255;
end;
end.

457
components/lazbarcodes/src/zint.pp
View File

@ -9,6 +9,8 @@ interface
} }
{$IFDEF FPC} {$IFDEF FPC}
{$MODE objfpc}{$H+}
{$MODESWITCH AdvancedRecords}
//{$PACKRECORDS C} //{$PACKRECORDS C}
{$ENDIF} {$ENDIF}
@ -43,214 +45,291 @@ interface
SUCH DAMAGE. SUCH DAMAGE.
} }
{$ifndef ZINT_H} type
{$define ZINT_H} { Pointer to line }
{ C++ extern C conditionnal removed }
{ __cplusplus }
{ Pointer to next line }
type
PointerTo_zint_render_line=^zint_render_line; PointerTo_zint_render_line=^zint_render_line;
PointerTo_PointerTo_zint_render_line=^PointerTo_zint_render_line; PointerTo_PointerTo_zint_render_line=^PointerTo_zint_render_line;
zint_render_line = record zint_render_line = record
x : single; x : single;
y : single; y : single;
length : single; length : single;
width : single; width : single;
next : PointerTo_zint_render_line; // ^zint_render_line; next : PointerTo_zint_render_line; // Pointer to next line;
end; end;
PZintRenderLine = ^zint_render_line;
PPZintRenderLine = ^PZintRenderLine;
{ Suggested string width, may be 0 if none recommended } { Suggested string width, may be 0 if none recommended }
{ Pointer to next character } { Pointer to character }
PointerTo_zint_render_string=^zint_render_string; PointerTo_zint_render_string=^zint_render_string;
PointerTo_PointerTo_zint_render_string=^PointerTo_zint_render_string; PointerTo_PointerTo_zint_render_string=^PointerTo_zint_render_string;
zint_render_string = record zint_render_string = record
x : single; x : single;
y : single; y : single;
fsize : single; fsize : single;
width : single; width : single; // Suggested string width, may be 0 if none recommended
length : longint; length : longint;
text : ^byte; text : ^byte;
next : PointerTo_zint_render_string; // ^zint_render_string; next : PointerTo_zint_render_string; // Pointer to next character
end; end;
PZintRenderString = ^zint_render_string;
PPZintRenderString = ^PZintRenderString;
{ Pointer to next ring } { Pointer to ring }
PointerTo_zint_render_ring=^zint_render_ring; PointerTo_zint_render_ring=^zint_render_ring;
PointerTo_PointerTo_zint_render_ring=^PointerTo_zint_render_ring; PointerTo_PointerTo_zint_render_ring=^PointerTo_zint_render_ring;
zint_render_ring = record zint_render_ring = record
x : single; x : single;
y : single; y : single;
radius : single; radius : single;
line_width : single; line_width : single;
next : PointerTo_zint_render_ring; // ^zint_render_ring; next : PointerTo_zint_render_ring; // Pointer to next ring
end; end;
{ Pointer to next hexagon } { Pointer to hexagon }
PointerTo_zint_render_hexagon=^zint_render_hexagon; PointerTo_zint_render_hexagon=^zint_render_hexagon;
PointerTo_PointerTo_zint_render_hexagon=^PointerTo_zint_render_hexagon; PointerTo_PointerTo_zint_render_hexagon=^PointerTo_zint_render_hexagon;
zint_render_hexagon = record zint_render_hexagon = record
x : single; x : single;
y : single; y : single;
next : PointerTo_zint_render_hexagon; // ^zint_render_hexagon; next : PointerTo_zint_render_hexagon; // ^Pointer to next hexagon;
end; end;
{ Pointer to first line }
{ Pointer to first string }
{ Pointer to first ring }
{ Pointer to first hexagon }
PointerTo_zint_render=^zint_render; PointerTo_zint_render=^zint_render;
zint_render = record zint_render = record
width : single; width : single;
height : single; height : single;
lines : ^zint_render_line; lines : ^zint_render_line; // Pointer to first line
strings : ^zint_render_string; strings : ^zint_render_string; // Pointer to first string
rings : ^zint_render_ring; rings : ^zint_render_ring; // Pointer to first ring
hexagons : ^zint_render_hexagon; hexagons : ^zint_render_hexagon; // Pointer to first hexagon
end; // added by wp
exact_width: single; // exact width of symbol after rendering. symbol^.width may be wrong...
exact_height: single; // height of symbol after rendering.
scale: single; // scale factor used for rendering
end;
PZintRender = ^zint_render;
{ Largest symbol is 177x177 QR Code } const
zint_symbol = record ZINT_ROWS_MAX = 178;
symbology : longint; ZINT_COLS_MAX = 178;
height : longint; GL_CONST = 2.8346; // = 72 / 25.4 --> conversion pixels to mm
whitespace_width : longint;
border_width : longint; type
output_options : longint; TColorChars = array[0..9] of char;
fgcolour : array[0..9] of char;
bgcolour : array[0..9] of char; PointerTo_zint_symbol = ^zint_symbol;
outfile : array[0..255] of char; zint_symbol = record
scale : single; symbology : longint;
option_1 : longint; height : longint;
option_2 : longint; whitespace_width : longint;
option_3 : longint; border_width : longint;
show_hrt : longint; output_options : longint;
input_mode : longint; fgcolour : TColorChars;
text : array[0..127] of byte; bgcolour : TColorChars;
rows : longint; outfile : array[0..255] of char;
width : longint; scale : single;
primary : array[0..127] of char; option_1 : longint;
encoded_data : array[0..177] of array[0..142] of byte; option_2 : longint;
row_height : array[0..177] of longint; option_3 : longint;
errtxt : array[0..99] of char; option : longint; // added by wp
bitmap : ^char; show_hrt : longint;
bitmap_width : longint; input_mode : longint;
bitmap_height : longint; text : array[0..127] of byte;
rendered : ^zint_render; rows : longint;
end; width : longint;
primary : array[0..127] of char;
encoded_data : array[0..ZINT_ROWS_MAX-1] of bitpacked array[0..ZINT_COLS_MAX-1] of boolean; // wp: changed to bitpacked
row_height : array[0..ZINT_ROWS_MAX-1] of longint; // Largest symbol is 177x177 QR Code
errtxt : array[0..99] of char;
bitmap : ^char;
bitmap_width : longint;
bitmap_height : longint;
rendered : ^zint_render;
// added by wp
font_height: integer;
function GetText: String;
procedure SetText(const AText: String);
function GetErrorText: String;
procedure SetErrorText(const AErrTxt: String);
end;
PZintSymbol = ^zint_symbol;
PointerTo_zint_symbol=^zint_symbol; TCharDynArray = array of char;
const
{ Tbarcode 7 codes } { Tbarcode 7 codes }
BARCODE_CODE11 = 1;
const BARCODE_C25MATRIX = 2;
BARCODE_CODE11 = 1; BARCODE_C25INTER = 3;
BARCODE_C25MATRIX = 2; BARCODE_C25IATA = 4;
BARCODE_C25INTER = 3; BARCODE_C25LOGIC = 6;
BARCODE_C25IATA = 4; BARCODE_C25IND = 7;
BARCODE_C25LOGIC = 6; BARCODE_CODE39 = 8;
BARCODE_C25IND = 7; BARCODE_EXCODE39 = 9;
BARCODE_CODE39 = 8; BARCODE_EANX = 13;
BARCODE_EXCODE39 = 9; BARCODE_EAN128 = 16;
BARCODE_EANX = 13; BARCODE_CODABAR = 18;
BARCODE_EAN128 = 16; BARCODE_CODE128 = 20;
BARCODE_CODABAR = 18; BARCODE_DPLEIT = 21;
BARCODE_CODE128 = 20; BARCODE_DPIDENT = 22;
BARCODE_DPLEIT = 21; BARCODE_CODE16K = 23;
BARCODE_DPIDENT = 22; BARCODE_CODE49 = 24;
BARCODE_CODE16K = 23; BARCODE_CODE93 = 25;
BARCODE_CODE49 = 24; BARCODE_FLAT = 28;
BARCODE_CODE93 = 25; BARCODE_RSS14 = 29;
BARCODE_FLAT = 28; BARCODE_RSS_LTD = 30;
BARCODE_RSS14 = 29; BARCODE_RSS_EXP = 31;
BARCODE_RSS_LTD = 30; BARCODE_TELEPEN = 32;
BARCODE_RSS_EXP = 31; BARCODE_UPCA = 34;
BARCODE_TELEPEN = 32; BARCODE_UPCE = 37;
BARCODE_UPCA = 34; BARCODE_POSTNET = 40;
BARCODE_UPCE = 37; BARCODE_MSI_PLESSEY = 47;
BARCODE_POSTNET = 40; BARCODE_FIM = 49;
BARCODE_MSI_PLESSEY = 47; BARCODE_LOGMARS = 50;
BARCODE_FIM = 49; BARCODE_PHARMA = 51;
BARCODE_LOGMARS = 50; BARCODE_PZN = 52;
BARCODE_PHARMA = 51; BARCODE_PHARMA_TWO = 53;
BARCODE_PZN = 52; BARCODE_PDF417 = 55;
BARCODE_PHARMA_TWO = 53; BARCODE_PDF417TRUNC = 56;
BARCODE_PDF417 = 55; BARCODE_MAXICODE = 57;
BARCODE_PDF417TRUNC = 56; BARCODE_QRCODE = 58;
BARCODE_MAXICODE = 57; BARCODE_CODE128B = 60;
BARCODE_QRCODE = 58; BARCODE_AUSPOST = 63;
BARCODE_CODE128B = 60; BARCODE_AUSREPLY = 66;
BARCODE_AUSPOST = 63; BARCODE_AUSROUTE = 67;
BARCODE_AUSREPLY = 66; BARCODE_AUSREDIRECT = 68;
BARCODE_AUSROUTE = 67; BARCODE_ISBNX = 69;
BARCODE_AUSREDIRECT = 68; BARCODE_RM4SCC = 70;
BARCODE_ISBNX = 69; BARCODE_DATAMATRIX = 71;
BARCODE_RM4SCC = 70; BARCODE_EAN14 = 72;
BARCODE_DATAMATRIX = 71; BARCODE_CODABLOCKF = 74;
BARCODE_EAN14 = 72; BARCODE_NVE18 = 75;
BARCODE_CODABLOCKF = 74; BARCODE_JAPANPOST = 76;
BARCODE_NVE18 = 75; BARCODE_KOREAPOST = 77;
BARCODE_JAPANPOST = 76; BARCODE_RSS14STACK = 79;
BARCODE_KOREAPOST = 77; BARCODE_RSS14STACK_OMNI = 80;
BARCODE_RSS14STACK = 79; BARCODE_RSS_EXPSTACK = 81;
BARCODE_RSS14STACK_OMNI = 80; BARCODE_PLANET = 82;
BARCODE_RSS_EXPSTACK = 81; BARCODE_MICROPDF417 = 84;
BARCODE_PLANET = 82; BARCODE_ONECODE = 85;
BARCODE_MICROPDF417 = 84; BARCODE_PLESSEY = 86;
BARCODE_ONECODE = 85;
BARCODE_PLESSEY = 86; // Tbarcode 8 codes
{ Tbarcode 8 codes } BARCODE_TELEPEN_NUM = 87;
BARCODE_TELEPEN_NUM = 87; BARCODE_ITF14 = 89;
BARCODE_ITF14 = 89; BARCODE_KIX = 90;
BARCODE_KIX = 90; BARCODE_AZTEC = 92;
BARCODE_AZTEC = 92; BARCODE_DAFT = 93;
BARCODE_DAFT = 93; BARCODE_MICROQR = 97;
BARCODE_MICROQR = 97;
{ Tbarcode 9 codes } // Tbarcode 9 codes
BARCODE_HIBC_128 = 98; BARCODE_HIBC_128 = 98;
BARCODE_HIBC_39 = 99; BARCODE_HIBC_39 = 99;
BARCODE_HIBC_DM = 102; BARCODE_HIBC_DM = 102;
BARCODE_HIBC_QR = 104; BARCODE_HIBC_QR = 104;
BARCODE_HIBC_PDF = 106; BARCODE_HIBC_PDF = 106;
BARCODE_HIBC_MICPDF = 108; BARCODE_HIBC_MICPDF = 108;
BARCODE_HIBC_BLOCKF = 110; BARCODE_HIBC_BLOCKF = 110;
BARCODE_HIBC_AZTEC = 112; BARCODE_HIBC_AZTEC = 112;
{ Zint specific }
BARCODE_AZRUNE = 128; // Zint specific
BARCODE_CODE32 = 129; BARCODE_AZRUNE = 128;
BARCODE_EANX_CC = 130; BARCODE_CODE32 = 129;
BARCODE_EAN128_CC = 131; BARCODE_EANX_CC = 130;
BARCODE_RSS14_CC = 132; BARCODE_EAN128_CC = 131;
BARCODE_RSS_LTD_CC = 133; BARCODE_RSS14_CC = 132;
BARCODE_RSS_EXP_CC = 134; BARCODE_RSS_LTD_CC = 133;
BARCODE_UPCA_CC = 135; BARCODE_RSS_EXP_CC = 134;
BARCODE_UPCE_CC = 136; BARCODE_UPCA_CC = 135;
BARCODE_RSS14STACK_CC = 137; BARCODE_UPCE_CC = 136;
BARCODE_RSS14_OMNI_CC = 138; BARCODE_RSS14STACK_CC = 137;
BARCODE_RSS_EXPSTACK_CC = 139; BARCODE_RSS14_OMNI_CC = 138;
BARCODE_CHANNEL = 140; BARCODE_RSS_EXPSTACK_CC = 139;
BARCODE_CODEONE = 141; BARCODE_CHANNEL = 140;
BARCODE_GRIDMATRIX = 142; BARCODE_CODEONE = 141;
BARCODE_NO_ASCII = 1; BARCODE_GRIDMATRIX = 142;
BARCODE_BIND = 2;
BARCODE_BOX = 4; BARCODE_NO_ASCII = 1;
BARCODE_STDOUT = 8; BARCODE_BIND = 2;
READER_INIT = 16; BARCODE_BOX = 4;
SMALL_TEXT = 32; BARCODE_STDOUT = 8;
DATA_MODE = 0; READER_INIT = 16;
UNICODE_MODE = 1; SMALL_TEXT = 32;
GS1_MODE = 2;
KANJI_MODE = 3; DATA_MODE = 0;
SJIS_MODE = 4; UNICODE_MODE = 1;
DM_SQUARE = 100; GS1_MODE = 2;
WARN_INVALID_OPTION = 2; KANJI_MODE = 3;
ERROR_TOO_LONG = 5; SJIS_MODE = 4;
ERROR_INVALID_DATA = 6;
ERROR_INVALID_CHECK = 7; DM_SQUARE = 100;
ERROR_INVALID_OPTION = 8;
ERROR_ENCODING_PROBLEM = 9; WARN_INVALID_OPTION = 2;
ERROR_FILE_ACCESS = 10; ERROR_TOO_LONG = 5;
ERROR_MEMORY = 11; ERROR_INVALID_DATA = 6;
{$ENDIF} ERROR_INVALID_CHECK = 7;
ERROR_INVALID_OPTION = 8;
ERROR_ENCODING_PROBLEM = 9;
ERROR_FILE_ACCESS = 10;
ERROR_MEMORY = 11;
implementation implementation
function zint_symbol.GetErrorText: String;
var
i: Integer;
begin
Result := '';
SetLength(Result, 100);
for i := 0 to 99 do
begin
if errtxt[i] = #0 then
begin
SetLength(Result, i);
exit;
end;
Result[i+1] := errtxt[i];
end;
end;
function zint_symbol.GetText: String;
var
i: Integer;
begin
Result := '';
SetLength(Result, 128);
for i := 0 to 127 do
begin
if text[i] = 0 then
begin
SetLength(Result, i);
exit;
end;
Result[i+1] := char(text[i]);
end;
end;
procedure zint_symbol.SetErrorText(const AErrTxt: String);
var
i, n: Integer;
begin
n := Length(AErrTxt);
if n > 100 then n := 100;
FillChar(errtxt, 100, 0);
for i := 1 to n do
errtxt[i-1] := AErrTxt[i];
end;
procedure zint_symbol.SetText(const AText: String);
var
i, n: Integer;
begin
n := Length(AText);
if n > 128 then n := 128;
FillChar(text, 128, 0);
for i := 1 to n do
text[i-1] := ord(AText[i]);
end;
end. end.