Context Navigation

ubarcodes.pas

Last change on this file was 123, checked in by chronos, 3 years ago
Added: QR code image visible in contact others tab. It can be saved as image to file.
File size: 84.3 KB

Line
1	unit ubarcodes;
2
3	{$mode objfpc}{$H+}
4
5	interface
6
7	uses
8	Classes, SysUtils, Controls, LResources, Graphics, Types,
9	zint, udrawers;
10
11	type
12
13	TBarcodeType = (
14	// TBarcodeC11
15	bctCode11,
16	// TBarcode128
17	bctCode128, bctEAN128,
18	// TBarcode2of5
19	bctCode25DataLogic, bctCode25IATA, bctCode25Industrial,
20	bctCode25Interleaved, bctCode25Standard, bctITF14,
21	// TBarcode3of9
22	bctCode39, bctCode39Ext, bctLOGMARS, bctCode93,
23	// TBarcodeEAN
24	bctEAN, bctEAN14, bctISBN, bctNVE18, bctUPCA, bctUPCE,
25	// TBarcodeChannelCode
26	bctChannelCode,
27	// TBarcodePlessey
28	bctPlessey, bctMSIPlessey,
29	// TBarcodeTelePen
30	bctTelepen, bctTelepenNum,
31	// TBarcodeMedical
32	bctCodaBar, bctCode32, bctPharmaOne, bctPharmaTwo, bctPZN7, bctPZN8,
33	// TBarcodePostal
34	bctAustraliaPostCustomer, bctAustraliaPostReplyPaid, bctAustraliaPostRoute,
35	bctAustraliaPostRedirect, bctDaft,
36	bctDeutschePostIdentCode, bctDeutschePostLeitCode,
37	bctFIM, bctJapanPost, bctKix, bctKoreaPost, bctPlanet, bctPostNet, bctRM4SCC,
38
39	// TBarcodePDF417
40	bctPDF417, bctPDF417trunc, bctMicroPDF417,
41
42	// TBarcodeQR
43	bctQR,
44	// TBarcodeMicroQR
45	bctMicroQR,
46	// TBarcodeAztec
47	bctAztec,
48	// TBarcodeAztecRune
49	bctAztecRune,
50	// TBarcodeDataMatrix
51	bctDataMatrix
52	);
53	TBarcodeTypes = set of TBarcodeType;
54
55	TBarcodeBearerBarMode = (bbmNone, bbmBearerBars, bbmBox);
56
57	{ TLazBarcodeCustomBase }
58
59	TLazBarcodeCustomBase=class(TGraphicControl)
60	private
61	FSymbol: PZintSymbol;
62	//FQR: PointerTo_zint_symbol; // deprecated, use FSymbol instead
63	FBackgroundColor: TColor;
64	FBearerBarMode: TBarcodeBearerBarMode;
65	FForegroundColor: TColor;
66	FLastErrorString: String;
67	FMargin: Integer;
68	FRecommendedSymbolSize: Boolean;
69	FScale: Integer;
70	FSymbolHeight: Integer;
71	FMinSymbolHeight: Integer;
72	FWhitespaceWidth: Integer;
73	procedure SetBackgroundColor(const AValue: TColor);
74	procedure SetBearerBarMode(const AValue: TBarcodeBearerBarMode);
75	procedure SetForegroundColor(const AValue: TColor);
76	procedure SetMargin(const AValue: Integer);
77	procedure SetMinSymbolHeight(const AValue: Integer);
78	procedure SetRecommendedSymbolSize(const AValue: Boolean);
79	procedure SetScale(const AValue: Integer);
80	procedure SetWhitespaceWidth(const AValue: Integer);
81	procedure SetSymbolHeight(const AValue: Integer);
82	protected
83	FIsPainting: Integer;
84	procedure DoOnResize; override;
85	procedure GenerateAndInvalidate;
86	class function GetControlClassDefaultSize: TSize; override;
87	procedure InitSymbol(ASymbology: Integer); virtual;
88	procedure IntfPaintOnCanvas(const aTargetCanvas: TCanvas; const aRect: TRect); virtual;
89	procedure Paint; override;
90	procedure SetRecommendedSymbolSizeParams; virtual;
91	procedure UpdateAutoSize;
92	property BackgroundColor: TColor read FBackgroundColor write SetBackgroundColor default clWhite;
93	property BearerBarMode: TBarcodeBearerBarMode read FBearerBarMode write SetBearerBarMode default bbmNone;
94	property ForegroundColor: TColor read FForegroundColor write SetForegroundColor default clBlack;
95	property Margin: Integer read FMargin write SetMargin default 4;
96	property MinSymbolHeight: Integer read FMinSymbolHeight write SetMinSymbolHeight default 0;
97	property RecommendedSymbolSize: Boolean read FRecommendedSymbolSize write SetRecommendedSymbolSize default true;
98	property Scale: Integer read FScale write SetScale default 0;
99	property WhitespaceWidth: Integer read FWhitespaceWidth write SetWhitespaceWidth default 4;
100	property SymbolHeight: Integer read FSymbolHeight write SetSymbolHeight default 0;
101	public
102	constructor Create(AOwner: TComponent); override;
103	destructor Destroy; override;
104	procedure CopyToClipboard;
105	procedure Generate; virtual; abstract;
106	procedure PaintOnCanvas(const aTargetCanvas: TCanvas; const aRect: TRect); virtual;
107	procedure SaveToEpsFile(const AFileName: String);
108	procedure SaveToEpsStream(const AStream: TStream); virtual;
109	procedure SaveToFile(const AFileName: String; AImageClass: TFPImageBitmapClass = nil;
110	AWidth: Integer = -1; AHeight: Integer = -1);
111	procedure SaveToStream(const AStream: TStream; AImageClass: TFPImageBitmapClass = nil;
112	AWidth: Integer = -1; AHeight: Integer = -1); virtual;
113	procedure SaveToSvgFile(const AFileName: String);
114	procedure SaveToSvgStream(const AStream: TStream); virtual;
115	property ErrorString: String read FLastErrorString;
116	published
117	property Align;
118	property BorderSpacing;
119	property Color default clWhite;
120	property Constraints;
121	property ParentColor;
122	property OnPaint;
123	property OnResize;
124	property OnShowHint;
125	property OnClick;
126	property OnDblClick;
127	property OnMouseDown;
128	property OnMouseMove;
129	property OnMouseUp;
130	property OnMouseEnter;
131	property OnMouseLeave;
132	property OnMouseWheel;
133	property OnMouseWheelDown;
134	property OnMouseWheelUp;
135	property OnDragDrop;
136	property OnDragOver;
137	property OnEndDock;
138	property OnEndDrag;
139	property OnStartDock;
140	property OnStartDrag;
141	end;
142
143	{ TLazBarcodeCustomText }
144
145	TLazBarcodeCustomText=class(TLazBarcodeCustomBase)
146	private
147	FShowHumanReadableText: Boolean;
148	procedure SetShowHumanReadableText(const AValue: Boolean);
149	procedure SetText(const AValue: TCaption);
150	protected
151	FText: TCaption;
152	function GetSampleText: String; virtual;
153	property ShowHumanReadableText: Boolean read FShowHumanReadableText write SetShowHumanReadableText default true;
154	public
155	constructor Create(AOwner: TComponent); override;
156	procedure SampleText;
157	published
158	property Text: TCaption read FText write SetText;
159	end;
160
161
162	{ TCustomLazBarcode }
163
164	TCustomBarcode = class(TLazBarcodeCustomText)
165	protected
166	FBarcodeType: TBarcodeType;
167	FErrorCode: Integer;
168	FValidBarcodeTypes: TBarcodeTypes;
169	procedure FontChanged(Sender: TObject); override;
170	procedure InitSymbol(ASymbology: Integer); override;
171	function InternalGenerate: Integer; virtual;
172	procedure IntfPaintOnCanvas(const aTargetCanvas: TCanvas; const aRect: TRect); override;
173	procedure SetBarcodeType(const AValue: TBarcodeType);
174	protected
175	property BarcodeType: TBarcodeType read FBarcodeType write SetBarcodeType;
176	public
177	constructor Create(AOwner: TComponent); override;
178	procedure Generate; override;
179	published
180	property BackgroundColor;
181	property ForegroundColor;
182	property Margin;
183	property ParentColor;
184	property Scale;
185	property Font;
186	property ParentFont;
187	end;
188
189
190	{ TSimpleBarcode
191
192	These bar codes types implement their own drawing procedure which is simpler
193	and more flexible than the complex Zint routine. }
194
195	TSimpleBarcode = class(TCustomBarcode)
196	private
197	FAddCheckSum: Boolean;
198	FDisplayCheckSum: Boolean;
199	procedure SetAddCheckSum(const AValue: Boolean);
200	procedure SetDisplayCheckSum(const AValue: Boolean);
201	protected
202	function CalcFactor(AWidth, {%H-}AHeight: Integer): Integer; virtual;
203	procedure CalcSize(AFactor: Integer; out ATotalWidth, ATotalHeight,
204	ASymbolWidth, ASymbolHeight, ATextWidth, ATextHeight,
205	ABorderWidth, AWhitespaceWidth: Integer); virtual;
206	function CalcSymbolStart(ABorderWidth, AWhiteSpaceWidth: Integer): Integer; virtual;
207	procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: Integer;
208	WithThemeSpace: Boolean); override;
209	procedure DrawBarcode(ADrawer: TBasicBarcodeDrawer; AFactor: Double);
210	procedure GetTextSize(const AText: String; out AWidth, AHeight: Integer);
211	function InternalGenerate: Integer; override;
212	procedure IntfPaintOnCanvas(const aTargetCanvas: TCanvas; const aRect: TRect); override;
213	procedure Paint; override;
214	procedure RenderBarcode(AWidth, AHeight: Integer); virtual;
215	procedure RenderBearerBars(AWidth, AHeight, ABorder: Integer; var ALastLine: PZintRenderline);
216	procedure RenderBox(AWidth, AHeight, ABorder: Integer; var ALastLine: PZintRenderLine);
217	procedure RenderSymbol(xLeft, yTop, ASymbolHeight, {%H-}ATextHeight, AFactor: Integer;
218	var ALastLine: PZintRenderLine); virtual;
219	procedure RenderText(ASymbolWidth, ASymbolStart, ATextPos: Integer); virtual;
220	property AddCheckSum: Boolean read FAddCheckSum write SetAddCheckSum default true;
221	property DisplayCheckSum: Boolean read FDisplayCheckSum write SetDisplayCheckSum default false;
222	public
223	constructor Create(AOwner: TComponent); override;
224	procedure PaintOnCanvas(const ACanvas: TCanvas; const ARect: TRect); override;
225
226	procedure SaveToEpsStream(const AStream: TStream); override;
227	procedure SaveToStream(const AStream: TStream; AImageClass: TFPImageBitmapClass = nil;
228	AWidth: Integer = -1; AHeight: Integer = -1); override;
229	procedure SaveToSvgStream(const AStream: TStream); override;
230	published
231	property AutoSize;
232	property RecommendedSymbolSize;
233	end;
234
235
236	{ TBarcodeC11 }
237
238	TBarcodeC11 = class(TSimpleBarcode)
239	protected
240	class function GetControlClassDefaultSize: TSize; override;
241	function GetSampleText: String; override;
242	function InternalGenerate: Integer; override;
243	public
244	constructor Create(AOwner: TComponent); override;
245	published
246	property AddChecksum;
247	property BearerBarMode;
248	property DisplayChecksum;
249	property ShowHumanReadableText;
250	property SymbolHeight;
251	property WhiteSpaceWidth;
252	end;
253
254
255	{ TBarcodeC128 }
256
257	TBarcodeTypeC128 = bctCode128..bctEAN128;
258
259	TBarcodeC128 = class(TSimpleBarcode)
260	private
261	function GetBarcodeType: TBarcodeTypeC128;
262	procedure SetBarcodeType(const AValue: TBarcodeTypeC128);
263	protected
264	class function GetControlClassDefaultSize: TSize; override;
265	function GetSampleText: String; override;
266	function InternalGenerate: Integer; override;
267	public
268	constructor Create(AOwner: TComponent); override;
269	published
270	property BarcodeType: TBarcodeTypeC128
271	read GetBarcodeType write SetBarcodeType default bctCode128;
272	property ShowHumanReadableText;
273	property SymbolHeight;
274	property WhiteSpaceWidth;
275	end;
276
277
278	{ TBarcode2of5 }
279
280	TBarcodeType2of5 = bctCode25DataLogic..bctITF14;
281
282	TBarcode2of5 = class(TSimpleBarcode)
283	private
284	function GetBarcodeType: TBarcodeType2of5;
285	procedure SetBarcodeType(const AValue: TBarcodeType2of5);
286	protected
287	class function GetControlClassDefaultSize: TSize; override;
288	function GetSampleText: String; override;
289	function InternalGenerate: Integer; override;
290	procedure SetRecommendedSymbolSizeParams; override;
291	public
292	constructor Create(AOwner: TComponent); override;
293	published
294	property BarcodeType: TBarcodeType2of5
295	read GetBarcodeType write SetBarcodeType default bctCode25DataLogic;
296	property AddChecksum;
297	property BearerBarMode;
298	property DisplayChecksum;
299	property ShowHumanReadableText;
300	property SymbolHeight;
301	property WhiteSpaceWidth;
302	end;
303
304
305	{ TBarcode3of9 }
306
307	TBarcodeType3of9 = bctCode39..bctCode93;
308
309	TBarcode3of9 = class(TSimpleBarcode)
310	private
311	function GetBarcodeType: TBarcodeType3of9;
312	procedure SetBarcodeType(const AValue: TBarcodeType3of9);
313	protected
314	class function GetControlClassDefaultSize: TSize; override;
315	function GetSampleText: String; override;
316	function InternalGenerate: Integer; override;
317	public
318	constructor Create(AOwner: TComponent); override;
319	published
320	property BarcodeType: TBarcodeType3of9
321	read GetBarcodeType write SetBarcodeType default bctCode39;
322	property AddChecksum;
323	property BearerBarMode;
324	property DisplayChecksum;
325	property ShowHumanReadableText;
326	property SymbolHeight;
327	property WhiteSpaceWidth;
328	end;
329
330
331	{ TBarcodeEAN }
332
333	TBarcodeTypeEAN = bctEAN..bctUPCE;
334
335	TBarcodeEAN = class(TSimpleBarcode) //CustomBarcode)
336	private
337	const
338	SPACER = '00';
339	function GetBarcodeType: TBarcodeTypeEAN;
340	procedure SetBarcodeType(const AValue: TBarcodeTypeEAN);
341	protected
342	procedure CalcSize(AFactor: Integer; out ATotalWidth, ATotalHeight,
343	ASymbolWidth, ASymbolHeight, ATextWidth, ATextHeight,
344	ABorderWidth, AWhitespaceWidth: Integer); override;
345	function CalcSymbolStart(ABorderWidth, AWhiteSpaceWidth: Integer): integer; override;
346	function GetAddOnText: String;
347	class function GetControlClassDefaultSize: TSize; override;
348	function GetLeftText: String;
349	function GetRightText: String;
350	function GetSampleText: String; override;
351	function InternalGenerate: Integer; override;
352	procedure RenderSymbol(xLeft, yTop, AHeight, ATextHeight, AFactor: Integer;
353	var ALastLine: PZintRenderLine); override;
354	procedure RenderText(ASymbolWidth, ASymbolStart, ATextPos: Integer); override;
355	procedure SetRecommendedSymbolSizeParams; override;
356	function UPC_EAN_Flag: Integer;
357	public
358	constructor Create(AOwner: TComponent); override;
359	published
360	property BarcodeType: TBarcodeTypeEAN read GetBarcodeType write SetBarcodeType default bctEAN;
361	property ShowHumanReadableText;
362	property SymbolHeight;
363	property WhiteSpaceWidth;
364	end;
365
366
367	{ TBarcodeChannelCode }
368
369	TBarcodeChannelCode = class(TSimpleBarcode) //CustomBarcode)
370	private
371	FChannelCount: integer; // only 0, 3..8
372	procedure SetChannelCount(const AValue: Integer);
373	protected
374	class function GetControlClassDefaultSize: TSize; override;
375	function GetSampleText: String; override;
376	function InternalGenerate: Integer; override;
377	procedure SetRecommendedSymbolSizeParams; override;
378	public
379	constructor Create(AOwner: TComponent); override;
380	published
381	property ChannelCount: Integer read FChannelCount write SetChannelCount default 0;
382	property ShowHumanReadableText;
383	property SymbolHeight;
384	property WhiteSpaceWidth;
385	end;
386
387	{ TBarcodePlessey }
388
389	TBarcodeTypePlessey = bctPlessey..bctMSIPlessey;
390	TPlesseyCheckChar = (pcOneMod10, pcTwoMod10, pcOneMod11, pcOneMod10Mod11);
391
392	TBarcodePlessey = class(TSimpleBarcode)
393	private
394	FCheckChar: TPlesseyCheckChar;
395	function GetBarcodeType: TBarcodeTypePlessey;
396	procedure SetBarcodeType(const AValue: TBarcodeTypePlessey);
397	procedure SetCheckChar(const AValue: TPlesseyCheckChar);
398	protected
399	class function GetControlClassDefaultSize: TSize; override;
400	function GetSampleText: String; override;
401	function InternalGenerate: Integer; override;
402	procedure SetRecommendedSymbolSizeParams; override;
403	public
404	constructor Create(AOwner: TComponent); override;
405	published
406	property BarcodeType: TBarcodeTypePlessey read GetBarcodeType write SetBarcodeType default bctPlessey;
407	property CheckChar: TPlesseyCheckChar read FCheckChar write SetCheckChar default pcOneMod10;
408	property AddChecksum;
409	property DisplayChecksum;
410	property ShowHumanReadableText;
411	property SymbolHeight;
412	property WhiteSpaceWidth;
413	end;
414
415
416	{ TBarcodeTelepen }
417
418	TBarcodeTypeTelepen = bctTelepen..bctTelepenNum;
419
420	TBarcodeTelepen = class(TSimpleBarcode) //CustomBarcode)
421	private
422	function GetBarcodeType: TBarcodeTypeTelepen;
423	procedure SetBarcodeType(const AValue: TBarcodeTypeTelepen);
424	protected
425	class function GetControlClassDefaultSize: TSize; override;
426	function GetSampleText: String; override;
427	function InternalGenerate: Integer; override;
428	procedure SetRecommendedSymbolSizeParams; override;
429	public
430	constructor Create(AOwner: TComponent); override;
431	published
432	property BarcodeType: TBarcodeTypeTelepen read GetBarcodeType write SetBarcodeType default bctTelepen;
433	property ShowHumanReadableText;
434	property SymbolHeight;
435	property WhiteSpaceWidth;
436	end;
437
438
439	{ TBarcodeMedical }
440
441	TBarcodeTypeMedical = bctCodaBar..bctPZN8;
442
443	TBarcodeMedical = class(TSimpleBarcode)
444	private
445	function GetBarcodeType: TBarcodeTypeMedical;
446	procedure SetBarcodeType(const AValue: TBarcodeTypeMedical);
447	protected
448	class function GetControlClassDefaultSize: TSize; override;
449	function GetSampleText: String; override;
450	function InternalGenerate: Integer; override;
451	procedure SetRecommendedSymbolSizeParams; override;
452	public
453	constructor Create(AOwner: TComponent); override;
454	published
455	property BarcodeType: TBarcodeTypeMedical read GetBarcodeType write SetBarcodeType default bctCodaBar;
456	property ShowHumanReadableText;
457	property SymbolHeight;
458	property WhiteSpaceWidth;
459	end;
460
461
462	{ TBarcodePostal }
463
464	TBarcodeTypePostal = bctAustraliaPostCustomer..bctRM4SCC;
465
466	TBarcodePostal = class(TSimpleBarcode)
467	private
468	FGrouped: Boolean;
469	function GetBarcodeType: TBarcodeTypePostal;
470	procedure SetBarcodeType(const AValue: TBarcodeTypePostal);
471	procedure SetGrouped(const AValue: Boolean);
472	protected
473	class function GetControlClassDefaultSize: TSize; override;
474	function GetSampleText: String; override;
475	function InternalGenerate: Integer; override;
476	procedure SetRecommendedSymbolSizeParams; override;
477	public
478	constructor Create(AOwner: TComponent); override;
479	published
480	property BarcodeType: TBarcodeTypePostal read GetBarcodeType write SetBarcodeType default bctPostNet;
481	property Grouped: Boolean read FGrouped write SetGrouped default true;
482	property ShowHumanReadableText;
483	property SymbolHeight;
484	property WhiteSpaceWidth;
485	end;
486
487
488	{ TBarcodePDF417 }
489
490	TBarcodeTypePDF417 = bctPDF417..bctMicroPDF417;
491
492	TBarcodePDF417 = class(TSimpleBarcode)
493	private
494	function GetBarcodeType: TBarcodeTypePDF417;
495	function GetRowHeightRatio: Integer;
496	procedure SetBarcodeType(const AValue: TBarcodeTypePDF417);
497	procedure SetRowHeightRatio(const AValue: Integer);
498	protected
499	procedure CalcSize(AFactor: Integer; out ATotalWidth, ATotalHeight,
500	ASymbolWidth, ASymbolHeight, ATextWidth, ATextHeight,
501	ABorderWidth, AWhitespaceWidth: Integer); override;
502	function CalcSymbolStart(ABorderWidth, {%H-}AWhiteSpaceWidth: integer): Integer; override;
503	class function GetControlClassDefaultSize: TSize; override;
504	{
505	procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: Integer;
506	WithThemeSpace: Boolean); override;
507	}
508	function InternalGenerate: Integer; override;
509	procedure SetRecommendedSymbolSizeParams; override;
510	public
511	constructor Create(AOwner: TComponent); override;
512	published
513	property BarcodeType: TBarcodeTypePDF417 read GetBarcodeType write SetBarcodeType default bctPDF417;
514	property RowHeightRatio: Integer read GetRowHeightRatio write SetrowHeightRatio default 3;
515	end;
516
517
518	{ TBarcodeSquare }
519
520	TBarcodeSquare = class(TSimpleBarcode)
521	protected
522	function CalcFactor(AWidth, AHeight: Integer): Integer; override;
523	procedure CalcSize(AFactor: Integer; out ATotalWidth, ATotalHeight,
524	ASymbolWidth, ASymbolHeight, ATextWidth, ATextHeight,
525	ABorderWidth, AWhitespaceWidth: Integer); override;
526	function CalcSymbolStart(ABorderWidth, {%H-}AWhiteSpaceWidth: integer): Integer; override;
527	procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: Integer;
528	WithThemeSpace: Boolean); override;
529	class function GetControlClassDefaultSize: TSize; override;
530	procedure SetRecommendedSymbolSizeParams; override;
531	public
532	constructor Create(AOwner: TComponent); override;
533	end;
534
535
536	{ TBarcodeQR }
537
538	TBarcodeQR_ECCLevel= (eBarcodeQR_ECCLevel_Auto=0,
539	eBarcodeQR_ECCLevel_L=1,eBarcodeQR_ECCLevel_M=2,
540	eBarcodeQR_ECCLevel_Q=3,eBarcodeQR_ECCLevel_H=4);
541
542	TBarcodeQR = class(TBarcodeSquare)
543	private
544	procedure SetECCLevel(const AValue: TBarcodeQR_ECCLevel);
545	protected
546	FECCLevel: TBarcodeQR_ECCLevel;
547	procedure UpdateECCLevel;
548	function InternalGenerate: Integer; override;
549	public
550	constructor Create(AOwner: TComponent); override;
551	published
552	property ECCLevel: TBarcodeQR_ECCLevel read FECCLevel write SetECCLevel default eBarcodeQR_ECCLevel_Auto;
553	end;
554
555
556	{ TBarcodeMicroQR }
557
558	TBarcodeMicroQR = class(TBarcodeQR)
559	protected
560	function InternalGenerate: Integer; override;
561	public
562	constructor Create(AOwner: TComponent); override;
563	end;
564
565
566	{ TBarcodeAztec }
567
568	TBarcodeAztec = class(TBarcodeSquare)
569	protected
570	function InternalGenerate: Integer; override;
571	public
572	constructor Create(AOwner: TComponent); override;
573	end;
574
575
576	{ TBarcodeAztecRune }
577
578	TBarcodeAztecRune_Value= 0..999;
579
580	TBarcodeAztecRune = class(TBarcodeSquare)
581	private
582	function GetValue: TBarcodeAztecRune_Value;
583	procedure SetValue(const AValue: TBarcodeAztecRune_Value);
584	protected
585	FValue: TBarcodeAztecRune_Value;
586	function GetSampleText: String; override;
587	function InternalGenerate: Integer; override;
588	public
589	constructor Create(AOwner: TComponent); override;
590	published
591	property Value: TBarcodeAztecRune_Value read GetValue write SetValue;
592	end;
593
594
595	{ TBarcodeDataMatrix }
596
597	TBarcodeDataMatrix = class(TBarcodeSquare)
598	protected
599	function InternalGenerate: Integer; override;
600	public
601	constructor Create(AOwner: TComponent); override;
602	end;
603
604
605	procedure Register;
606
607	implementation
608
609	{$R lazbarcodes_icons.res}
610
611	uses
612	clipbrd, propedits,
613	lbc_basic, lbc_helper, lbc_render, lbc_svg,
614	lbc_code, lbc_code128, lbc_2of5, lbc_upcean, lbc_plessey, lbc_telepen,
615	lbc_medical, lbc_postal, lbc_auspost,
616	lbc_pdf417, lbc_datamatrix, lbc_qr, lbc_aztec;
617
618	procedure Register;
619	begin
620	RegisterComponents('Laz Barcodes', [
621	// 1D barcodes
622	TBarcodeC11, TBarcodeC128, TBarcode2of5, TBarcode3of9, TBarcodeEAN,
623	TBarcodeChannelCode, TBarcodePlessey, TBarcodeTelepen,
624	TBarcodeMedical, TBarcodePostal,
625
626	// 2D barcodes
627	TBarcodeQR, TBarcodeMicroQR,
628	TBarcodeAztec, TBarcodeAztecRune,
629	TBarcodeDataMatrix,
630	TBarcodePDF417
631	]);
632
633	RegisterPropertyEditor(TypeInfo(TCaption), TLazBarcodeCustomText, 'Text', TCaptionPropertyEditor);
634	end;
635
636	function ColorToChars(AColor: TColor): TColorChars;
637	type
638	TRGBA = packed record
639	r, g, b, a: byte;
640	end;
641	var
642	s: String;
643	c: TRGBA;
644	i: Integer;
645	begin
646	c := TRGBA(ColorToRGB(AColor));
647	s := Format('%.2x%.2x%.2x', [c.R, c.G, c.B]);
648	Result := Default(TColorChars);
649	for i := 1 to Length(s) do
650	Result[i-1] := s[i];
651	end;
652
653	function InchToMillimeters(AValue: Double): Double;
654	begin
655	Result := AValue * 25.4;
656	end;
657
658	function InchToPixels(AValue: Double): Integer;
659	begin
660	Result := round(AValue * ScreenInfo.PixelsPerInchX);
661	end;
662
663	function MillimetersToInch(AValue: Double): Double;
664	begin
665	Result := AValue / 25.4;
666	end;
667
668	function MillimetersToPixels(AValue: Double): Integer;
669	begin
670	Result := round(MillimetersToInch(AValue) * ScreenInfo.PixelsPerInchX);
671	end;
672
673	function GetSymbology(ABarcodeType: TBarcodeType): Integer;
674	begin
675	case ABarcodeType of
676	bctCode11:
677	Result := BARCODE_CODE11;
678	bctCode128:
679	Result := BARCODE_CODE128;
680	bctEAN128:
681	Result := BARCODE_EAN128;
682	bctCode25DataLogic:
683	Result := BARCODE_C25LOGIC;
684	bctCode25IATA:
685	Result := BARCODE_C25IATA;
686	bctCode25Industrial:
687	Result := BARCODE_C25IND;
688	bctCode25Interleaved:
689	Result := BARCODE_C25INTER;
690	bctCode25Standard:
691	Result := BARCODE_C25MATRIX;
692	bctITF14:
693	Result := BARCODE_ITF14;
694	bctCode39:
695	Result := BARCODE_CODE39;
696	bctCode39Ext:
697	Result := BARCODE_EXCODE39;
698	bctLOGMARS:
699	Result := BARCODE_LOGMARS;
700	bctCode93:
701	Result := BARCODE_CODE93;
702	bctEAN:
703	Result := BARCODE_EANX;
704	bctEAN14:
705	Result := BARCODE_EAN14;
706	bctISBN:
707	Result := BARCODE_ISBNX;
708	bctNVE18:
709	Result := BARCODE_NVE18;
710	bctUPCA:
711	Result := BARCODE_UPCA;
712	bctUPCE:
713	Result := BARCODE_UPCE;
714	bctChannelCode:
715	Result := BARCODE_CHANNEL;
716	bctPlessey:
717	Result := BARCODE_PLESSEY;
718	bctMSIPlessey:
719	Result := BARCODE_MSI_PLESSEY;
720	bctTelepen:
721	Result := BARCODE_TELEPEN;
722	bctTelepenNum:
723	Result := BARCODE_TELEPEN_NUM;
724	bctCodaBar:
725	Result := BARCODE_CODABAR;
726	bctCode32:
727	Result := BARCODE_CODE32;
728	bctPharmaOne:
729	Result := BARCODE_PHARMA;
730	bctPharmaTwo:
731	Result := BARCODE_PHARMA_TWO;
732	bctPZN7:
733	Result := BARCODE_PZN;
734	bctPZN8:
735	Result := BARCODE_PZN;
736	bctAustraliaPostCustomer:
737	Result := BARCODE_AUSPOST;
738	bctAustraliaPostReplyPaid:
739	Result := BARCODE_AUSREPLY;
740	bctAustraliaPostRoute:
741	Result := BARCODE_AUSROUTE;
742	bctAustraliaPostRedirect:
743	Result := BARCODE_AUSREDIRECT;
744	bctDaft:
745	Result := BARCODE_DAFT;
746	bctDeutschePostIdentCode:
747	Result := BARCODE_DPIDENT;
748	bctDeutschePostLeitCode:
749	Result := BARCODE_DPLEIT;
750	bctFIM:
751	Result := BARCODE_FIM;
752	bctJapanPost:
753	Result := BARCODE_JAPANPOST;
754	bctKIX:
755	Result := BARCODE_KIX;
756	bctKoreaPost:
757	Result := BARCODE_KOREAPOST;
758	bctPlanet:
759	Result := BARCODE_PLANET;
760	bctPostNet:
761	Result := BARCODE_POSTNET;
762	bctRM4SCC:
763	Result := BARCODE_RM4SCC;
764	bctPDF417:
765	Result := BARCODE_PDF417;
766	bctPDF417Trunc:
767	Result := BARCODE_PDF417TRUNC;
768	bctMicroPDF417:
769	Result := BARCODE_MICROPDF417;
770	bctQR:
771	Result := BARCODE_QRCODE;
772	bctMicroQR:
773	Result := BARCODE_MICROQR;
774	bctAztec:
775	Result := BARCODE_AZTEC;
776	bctAztecRune:
777	Result := BARCODE_AZRUNE;
778	bctDataMatrix:
779	Result := BARCODE_DATAMATRIX
780	else
781	Result := -1
782	end;
783	end;
784
785	{ TLazBarcodeCustomBase }
786
787	constructor TLazBarcodeCustomBase.Create(AOwner: TComponent);
788	begin
789	inherited Create(AOwner);
790
791	with GetControlClassDefaultSize do
792	SetInitialBounds(0, 0, CX, CY);
793
794	Color := clWhite;
795	FBackgroundColor := clWhite;
796	FMargin := 4;
797	FForegroundColor := clBlack;
798	// FStrictSize := true;
799	FWhiteSpaceWidth := 4;
800
801	SetRecommendedSymbolSize(true);
802	end;
803
804	destructor TLazBarcodeCustomBase.Destroy;
805	begin
806	if Assigned(FSymbol) then begin
807	ZBarcode_Delete(FSymbol);
808	FSymbol := nil;
809	end;
810	inherited Destroy;
811	end;
812
813	procedure TLazBarcodeCustomBase.CopyToClipboard;
814	var
815	stream: TStream;
816	begin
817	stream := TMemoryStream.Create;
818	try
819	SaveToStream(stream);
820	stream.Position := 0;
821	Clipboard.AddFormat(CF_BITMAP, stream);
822	finally
823	stream.Free;
824	end;
825	end;
826
827	procedure TLazBarcodeCustomBase.DoOnResize;
828	begin
829	inherited;
830	// if (FScale = 0) or (FSymbolheight = 0) then // no display at designtime with this
831	Generate;
832	end;
833
834	procedure TLazBarcodeCustomBase.GenerateAndInvalidate;
835	begin
836	FLastErrorString := '';
837	Generate;
838	Self.Invalidate;
839	end;
840
841	class function TLazBarcodeCustomBase.GetControlClassDefaultSize: TSize;
842	begin
843	Result.CX := 200;
844	Result.CY := 80;
845	end;
846
847	function GetTextHeight(AFont: TFont): Integer;
848	var
849	bmp: TBitmap;
850	begin
851	bmp := TBitmap.Create;
852	try
853	bmp.SetSize(10, 10);
854	bmp.Canvas.Font.Assign(AFont);
855	Result := bmp.Canvas.TextHeight('Tg');
856	finally
857	bmp.Free;
858	end;
859	end;
860
861	procedure TLazBarcodeCustomBase.InitSymbol(ASymbology: Integer);
862	begin
863	if ASymbology = -1 then
864	exit;
865
866	with FSymbol^ do
867	begin
868	symbology := ASymbology;
869	border_width := FMargin;
870	font_height := GetTextHeight(Font);
871	scale := FScale;
872	case FBearerBarMode of
873	bbmNone:
874	;
875	bbmBearerBars:
876	output_options := output_options or BARCODE_BIND;
877	bbmBox:
878	output_options := output_options or BARCODE_BOX;
879	end;
880	fgColour := ColorToChars(FForegroundColor);
881	bgColour := ColorToChars(FBackgroundColor);
882	end;
883	end;
884
885	procedure TLazBarcodeCustomBase.IntfPaintOnCanvas(const aTargetCanvas: TCanvas;
886	const aRect: TRect);
887	var
888	ErrorCode: integer;
889	Line: PointerTo_zint_render_line;
890	BaseX,BaseY: integer;
891	X,Y: integer;
892
893	procedure ClearBackground;
894	begin
895	aTargetCanvas.Brush.Color:=FBackgroundColor;
896	aTargetCanvas.FillRect(aRect);
897	end;
898
899	begin
900	if not aTargetCanvas.HandleAllocated then exit;
901	if not Assigned(FSymbol) then begin
902	ClearBackground;
903	exit;
904	end;
905	if not Assigned(FSymbol^.rendered) then begin
906	X := aRect.Right - aRect.Left + 1;
907	Y := aRect.Bottom - aRect.Top + 1;
908	{
909	if FStrictSize then begin
910	BaseX := FSymbol^.width + FSymbol^.border_width*2;
911	BaseY := FSymbol^.rows + FSymbol^.border_width*2;
912	ErrorCode := render_plot(FSymbol, X-(X mod BaseX), Y-(Y mod BaseY));
913	end else // not strict size: stretch over full width of control
914	}
915	ErrorCode := render_plot(FSymbol,X,Y);
916	if ErrorCode<>1 then begin
917	FLastErrorString := FSymbol^.errtxt;
918	exit;
919	end else begin
920	FLastErrorString:='';
921	end;
922	end;
923
924	if Assigned(FSymbol^.rendered) then begin
925	baseX := round((aRect.Left + aRect.Right - FSymbol^.rendered^.exact_width) / 2);
926	if baseX < aRect.Left then baseX := aRect.Left;
927	baseY := aRect.Top;
928
929	Line:=FSymbol^.rendered^.lines;
930	ClearBackground;
931	aTargetCanvas.Brush.Color:=FForegroundColor;
932	while Assigned(Line) do begin
933	aTargetCanvas.FillRect(
934	round(Line^.x)+baseX, //aRect.Left,
935	round(Line^.y)+baseY, //aRect.Top,
936	round(Line^.x+Line^.width)+baseX, //aRect.Left,
937	round(Line^.y+Line^.length)+baseY //aRect.Top
938	);
939	Line:=Line^.next;
940	end;
941	end;
942	end;
943
944	procedure TLazBarcodeCustomBase.Paint;
945	begin
946	if FIsPainting = 0 then
947	begin
948	inc(FIsPainting);
949	try
950	IntfPaintOnCanvas(Canvas, ClientRect);
951	finally
952	dec(FIsPainting);
953	end;
954	end;
955	end;
956
957	procedure TLazBarcodeCustomBase.PaintOnCanvas(const aTargetCanvas: TCanvas;
958	const aRect: TRect);
959	begin
960	//Destroy rendering
961	Generate;
962	//Create new rendering
963	IntfPaintOnCanvas(aTargetCanvas,aRect);
964	//Destroy rendering, new rendering generated when paint called.
965	Generate;
966	end;
967
968	procedure TLazBarcodeCustomBase.SaveToFile(const AFileName: String;
969	AImageClass: TFPImageBitmapClass = nil;
970	AWidth: Integer = -1; AHeight: Integer = -1);
971	var
972	stream: TStream;
973	begin
974	stream := TFileStream.Create(AFileName, fmCreate);
975	try
976	SaveToStream(stream, AImageClass, AWidth, AHeight);
977	finally
978	stream.Free;
979	end;
980	end;
981
982	procedure TLazBarcodeCustomBase.SaveToEpsFile(const AFileName: String);
983	var
984	stream: TFileStream;
985	begin
986	stream := TFileStream.Create(AFileName, fmCreate + fmShareDenyWrite);
987	try
988	SaveToEpsStream(stream);
989	finally
990	stream.Free;
991	end;
992	end;
993
994	procedure TLazBarcodeCustomBase.SaveToEpsStream(const AStream: TStream);
995	begin
996	// to be done (is overriden by TSimpleBarcode)
997	end;
998
999	procedure TLazBarcodeCustomBase.SaveToStream(const AStream: TStream;
1000	AImageClass: TFPImageBitmapClass = nil;
1001	AWidth: Integer = -1; AHeight: Integer = -1);
1002	var
1003	bmp: TFPImageBitmap;
1004	begin
1005	if AImageClass = nil then
1006	bmp := TBitmap.Create
1007	else
1008	bmp := AImageClass.Create;
1009	if AWidth = -1 then AWidth := Width;
1010	if AHeight = -1 then AHeight := Height;
1011	try
1012	bmp.SetSize(AWidth, AHeight);
1013	bmp.Canvas.Brush.Color := clWhite;
1014	bmp.Canvas.FillRect(0, 0, bmp.Width, bmp.Height);
1015	PaintOnCanvas(bmp.Canvas, Rect(0, 0, bmp.Width, bmp.Height));
1016	bmp.SaveToStream(AStream);
1017	finally
1018	bmp.Free;
1019	end;
1020	end;
1021
1022	procedure TLazBarcodeCustomBase.SaveToSvgFile(const AFileName: String);
1023	var
1024	stream: TFileStream;
1025	begin
1026	stream := TFileStream.Create(AFileName, fmCreate + fmShareDenyWrite);
1027	try
1028	SaveToSvgStream(stream);
1029	finally
1030	stream.Free;
1031	end;
1032	end;
1033
1034	procedure TLazBarcodeCustomBase.SaveToSvgStream(const AStream: TStream);
1035	begin
1036	svg_plot(AStream, FSymbol);
1037	end;
1038
1039	procedure TLazBarcodeCustomBase.SetBackgroundColor(const AValue: TColor);
1040	begin
1041	if FBackgroundColor<>AValue then begin
1042	FBackgroundColor:=AValue;
1043	GenerateAndInvalidate;
1044	end;
1045	end;
1046
1047	procedure TLazBarcodeCustomBase.SetBearerBarMode(const AValue: TBarcodeBearerBarMode);
1048	begin
1049	if FBearerBarMode <> AValue then
1050	begin
1051	FBearerBarMode := AValue;
1052	FRecommendedSymbolSize := false;
1053	GenerateAndInvalidate;
1054	end;
1055	end;
1056
1057	procedure TLazBarcodeCustomBase.SetForegroundColor(const AValue: TColor);
1058	begin
1059	if FForegroundColor<>AValue then begin
1060	FForegroundColor:=AValue;
1061	GenerateAndInvalidate;
1062	end;
1063	end;
1064
1065	procedure TLazBarcodeCustomBase.SetMargin(const AValue: Integer);
1066	begin
1067	if FMargin <> AValue then
1068	begin
1069	FMargin := AValue;
1070	GenerateAndInvalidate;
1071	end;
1072	end;
1073
1074	procedure TLazBarcodeCustomBase.SetMinSymbolHeight(const AValue: Integer);
1075	begin
1076	if FMinSymbolHeight <> AValue then
1077	begin
1078	FMinSymbolHeight := AValue;
1079	GenerateAndInvalidate;
1080	end;
1081	end;
1082
1083	procedure TLazBarcodeCustomBase.SetRecommendedSymbolSize(const AValue: Boolean);
1084	begin
1085	//if FRecommendedSymbolSize = AValue then exit; // this is harmful here.
1086
1087	FRecommendedSymbolSize := AValue;
1088	if FRecommendedSymbolSize then
1089	SetRecommendedSymbolSizeParams;
1090	GenerateAndInvalidate;
1091	end;
1092
1093	procedure TLazBarcodeCustomBase.SetRecommendedSymbolSizeParams;
1094	begin
1095	FScale := 2;
1096	FSymbolHeight := 60;
1097	end;
1098
1099	procedure TLazBarcodeCustomBase.SetScale(const AValue: Integer);
1100	begin
1101	if FScale = AValue then exit;
1102	FScale := AValue;
1103	FRecommendedSymbolSize := false;
1104	GenerateAndInvalidate;
1105	end;
1106
1107	procedure TLazBarcodeCustomBase.SetWhitespaceWidth(const AValue: Integer);
1108	begin
1109	if FWhitespaceWidth <> AValue then
1110	begin
1111	FWhitespaceWidth := AValue;
1112	FRecommendedSymbolSize := false;
1113	GenerateAndInvalidate;
1114	end;
1115	end;
1116
1117	procedure TLazBarcodeCustomBase.SetSymbolHeight(const AValue: Integer);
1118	begin
1119	if FSymbolHeight <> AValue then
1120	begin
1121	FSymbolHeight := AValue;
1122	FRecommendedSymbolSize := false;
1123	GenerateAndInvalidate;
1124	end;
1125	end;
1126
1127	procedure TLazBarcodeCustomBase.UpdateAutoSize;
1128	begin
1129	InvalidatePreferredSize;
1130	AdjustSize;
1131	end;
1132
1133
1134	{ TLazBarcodeCustomText }
1135
1136	constructor TLazBarcodeCustomText.Create(AOwner: TComponent);
1137	begin
1138	inherited Create(AOwner);
1139	FText := GetSampleText;
1140	FShowHumanReadableText := true;
1141	end;
1142
1143	function TLazBarcodeCustomText.GetSampleText: String;
1144	begin
1145	Result := ClassName;
1146	end;
1147
1148	procedure TLazBarcodeCustomText.SampleText;
1149	begin
1150	SetText(GetSampleText);
1151	end;
1152
1153	procedure TLazBarcodeCustomText.SetShowHumanReadableText(const AValue: Boolean);
1154	begin
1155	if FShowHumanReadableText = AValue then exit;
1156	FShowHumanReadableText := AValue;
1157	GenerateAndInvalidate;
1158	end;
1159
1160	procedure TLazBarcodeCustomText.SetText(const AValue: TCaption);
1161	begin
1162	if FText <> AValue then begin
1163	if AValue = '' then
1164	FText := GetSampleText
1165	else
1166	FText := AValue;
1167	FLastErrorString := '';
1168	GenerateAndInvalidate;
1169	end;
1170	end;
1171
1172
1173	{ TCustomBarcode }
1174
1175	constructor TCustomBarcode.Create(AOwner: TComponent);
1176	begin
1177	inherited;
1178	end;
1179
1180	procedure TCustomBarcode.FontChanged(Sender: TObject);
1181	begin
1182	GenerateAndInvalidate;
1183	end;
1184
1185	procedure TCustomBarcode.Generate;
1186	var
1187	len: Integer;
1188	sym: Integer;
1189	begin
1190	if Assigned(FSymbol) then begin
1191	ZBarcode_Delete(FSymbol);
1192	FSymbol := nil;
1193	end;
1194
1195	len := Length(FText);
1196	if len = 0 then
1197	exit;
1198
1199	sym := GetSymbology(FBarcodeType);
1200	if (sym = -1) then
1201	raise Exception.Create('Barcode type not supported.');
1202
1203	FSymbol := ZBarcode_Create();
1204	InitSymbol(sym);
1205	FErrorCode := InternalGenerate;
1206	if FErrorCode = 0 then
1207	UpdateAutoSize
1208	else
1209	FLastErrorString := FSymbol^.errtxt;
1210	end;
1211
1212	procedure TCustomBarcode.InitSymbol(ASymbology: Integer);
1213	begin
1214	inherited InitSymbol(ASymbology);
1215	FSymbol^.show_hrt := ord(FShowHumanReadableText);
1216	end;
1217
1218	function TCustomBarcode.InternalGenerate: Integer;
1219	begin
1220	Result := 0;
1221	end;
1222
1223	procedure TCustomBarcode.IntfPaintOnCanvas(const aTargetCanvas: TCanvas;
1224	const aRect: TRect);
1225	var
1226	str: PointerTo_zint_render_string;
1227	baseX, baseY, w, x, y: Integer;
1228	begin
1229	inherited;
1230
1231	if (FSymbol = nil) or (FSymbol^.rendered = nil) then
1232	exit;
1233
1234	baseX := round((aRect.Left + aRect.Right - FSymbol^.rendered^.exact_width) / 2);
1235	baseY := aRect.Top;
1236
1237	// Draw the symbol's human-readable text, if requested.
1238	if FShowHumanReadableText then begin
1239	aTargetCanvas.Font.Assign(Font);
1240	if aTargetCanvas.Font.Size = 0 then
1241	aTargetcanvas.Font.Height := GetFontData(aTargetCanvas.Font.Handle).Height;
1242	aTargetCanvas.Font.Color := FForegroundColor;
1243	aTargetCanvas.Brush.Style := bsClear;
1244	str := FSymbol^.rendered^.strings;
1245	while Assigned(str) do begin
1246	w := aTargetCanvas.TextWidth(PChar(str^.Text));
1247	x := round(str^.x - w*0.5) + baseX;
1248	y := round(str^.y) + baseY;
1249	aTargetCanvas.TextOut(x, y, PChar(str^.text));
1250	str := str^.next;
1251	end;
1252	end;
1253	end;
1254
1255	procedure TCustomBarcode.SetBarcodeType(const AValue: TBarcodeType);
1256	begin
1257	if (FBarcodeType = AValue) or not (AValue in FValidBarcodeTypes) then
1258	exit;
1259	FBarcodeType := AValue;
1260	GenerateAndInvalidate;
1261	end;
1262
1263
1264	{ TSimpleBarcode }
1265
1266	constructor TSimpleBarcode.Create(AOwner: TComponent);
1267	begin
1268	inherited;
1269	FAddCheckSum := true;
1270	FDisplayCheckSum := false;
1271	FText := GetSampleText;
1272	end;
1273
1274	function TSimpleBarcode.CalcFactor(AWidth, AHeight: Integer): Integer;
1275	var
1276	wtotal, htotal, wsymbol, hsymbol, wtext, htext, border, wwhite: Integer;
1277	begin
1278	CalcSize(1, wtotal, htotal, wsymbol, hsymbol, wtext, htext, border, wwhite);
1279	Result := AWidth div wtotal;
1280	if Result = 0 then Result := 1;
1281	end;
1282
1283	{ Calculates the dimensions of the barcode.
1284	The scaling factor has been applied. }
1285	procedure TSimpleBarcode.CalcSize(AFactor: Integer;
1286	out ATotalWidth, ATotalHeight, ASymbolWidth, ASymbolHeight,
1287	ATextWidth, ATextHeight, ABorderWidth, AWhitespaceWidth: Integer);
1288	begin
1289	// Calculate size of human-readable text and length of the bars
1290	if FShowHumanReadableText and (FSymbol^.GetText <> '') then
1291	GetTextSize(FSymbol^.GetText, ATextWidth, ATextHeight)
1292	else
1293	begin
1294	ATextWidth := 0;
1295	ATextHeight := 0;
1296	end;
1297
1298	ASymbolWidth := FSymbol^.Width * AFactor;
1299
1300	if FBearerBarMode <> bbmNone then
1301	begin
1302	ABorderWidth := FMargin * AFactor;
1303	AWhitespaceWidth := FWhitespaceWidth * AFactor;
1304	end else
1305	begin
1306	ABorderWidth := FMargin;
1307	AWhiteSpaceWidth := FWhiteSpaceWidth;
1308	end;
1309
1310	ATotalWidth := ASymbolWidth + 2 * AWhiteSpaceWidth;
1311	if FBearerBarMode = bbmBox then
1312	inc(ATotalWidth, 2*ABorderWidth);
1313
1314	if SymbolHeight = 0 then
1315	begin
1316	ATotalHeight := ClientHeight;
1317	ASymbolHeight := ATotalHeight - 2*ABorderWidth - ATextHeight;
1318	if ASymbolHeight < FMinSymbolHeight then begin
1319	ASymbolHeight := FMinSymbolHeight;
1320	ATotalHeight := ASymbolHeight + 2*ABorderWidth + ATextWidth;
1321	end;
1322	end else
1323	begin
1324	if SymbolHeight < FMinSymbolHeight then
1325	ASymbolHeight := FMinSymbolHeight
1326	else
1327	ASymbolHeight := SymbolHeight;
1328	ATotalHeight := ASymbolHeight + 2*ABorderWidth + ATextHeight;
1329	end;
1330	end;
1331
1332	{ Calculates the x coordinate at which the first bar will begin. }
1333	function TSimpleBarCode.CalcSymbolStart(ABorderWidth, AWhiteSpaceWidth: integer): Integer;
1334	begin
1335	Result := AWhiteSpaceWidth;
1336	if FBearerBarMode = bbmBox then
1337	inc(Result, ABorderWidth);
1338	end;
1339
1340	procedure TSimpleBarcode.CalculatePreferredSize(
1341	var PreferredWidth, PreferredHeight: Integer;
1342	WithThemeSpace: Boolean);
1343	var
1344	wtot, htot, wsym, hsym, wtxt, htxt, wb, wws: Integer;
1345	begin
1346	inherited;
1347
1348	if (FScale <> 0) and (FSymbolHeight <> 0) and (FSymbol <> nil) then //and (not FShowCodeAsText or (FSymbol^.GetText <> '')) then
1349	begin
1350	CalcSize(FScale, wtot, htot, wsym, hsym, wtxt, htxt, wb, wws);
1351	PreferredWidth := wtot;
1352	PreferredHeight := htot;
1353	end;
1354	end;
1355
1356	procedure TSimpleBarcode.DrawBarcode(ADrawer: TBasicBarcodeDrawer; AFactor: Double);
1357	var
1358	line: PZintRenderLine;
1359	str: PZintRenderString;
1360	fd: TFontData;
1361	begin
1362	// Prepare drawer
1363	if FBackgroundColor = clDefault then
1364	ADrawer.BackColor := GetDefaultColor(dctBrush)
1365	else
1366	ADrawer.BackColor := ColorToRGB(FBackgroundColor);
1367
1368	if FForegroundColor = clDefault then
1369	ADrawer.TextColor := GetDefaultColor(dctFont)
1370	else
1371	ADrawer.BarColor := ColorToRGB(FForegroundColor);
1372
1373	if Font.Color = clDefault then
1374	ADrawer.TextColor := GetDefaultColor(dctFont)
1375	else
1376	ADrawer.TextColor := ColorToRGB(Font.Color);
1377
1378	ADrawer.FontName := Font.Name;
1379	ADrawer.FontSize := Font.Size;
1380	if (Font.Name = 'default') or (Font.Size = 0) then
1381	begin
1382	fd := GetFontData(Font.Reference.Handle);
1383	if Font.Name = 'default' then
1384	ADrawer.FontName := fd.Name;
1385	if Font.Size = 0 then
1386	begin
1387	ADrawer.FontSize := fd.Height * 72 div Font.PixelsPerInch;
1388	if ADrawer.FontSize < 0 then ADrawer.FontSize := -ADrawer.FontSize;
1389	end;
1390	end;
1391	ADrawer.FontStyle := Font.Style;
1392
1393	// Start drawing, clear background
1394	ADrawer.BeginDrawing;
1395
1396	// Draw the lines (bars, bearing bars, box)
1397	line := FSymbol^.Rendered^.lines;
1398	while Assigned(Line) do begin
1399	ADrawer.DrawBar(
1400	AFactor * line^.x,
1401	AFactor * line^.y,
1402	AFactor * (line^.x + line^.width),
1403	AFactor * (line^.y + line^.length)
1404	);
1405	line := line^.next;
1406	end;
1407
1408	// Draw the text
1409	if FShowHumanReadableText then begin
1410	str := FSymbol^.Rendered^.strings;
1411	while Assigned(str) do begin
1412	ADrawer.DrawCenteredText(AFactor * str^.x, AFactor * str^.y, PChar(str^.Text));
1413	str := str^.next;
1414	end;
1415	end;
1416
1417	// Finish drawing
1418	ADrawer.EndDrawing;
1419	end;
1420
1421	{ Measures size of the specified text in pixels using the current barcode font. }
1422	procedure TSimpleBarCode.GetTextSize(const AText: String; out AWidth, AHeight: Integer);
1423	var
1424	bmp: TBitmap;
1425	extent: TSize;
1426	begin
1427	bmp := TBitmap.Create;
1428	try
1429	bmp.SetSize(1, 1);
1430	bmp.Canvas.Pixels[0, 0] := clWhite; // get the handle
1431	bmp.Canvas.Font.Assign(Font);
1432	extent := bmp.Canvas.TextExtent(AText);
1433	AWidth := extent.CX;
1434	AHeight := extent.CY;
1435	finally
1436	bmp.Free;
1437	end;
1438	end;
1439
1440	function TSimpleBarcode.InternalGenerate: Integer;
1441	begin
1442	Result := inherited;
1443
1444	// FAddCheckSum and FShowCheckSum set bits 1 and 2 of the Zint symbol's
1445	// option.
1446	FSymbol^.Option := 0;
1447	if FAddCheckSum then
1448	begin
1449	FSymbol^.Option := FSymbol^.Option or OPTION_ADD_CHECKSUM;
1450	if FDisplayCheckSum then
1451	FSymbol^.Option := FSymbol^.Option or OPTION_DISPLAY_CHECKSUM;
1452	end;
1453	end;
1454
1455	{ Adaption of the inherited method to allow for simplified drawing of
1456	simple single-row linear barcodes. }
1457	procedure TSimpleBarcode.IntfPaintOnCanvas(const ATargetCanvas: TCanvas;
1458	const ARect: TRect);
1459	var
1460	drawer: TCanvasBarcodeDrawer;
1461	begin
1462	if FSymbol^.Rendered = nil then
1463	raise Exception.Create('Bar code must have been rendered before drawing.');
1464
1465	drawer := TCanvasBarcodeDrawer.Create(ATargetCanvas, ARect.Width, ARect.Height);
1466	try
1467	DrawBarcode(drawer, 1.0);
1468	finally
1469	drawer.Free;
1470	end;
1471	end;
1472
1473	{ Paints the barcode on the control's canvas. Draws to an intermediate bitmap
1474	first which is then centered on the control. }
1475	procedure TSimpleBarcode.Paint;
1476	var
1477	bmp: TBitmap;
1478	w, h: Integer;
1479	R: TRect;
1480	ts: TTextstyle;
1481	begin
1482	if Color = clDefault then
1483	Canvas.Brush.Color := GetDefaultColor(dctBrush)
1484	else
1485	Canvas.Brush.Color := ColorToRGB(Color);
1486	Canvas.FillRect(0, 0, ClientWidth, ClientHeight);
1487
1488	if (FSymbol = nil) or (FText = '') then
1489	exit;
1490
1491	if FSymbol^.rendered = nil then
1492	RenderBarcode(ClientWidth, ClientHeight);
1493
1494	if (FErrorCode > 2) then
1495	begin
1496	ts := Canvas.TextStyle;
1497	ts.Alignment := taCenter;
1498	ts.Layout := tlCenter;
1499	ts.Wordbreak := true;
1500	ts.SingleLine := false;
1501	Canvas.Font.Assign(Font);
1502	Canvas.TextRect(ClientRect, 0, 0, 'Error: ' + LineEnding + ErrorString, ts);
1503	exit;
1504	end;
1505
1506	w := round(FSymbol^.Rendered^.Exact_Width);
1507	h := round(FSymbol^.Rendered^.Exact_Height);
1508
1509	bmp := TBitmap.Create;
1510	try
1511	bmp.SetSize(w, h);
1512	IntfPaintOnCanvas(bmp.Canvas, Rect(0, 0, w, h));
1513	Canvas.Draw((ClientWidth - w) div 2, (ClientHeight - h) div 2, bmp);
1514	finally
1515	bmp.Free;
1516	end;
1517	end;
1518
1519	procedure TSimpleBarCode.PaintOnCanvas(const ACanvas: TCanvas; const ARect: TRect);
1520	begin
1521	IntfPaintOnCanvas(ACanvas, ARect);
1522	end;
1523
1524	{ Creates the bar code pattern. Stores it as "lines" and "strings" in the
1525	"rendered" record of the TZintSymbol. }
1526	procedure TSimpleBarcode.RenderBarcode(AWidth, AHeight: Integer);
1527	var
1528	wtotal: Integer; // total width of the barcode, from left-mode to right-most feature
1529	htotal: Integer; // total height of the barcode, incl. text and borders
1530	wsymbol: Integer; // width from first and to last bar
1531	hsymbol: Integer; // height of the barcode symbol, i.e. bars only.
1532	wtext: Integer; // width of the human-readable text
1533	htext: Integer; // height of the human-readable text
1534	border: Integer; // width of the margin around symbol. Occupied by bearer bars.
1535	wwhite: Integer; // width of the white space before and after the symbol, used for bearer bars or box
1536	factor: Integer; // scaling factor for width
1537	x, y: Integer;
1538	rendered: PZintRender; // Pointer to Zint rendering record. It collects the rendered results.
1539	lastLine: PZintRenderLine = nil;
1540	begin
1541	if FSymbol^.rendered <> nil then
1542	exit;
1543
1544	if FRecommendedSymbolSize then
1545	SetRecommendedSymbolSizeParams;
1546
1547	// The rendered pattern will be stored in the Rendered record of the Zint symbol.
1548	GetMem(FSymbol^.rendered, SizeOf(zint_render));
1549	rendered := FSymbol^.rendered;
1550	rendered^.Lines := nil;
1551	rendered^.Strings := nil;
1552	rendered^.Rings := nil;
1553	rendered^.Hexagons := nil;
1554
1555	// Calculate size of barcode
1556	if (FScale <= 0) then // automatic sizing
1557	factor := CalcFactor(AWidth, AHeight)
1558	else
1559	factor := FScale;
1560	CalcSize(factor, wtotal, htotal, wsymbol, hsymbol, wText, hText, border, wwhite);
1561
1562	// Set size of barcode and get x position of 1st bar.
1563	if wtext > wtotal then begin
1564	AWidth := wtext;
1565	AHeight := htotal;
1566	x := (wtext - wsymbol) div 2;
1567	end else
1568	begin
1569	AWidth := wtotal;
1570	AHeight := htotal;
1571	x := CalcSymbolStart(border, wwhite);
1572	end;
1573
1574	// Render bars and spaces
1575	RenderSymbol(x, border, hsymbol, htext, factor, lastline);
1576
1577	// Render the human-readable text
1578	if FShowHumanReadableText then
1579	begin
1580	y := htotal - htext;
1581	{
1582	if FShowBearerBars or FShowBox then
1583	dec(y, border);
1584	}
1585	RenderText(wsymbol, x, y);
1586	end;
1587
1588	// Render the horizontal bearer bars
1589	if FBearerBarMode <> bbmNone then
1590	RenderBearerBars(AWidth, hsymbol, border, lastline);
1591
1592	// Draw box
1593	if FBearerBarMode = bbmBox then
1594	RenderBox(AWidth, hsymbol, border, lastline);
1595
1596	// Store the symbol's rendered dimensions
1597	rendered^.exact_width := AWidth;
1598	rendered^.exact_height := AHeight;
1599	end;
1600
1601	{ Renders the horizontal bearer bars.
1602	- AWidth: total width of the symbol incl Border and WhiteSpaceWidth
1603	- AHeight: height of the symbol (without text)
1604	- ABorder: line width of the bearer bar }
1605	procedure TSimpleBarcode.RenderBearerBars(AWidth, AHeight, ABorder: Integer;
1606	var ALastLine: PZintRenderLine);
1607	var
1608	line: PZintRenderLine;
1609	begin
1610	line := render_plot_create_line(0, 0, AWidth, ABorder);
1611	render_plot_add_line(FSymbol, line, @ALastLine);
1612
1613	line := render_plot_create_line(0, ABorder + AHeight, AWidth, ABorder);
1614	render_plot_add_line(FSymbol, line, @ALastLine);
1615	end;
1616
1617	{ Renders the vertical lines of the box. The horizontal lines of the box already
1618	have been render by RenderBearerBars.
1619	- AWidth: total width of the symbol incl Border and WhiteSpaceWidth
1620	- AHeight: height of the symbol (without text)
1621	- ABorder: width of the box border }
1622	procedure TSimpleBarcode.RenderBox(AWidth, AHeight, ABorder: Integer;
1623	var ALastLine: PZintRenderLine);
1624	var
1625	line: PZintRenderLine;
1626	begin
1627	line := render_plot_create_line(0, 0, ABorder, ABorder + AHeight + ABorder);
1628	render_plot_add_line(FSymbol, line, @ALastLine);
1629
1630	line := render_plot_create_line(AWidth - ABorder, 0, AWidth, ABorder + AHeight + ABorder);
1631	render_plot_add_line(FSymbol, line, @ALastLine);
1632	end;
1633
1634	{ Renders bars and spaces.
1635	- xLeft, yTop: left/top corner of the first bar
1636	- ASymbolHeight: height of the entire symbol (without text)
1637	- ATextHeight: height of the human-readable text. Needed by EAN code bar extensions.
1638	- AFactor: current scaling factor with respect to pixels }
1639	procedure TSimpleBarcode.RenderSymbol(xLeft, yTop, ASymbolHeight, ATextHeight, AFactor: Integer;
1640	var ALastLine: PZintRenderline);
1641	var
1642	i: Integer; // general loop variable
1643	x, y: Integer; // coordinates of the left/top corner of the currently rendered bar.
1644	row: Integer; // index of the currently rendered row
1645	total_row_height: Integer; // some of the heights stored in the Zint symbol record
1646	hrow: Integer; // height of the currently rendered row
1647	wblock: Integer; // width of an individual bar or space
1648	isBar: Boolean; // flag indication whether the currently rendered feature is a bar or a space
1649	line: PZintRenderLine;
1650	begin
1651	// Calculate total row height from the Zint symbol
1652	total_row_height := 0;
1653	for row := 0 to FSymbol^.rows-1 do
1654	total_row_height := total_row_height + FSymbol^.row_height[row];
1655
1656	// y loop to render the symbol's bars and spaces
1657	y := yTop;
1658	for row := 0 to FSymbol^.rows-1 do
1659	begin
1660	if total_row_height = 0 then
1661	hrow := ASymbolHeight div FSymbol^.Rows
1662	else
1663	hrow := round(ASymbolHeight * FSymbol^.row_height[row] / total_row_height);
1664
1665	isBar := module_is_set(FSymbol, row, 0);
1666	x := xLeft;
1667	i := 0;
1668	while i < FSymbol^.Width do
1669	begin
1670	// Get width of current bar or space ("block")
1671	wblock := 0;
1672	repeat
1673	inc(wblock);
1674	until
1675	(i + wblock >= FSymbol^.Width) or
1676	(module_is_set(FSymbol, row, i + wblock) <> module_is_set(FSymbol, row, i));
1677
1678	// Render bar. If no bar: skip this block
1679	if isBar then
1680	begin
1681	line := render_plot_create_line(x, y, wblock*AFactor, hrow);
1682	render_plot_add_line(FSymbol, line, @ALastLine);
1683	end;
1684
1685	// Advance to next block
1686	inc(i, wblock);
1687	inc(x, wblock*AFactor);
1688	isBar := not isBar;
1689	end;
1690
1691	// Advance to next row
1692	y := y + hrow;
1693	end;
1694	end;
1695
1696	{ Renders the symbol's human-readable text.
1697	- ASymbolWidth: width of the symbol, the text is centered
1698	- ASymbolstart: the x coordinate at which the first bar is drawn
1699	- ATextPos: vertical coordinate of the text position, refers to top of text. }
1700	procedure TSimpleBarcode.RenderText(ASymbolWidth, ASymbolStart, ATextPos: Integer);
1701	var
1702	lastString: PZintRenderString = nil;
1703	x: Integer;
1704	begin
1705	x := ASymbolStart + ASymbolWidth div 2;
1706	render_plot_add_string(FSymbol, FSymbol^.text, x, ATextPos, 0, 0, @laststring);
1707	end;
1708
1709	{ Renders the barcode and saves it to the specified stream in the EPS format.
1710	Converts the rendered pixels of the barcode to the same size in the Symbol.
1711	Coordinates are points (1pt = 1/72 inch. }
1712	procedure TSimpleBarcode.SaveToEpsStream(const AStream: TStream);
1713	var
1714	factor, w, h: Double;
1715	drawer: TEpsBarcodeDrawer;
1716	begin
1717	if (FSymbol^.rendered = nil) then
1718	RenderBarcode(ClientWidth, ClientHeight);
1719
1720	factor := 72.0 / ScreenInfo.PixelsPerInchX; // Conversion from pixels to pts
1721	w := FSymbol^.rendered^.exact_width * factor; // Barcode width in pt
1722	h := FSymbol^.rendered^.exact_height * factor;// Barcode height in pt
1723
1724	drawer := TEpsBarcodeDrawer.Create(w, h, FSymbol^.GetText);
1725	try
1726	DrawBarcode(drawer, factor);
1727	drawer.SaveToStream(AStream);
1728	finally
1729	drawer.Free;
1730	end;
1731	end;
1732
1733	{ Renders the barcode and saves it as a graphic image to the specified stream.
1734	AImageClass is the image class to be created, e.g. TPortableNetworkGraphic
1735	(default, if omitted: TBitmap)
1736	AWidth and AHeight set the size of the bitmap which is assumed to be equal
1737	to the size of the rendered barcode if omitted. }
1738	procedure TSimpleBarcode.SaveToStream(const AStream: TStream;
1739	AImageClass: TFPImageBitmapClass = nil;
1740	AWidth: Integer = -1; AHeight: Integer = -1);
1741	var
1742	img: TFPImageBitmap;
1743	begin
1744	if FSymbol^.rendered = nil then
1745	RenderBarcode(ClientWidth, ClientHeight);
1746
1747	if AWidth = -1 then
1748	AWidth := round(FSymbol^.Rendered^.Exact_Width);
1749	if AHeight = -1 then
1750	AHeight := round(FSymbol^.Rendered^.Exact_Height);
1751
1752	if AImageClass = nil then
1753	img := TBitmap.Create
1754	else
1755	img := AImageClass.Create;
1756	try
1757	img.SetSize(AWidth, AHeight);
1758	img.Canvas.Brush.Color := clWhite;
1759	img.Canvas.FillRect(0, 0, img.Width, img.Height);
1760	PaintOnCanvas(img.Canvas, Rect(0, 0, img.Width, img.Height));
1761	img.SaveToStream(AStream);
1762	finally
1763	img.Free;
1764	end;
1765	end;
1766
1767	{ Renders the barcode and saves it as a svg image to the specified stream.
1768	Converts the rendered pixels of the barcode to the same size in the svg.
1769	svg coordinates are millimeters. }
1770	procedure TSimpleBarcode.SaveToSvgStream(const AStream: TStream);
1771	var
1772	factor, w, h: Double;
1773	drawer: TSvgBarcodeDrawer;
1774	begin
1775	if (FSymbol^.rendered = nil) then
1776	RenderBarcode(ClientWidth, ClientHeight);
1777
1778	factor := 25.4 / ScreenInfo.PixelsPerInchX; // Conversion from pixels to mm
1779	w := FSymbol^.rendered^.exact_width * factor; // Barcode width in mm
1780	h := FSymbol^.rendered^.exact_height * factor; // Barcode height in mm
1781
1782	drawer := TSvgBarcodeDrawer.Create(w, h, FSymbol^.GetText);
1783	try
1784	DrawBarcode(drawer, factor);
1785	drawer.SaveToStream(AStream);
1786	finally
1787	drawer.Free;
1788	end;
1789	end;
1790
1791	procedure TSimpleBarcode.SetAddCheckSum(const AValue: Boolean);
1792	begin
1793	if FAddCheckSum <> AValue then
1794	begin
1795	FAddCheckSum := AValue;
1796	GenerateAndInvalidate;
1797	end;
1798	end;
1799
1800	procedure TSimpleBarcode.SetDisplayCheckSum(const AValue: Boolean);
1801	begin
1802	if FDisplayCheckSum <> AValue then
1803	begin
1804	FDisplayCheckSum := AValue;
1805	GenerateAndInvalidate;
1806	end;
1807	end;
1808
1809
1810	{ TBarcodeC11 }
1811
1812	constructor TBarcodeC11.Create(AOwner: TComponent);
1813	begin
1814	FBarcodeType := bctCode11;
1815	FValidBarcodeTypes := [bctCode11];
1816	inherited;
1817	end;
1818
1819	class function TBarcodeC11.GetControlClassDefaultSize: TSize;
1820	begin
1821	Result.CX := 220;
1822	Result.CY := 80;
1823	end;
1824
1825	function TBarcodeC11.GetSampleText: String;
1826	begin
1827	Result := '012345678';
1828	end;
1829
1830	function TBarcodeC11.InternalGenerate: Integer;
1831	begin
1832	Result := inherited;
1833	if Result = 0 then
1834	Result := code_11(FSymbol, FText);
1835	end;
1836
1837
1838	{ TBarcodeC128 }
1839
1840	constructor TBarcodeC128.Create(AOwner: TComponent);
1841	var
1842	bct: TBarcodeTypeC128;
1843	begin
1844	FBarcodeType := bctCode128;
1845	for bct in TBarcodeTypeC128 do
1846	Include(FValidBarcodeTypes, bct);
1847	inherited;
1848	end;
1849
1850	function TBarcodeC128.GetBarcodeType: TBarcodeTypeC128;
1851	begin
1852	Result := TBarcodeTypeC128(FBarcodeType);
1853	end;
1854
1855	class function TBarcodeC128.GetControlClassDefaultSize: TSize;
1856	begin
1857	Result.CX := 460;
1858	Result.CY := 80;
1859	end;
1860
1861	function TBarcodeC128.GetSampleText: String;
1862	begin
1863	case FBarcodeType of
1864	bctCode128:
1865	Result := 'Sample-Code-128';
1866	bctEAN128:
1867	Result := '[01]Sample-EAN-128';
1868	end;
1869	end;
1870
1871	function TBarcodeC128.InternalGenerate: Integer;
1872	begin
1873	Result := inherited;
1874	if Result = 0 then
1875	case FBarcodeType of
1876	bctCode128:
1877	Result := code_128(FSymbol, @FText[1], Length(FText));
1878	bctEAN128:
1879	Result := ean_128(FSymbol, @FText[1], Length(FText));
1880	else
1881	raise Exception.Create('Barcode type not supported.');
1882	end;
1883	end;
1884
1885	procedure TBarcodeC128.SetBarcodeType(const AValue: TBarcodeTypeC128);
1886	begin
1887	inherited SetBarcodeType(AValue);
1888	end;
1889
1890
1891	{ TBarcode2of5 }
1892
1893	constructor TBarcode2of5.Create(AOwner: TComponent);
1894	var
1895	bct: TBarcodeType2of5;
1896	begin
1897	FBarcodeType := bctCode25DataLogic;
1898	for bct in TBarcodeType2of5 do
1899	Include(FValidBarcodeTypes, bct);
1900	inherited;
1901	end;
1902
1903	function TBarcode2of5.GetBarcodeType: TBarcodeType2of5;
1904	begin
1905	Result := TBarcodeType2of5(FBarcodeType);
1906	end;
1907
1908	class function TBarcode2of5.GetControlClassDefaultSize: TSize;
1909	begin
1910	Result.CX := 430;
1911	Result.CY := 80;
1912	end;
1913
1914	function TBarcode2of5.GetSampleText: String;
1915	begin
1916	Result := '012345678';
1917	end;
1918
1919	function TBarcode2of5.InternalGenerate: Integer;
1920	begin
1921	Result := inherited;
1922
1923	if Result = 0 then
1924	begin
1925	case FBarcodeType of
1926	bctCode25DataLogic:
1927	Result := logic_two_of_five(FSymbol, FText);
1928	bctCode25IATA:
1929	Result := iata_two_of_five(FSymbol, FText);
1930	bctCode25Industrial:
1931	Result := industrial_two_of_five(FSymbol, FText);
1932	bctCode25Interleaved:
1933	Result := interleaved_two_of_five(FSymbol, FText);
1934	bctCode25Standard:
1935	Result := matrix_two_of_five(FSymbol, FText);
1936	bctITF14:
1937	Result := itf14(FSymbol, FText);
1938	else
1939	raise Exception.Create('Barcode type not supported.');
1940	end;
1941	end;
1942	end;
1943
1944	procedure TBarcode2of5.SetBarcodeType(const AValue: TBarcodeType2of5);
1945	begin
1946	inherited SetBarcodeType(AValue);
1947	end;
1948
1949	procedure TBarcode2of5.SetRecommendedSymbolSizeParams;
1950	begin
1951	inherited;
1952	case FBarcodeType of
1953	bctITF14:
1954	begin
1955	// https://www.gs1ie.org/standards/data-carriers/barcodes/itf-14/
1956	FScale := MillimetersToPixels(1.016);
1957	FSymbolHeight := MillimetersToPixels(32.0);
1958	end;
1959	else
1960	;
1961	end;
1962	end;
1963
1964
1965	{ TBarcode3of9 }
1966
1967	constructor TBarcode3of9.Create(AOwner: TComponent);
1968	var
1969	bct: TBarcodeType3of9;
1970	begin
1971	FBarcodeType := bctCode39;
1972	for bct in TBarcodeType3of9 do
1973	Include(FValidBarcodeTypes, bct);
1974	inherited;
1975	end;
1976
1977	function TBarcode3of9.GetBarcodeType: TBarcodeType3of9;
1978	begin
1979	Result := TBarcodeType3of9(FBarcodeType);
1980	end;
1981
1982	class function TBarcode3of9.GetControlClassDefaultSize: TSize;
1983	begin
1984	Result.CX := 430;
1985	Result.CY := 80;
1986	end;
1987
1988	function TBarcode3of9.GetSampleText: String;
1989	begin
1990	Result := 'Barcode';
1991	end;
1992
1993	function TBarcode3of9.InternalGenerate: Integer;
1994	begin
1995	Result := inherited;
1996	if Result = 0 then
1997	case FBarcodeType of
1998	bctCode39,
1999	bctLOGMARS:
2000	Result := c39(FSymbol, FText);
2001	bctCode39Ext:
2002	Result := ec39(FSymbol, FText);
2003	bctCode93:
2004	Result := c93(FSymbol, FText);
2005	else
2006	raise Exception.Create('Barcode type not supported.');
2007	end;
2008	end;
2009
2010	procedure TBarcode3of9.SetBarcodeType(const AValue: TBarcodeType3of9);
2011	begin
2012	inherited SetBarcodeType(AValue);
2013	end;
2014
2015
2016	{ TBarcodeEAN }
2017
2018	constructor TBarcodeEAN.Create(AOwner: TComponent);
2019	var
2020	bct: TBarcodeTypeEAN;
2021	begin
2022	FBarcodeType := bctEAN;
2023	for bct in TBarcodeTypeEAN do
2024	Include(FValidBarcodeTypes, bct);
2025
2026	inherited;
2027	end;
2028
2029	{ Reserve space for the pre-text printed to the left of the symbol. }
2030	procedure TBarcodeEAN.CalcSize(AFactor: Integer; out ATotalWidth, ATotalHeight,
2031	ASymbolWidth, ASymbolHeight, ATextWidth, ATextHeight,
2032	ABorderWidth, AWhitespaceWidth: Integer);
2033	var
2034	leftText, rightText: String;
2035	wLeftText, wRightText, h: Integer;
2036	begin
2037	inherited CalcSize(AFactor, ATotalWidth, ATotalHeight,
2038	ASymbolWidth, ASymbolHeight, ATextWidth, ATextHeight,
2039	ABorderWidth, AWhiteSpaceWidth);
2040
2041	if FShowHumanReadableText then
2042	begin
2043	leftText := GetLeftText;
2044	if leftText <> '' then
2045	begin
2046	GetTextSize(leftText + SPACER, wLeftText, h);
2047	inc(ATotalWidth, wLeftText);
2048	end;
2049
2050	rightText := GetRightText;
2051	if rightText <> '' then
2052	begin
2053	GetTextSize(SPACER + rightText , wRightText, h);
2054	inc(ATotalWidth, wRightText);
2055	end;
2056	end;
2057	end;
2058
2059	function TBarcodeEAN.CalcSymbolStart(ABorderWidth, AWhiteSpaceWidth: Integer): Integer;
2060	var
2061	leftText: String;
2062	wLeftText, h: Integer;
2063	begin
2064	Result := inherited CalcSymbolStart(ABorderWidth, AWhiteSpaceWidth);
2065	if FShowHumanReadableText then
2066	begin
2067	leftText := GetLeftText;
2068	if leftText <> '' then
2069	begin
2070	GetTextSize(leftText + SPACER, wLeftText, h);
2071	inc(Result, wLeftText div 2);
2072	// advance only by half of the text width since the text will be centered.
2073	end;
2074	end;
2075	end;
2076
2077	function TBarcodeEAN.GetAddOnText: String;
2078	var
2079	txt: String;
2080	p: Integer;
2081	begin
2082	txt := FSymbol^.GetText;
2083	p := pos('+', txt);
2084	if p > 0 then
2085	Result := Copy(txt, p+1)
2086	else
2087	Result := '';
2088	end;
2089
2090	function TBarcodeEAN.GetBarcodeType: TBarcodeTypeEAN;
2091	begin
2092	Result := TBarcodeTypeEAN(FBarcodeType);
2093	end;
2094
2095	class function TBarcodeEAN.GetControlClassDefaultSize: TSize;
2096	begin
2097	Result.CX := 330;
2098	Result.CY := 110;
2099	end;
2100
2101	function TBarcodeEAN.GetLeftText: String;
2102	var
2103	txt: String;
2104	begin
2105	txt := FSymbol^.GetText;
2106	if UPC_EAN_Flag in [13, 12, 6] then // EAN-13, UPC-A, UPC-E
2107	Result := txt[1]
2108	else
2109	Result := '';
2110	end;
2111
2112	function TBarCodeEAN.GetRightText: String;
2113	var
2114	txt: String;
2115	begin
2116	txt := FSymbol^.GetText;
2117	case UPC_EAN_Flag of
2118	12: Result := txt[12]; // UPC-A
2119	6: Result := txt[8]; // UPC-E
2120	else Result := '';
2121	end;
2122	end;
2123
2124	function TBarcodeEAN.GetSampleText: String;
2125	begin
2126	case FBarcodeType of
2127	bctEAN:
2128	Result := '012345678';
2129	bctEAN14:
2130	Result := '1845678901001';
2131	bctISBN:
2132	Result := '9781234567897';
2133	bctNVE18:
2134	Result := '614141123456789';
2135	bctUPCA:
2136	Result := '72527273070';
2137	bctUPCE:
2138	Result := '0123456';
2139	else
2140	Result := inherited;
2141	end;
2142	end;
2143
2144	function TBarcodeEAN.InternalGenerate: Integer;
2145	var
2146	len: integer;
2147	begin
2148	len := Length(FText);
2149	case FBarcodeType of
2150	bctEAN:
2151	Result := eanx(FSymbol, FText);
2152	bctEAN14:
2153	Result := ean_14(FSymbol, @FText[1], len);
2154	bctISBN:
2155	Result := eanx(FSymbol, FText);
2156	bctNVE18:
2157	Result := nve_18(FSymbol, @FText[1], len);
2158	bctUPCA:
2159	Result := eanx(FSymbol, FText);
2160	bctUPCE:
2161	Result := eanx(FSymbol, FText);
2162	else
2163	raise Exception.Create('Barcode type not supported.');
2164	end;
2165	end;
2166
2167	{ Is overridden to handle the bar extensions of most of the UPC/EAN codes, i.e.
2168	some bars are drawn longer than the others.}
2169	procedure TBarcodeEAN.RenderSymbol(xLeft, yTop, AHeight, ATextHeight, AFactor: Integer;
2170	var ALastLine: PZintRenderLine);
2171	var
2172	i, n: Integer;
2173	line: PZintRenderLine;
2174	upc_ean: Integer;
2175	extendBar: boolean;
2176	begin
2177	inherited;
2178
2179	// Count the bars
2180	n := 0;
2181	line := FSymbol^.rendered^.lines;
2182	while line <> nil do
2183	begin
2184	Inc(n);
2185	line := line^.next;
2186	end;
2187
2188	// Draw the bar extensions
2189	upc_ean := UPC_EAN_Flag;
2190	i := 0;
2191	line := FSymbol^.rendered^.lines;
2192	while line <> nil do
2193	begin
2194	extendBar := false;
2195	case upc_ean of
2196	8: // EAN-8
2197	if (i in [0, 1, 10, 11, 20, 21]) then extendBar := true;
2198	13: // EAN-13
2199	if (i in [0, 1, 14, 15, 28, 29]) then extendBar := true;
2200	12: // UPC-A
2201	if (i in [0, 1, 2, 3, 14, 15, 26, 27, 28, 29]) then extendBar := true;
2202	6: // UPC-E
2203	if (i in [0, 1, 14, 15, 16]) then extendBar := true;
2204	else
2205	;
2206	end;
2207	if extendBar then
2208	line^.length := line^.length + ATextHeight;
2209	Inc(i);
2210	line := line^.next;
2211	end;
2212	end;
2213
2214	{ Is overridden to show text in groups and before and after the symbol }
2215	procedure TBarcodeEAN.RenderText(ASymbolWidth, ASymbolStart, ATextPos: Integer);
2216
2217	function TextCenter(LineL, LineR: Integer): Integer;
2218	var
2219	i: Integer;
2220	line: PZintRenderLine;
2221	x1, x2: Integer;
2222	begin
2223	x1 := -999;
2224	x2 := -999;
2225	i := 0;
2226	line := FSymbol^.rendered^.lines;
2227	while line <> nil do
2228	begin
2229	if i = LineL then
2230	x1 := round(line^.x + line^.width)
2231	else
2232	if (LineR <> -1) and (i = LineR) then
2233	x2 := round(line^.x)
2234	else
2235	if (LineR = -1) then
2236	x2 := round(line^.x);
2237	line := line^.next;
2238	inc(i);
2239	end;
2240	Result := (x1 + x2) div 2;
2241	end;
2242
2243	var
2244	lastString: PZintRenderString = nil;
2245	fullText: String;
2246	text14: String = ''; // text centered 1/4 of the width
2247	text34: String = ''; // text centered at 3/4 of the width
2248	text24: String = ''; // text centered over the full width
2249	textL: String = ''; // text to the left of the first bar
2250	textR: String = ''; // text to the right of the last bar
2251	textAddOn: String = ''; // add-on text
2252	x14, x24, x34, xaddon: Integer;
2253	w, h: Integer;
2254	begin
2255	fullText := FSymbol^.GetText;
2256	if fullText = '' then
2257	exit;
2258
2259	textL := GetLeftText;
2260	textR := GetRightText;
2261	textAddOn := GetAddOnText;
2262	case UPC_EAN_Flag of
2263	8: // EAN-8
2264	begin
2265	text14 := copy(fullText, 1, 4);
2266	text34 := copy(fullText, 5, 4);
2267	x14 := TextCenter(1, 10);
2268	x34 := TextCenter(11, 20);
2269	if textAddOn <> '' then xAddOn := TextCenter(22, -1);
2270	end;
2271	13: // EAN-13
2272	begin
2273	text14 := copy(fullText, 2, 6);
2274	text34 := copy(fullText, 8, 6);
2275	x14 := TextCenter(1, 14);
2276	x34 := TextCenter(15, 28);
2277	if textAddOn <> '' then xAddOn := TextCenter(30, -1);
2278	end;
2279	12: // UPC-A
2280	begin
2281	text14 := copy(fullText, 2, 5);
2282	text34 := copy(fullText, 7, 6);
2283	x14 := TextCenter(3, 14);
2284	x34 := TextCenter(15, 26);
2285	if textAddOn <> '' then xAddOn := TextCenter(30, -1);
2286	end;
2287	6: // UPC-E
2288	begin
2289	text24 := copy(fullText, 2, 6);
2290	x24 := TextCenter(1, 14);
2291	if textAddOn <> '' then xAddOn := TextCenter(17, -1);
2292	end;
2293	else
2294	text24 := fullText;
2295	x24 := ASymbolStart + ASymbolWidth div 2;
2296	end;
2297
2298	if textL <> '' then
2299	begin
2300	GetTextSize(textL + SPACER, w, h);
2301	render_plot_add_string(FSymbol, PByte(textL), ASymbolStart - w div 2, ATextPos, 0, 0, @laststring);
2302	end;
2303
2304	if text14 <> '' then
2305	render_plot_add_string(FSymbol, PByte(text14), x14, ATextPos, 0, 0, @laststring);
2306
2307	if text34 <> '' then
2308	render_plot_add_string(FSymbol, PByte(text34), x34, ATextPos, 0, 0, @laststring);
2309
2310	if (text24 <> '') then
2311	render_plot_add_string(FSymbol, PByte(text24), x24, ATextPos, 0, 0, @laststring);
2312
2313	if textR <> '' then
2314	begin
2315	GetTextSize(SPACER + textR, w, h);
2316	render_plot_add_string(FSymbol, PByte(textR), ASymbolStart + ASymbolWidth + w div 2, ATextPos, 0, 0, @laststring);
2317	end;
2318
2319	if textAddOn <> '' then
2320	render_plot_add_string(FSymbol, PByte(textAddOn), xAddOn, ATextPos, 0, 0, @laststring);
2321	end;
2322
2323	procedure TBarcodeEAN.SetBarcodeType(const AValue: TBarcodeTypeEAN);
2324	begin
2325	inherited SetBarcodeType(AValue);
2326	end;
2327
2328	procedure TBarcodeEAN.SetRecommendedSymbolSizeParams;
2329	begin
2330	inherited;
2331
2332	FScale := MillimetersToPixels(0.330);
2333	if FScale < 2 then FScale := 2;
2334	case UPC_EAN_FLAG of
2335	6, 12:
2336	begin // UPC-A, UPC-E
2337	FSymbolHeight := MillimetersToPixels(22.85);
2338	end;
2339	13:
2340	begin // EAN-13
2341	// https://www.gs1ie.org/standards/data-carriers/barcodes/ean-13/
2342	FSymbolHeight := MillimetersToPixels(22.85);
2343	FWhiteSpaceWidth := MillimetersToPixels(3.63);
2344	// not implemented: the left and right margins should be different...
2345	end;
2346	8:
2347	begin // EAN-8
2348	// https://www.gs1ie.org/standards/data-carriers/barcodes/ean-8/
2349	FScale := MillimetersToPixels(0.330);
2350	FSymbolHeight := MillimetersToPixels(18.23);
2351	FWhiteSpaceWidth := MillimetersToPixels(2.31);
2352	end;
2353	2, 5: // EAN-2 and EAN-5
2354	FSymbolHeight := MillimetersToPixels(21.10);
2355	else
2356	;
2357	end;
2358	end;
2359
2360	function TBarcodeEAN.UPC_EAN_Flag: Integer;
2361	var
2362	len: Integer;
2363	begin
2364	Result := 0;
2365	if FSymbol = nil then
2366	exit;
2367
2368	len := Length(FSymbol^.GetText);
2369
2370	if ((FSymbol^.symbology = BARCODE_EANX) and (FSymbol^.rows = 1)) or
2371	(FSymbol^.symbology = BARCODE_EANX_CC) or
2372	(FSymbol^.symbology = BARCODE_ISBNX) then
2373	begin
2374	case len of
2375	13, 16, 19: Result := 13;
2376	2: Result := 2;
2377	5: Result := 5;
2378	else Result := 8;
2379	end;
2380	end
2381	else
2382	if ((FSymbol^.symbology = BARCODE_UPCA) and (FSymbol^.rows = 1)) or
2383	(FSymbol^.symbology = BARCODE_UPCA_CC)
2384	then
2385	Result := 12
2386	else
2387	if ((FSymbol^.symbology = BARCODE_UPCE)) and (FSymbol^.rows = 1) or
2388	(FSymbol^.symbology = BARCODE_UPCE_CC)
2389	then
2390	Result := 6;
2391	end;
2392
2393
2394	{ TBarcodeChannelCode }
2395
2396	constructor TBarcodeChannelCode.Create(AOwner: TComponent);
2397	begin
2398	FBarcodeType := bctChannelCode;
2399	FValidBarcodeTypes := [bctChannelCode];
2400	inherited;
2401	end;
2402
2403	class function TBarcodeChannelCode.GetControlClassDefaultSize: TSize;
2404	begin
2405	Result.CX := 90;
2406	Result.CY := 90;
2407	end;
2408
2409	function TBarcodeChannelCode.GetSampleText: String;
2410	begin
2411	Result := '1234567';
2412	end;
2413
2414	function TBarcodeChannelCode.InternalGenerate: Integer;
2415	begin
2416	FSymbol^.option_2 := FChannelCount;
2417	Result := channel_code(FSymbol, FText);
2418	end;
2419
2420	procedure TBarcodeChannelCode.SetChannelCount(const AValue: Integer);
2421	begin
2422	if FChannelCount <> AValue then
2423	begin
2424	FChannelCount := AValue;
2425	GenerateAndInvalidate;
2426	end;
2427	end;
2428
2429	procedure TBarcodeChannelCode.SetRecommendedSymbolSizeParams;
2430	begin
2431	inherited;
2432	// https://barcodeguide.seagullscientific.com/Content/Symbologies/Channel_Code.htm
2433	FWhitespaceWidth := 2*FScale;
2434	FMinSymbolHeight := MillimetersToPixels(5.0);
2435	end;
2436
2437
2438	{ TBarcodeTypePlessey }
2439
2440	constructor TBarcodePlessey.Create(AOwner: TComponent);
2441	var
2442	bct: TBarcodeTypePlessey;
2443	begin
2444	FBarcodeType := bctPlessey;
2445	for bct in TBarcodeTypePlessey do
2446	Include(FValidBarcodeTypes, bct);
2447	inherited;
2448	FBearerBarMode := bbmNone;
2449	end;
2450
2451	function TBarcodePlessey.GetBarcodeType: TBarcodeTypePlessey;
2452	begin
2453	Result := TBarcodeTypePlessey(FBarcodeType);
2454	end;
2455
2456	class function TBarcodePlessey.GetControlClassDefaultSize: TSize;
2457	begin
2458	Result.CX := 450;
2459	Result.CY := 80;
2460	end;
2461
2462	function TBarcodePlessey.GetSampleText: String;
2463	begin
2464	Result := '012345678';
2465	end;
2466
2467	function TBarcodePlessey.InternalGenerate: Integer;
2468	begin
2469	Result := inherited;
2470	if Result = 0 then
2471	case FBarcodeType of
2472	bctPlessey:
2473	Result := plessey(FSymbol, FText);
2474	bctMSIPlessey:
2475	begin
2476	if FSymbol^.Option AND OPTION_ADD_CHECKSUM <> 0 then
2477	// Select type of checksum
2478	FSymbol^.Option_2 := ord(FCheckChar) + 1
2479	else
2480	FSymbol^.Option_2 := 0;
2481	Result := msi_plessey(FSymbol, FText);
2482	end;
2483	else
2484	raise Exception.Create('Barcode type not supported.');
2485	end;
2486	end;
2487
2488	procedure TBarcodePlessey.SetBarcodeType(const AValue: TBarcodeTypePlessey);
2489	begin
2490	inherited SetBarcodeType(AValue);
2491	end;
2492
2493	procedure TBarcodePlessey.SetCheckChar(const AValue: TPlesseyCheckChar);
2494	begin
2495	if FCheckChar = AValue then exit;
2496	FCheckChar := AValue;
2497	GenerateAndInvalidate;
2498	end;
2499
2500	procedure TBarcodePlessey.SetRecommendedSymbolSizeParams;
2501	begin
2502	inherited;
2503	// https://barcodeguide.seagullscientific.com/content/Symbologies/Plessey.htm
2504	FWhiteSpaceWidth := InchToPixels(0.125);
2505	FBearerBarMode := bbmNone;
2506	end;
2507
2508
2509	{ TBarcodeTelepen }
2510
2511	constructor TBarcodeTelepen.Create(AOwner: TComponent);
2512	var
2513	bct: TBarcodeTypeTelepen;
2514	begin
2515	FBarcodeType := bctTelepen;
2516	for bct in TBarcodeTypeTelepen do
2517	Include(FValidBarcodeTypes, bct);
2518	inherited;
2519	FBearerBarMode := bbmNone;
2520	end;
2521
2522	function TBarcodeTelepen.GetBarcodeType: TBarcodeTypeTelepen;
2523	begin
2524	Result := TBarcodeTypeTelepen(FBarcodeType);
2525	end;
2526
2527	class function TBarcodeTelepen.GetControlClassDefaultSize: TSize;
2528	begin
2529	Result.CX := 280;
2530	Result.CY := 80;
2531	end;
2532
2533	function TBarcodeTelepen.GetSampleText: String;
2534	begin
2535	case FBarcodeType of
2536	bctTelepenNum:
2537	Result := '012345678';
2538	else
2539	Result := 'Telepen';
2540	end;
2541	end;
2542
2543	function TBarcodeTelepen.InternalGenerate: Integer;
2544	begin
2545	case FBarcodeType of
2546	bctTelepen:
2547	Result := telepen(FSymbol, FText);
2548	bctTelepenNum:
2549	Result := telepen_num(FSymbol, FText);
2550	else
2551	raise Exception.Create('Barcode type not supported.');
2552	end;
2553	end;
2554
2555	procedure TBarcodeTelepen.SetBarcodeType(const AValue: TBarcodeTypeTelepen);
2556	begin
2557	inherited SetBarcodeType(AValue);
2558	end;
2559
2560	procedure TBarcodeTelepen.SetRecommendedSymbolSizeParams;
2561	begin
2562	inherited;
2563	FWhiteSpaceWidth := MillimetersToPixels(2.54);
2564	FBearerBarMode := bbmNone;
2565	end;
2566
2567
2568	{ TBarcodeMedical }
2569
2570	constructor TBarcodeMedical.Create(AOwner: TComponent);
2571	var
2572	bct: TBarcodeTypeMedical;
2573	begin
2574	FBarcodeType := bctCodaBar;
2575	for bct in TBarcodeTypeMedical do
2576	Include(FValidBarcodeTypes, bct);
2577	inherited;
2578	FBearerBarMode := bbmNone;
2579	end;
2580
2581	function TBarcodeMedical.GetBarcodeType: TBarcodeTypeMedical;
2582	begin
2583	Result := TBarcodeTypeMedical(FBarcodeType);
2584	end;
2585
2586	class function TBarcodeMedical.GetControlClassDefaultSize: TSize;
2587	begin
2588	Result.CX := 330;
2589	Result.CY := 80;
2590	end;
2591
2592	function TBarcodeMedical.GetSampleText: String;
2593	begin
2594	case FBarcodeType of
2595	bctCodaBar:
2596	Result := '012345678';
2597	bctCode32:
2598	Result := '01234567';
2599	bctPharmaOne:
2600	Result := '123456';
2601	bctPharmaTwo:
2602	Result := '12345678';
2603	bctPZN7:
2604	Result := '123456';
2605	bctPZN8:
2606	Result := '1234567';
2607	else
2608	Result := inherited;
2609	end;
2610	end;
2611
2612	function TBarcodeMedical.InternalGenerate: Integer;
2613	begin
2614	case FBarcodeType of
2615	bctCodaBar:
2616	Result := codabar(FSymbol, FText);
2617	bctCode32:
2618	Result := code32(FSymbol, FText);
2619	bctPharmaOne:
2620	Result := pharma_one(FSymbol, FText);
2621	bctPharmaTwo:
2622	Result := pharma_two(FSymbol, FText);
2623	bctPZN7:
2624	begin
2625	FSymbol^.option_3 := 7;
2626	Result := Pharmazentral(FSymbol, FText);
2627	end;
2628	bctPZN8:
2629	begin
2630	FSymbol^.option_3 := 8;
2631	Result := Pharmazentral(FSymbol, FText);
2632	end;
2633	else
2634	raise Exception.Create('Barcode type not supported.');
2635	end;
2636	end;
2637
2638	procedure TBarcodeMedical.SetBarcodeType(const AValue: TBarcodeTypeMedical);
2639	begin
2640	inherited SetBarcodeType(AValue);
2641	end;
2642
2643	procedure TBarcodeMedical.SetRecommendedSymbolSizeParams;
2644	begin
2645	inherited;
2646	FBearerBarMode := bbmNone;
2647	case FBarcodeType of
2648	bctCodabar:
2649	begin
2650	FScale := 2;
2651	FWhitespaceWidth := 10 * FScale;
2652	FMinSymbolHeight := MillimetersToPixels(5.0);
2653	end;
2654	bctPharmaOne:
2655	begin
2656	// https://help.commonvisionblox.com/Barcode/html_1dpharmacode_hints.htm
2657	FScale := MillimetersToPixels(0.5);
2658	FSymbolHeight := MillimetersToPixels(8.0);
2659	// https://barcodeguide.seagullscientific.com/Content/Symbologies/Phamacode.htm
2660	FWhitespaceWidth := MillimetersToPixels(6.0);
2661	end;
2662	bctPharmaTwo:
2663	begin
2664	// https://www.google.com/url?sa=t&rct=j&q=&esrc=s&source=web&cd=&ved=2ahUKEwjnua28sZb2AhXwSPEDHYfuAN4QFnoECCkQAQ&url=http%3A%2F%2Fwww.gomaro.ch%2Fftproot%2FLaetus_PHARMA-CODE.pdf&usg=AOvVaw05Tz-byyhJWQ15iDMIEqe1
2665	// https://www.google.com/url?sa=t&rct=j&q=&esrc=s&source=web&cd=&ved=2ahUKEwj-yumGsJb2AhVISPEDHbeKAec4ChAWegQIGRAB&url=http%3A%2F%2Fwww.gomaro.ch%2Fftproot%2FLaetus_PHARMA-CODE.pdf&usg=AOvVaw05Tz-byyhJWQ15iDMIEqe1
2666	FScale := MillimetersToPixels(0.8);
2667	FSymbolHeight := MillimetersToPixels(12.0);
2668	// https://barcodeguide.seagullscientific.com/Content/Symbologies/TwoTrackPharmacode.htm
2669	FWhitespaceWidth := MillimetersToPixels(6.0);
2670	end;
2671	else
2672	;
2673	end;
2674	end;
2675
2676
2677	{ TBarcodePostal }
2678
2679	constructor TBarcodePostal.Create(AOwner: TComponent);
2680	var
2681	bct: TBarcodeTypePostal;
2682	begin
2683	FBarcodeType := bctPostNet;
2684	for bct in TBarcodeTypePostal do
2685	Include(FValidBarcodeTypes, bct);
2686
2687	inherited;
2688
2689	FBearerBarMode := bbmNone;
2690	FGrouped := true;
2691	end;
2692
2693	function TBarcodePostal.GetBarcodeType: TBarcodeTypePostal;
2694	begin
2695	Result := TBarcodeTypePostal(FBarcodeType);
2696	end;
2697
2698	class function TBarcodePostal.GetControlClassDefaultSize: TSize;
2699	begin
2700	Result.CX := 390;
2701	Result.CY := 92;
2702	end;
2703
2704	function TBarcodePostal.GetSampleText: String;
2705	begin
2706	case FBarcodeType of
2707	bctAustraliaPostCustomer:
2708	Result := '12345678Abcde';
2709	bctAustraliaPostReplyPaid:
2710	Result := '12345678';
2711	bctAustraliaPostRoute:
2712	Result := '12345678';
2713	bctAustraliaPostRedirect:
2714	Result := '12345678';
2715	bctDaft:
2716	Result := 'DAFTDAFTDAFT';
2717	bctDeutschePostIdentCode:
2718	Result := '12345678901';
2719	bctDeutschePostLeitCode:
2720	Result := '1234567890123';
2721	bctFIM:
2722	Result := 'A';
2723	bctJapanPost:
2724	Result := '0123456789';
2725	bctKoreaPost:
2726	Result := '123456';
2727	bctKIX:
2728	Result := 'ABC123456';
2729	bctPlanet:
2730	Result := '123456789';
2731	bctPostNet:
2732	Result := '12345678901';
2733	bctRM4SCC:
2734	Result := '1234567ABC';
2735	else
2736	Result := inherited;
2737	end;
2738	end;
2739
2740	function TBarcodePostal.InternalGenerate: Integer;
2741	begin
2742	if FGrouped then
2743	FSymbol^.Option := OPTION_GROUPED_CHARS;
2744
2745	case FBarcodeType of
2746	bctAustraliaPostCustomer,
2747	bctAustraliaPostReplyPaid,
2748	bctAustraliaPostRoute,
2749	bctAustraliaPostRedirect:
2750	// Result := australia_post(FSymbol, PByte(FText), Length(FText)); // strLen(PChar(@FSymbol^.Text[0])));
2751	Result := australia_post(FSymbol, FText);
2752	bctDaft:
2753	Result := daft_code(FSymbol, FText);
2754	bctDeutschePostIdentCode:
2755	Result := dpident(FSymbol, FText);
2756	bctDeutschePostLeitCode:
2757	Result := dpleit(FSymbol, FText);
2758	bctFIM:
2759	Result := fim(FSymbol, FText);
2760	bctJapanPost:
2761	Result := japan_post(FSymbol, FText);
2762	bctKix:
2763	Result := kix_code(FSymbol, FText);
2764	bctKoreaPost:
2765	Result := korea_post(FSymbol, FText);
2766	bctPlanet:
2767	Result := planet_plot(FSymbol, FText);
2768	bctPostNet:
2769	Result := post_plot(FSymbol, FText);
2770	bctRM4SCC:
2771	Result := royal_plot(FSymbol, FText);
2772	else
2773	raise Exception.Create('Barcode type not supported.');
2774	end;
2775	end;
2776
2777	procedure TBarcodePostal.SetBarcodeType(const AValue: TBarcodeTypePostal);
2778	begin
2779	inherited SetBarcodeType(AValue);
2780	end;
2781
2782	procedure TBarcodePostal.SetGrouped(const AValue: Boolean);
2783	begin
2784	if FGrouped = AValue then exit;
2785	FGrouped := AValue;
2786	GenerateAndInvalidate;
2787	end;
2788
2789	procedure TBarcodePostal.SetRecommendedSymbolSizeParams;
2790	begin
2791	inherited;
2792	case FBarcodeType of
2793	bctAustraliaPostCustomer,
2794	bctAustraliaPostReplyPaid,
2795	bctAustraliaPostRoute,
2796	bctAustraliaPostRedirect:
2797	begin
2798	// https://www.google.com/url?sa=t&rct=j&q=&esrc=s&source=web&cd=&ved=2ahUKEwiVn67kxJ72AhW3SfEDHa6TDKQQFnoECBEQAQ&url=https%3A%2F%2Fauspost.com.au%2Fcontent%2Fdam%2Fauspost_corp%2Fmedia%2Fdocuments%2Fbarcoding-fact-sheet-oct14.pdf&usg=AOvVaw1lhoTgaNWAS9uF68b9a4Z0
2799	FScale := MillimetersToPixels(0.4);
2800	FSymbolHeight := MillimetersToPixels(5.0);
2801	FMinSymbolHeight := MillimetersToPixels(4.2);
2802	FMargin := MillimetersToPixels(2.0);
2803	FWhiteSpaceWidth := MillimetersToPixels(4.0);
2804	end;
2805	bctFIM:
2806	begin
2807	// https://barcodeguide.seagullscientific.com/Content/Symbologies/FIM.htm
2808	FScale := InchToPixels(0.03125);
2809	FSymbolHeight := InchToPixels(0.625);
2810	end;
2811	bctPostNet, bctPlanet:
2812	begin
2813	// https://pe.usps.com/Archive/NHTML/DMMArchive20170807/204.htm#ep1125449
2814	// "A full bar must be 0.125 ±0.010 inch high"
2815	// "A half bar must be 0.050 ±0.010 inch high."
2816	// "All bars must be 0.020 ±0.005 inch wide"
2817	FSymbolHeight := InchToPixels(0.125);
2818	FScale := InchToPixels(0.020);
2819	end;
2820	bctKIX, bctRM4SCC:
2821	begin
2822	// from lbc_render.pas
2823	FScale := (ScreenInfo.PixelsPerInchY div 2) div 22; // 22 bars per inch
2824	FSymbolHeight := MillimetersToPixels(5.22);
2825	end;
2826	bctJapanPost:
2827	begin
2828	// at least 2 mm quiet zone on all sides
2829	FMargin := MillimetersToPixels(2.0);
2830	FWhiteSpaceWidth := 0;
2831	end;
2832	else
2833	;
2834	end;
2835	FBearerBarMode := bbmNone;
2836	end;
2837
2838
2839	{ TBarcodePDF417 }
2840
2841	constructor TBarcodePDF417.Create(AOwner: TComponent);
2842	var
2843	bct: TBarcodeTypePDF417;
2844	begin
2845	FBarcodeType := bctPDF417;
2846	for bct in TBarcodeTypePDF417 do
2847	Include(FValidBarcodeTypes, bct);
2848
2849	inherited;
2850
2851	FShowHumanReadableText := false;
2852	FSymbolHeight := 3;
2853	FWhiteSpaceWidth := 0;
2854	end;
2855
2856	procedure TBarcodePDF417.CalcSize(AFactor: Integer; out ATotalWidth, ATotalHeight,
2857	ASymbolWidth, ASymbolHeight, ATextWidth, ATextHeight,
2858	ABorderWidth, AWhitespaceWidth: Integer);
2859	var
2860	x_factor, y_factor: Integer;
2861	begin
2862	inherited;
2863	if FSymbol <> nil then
2864	begin
2865	x_factor := AFactor;
2866	if FSymbolHeight <= 0 then
2867	y_factor := 3 * x_factor
2868	else
2869	y_factor := FSymbolHeight * x_factor; // FSymbolHeight is interpreted as row height here.
2870	ASymbolHeight := FSymbol^.rows * y_factor;
2871	ATotalHeight := ASymbolHeight + 2*ABorderWidth;
2872	end;
2873	end;
2874
2875	function TBarCodePDF417.CalcSymbolStart(ABorderWidth, AWhiteSpaceWidth: integer): Integer;
2876	begin
2877	Result := ABorderWidth;
2878	end;
2879	{
2880	procedure TBarCodePDF417.CalculatePreferredSize(
2881	var PreferredWidth, PreferredHeight: Integer;
2882	WithThemeSpace: Boolean);
2883	var
2884	wtot, htot, wsym, hsym, wtxt, htxt, wb, wws: Integer;
2885	factor: Integer;
2886	begin
2887	inherited;
2888
2889	if FScale = 0 then
2890	factor := CalcFactor(ClientWidth, ClientHeight)
2891	else
2892	factor := FScale;
2893	CalcSize(factor, wtot, htot, wsym, hsym, wtxt, htxt, wb, wws);
2894	PreferredWidth := wtot;
2895	PreferredHeight := htot;
2896	end;
2897	}
2898
2899	function TBarcodePDF417.GetBarcodeType: TBarcodeTypePDF417;
2900	begin
2901	Result := TBarcodeTypePDF417(FBarcodeType);
2902	end;
2903
2904	class function TBarcodePDF417.GetControlClassDefaultSize: TSize;
2905	begin
2906	Result.CX := 225;
2907	Result.CY := 110;
2908	end;
2909
2910	function TBarcodePDF417.GetRowHeightRatio: Integer;
2911	begin
2912	Result := FSymbolHeight;
2913	end;
2914
2915	function TBarcodePDF417.InternalGenerate: Integer;
2916	begin
2917	case FBarcodeType of
2918	bctPDF417:
2919	Result := pdf417(FSymbol, PByte(@FText[1]), Length(FText));
2920	bctPDF417trunc:
2921	Result := pdf417enc(FSymbol, PByte(@FText[1]), Length(FText));
2922	bctMicroPDF417:
2923	Result := micro_pdf417(FSymbol, PByte(@FText[1]), Length(FText));
2924	else
2925	raise Exception.Create('Barcode type not supported.');
2926	end;
2927	end;
2928
2929	procedure TBarcodePDF417.SetBarcodeType(const AValue: TBarcodeTypePDF417);
2930	begin
2931	inherited SetBarcodeType(AValue);
2932	end;
2933
2934	procedure TBarcodePDF417.SetRecommendedSymbolSizeParams;
2935	begin
2936	inherited;
2937	FSymbolHeight := 3;
2938	end;
2939
2940	procedure TBarcodePDF417.SetRowHeightRatio(const AValue: Integer);
2941	begin
2942	SetSymbolHeight(AValue);
2943	end;
2944
2945
2946	{ TBarcodeSquare - a hierarchy of barcodes with a square symbol }
2947
2948	constructor TBarcodeSquare.Create(AOwner: TComponent);
2949	begin
2950	inherited;
2951	FScale := 0;
2952	FShowHumanReadableText := false;
2953	FSymbolHeight := 0;
2954	FWhiteSpaceWidth := 0;
2955	end;
2956
2957	{ Calculates the pixel multiplication factor to fill the entire control as much
2958	as possible. Needed when FScale = 0. Considers only integer multiples of
2959	pixels}
2960	function TBarcodeSquare.CalcFactor(AWidth, AHeight: Integer): Integer;
2961	begin
2962	if AWidth > AHeight then
2963	Result := AHeight div FSymbol^.Width
2964	else
2965	Result := AWidth div FSymbol^.Width;
2966	if Result = 0 then
2967	Result := 1;
2968	end;
2969
2970	{ Calculates scaled size parameters for the barcode. }
2971	procedure TBarcodeSquare.CalcSize(AFactor: Integer; out ATotalWidth, ATotalHeight,
2972	ASymbolWidth, ASymbolHeight, ATextWidth, ATextHeight,
2973	ABorderWidth, AWhitespaceWidth: Integer);
2974	begin
2975	ABorderWidth := FMargin;
2976	AWhiteSpaceWidth := 0;
2977
2978	// These barcodes do not show human-readable text
2979	ATextWidth := 0;
2980	ATextHeight := 0;
2981
2982	ASymbolWidth := (FSymbol^.Width) * AFactor;
2983	ASymbolHeight := ASymbolWidth;
2984
2985	ATotalWidth := ASymbolWidth + 2*ABorderWidth;
2986	ATotalHeight := ATotalWidth;
2987	end;
2988
2989	function TBarCodeSquare.CalcSymbolStart(ABorderWidth, AWhiteSpaceWidth: integer): Integer;
2990	begin
2991	Result := ABorderWidth;
2992	end;
2993
2994	procedure TBarcodeSquare.CalculatePreferredSize(
2995	var PreferredWidth, PreferredHeight: Integer;
2996	WithThemeSpace: Boolean);
2997	var
2998	wtot, htot, wsym, hsym, wtxt, htxt, wb, wws: Integer;
2999	factor: Integer;
3000	begin
3001	inherited;
3002	if FScale = 0 then
3003	factor := CalcFactor(ClientWidth, ClientHeight)
3004	else
3005	factor := FScale;
3006	CalcSize(factor, wtot, htot, wsym, hsym, wtxt, htxt, wb, wws);
3007	PreferredWidth := wtot;
3008	PreferredHeight := htot;
3009	end;
3010
3011	class function TBarcodeSquare.GetControlClassDefaultSize: TSize;
3012	begin
3013	Result.CX := 88;
3014	Result.CY := 88;
3015	end;
3016
3017	procedure TBarcodesquare.SetRecommendedSymbolSizeParams;
3018	begin
3019	FScale := 0;
3020	FSymbolHeight := 0;
3021	FShowHumanReadableText := false;
3022	end;
3023
3024
3025	{ TBarcodeQR }
3026
3027	constructor TBarcodeQR.Create(AOwner: TComponent);
3028	begin
3029	FBarcodeType := bctQR;
3030	FValidBarcodeTypes := [bctQR];
3031	inherited;
3032	end;
3033
3034	function TBarcodeQR.InternalGenerate: Integer;
3035	begin
3036	UpdateECCLevel;
3037	Result := qr_code(FSymbol, @FText[1], Length(FText));
3038	end;
3039
3040	procedure TBarcodeQR.SetECCLevel(const AValue: TBarcodeQR_ECCLevel);
3041	begin
3042	if FECCLevel=AValue then exit;
3043	FECCLevel:=AValue;
3044	GenerateAndInvalidate;
3045	end;
3046
3047	procedure TBarcodeQR.UpdateECCLevel;
3048	begin
3049	FSymbol^.option_1 := ord(FECCLevel);
3050	end;
3051
3052
3053	{ TBarcodeMicroQR }
3054
3055	constructor TBarcodeMicroQR.Create(AOwner: TComponent);
3056	begin
3057	FBarcodeType := bctMicroQR;
3058	FValidBarcodeTypes := [bctMicroQR];
3059	inherited;
3060	end;
3061
3062	function TBarcodeMicroQR.InternalGenerate: Integer;
3063	begin
3064	UpdateECCLevel;
3065	Result := microqr(FSymbol, @FText[1], Length(FText));
3066	end;
3067
3068
3069	{ TBarcodeAztec }
3070
3071	constructor TBarcodeAztec.Create(AOwner: TComponent);
3072	begin
3073	FBarcodeType := bctAztec;
3074	FShowHumanReadableText := false;
3075	FValidBarcodeTypes := [bctAztec];
3076	inherited;
3077	end;
3078
3079	function TBarcodeAztec.InternalGenerate: Integer;
3080	begin
3081	FShowHumanReadableText := false;
3082	Result := aztec(FSymbol, @FText[1], Length(FText));
3083	end;
3084
3085
3086	{ TBarcodeAztecRune }
3087
3088	constructor TBarcodeAztecRune.Create(AOwner: TComponent);
3089	begin
3090	FBarcodeType := bctAztecRune;
3091	FValidBarcodetypes := [bctAztecRune];
3092
3093	inherited;
3094
3095	FShowHumanReadableText := false;
3096	end;
3097
3098	function TBarcodeAztecRune.GetSampleText: String;
3099	begin
3100	Result := '123';
3101	end;
3102
3103	function TBarcodeAztecRune.GetValue: TBarcodeAztecRune_Value;
3104	begin
3105	Result := StrToInt(FText);
3106	end;
3107
3108	function TBarcodeAztecRune.InternalGenerate: Integer;
3109	begin
3110	Result := aztec_runes(FSymbol, @FText[1], Length(FText));
3111	end;
3112
3113	procedure TBarcodeAztecRune.SetValue(const AValue: TBarcodeAztecRune_Value);
3114	var
3115	txt: String;
3116	begin
3117	txt := IntToStr(AValue);
3118	if FText = txt then exit;
3119	FText := txt;
3120	GenerateAndInvalidate;
3121	end;
3122
3123
3124	{ TBarcodeDataMatrix }
3125
3126	constructor TBarcodeDataMatrix.Create(AOwner: TComponent);
3127	begin
3128	FBarcodeType := bctDataMatrix;
3129	FValidBarcodeTypes := [bctDataMatrix];
3130
3131	inherited;
3132
3133	FShowHumanReadableText := false;
3134	end;
3135
3136	function TBarcodeDataMatrix.InternalGenerate: Integer;
3137	begin
3138	Result := dmatrix(FSymbol, @FText[1], Length(FText));
3139	end;
3140
3141
3142	end.
3143

Note: See TracBrowser for help on using the repository browser.

Context Navigation

source: trunk/Packages/lazbarcodes/src/ubarcodes.pas

Download in other formats: