| 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.
|
|---|