1 | { lbc_upcean.pas - Handles EAN-based codes
|
---|
2 |
|
---|
3 | Based on Zint (done by Robin Stuart and the Zint team)
|
---|
4 | http://github.com/zint/zint
|
---|
5 | and Pascal adaption by TheUnknownOnes
|
---|
6 | http://theunknownones.net
|
---|
7 |
|
---|
8 | Refactoring: W. Pamler
|
---|
9 | }
|
---|
10 |
|
---|
11 | unit lbc_upcean;
|
---|
12 |
|
---|
13 | {$mode objfpc}{$H+}
|
---|
14 |
|
---|
15 | interface
|
---|
16 |
|
---|
17 | uses
|
---|
18 | zint;
|
---|
19 |
|
---|
20 | function eanx(ASymbol: PZintSymbol; const ASource: String): Integer;
|
---|
21 |
|
---|
22 | implementation
|
---|
23 |
|
---|
24 | uses
|
---|
25 | SysUtils, lbc_helper;
|
---|
26 |
|
---|
27 | const
|
---|
28 | SODIUM = '0123456789+';
|
---|
29 | EAN2 = 102;
|
---|
30 | EAN5 = 105;
|
---|
31 |
|
---|
32 | { UPC and EAN tables checked against EN 797:1996 }
|
---|
33 | const
|
---|
34 | { Number set for UPC-E symbol (EN Table 4) }
|
---|
35 | UPCParity0: array[0..9] of String = (
|
---|
36 | 'BBBAAA', 'BBABAA', 'BBAABA', 'BBAAAB', 'BABBAA',
|
---|
37 | 'BAABBA', 'BAAABB', 'BABABA', 'BABAAB', 'BAABAB'
|
---|
38 | );
|
---|
39 |
|
---|
40 | { Not covered by BS EN 797:1995 }
|
---|
41 | UPCParity1: array[0..9] of String = (
|
---|
42 | 'AAABBB', 'AABABB', 'AABBAB', 'AABBBA', 'ABAABB',
|
---|
43 | 'ABBAAB', 'ABBBAA', 'ABABAB', 'ABABBA', 'ABBABA');
|
---|
44 |
|
---|
45 | { Number sets for 2-digit add-on (EN Table 6) }
|
---|
46 | EAN2Parity: array[0..3] of String = (
|
---|
47 | 'AA', 'AB', 'BA', 'BB'
|
---|
48 | );
|
---|
49 |
|
---|
50 | { Number set for 5-digit add-on (EN Table 7) }
|
---|
51 | EAN5Parity: Array[0..9] of String = (
|
---|
52 | 'BBAAA', 'BABAA', 'BAABA', 'BAAAB', 'ABBAA',
|
---|
53 | 'AABBA', 'AAABB', 'ABABA', 'ABAAB', 'AABAB'
|
---|
54 | );
|
---|
55 |
|
---|
56 | { Left hand of the EAN-13 symbol (EN Table 3) }
|
---|
57 | EAN13Parity: Array[0..9] of String = (
|
---|
58 | 'AAAAA', 'ABABB', 'ABBAB', 'ABBBA', 'BAABB',
|
---|
59 | 'BBAAB', 'BBBAA', 'BABAB', 'BABBA', 'BBABA'
|
---|
60 | );
|
---|
61 |
|
---|
62 | { Representation set A and C (EN Table 1) }
|
---|
63 | EANsetA: Array[0..9] of String = (
|
---|
64 | '3211', '2221', '2122', '1411', '1132',
|
---|
65 | '1231', '1114', '1312', '1213', '3112'
|
---|
66 | );
|
---|
67 |
|
---|
68 | { Representation set B (EN Table 1) }
|
---|
69 | EANsetB: Array [0..9] of String = (
|
---|
70 | '1123', '1222', '2212', '1141', '2311',
|
---|
71 | '1321', '4111', '2131', '3121', '2113'
|
---|
72 | );
|
---|
73 |
|
---|
74 | {-------------------------------------------------------------------------------
|
---|
75 | UPC-A, UPC-E
|
---|
76 | -------------------------------------------------------------------------------}
|
---|
77 | { Calculate the correct check digit for a UPC barcode }
|
---|
78 | function upc_checksum(const ASource: String): String;
|
---|
79 | var
|
---|
80 | i, n, sum, check_digit: Integer;
|
---|
81 | begin
|
---|
82 | sum := 0;
|
---|
83 | for i := 1 to Length(ASource) do
|
---|
84 | begin
|
---|
85 | n := StrToInt(ASource[i]);
|
---|
86 | inc(sum, n);
|
---|
87 | if odd(i) then
|
---|
88 | inc(sum, 2 * n);
|
---|
89 | end;
|
---|
90 |
|
---|
91 | check_digit := 10 - sum mod 10;
|
---|
92 | if (check_digit = 10) then check_digit := 0;
|
---|
93 |
|
---|
94 | Result := IntToStr(check_digit);
|
---|
95 | end;
|
---|
96 |
|
---|
97 | { UPC A is usually used for 12 digit numbers, but this function takes a
|
---|
98 | source of any length }
|
---|
99 | procedure upca_draw(const ASource: String; var dest: String);
|
---|
100 | var
|
---|
101 | i, half_way: Cardinal;
|
---|
102 | begin
|
---|
103 | // START character
|
---|
104 | dest := '111';
|
---|
105 |
|
---|
106 | half_way := Length(ASource) div 2 + 1;
|
---|
107 | for i := 1 to Length(ASource) do
|
---|
108 | begin
|
---|
109 | if (i = half_way) then
|
---|
110 | begin
|
---|
111 | { middle character - separates manufacturer no. from product no. }
|
---|
112 | { also inverts right hand characters }
|
---|
113 | dest := dest + '11111';
|
---|
114 | end;
|
---|
115 |
|
---|
116 | lookup(NEON, EANsetA, ASource[i], dest);
|
---|
117 | end;
|
---|
118 |
|
---|
119 | // STOP character
|
---|
120 | dest := dest + '111';
|
---|
121 | end;
|
---|
122 |
|
---|
123 | { Make a UPC A barcode when we haven't been given the check digit }
|
---|
124 | procedure upca(ASymbol: PZintSymbol; const ASource: String; var dest: String);
|
---|
125 | var
|
---|
126 | gtin: String;
|
---|
127 | begin
|
---|
128 | gtin := ASource + upc_checksum(ASource);
|
---|
129 | upca_draw(gtin, dest);
|
---|
130 | ASymbol^.SetText(gtin);
|
---|
131 | end;
|
---|
132 |
|
---|
133 | { UPC E is a zero-compressed version of UPC A }
|
---|
134 | procedure upce(ASymbol: PZintSymbol; ASource: String; var dest: String);
|
---|
135 | var
|
---|
136 | i, num_system: Cardinal;
|
---|
137 | emode: char;
|
---|
138 | check: Integer;
|
---|
139 | check_digit: String;
|
---|
140 | equivalent: String;
|
---|
141 | parity: String = '';
|
---|
142 | temp: String = '';
|
---|
143 | hrt: String = ''; // "human-readable text"
|
---|
144 | begin
|
---|
145 | { Two number systems can be used - system 0 and system 1 }
|
---|
146 | if Length(ASource) = 7 then
|
---|
147 | begin
|
---|
148 | case ASource[1] of
|
---|
149 | '0': num_system := 0;
|
---|
150 | '1': num_system := 1;
|
---|
151 | else
|
---|
152 | num_system := 0;
|
---|
153 | ASource[1] := '0';
|
---|
154 | end;
|
---|
155 | temp := ASource;
|
---|
156 | hrt := ASource;
|
---|
157 | for i := 2 to 8 do
|
---|
158 | ASource[i-1] := temp[i];
|
---|
159 | end
|
---|
160 | else
|
---|
161 | begin
|
---|
162 | num_system := 0;
|
---|
163 | hrt := '0' + ASource;
|
---|
164 | end;
|
---|
165 |
|
---|
166 | { Expand the zero-compressed UPCE code to make a UPCA equivalent (EN Table 5) }
|
---|
167 | emode := ASource[6];
|
---|
168 | equivalent := StringOfChar('0', 11);
|
---|
169 | if (num_system = 1) then equivalent[1] := temp[1];
|
---|
170 | equivalent[2] := ASource[1];
|
---|
171 | equivalent[3] := ASource[2];
|
---|
172 |
|
---|
173 | case emode of
|
---|
174 | '0',
|
---|
175 | '1',
|
---|
176 | '2': begin
|
---|
177 | equivalent[4] := emode;
|
---|
178 | equivalent[9] := ASource[3];
|
---|
179 | equivalent[10] := ASource[4];
|
---|
180 | equivalent[11] := ASource[5];
|
---|
181 | end;
|
---|
182 | '3': begin
|
---|
183 | equivalent[4] := ASource[3];
|
---|
184 | equivalent[10] := ASource[4];
|
---|
185 | equivalent[11] := ASource[5];
|
---|
186 | if (ASource[3] in ['0', '1', '2']) then
|
---|
187 | { Note 1 - 'X3 shall not be equal to 0, 1 or 2' }
|
---|
188 | ASymbol^.SetErrorText('Invalid UPC-E data');
|
---|
189 | end;
|
---|
190 | '4': begin
|
---|
191 | equivalent[4] := ASource[3];
|
---|
192 | equivalent[5] := ASource[4];
|
---|
193 | equivalent[11] := ASource[5];
|
---|
194 | if (ASource[4] = '0') then
|
---|
195 | { Note 2 - 'X4 shall not be equal to 0' }
|
---|
196 | ASymbol^.SetErrorText('Invalid UPC-E data');
|
---|
197 | end;
|
---|
198 | '5',
|
---|
199 | '6',
|
---|
200 | '7',
|
---|
201 | '8',
|
---|
202 | '9': begin
|
---|
203 | equivalent[4] := ASource[3];
|
---|
204 | equivalent[5] := ASource[4];
|
---|
205 | equivalent[6] := ASource[5];
|
---|
206 | equivalent[11] := emode;
|
---|
207 | if (ASource[5] = '0') then
|
---|
208 | { Note 3 - 'X5 shall not be equal to 0' }
|
---|
209 | ASymbol^.SetErrorText('Invalid UPC-E data');
|
---|
210 | end;
|
---|
211 | end;
|
---|
212 |
|
---|
213 | // Get the check digit from the expanded UPCA code
|
---|
214 | check_digit := upc_checksum(equivalent);
|
---|
215 | check := StrToInt(check_digit);
|
---|
216 |
|
---|
217 | // Use the number system and check digit information to choose a parity scheme
|
---|
218 | if (num_system = 1) then
|
---|
219 | parity := UPCParity1[check]
|
---|
220 | else
|
---|
221 | parity := UPCParity0[check];
|
---|
222 |
|
---|
223 | // Take all this information and make the barcode pattern
|
---|
224 |
|
---|
225 | // START character
|
---|
226 | dest := '111';
|
---|
227 |
|
---|
228 | for i := 1 to Length(ASource) do
|
---|
229 | case parity[i] of
|
---|
230 | 'A': lookup(NEON, EANsetA, ASource[i], dest);
|
---|
231 | 'B': lookup(NEON, EANsetB, ASource[i], dest);
|
---|
232 | end;
|
---|
233 |
|
---|
234 | // STOP character
|
---|
235 | dest := dest + '111111';
|
---|
236 |
|
---|
237 | hrt := hrt + check_digit;
|
---|
238 | ASymbol^.SetText(hrt);
|
---|
239 | end;
|
---|
240 |
|
---|
241 | { EAN-2 and EAN-5 add-on codes }
|
---|
242 | procedure add_on(const ASource: String; var dest: String; mode: Integer);
|
---|
243 | var
|
---|
244 | parity: String;
|
---|
245 | code_type: Integer;
|
---|
246 | code_value: Integer;
|
---|
247 | parity_bit: Integer;
|
---|
248 | parity_sum: Integer;
|
---|
249 | i: Integer;
|
---|
250 | begin
|
---|
251 | // If an add-on then append with space
|
---|
252 | if (mode <> 0) then
|
---|
253 | dest := dest + '9';
|
---|
254 |
|
---|
255 | // START character
|
---|
256 | dest := dest + '112';
|
---|
257 |
|
---|
258 | // Determine EAN2 or EAN5 add-on
|
---|
259 | if Length(ASource) = 2 then
|
---|
260 | code_type := EAN2
|
---|
261 | else
|
---|
262 | code_type := EAN5;
|
---|
263 |
|
---|
264 | // Calculate parity for EAN2
|
---|
265 | if (code_type = EAN2) then
|
---|
266 | begin
|
---|
267 | code_value := StrToInt(copy(ASource, 1, 2));
|
---|
268 | parity_bit := code_value mod 4;
|
---|
269 | parity := EAN2Parity[parity_bit];
|
---|
270 | end else
|
---|
271 | // Calculate parity for EAN5
|
---|
272 | if (code_type = EAN5) then
|
---|
273 | begin
|
---|
274 | parity_sum :=
|
---|
275 | 3 * (StrToInt(ASource[1]) + StrToInt(ASource[3]) + StrToInt(ASource[5])) +
|
---|
276 | 9 * (StrToInt(ASource[2]) + StrToInt(ASource[4]));
|
---|
277 | parity_bit := parity_sum mod 10;
|
---|
278 | parity := EAN5Parity[parity_bit];
|
---|
279 | end;
|
---|
280 |
|
---|
281 | for i := 1 to Length(ASource) do
|
---|
282 | begin
|
---|
283 | case parity[i] of
|
---|
284 | 'A': lookup(NEON, EANsetA, ASource[i], dest);
|
---|
285 | 'B': lookup(NEON, EANsetB, ASource[i], dest);
|
---|
286 | end;
|
---|
287 |
|
---|
288 | { Glyph separator }
|
---|
289 | if i <> Length(ASource) then
|
---|
290 | dest := dest + '11';
|
---|
291 | end;
|
---|
292 | end;
|
---|
293 |
|
---|
294 |
|
---|
295 | {-------------------------------------------------------------------------------
|
---|
296 | EAN-13
|
---|
297 | -------------------------------------------------------------------------------}
|
---|
298 |
|
---|
299 | { Calculate the correct check digit for an EAN-13 barcode }
|
---|
300 | function ean_checksum(const ASource: String): String;
|
---|
301 | var
|
---|
302 | i, sum, check_digit, char_val: Integer;
|
---|
303 | begin
|
---|
304 | sum := 0;
|
---|
305 |
|
---|
306 | for i := Length(ASource) downto 1 do
|
---|
307 | begin
|
---|
308 | char_val := StrToInt(ASource[i]);
|
---|
309 | inc(sum, char_val);
|
---|
310 | if not odd(i) then
|
---|
311 | inc(sum, 2 * char_val);
|
---|
312 | end;
|
---|
313 |
|
---|
314 | check_digit := 10 - sum mod 10;
|
---|
315 | if (check_digit = 10) then check_digit := 0;
|
---|
316 |
|
---|
317 | Result := IntToStr(check_digit);
|
---|
318 | end;
|
---|
319 |
|
---|
320 | procedure ean13(ASymbol: PZintSymbol; const ASource: String; var dest: String);
|
---|
321 | var
|
---|
322 | i, half_way: Integer;
|
---|
323 | gtin: String;
|
---|
324 | parity: String;
|
---|
325 | begin
|
---|
326 | // Add the appropriate check digit
|
---|
327 | gtin := ASource + ean_checksum(ASource);
|
---|
328 |
|
---|
329 | // Get parity for first half of the symbol
|
---|
330 | parity := '';
|
---|
331 | lookup(SODIUM, EAN13Parity, gtin[1], parity);
|
---|
332 |
|
---|
333 | // Now get on with the cipher
|
---|
334 | half_way := 8;
|
---|
335 |
|
---|
336 | // START character
|
---|
337 | dest := '111';
|
---|
338 | for i := 2 to Length(gtin) do
|
---|
339 | begin
|
---|
340 | if (i = half_way) then
|
---|
341 | begin
|
---|
342 | // middle character - separates manufacturer no. from product no.
|
---|
343 | // also inverses right hand characters
|
---|
344 | dest := dest + '11111';
|
---|
345 | end;
|
---|
346 | if (i > 2) and (i < 8) and (parity[i - 2] = 'B') then
|
---|
347 | lookup(NEON, EANsetB, gtin[i], dest)
|
---|
348 | else
|
---|
349 | lookup(NEON, EANsetA, gtin[i], dest)
|
---|
350 | end;
|
---|
351 |
|
---|
352 | // STOP character
|
---|
353 | dest := dest + '111';
|
---|
354 |
|
---|
355 | ASymbol^.SetText(gtin);
|
---|
356 | end;
|
---|
357 |
|
---|
358 |
|
---|
359 | {-------------------------------------------------------------------------------
|
---|
360 | EAN-8
|
---|
361 |
|
---|
362 | Make an EAN-8 barcode when we haven't been given the check digit.
|
---|
363 | EAN-8 is basically the same as UPC-A but with fewer digits
|
---|
364 | -------------------------------------------------------------------------------}
|
---|
365 | procedure ean8(ASymbol: PZintSymbol; const ASource: String; var dest: String);
|
---|
366 | var
|
---|
367 | gtin: String;
|
---|
368 | begin
|
---|
369 | gtin := ASource + upc_checksum(ASource);
|
---|
370 | upca_draw(gtin, dest);
|
---|
371 | ASymbol^.SetText(gtin);
|
---|
372 | end;
|
---|
373 |
|
---|
374 |
|
---|
375 | {-------------------------------------------------------------------------------
|
---|
376 | ISBN
|
---|
377 | -------------------------------------------------------------------------------}
|
---|
378 | { For ISBN(13) only }
|
---|
379 | function isbn13_checksum(const ASource: String): String;
|
---|
380 | var
|
---|
381 | i, weight, sum, check: Integer;
|
---|
382 | begin
|
---|
383 | sum := 0;
|
---|
384 | weight := 1;
|
---|
385 | for i := 1 to Length(ASource)-1 do // Do no include check digit in calculation
|
---|
386 | begin
|
---|
387 | inc(sum, StrToInt(ASource[i]) * weight);
|
---|
388 | if weight = 1 then
|
---|
389 | weight := 3
|
---|
390 | else
|
---|
391 | weight := 1;
|
---|
392 | end;
|
---|
393 |
|
---|
394 | check := sum mod 10;
|
---|
395 | check := 10 - check;
|
---|
396 | if (check = 10) then check := 0;
|
---|
397 |
|
---|
398 | Result := IntToStr(check);
|
---|
399 | end;
|
---|
400 |
|
---|
401 | { For ISBN(10) and SBN only }
|
---|
402 | function isbn_checksum(const ASource: String): String;
|
---|
403 | var
|
---|
404 | i, weight, sum, check: Integer;
|
---|
405 | begin
|
---|
406 | sum := 0;
|
---|
407 | weight := 1;
|
---|
408 | for i := 1 to Length(ASource)-1 do // do not include check digit in calculation
|
---|
409 | begin
|
---|
410 | inc(sum, StrToInt(ASource[i]) * weight);
|
---|
411 | inc(weight);
|
---|
412 | end;
|
---|
413 |
|
---|
414 | check := sum mod 11;
|
---|
415 | if check = 10 then
|
---|
416 | Result := 'X'
|
---|
417 | else
|
---|
418 | Result := IntToStr(check);
|
---|
419 | end;
|
---|
420 |
|
---|
421 | { Make an EAN-13 barcode from an SBN or ISBN }
|
---|
422 | function isbn(ASymbol: PZintSymbol; var ASource: String; var dest: String): Integer;
|
---|
423 | var
|
---|
424 | check_digit: String;
|
---|
425 | s: String;
|
---|
426 | begin
|
---|
427 | // Input must be 9, 10 or 13 characters
|
---|
428 | if not (Length(ASource) in [9, 10, 13]) then
|
---|
429 | begin
|
---|
430 | ASymbol^.SetErrorText('Wrong input length (9, 10, or 13 characters)');
|
---|
431 | Result := ERROR_TOO_LONG;
|
---|
432 | exit;
|
---|
433 | end;
|
---|
434 |
|
---|
435 | Result := is_sane('0123456789Xx', ASource);
|
---|
436 | if (Result = ERROR_INVALID_DATA) then
|
---|
437 | begin
|
---|
438 | ASymbol^.SetErrorText('Invalid characters in input');
|
---|
439 | exit;
|
---|
440 | end;
|
---|
441 |
|
---|
442 | case Length(ASource) of
|
---|
443 | 13: begin // Using 13 character ISBN
|
---|
444 | s := copy(ASource, 1, 3);
|
---|
445 | if not ((s = '978') or (s = '979')) then
|
---|
446 | begin
|
---|
447 | ASymbol^.SetErrorText('Invalid ISBN');
|
---|
448 | Result := ERROR_INVALID_DATA;
|
---|
449 | exit;
|
---|
450 | end;
|
---|
451 | check_digit := isbn13_checksum(ASource);
|
---|
452 | if ASource[Length(ASource)] <> check_digit[1] then
|
---|
453 | begin
|
---|
454 | ASymbol^.SetErrorText('Incorrect ISBN checksum');
|
---|
455 | Result := ERROR_INVALID_CHECK;
|
---|
456 | exit;
|
---|
457 | end;
|
---|
458 | Delete(ASource, Length(ASource), 1); // Remove check digit for EAN13
|
---|
459 | ean13(ASymbol, ASource, dest);
|
---|
460 | end;
|
---|
461 |
|
---|
462 | 10: begin // Using 10 digit ISBN
|
---|
463 | check_digit := isbn_checksum(ASource);
|
---|
464 | if check_digit[1] <> ASource[Length(ASource)] then
|
---|
465 | begin
|
---|
466 | ASymbol^.SetErrorText('Incorrect ISBN checksum');
|
---|
467 | Result := ERROR_INVALID_CHECK;
|
---|
468 | exit;
|
---|
469 | end;
|
---|
470 | ASource := '978' + ASource;
|
---|
471 | Delete(ASource, Length(ASource), 1); // Remove check digit for EAN13
|
---|
472 | ean13(ASymbol, ASource, dest);
|
---|
473 | end;
|
---|
474 |
|
---|
475 | 9: begin // Using 9 digit SBN
|
---|
476 | // Add leading zero
|
---|
477 | ASource := '0' + ASource;
|
---|
478 | // Verify check digit
|
---|
479 | check_digit := isbn_checksum(ASource);
|
---|
480 | if check_digit[1] <> ASource[Length(ASource)] then
|
---|
481 | begin
|
---|
482 | ASymbol^.SetErrorText('Incorrect SBN checksum');
|
---|
483 | Result := ERROR_INVALID_CHECK;
|
---|
484 | exit;
|
---|
485 | end;
|
---|
486 | // Convert to EAN-13 number
|
---|
487 | ASource := '978' + ASource;
|
---|
488 | // Remove check digit for EAN13
|
---|
489 | Delete(ASource, Length(ASource), 1);
|
---|
490 | // Encode
|
---|
491 | ean13(ASymbol, ASource, dest);
|
---|
492 | end;
|
---|
493 | end;
|
---|
494 | end;
|
---|
495 |
|
---|
496 | { Add leading zeroes to EAN and UPC strings }
|
---|
497 | procedure ean_leading_zeroes(ASymbol: PZintSymbol;
|
---|
498 | const ASource: String; var local_source: String);
|
---|
499 | var
|
---|
500 | first_part: string;
|
---|
501 | second_part: string;
|
---|
502 | zfirst_part: string;
|
---|
503 | zsecond_part: string;
|
---|
504 | with_addon: Boolean;
|
---|
505 | first_len, second_len: Integer;
|
---|
506 | zfirst_len: Integer = 0;
|
---|
507 | zsecond_len: Integer = 0;
|
---|
508 | p, len: Integer;
|
---|
509 | begin
|
---|
510 | len := Length(ASource);
|
---|
511 |
|
---|
512 | // Split input at '+' into two strings
|
---|
513 | p := pos('+', ASource);
|
---|
514 | with_addon := p > 0;
|
---|
515 | if with_addon then
|
---|
516 | begin
|
---|
517 | first_len := p-1;
|
---|
518 | second_len := len - p;
|
---|
519 | first_part := copy(ASource, 1, first_len);
|
---|
520 | second_part := copy(ASource, p+1, second_len);
|
---|
521 | end else
|
---|
522 | begin
|
---|
523 | first_len := len;
|
---|
524 | second_len := 0;
|
---|
525 | first_part := ASource;
|
---|
526 | second_part := '';
|
---|
527 | end;
|
---|
528 |
|
---|
529 | { Calculate target lengths }
|
---|
530 | if (second_len <= 5) then zsecond_len := 5;
|
---|
531 | if (second_len <= 2) then zsecond_len := 2;
|
---|
532 | if (second_len = 0) then zsecond_len := 0;
|
---|
533 |
|
---|
534 | case ASymbol^.symbology of
|
---|
535 | BARCODE_EANX,
|
---|
536 | BARCODE_EANX_CC:
|
---|
537 | begin
|
---|
538 | if (first_len <= 12) then zfirst_len := 12;
|
---|
539 | if (first_len <= 7) then zfirst_len := 7;
|
---|
540 | if (second_len = 0) then
|
---|
541 | begin
|
---|
542 | if (first_len <= 5) then zfirst_len := 5;
|
---|
543 | if (first_len <= 2) then zfirst_len := 2;
|
---|
544 | end;
|
---|
545 | end;
|
---|
546 | BARCODE_UPCA,
|
---|
547 | BARCODE_UPCA_CC:
|
---|
548 | zfirst_len := 11;
|
---|
549 | BARCODE_UPCE,
|
---|
550 | BARCODE_UPCE_CC:
|
---|
551 | begin
|
---|
552 | if (first_len = 7) then zfirst_len := 7;
|
---|
553 | if (first_len <= 6) then zfirst_len := 6;
|
---|
554 | end;
|
---|
555 | BARCODE_ISBNX:
|
---|
556 | if (first_len <= 9) then zfirst_len := 9;
|
---|
557 | end;
|
---|
558 |
|
---|
559 | // Add leading zeros
|
---|
560 | zfirst_part := StringOfChar('0', zfirst_len - first_len) + first_part;
|
---|
561 | zsecond_part := StringOfChar('0', zsecond_len - second_len) + second_part;
|
---|
562 |
|
---|
563 | // Copy adjusted data back to local_source }
|
---|
564 | local_source := zfirst_part;
|
---|
565 | if zsecond_len <> 0 then
|
---|
566 | local_source := local_source + '+' + zsecond_part;
|
---|
567 | end;
|
---|
568 |
|
---|
569 | function eanx(ASymbol: PZintSymbol; const ASource: String): integer;
|
---|
570 | var
|
---|
571 | i, p: Integer;
|
---|
572 | src_len: Integer;
|
---|
573 | local_source: String = '';
|
---|
574 | first_part, second_part: String;
|
---|
575 | dest: String = '';
|
---|
576 | with_addon: Boolean;
|
---|
577 | begin
|
---|
578 | src_len := Length(ASource);
|
---|
579 |
|
---|
580 | if (src_len > 19) then
|
---|
581 | begin
|
---|
582 | ASymbol^.SetErrorText('Input too long');
|
---|
583 | Result := ERROR_TOO_LONG;
|
---|
584 | Exit;
|
---|
585 | end;
|
---|
586 |
|
---|
587 | if (ASymbol^.symbology <> BARCODE_ISBNX) then
|
---|
588 | begin
|
---|
589 | { ISBN has it's own checking routine }
|
---|
590 | Result := is_sane('0123456789+', ASource);
|
---|
591 | if (Result = ERROR_INVALID_DATA) then
|
---|
592 | begin
|
---|
593 | ASymbol^.SetErrorText('Invalid characters in data');
|
---|
594 | exit;
|
---|
595 | end;
|
---|
596 | end else
|
---|
597 | begin
|
---|
598 | Result := is_sane('0123456789Xx+', ASource);
|
---|
599 | if (Result = ERROR_INVALID_DATA) then
|
---|
600 | begin
|
---|
601 | ASymbol^.SetErrorText('Invalid characters in input');
|
---|
602 | exit;
|
---|
603 | end;
|
---|
604 | end;
|
---|
605 |
|
---|
606 | // Add leading zeroes
|
---|
607 | ean_leading_zeroes(ASymbol, ASource, local_source);
|
---|
608 | if (ASymbol^.symbology = BARCODE_ISBNX) then
|
---|
609 | local_source := Uppercase(local_source);
|
---|
610 |
|
---|
611 | // Split string to parts before and after '+' parts}
|
---|
612 | p := pos('+', local_source);
|
---|
613 | with_addon := p > 0;
|
---|
614 | if with_addon then
|
---|
615 | begin
|
---|
616 | first_part := copy(local_source, 1, p - 1);
|
---|
617 | second_part := copy(local_source, p + 1);
|
---|
618 | end else
|
---|
619 | begin
|
---|
620 | first_part := local_source;
|
---|
621 | second_part := '';
|
---|
622 | end;
|
---|
623 |
|
---|
624 | case ASymbol^.symbology of
|
---|
625 | BARCODE_EANX:
|
---|
626 | case Length(first_part) of
|
---|
627 | 2: begin // EAN-2
|
---|
628 | add_on(first_part, dest, 0);
|
---|
629 | ASymbol^.SetText(first_part);
|
---|
630 | end;
|
---|
631 | 5: begin // EAN-5
|
---|
632 | add_on(first_part, dest, 0);
|
---|
633 | ASymbol^.SetText(first_part);
|
---|
634 | end;
|
---|
635 | 7: ean8(ASymbol, first_part, dest);
|
---|
636 | 12: ean13(ASymbol, first_part, dest);
|
---|
637 | else
|
---|
638 | ASymbol^.SetErrorText('Invalid input length');
|
---|
639 | Result := ERROR_TOO_LONG;
|
---|
640 | exit;
|
---|
641 | end;
|
---|
642 |
|
---|
643 | BARCODE_EANX_CC:
|
---|
644 | case Length(first_part) of
|
---|
645 | // Adds vertical separator bars according to ISO/IEC 24723 section 11.4
|
---|
646 | 7: begin
|
---|
647 | set_module(ASymbol, ASymbol^.rows, 1);
|
---|
648 | set_module(ASymbol, ASymbol^.rows, 67);
|
---|
649 | set_module(ASymbol, ASymbol^.rows + 1, 0);
|
---|
650 | set_module(ASymbol, ASymbol^.rows + 1, 68);
|
---|
651 | set_module(ASymbol, ASymbol^.rows + 2, 1);
|
---|
652 | set_module(ASymbol, ASymbol^.rows + 1, 67);
|
---|
653 | ASymbol^.row_height[ASymbol^.rows] := 2;
|
---|
654 | ASymbol^.row_height[ASymbol^.rows + 1] := 2;
|
---|
655 | ASymbol^.row_height[ASymbol^.rows + 2] := 2;
|
---|
656 | Inc(ASymbol^.rows, 3);
|
---|
657 | ean8(ASymbol, first_part, dest);
|
---|
658 | end;
|
---|
659 | 12: begin
|
---|
660 | set_module(ASymbol, ASymbol^.rows, 1);
|
---|
661 | set_module(ASymbol, ASymbol^.rows, 95);
|
---|
662 | set_module(ASymbol, ASymbol^.rows + 1, 0);
|
---|
663 | set_module(ASymbol, ASymbol^.rows + 1, 96);
|
---|
664 | set_module(ASymbol, ASymbol^.rows + 2, 1);
|
---|
665 | set_module(ASymbol, ASymbol^.rows + 2, 95);
|
---|
666 | ASymbol^.row_height[ASymbol^.rows] := 2;
|
---|
667 | ASymbol^.row_height[ASymbol^.rows + 1] := 2;
|
---|
668 | ASymbol^.row_height[ASymbol^.rows + 2] := 2;
|
---|
669 | Inc(ASymbol^.rows, 3);
|
---|
670 | ean13(ASymbol, first_part, dest);
|
---|
671 | end;
|
---|
672 | else
|
---|
673 | ASymbol^.SetErrorText('Invalid EAN input length');
|
---|
674 | Result := ERROR_TOO_LONG;
|
---|
675 | exit;
|
---|
676 | end;
|
---|
677 |
|
---|
678 | BARCODE_UPCA:
|
---|
679 | if Length(first_part) = 11 then
|
---|
680 | upca(ASymbol, first_part, dest)
|
---|
681 | else
|
---|
682 | begin
|
---|
683 | ASymbol^.SetErrorText('Wrong input length');
|
---|
684 | Result := ERROR_TOO_LONG;
|
---|
685 | Exit;
|
---|
686 | end;
|
---|
687 |
|
---|
688 | BARCODE_UPCA_CC:
|
---|
689 | if Length(first_part) = 11 then
|
---|
690 | begin
|
---|
691 | set_module(ASymbol, ASymbol^.rows, 1);
|
---|
692 | set_module(ASymbol, ASymbol^.rows, 95);
|
---|
693 | set_module(ASymbol, ASymbol^.rows + 1, 0);
|
---|
694 | set_module(ASymbol, ASymbol^.rows + 1, 96);
|
---|
695 | set_module(ASymbol, ASymbol^.rows + 2, 1);
|
---|
696 | set_module(ASymbol, ASymbol^.rows + 2, 95);
|
---|
697 | ASymbol^.row_height[ASymbol^.rows] := 2;
|
---|
698 | ASymbol^.row_height[ASymbol^.rows + 1] := 2;
|
---|
699 | ASymbol^.row_height[ASymbol^.rows + 2] := 2;
|
---|
700 | Inc(ASymbol^.rows, 3);
|
---|
701 | upca(ASymbol, first_part, dest);
|
---|
702 | end
|
---|
703 | else
|
---|
704 | begin
|
---|
705 | ASymbol^.SetErrorText('Wrong UPC-A input length');
|
---|
706 | Result := ERROR_TOO_LONG;
|
---|
707 | Exit;
|
---|
708 | end;
|
---|
709 |
|
---|
710 | BARCODE_UPCE:
|
---|
711 | if Length(first_part) in [6, 7] then
|
---|
712 | upce(ASymbol, first_part, dest)
|
---|
713 | else
|
---|
714 | begin
|
---|
715 | ASymbol^.SetErrorText('Input wrong length');
|
---|
716 | Result := ERROR_TOO_LONG;
|
---|
717 | Exit;
|
---|
718 | end;
|
---|
719 |
|
---|
720 | BARCODE_UPCE_CC:
|
---|
721 | if Length(first_part) in [6, 7] then
|
---|
722 | begin
|
---|
723 | set_module(ASymbol, ASymbol^.rows, 1);
|
---|
724 | set_module(ASymbol, ASymbol^.rows, 51);
|
---|
725 | set_module(ASymbol, ASymbol^.rows + 1, 0);
|
---|
726 | set_module(ASymbol, ASymbol^.rows + 1, 52);
|
---|
727 | set_module(ASymbol, ASymbol^.rows + 2, 1);
|
---|
728 | set_module(ASymbol, ASymbol^.rows + 2, 51);
|
---|
729 | ASymbol^.row_height[ASymbol^.rows] := 2;
|
---|
730 | ASymbol^.row_height[ASymbol^.rows + 1] := 2;
|
---|
731 | ASymbol^.row_height[ASymbol^.rows + 2] := 2;
|
---|
732 | Inc(ASymbol^.rows, 3);
|
---|
733 | upce(ASymbol, first_part, dest);
|
---|
734 | end
|
---|
735 | else
|
---|
736 | begin
|
---|
737 | ASymbol^.SetErrorText('Wrong UPC-E input length');
|
---|
738 | Result := ERROR_TOO_LONG;
|
---|
739 | Exit;
|
---|
740 | end;
|
---|
741 |
|
---|
742 | BARCODE_ISBNX:
|
---|
743 | begin
|
---|
744 | Result := isbn(ASymbol, first_part, dest);
|
---|
745 | if (Result > 4) then
|
---|
746 | Exit;
|
---|
747 | end;
|
---|
748 | end;
|
---|
749 |
|
---|
750 | case Length(second_part) of
|
---|
751 | 0: ;
|
---|
752 | 2: begin
|
---|
753 | add_on(second_part, dest, 1);
|
---|
754 | ASymbol^.SetText(ASymbol^.GetText + '+' + second_part);
|
---|
755 | end;
|
---|
756 | 5: begin
|
---|
757 | add_on(second_part, dest, 1);
|
---|
758 | ASymbol^.SetText(ASymbol^.GetText + '+' + second_part);
|
---|
759 | end;
|
---|
760 | else
|
---|
761 | ASymbol^.SetErrorText('Invalid length input');
|
---|
762 | Result := ERROR_TOO_LONG;
|
---|
763 | Exit;
|
---|
764 | end;
|
---|
765 |
|
---|
766 | expand(ASymbol, dest);
|
---|
767 |
|
---|
768 | case ASymbol^.symbology of
|
---|
769 | BARCODE_EANX_CC,
|
---|
770 | BARCODE_UPCA_CC,
|
---|
771 | BARCODE_UPCE_CC:
|
---|
772 | begin
|
---|
773 | { shift the symbol to the right one space to allow for separator bars }
|
---|
774 | for i := (ASymbol^.width + 1) downto 1 do
|
---|
775 | begin
|
---|
776 | if module_is_set(ASymbol, ASymbol^.rows - 1, i - 1) then
|
---|
777 | set_module(ASymbol, ASymbol^.rows - 1, i)
|
---|
778 | else
|
---|
779 | unset_module(ASymbol, ASymbol^.rows - 1, i);
|
---|
780 | end;
|
---|
781 | unset_module(ASymbol, ASymbol^.rows - 1, 0);
|
---|
782 | Inc(ASymbol^.width, 2);
|
---|
783 | end;
|
---|
784 | end;
|
---|
785 |
|
---|
786 | if (Result = 0) and (ASymbol^.GetErrorText <> '') and (ASymbol^.GetErrorText[1] = 'w') then
|
---|
787 | Result := 1; { flag UPC-E warnings }
|
---|
788 | end;
|
---|
789 |
|
---|
790 | end.
|
---|