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

Last change on this file was 123, checked in by chronos, 4 years ago
  • Added: QR code image visible in contact others tab. It can be saved as image to file.
File size: 18.1 KB
Line 
1{ lbc_code.pas - Handles Code 11, 39, 39+ and 93, as well as channel_code
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
11unit lbc_code;
12
13{$mode objfpc}{$H+}
14
15interface
16
17uses
18 SysUtils, zint;
19
20function code_11(ASymbol: PZintSymbol; const ASource: String): Integer;
21function c39(ASymbol: PZintSymbol; const ASource: String): Integer;
22function pharmazentral(ASymbol: PZintSymbol; const ASource: String): Integer;
23function ec39(ASymbol: PZIntSymbol; const ASource: String): Integer;
24function c93(ASymbol: PZintSymbol; const ASource: String): Integer;
25function channel_code(ASymbol: PZintSymbol; const ASource: String): Integer;
26
27
28implementation
29
30uses
31 lbc_helper;
32
33const
34 C11Table: array[0..10] of String = (
35 '111121', '211121', '121121', '221111', '112121',
36 '212111', '122111', '111221', '211211', '211111',
37 '112111'
38 );
39
40 { Code 39 tables checked against ISO/IEC 16388:2007 }
41 C39Table: array[0..42] of String = (
42 // bar-space-bar-space-bar-space-..., given in width units
43 '1112212111', '2112111121', '1122111121', '2122111111', '1112211121', // '0', '1', ...
44 '2112211111', '1122211111', '1112112121', '2112112111', '1122112111',
45 '2111121121', '1121121121', '2121121111', '1111221121', '2111221111', // 'A', 'B', ...
46 '1121221111', '1111122121', '2111122111', '1121122111', '1111222111',
47 '2111111221', '1121111221', '2121111211', '1111211221', '2111211211',
48 '1121211211', '1111112221', '2111112211', '1121112211', '1111212211',
49 '2211111121', '1221111121', '2221111111', '1211211121', '2211211111',
50 '1221211111', '1211112121', '2211112111', '1221112111', '1212121111', // 'Z', '-', ..
51 '1212111211', '1211121211', '1112121211'
52 ); // Code 39 character assignments (Table 1)
53
54 { Encoding the full ASCII character set in Code 39 (Table A2) }
55 const EC39Ctrl: array[0..127] of String = (
56 '%U', '$A', '$B', '$C', '$D', '$E', '$F', '$G', '$H', '$I',
57 '$J', '$K', '$L', '$M', '$N', '$O', '$P', '$Q', '$R', '$S',
58 '$T', '$U', '$V', '$W', '$X', '$Y', '$Z', '%A', '%B', '%C',
59 '%D', '%E', ' ', '/A', '/B', '/C', '/D', '/E', '/F', '/G',
60 '/H', '/I', '/J', '/K', '/L', '-', '.', '/O', '0', '1',
61 '2', '3', '4', '5', '6', '7', '8', '9', '/Z', '%F',
62 '%G', '%H', '%I', '%J', '%V', 'A', 'B', 'C', 'D', 'E',
63 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O',
64 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y',
65 'Z', '%K', '%L', '%M', '%N', '%O', '%W', '+A', '+B', '+C',
66 '+D', '+E', '+F', '+G', '+H', '+I', '+J', '+K', '+L', '+M',
67 '+N', '+O', '+P', '+Q', '+R', '+S', '+T', '+U', '+V', '+W',
68 '+X', '+Y', '+Z', '%P', '%Q', '%R', '%S', '%T'
69 );
70
71 const C93Ctrl: array[0..127] of String = (
72 'bU', 'aA', 'aB', 'aC', 'aD', 'aE', 'aF', 'aG', 'aH', 'aI',
73 'aJ', 'aK', 'aL', 'aM', 'aN', 'aO', 'aP', 'aQ', 'aR', 'aS',
74 'aT', 'aU', 'aV', 'aW', 'aX', 'aY', 'aZ', 'bA', 'bB', 'bC',
75 'bD', 'bE', ' ', 'cA', 'cB', 'cC', 'cD', 'cE', 'cF', 'cG',
76 'cH', 'cI', 'cJ', 'cK', 'cL', 'cM', 'cN', 'cO', '0', '1',
77 '2', '3', '4', '5', '6', '7', '8', '9', 'cZ', 'bF',
78 'bG', 'bH', 'bI', 'bJ', 'bV', 'A', 'B', 'C', 'D', 'E',
79 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O',
80 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y',
81 'Z', 'bK', 'bL', 'bM', 'bN', 'bO', 'bW', 'dA', 'dB', 'dC',
82 'dD', 'dE', 'dF', 'dG', 'dH', 'dI', 'dJ', 'dK', 'dL', 'dM',
83 'dN', 'dO', 'dP', 'dQ', 'dR', 'dS', 'dT', 'dU', 'dV', 'dW',
84 'dX', 'dY', 'dZ', 'bP', 'bQ', 'bR', 'bS', 'bT'
85 );
86
87 const C93Table: array[0..46] of String = (
88 '131112', '111213', '111312', '111411', '121113', '121212', // '0'..'5'
89 '121311', '111114', '131211', '141111', '211113', '211212', // '6'..'B'
90 '211311', '221112', '221211', '231111', '112113', '112212', // 'C'..'H'
91 '112311', '122112', '132111', '111123', '111222', '111321', // 'I'..'N'
92 '121122', '131121', '212112', '212211', '211122', '211221', // 'O'..'T'
93 '221121', '222111', '112122', '112221', '122121', '123111', // 'U'..'Z'
94 '121131', '311112', '311211', '321111', '112131', '113121', // '-', '.', ' ', '$', '/', '+'
95 '211131', '121221', '312111', '311121', '122211' // '%', 'a', 'b', 'c', 'c'
96 );
97
98
99{-------------------------------------------------------------------------------
100 Code 11
101
102 Allowed characters:
103 numeric digits (0-9), the hyphen character (-)
104 (Code 11 derives its name from these 11 characters).
105 Length:
106 basically unlimited (function errors after 121 characters, though).
107-------------------------------------------------------------------------------}
108function CheckSum_C11(ASource: String): String;
109var
110 i, len: Integer;
111 c_digit, c_weight, c_count: Integer;
112 k_digit, k_weight, k_count: Integer;
113 weight: array of Integer = nil;
114begin
115 len := Length(ASource);
116 SetLength(weight, len + 1);
117
118 // Determine weights
119 for i := 0 to len-1 do
120 begin
121 if ASource[i+1] = '-' then
122 weight[i] := 10
123 else
124 weight[i] := ctoi(ASource[i+1]);
125 end;
126
127 // Calculate C checksum
128 c_weight := 1;
129 c_count := 0;
130 for i := len-1 downto 0 do
131 begin
132 inc(c_count, c_weight * weight[i]);
133 inc(c_weight);
134 if (c_weight > 10) then
135 c_weight := 1;
136 end;
137 c_digit := c_count mod 11;
138 weight[len] := c_digit;
139 // weight is 0-based and has been allocated for len+1 elements.
140
141 // Calculate K checksum
142 k_weight := 1;
143 k_count := 0;
144 for i := len downto 0 do
145 begin
146 inc(k_count, k_weight * weight[i]);
147 inc(k_weight);
148 if (k_weight > 9) then
149 k_weight := 1;
150 end;
151 k_digit := k_count mod 11;
152
153 // Convert checksum to string
154 Result := itoc(c_digit) + itoc(k_digit);
155 if (Result[1] = 'A') then Result[1] := '-';
156 if (Result[2] = 'A') then Result[2] := '-';
157end;
158
159function code_11(ASymbol: PZintSymbol; const ASource: String): Integer;
160begin
161 Result := basic_encoder(ASymbol, ASource,
162 121, SODIUM, '112211', C11Table, '11221', @CheckSum_C11, false);
163end;
164
165
166{-------------------------------------------------------------------------------
167 Code 39
168-------------------------------------------------------------------------------}
169function CheckSum_C39(ASource: String): String;
170var
171 i, sum: Integer;
172begin
173 sum := 0;
174 for i := 1 to Length(ASource) do
175 inc(sum, pos(ASource[i], SILVER) - 1);
176
177 sum := sum mod 43;
178
179 if (sum < 10) then
180 Result := itoc(sum)
181 else
182 begin
183 if (sum < 36) then
184 Result := Char((sum - 10) + Ord('A'))
185 else
186 case sum of
187 36: Result := '-';
188 37: Result := '.';
189 38: Result := ' ';
190 39: Result := '$';
191 40: Result := '/';
192 41: Result := '+';
193 42: Result := #37;
194 else
195 Result := ' ';
196 end;
197 end;
198
199 { Display a space check digit as _, otherwise it looks like an error }
200 if (Result = ' ') then
201 Result := '_';
202end;
203
204{ LOGMARS uses wider 'wide' bars than normal Code 39 }
205procedure WiderBars(var s: String);
206var
207 i: Integer;
208begin
209 for i := 1 to Length(s) do
210 if s[i]='2' then s[i] := '3';
211end;
212
213function c39(ASymbol: PZintSymbol; const ASource: String): Integer;
214var
215 i, maxlen: Integer;
216 startcode, stopcode: String;
217 charcodes: array[0..42] of String;
218 checkSumFunc: TCheckSumFunc;
219begin
220 startcode := '1211212111';
221 stopcode := '121121211';
222 charcodes := C39Table;
223 checkSumFunc := nil;
224 maxlen := 74;
225
226 if (ASymbol^.symbology = BARCODE_LOGMARS) or (ASymbol^.symbology = BARCODE_HIBC_39) then
227 begin
228 WiderBars(startcode);
229 WiderBars(stopcode);
230 for i := Low(charcodes) to High(charcodes) do
231 WiderBars(charcodes[i]);
232 end;
233
234 if (ASymbol^.symbology = BARCODE_LOGMARS) or
235 (ASymbol^.option_2 = 1) or
236 (ASymbol^.option and OPTION_ADD_CHECKSUM = OPTION_ADD_CHECKSUM) then
237 begin
238 checkSumFunc := @CheckSum_C39;
239 ASymbol^.Option := ASymbol^.Option or OPTION_ADD_CHECKSUM;
240 end;
241
242 if (ASymbol^.symbology = BARCODE_LOGMARS) then
243 maxlen := 59;
244
245 Result := basic_encoder(ASymbol, Uppercase(ASource),
246 maxlen, SILVER, startcode, charcodes, stopcode, checkSumFunc, false);
247
248 if ASymbol^.symbology = BARCODE_CODE39 then
249 ASymbol^.SetText('*' + ASymbol^.GetText + '*');
250end;
251
252
253{-------------------------------------------------------------------------------
254 Pharmazentral Nummer (PZN)
255-------------------------------------------------------------------------------}
256function pharmazentral(ASymbol: PZintSymbol; const ASource: String): Integer;
257var
258 i, i0, error_number, zeros, digits, maxDigits, sum, src_len: Integer;
259 localstr: String = '';
260 check_digit: byte;
261begin
262 digits := ASymbol^.option_3;
263 if not (digits in [7, 8]) then
264 raise Exception.Create('[pharmazentral] Number of digits can only be 7 or 8');
265
266 maxDigits := digits - 1; // check-digit included
267
268 src_len := Length(ASource);
269 if (src_len > maxDigits) then
270 begin
271 ASymbol^.SetErrorText('Wrong input length');
272 Result := ERROR_TOO_LONG;
273 exit;
274 end;
275
276 error_number := is_sane(NEON, ASource);
277 if (error_number = ERROR_INVALID_DATA) then
278 begin
279 ASymbol^.SetErrorText('Invalid characters in data');
280 Result := error_number;
281 exit;
282 end;
283
284 zeros := maxDigits - src_len;
285 localstr := '-' + StringOfChar('0', zeros) + ASource;
286
287 i0 := 7 - MaxDigits;
288 sum := 0;
289 for i := 1 to maxDigits do
290 inc(sum, (i + i0) * ctoi(localstr[i+1]));
291 // wp: i+1 is correct because '-' was added to localStr
292
293 check_digit := sum mod 11;
294 localstr := localstr + itoc(check_digit);
295 if check_digit = ord('A') then
296 begin
297 ASymbol^.SetErrorText('Invalid PZN Data');
298 Result := ERROR_INVALID_DATA;
299 exit;
300 end;
301
302 Result := c39(ASymbol, localstr);
303
304 ASymbol^.SetText('PZN' + localstr);
305end;
306
307
308{-------------------------------------------------------------------------------
309 Extended Code 39 - ISO/IEC 16388:2007 Annex A
310-------------------------------------------------------------------------------}
311
312function ec39(ASymbol: PZintSymbol; const ASource: String): Integer;
313var
314 i: Integer;
315 buffer: string;
316 check: char;
317begin
318 if (Length(ASource) > 74) then
319 begin
320 ASymbol^.SetErrorText('Input too long (max 74 characters).');
321 Result := ERROR_TOO_LONG;
322 exit;
323 end;
324
325 { Creates a buffer string and places control characters into it }
326 buffer := '';
327 for i := 1 to Length(ASource) do
328 begin
329 if ASource[i] > #127 then
330 begin
331 { Cannot encode extended ASCII }
332 ASymbol^.SetErrorText('Invalid character in input data');
333 Result := ERROR_INVALID_DATA;
334 exit;
335 end;
336 buffer := buffer + EC39Ctrl[byte(ASource[i])];
337 end;
338
339 { Then send the buffer to the C39 function }
340 Result := c39(ASymbol, buffer);
341
342 if ASymbol^.Option and OPTION_DISPLAY_CHECKSUM = OPTION_DISPLAY_CHECKSUM then
343 begin
344 // Retrieve appended check character
345 buffer := ASymbol^.GetText;
346 check := buffer[Length(buffer)];
347 ASymbol^.SetText(aSource + check);
348 end else
349 ASymbol^.SetText(ASource);
350end;
351
352
353{-------------------------------------------------------------------------------
354 Code 93
355
356 An advancement on Code 39 and the definition is a lot tighter
357
358 SILVER includes the extra characters a, b, c and d to represent Code 93 specific
359 shift characters 1, 2, 3 and 4 respectively. These characters are never used by
360 c39() and ec39()
361-------------------------------------------------------------------------------}
362function CheckSum_C93(ASource: String): String;
363var
364 values: Array of Integer = nil;
365 i: Integer;
366 c, k, weight, len: Integer;
367begin
368 len := Length(ASource);
369 SetLength(values, len + 1); // Allocate one more element for check digit C
370 for i := 1 to len do
371 values[i-1] := pos(ASource[i], SILVER) - 1;
372
373 { Check digit C }
374 c := 0;
375 weight := 1;
376 for i := len-1 downto 0 do
377 begin
378 Inc(c, values[i] * weight);
379 Inc(weight);
380 if (weight = 21) then
381 weight := 1;
382 end;
383 c := c mod 47;
384 values[len] := c; // Element at index len has been allocated above!
385
386 { Check digit K }
387 k := 0;
388 weight := 1;
389 for i := len downto 0 do // Use len (rather than len-1) because of extra allocation
390 begin
391 Inc(k, values[i] * weight);
392 Inc(weight);
393 if (weight = 16) then
394 weight := 1;
395 end;
396 k := k mod 47;
397
398 Result := SILVER[c+1] + SILVER[k+1];
399end;
400
401function c93(ASymbol: PZintSymbol; const ASource: String): Integer;
402var
403 i: Integer;
404 buffer: String;
405 check: String;
406begin
407 if Length(ASource) > 107 then
408 begin
409 ASymbol^.SetErrorText('Input too long (max 107 characters).');
410 Result := ERROR_TOO_LONG;
411 exit;
412 end;
413
414 // Prepare message content
415 buffer := '';
416 for i := 1 to Length(ASource) do
417 begin
418 if ASource[i] > #127 then
419 begin
420 // Cannot encode extended ASCII
421 ASymbol^.SetErrorText('Invalid characters in input data.');
422 Result := ERROR_INVALID_DATA;
423 exit;
424 end;
425 buffer := buffer + C93Ctrl[byte(ASource[i])];
426 end;
427
428 Result := basic_encoder(ASymbol, buffer,
429 107, SILVER, '111141', C93Table, '1111411', @CheckSum_C93, false
430 );
431
432 // Show the original input string as human-readable text
433 if (Result = 0) then
434 begin
435 // If input string contains #0 replace it by space
436 buffer := ASource;
437 for i := 1 to Length(buffer) do
438 if buffer[i] = #0 then buffer[i] := ' ';
439 if (ASymbol^.Option and OPTION_DISPLAY_CHECKSUM <> 0) then
440 begin
441 // Extract check chars from generated symbol code...
442 check := Copy(ASymbol^.GetText, Length(ASymbol^.GetText)-1, 2);
443 // ... and append to original input string
444 ASymbol^.SetText(buffer + check);
445 end else
446 ASymbol^.SetText(buffer);
447 end;
448end;
449
450
451{-------------------------------------------------------------------------------
452 channel_code
453
454 NextS() and NextB() are from ANSI/AIM BC12-1998 and are Copyright (c) AIM 1997
455
456 They are used here on the understanding that they form part of the
457 specification for Channel Code and therefore their use is permitted under the
458 following terms set out in that document:
459
460 "It is the intent and understanding of AIM [t]hat the symbology presented in
461 this specification is entirely in the public domain and free of all use
462 restrictions, licenses and fees. AIM USA, its member companies, or individual
463 officers assume no liability for the use of this document."
464-------------------------------------------------------------------------------}
465
466procedure CheckCharacter(var APattern: String; const AValue, ATarget_Value: Integer;
467 const S, B: array of Integer);
468var
469 i: Integer;
470begin
471 if (AValue = ATarget_value) then
472 begin
473 { Target reached - save the generated pattern }
474 APattern := '11110';
475 for i := 0 to 10 do
476 APattern := APattern + itoc(S[i]) + itoc(B[i]);
477 end;
478end;
479
480procedure NextS(Chan, i, MaxS, MaxB: Integer; var S, B: array of Integer;
481 var AValue, ATarget_value: Integer; var APattern: String); forward;
482
483procedure NextB(chan, i, MaxB, MaxS: Integer; var S, B: array of Integer;
484 var AValue, ATarget_value: Integer; var APattern: String);
485var
486 _b: Integer;
487begin
488 if (S[i] + B[i-1] + S[i-1] + B[i-2] > 4) then
489 _b := 1
490 else
491 _b := 2;
492
493 if (i < Chan + 2) then
494 begin
495 while _b <= MaxB do
496 begin
497 B[i] := _b;
498 NextS(Chan, i + 1, MaxS, MaxB + 1 - _b, S, B, AValue, ATarget_value, APattern);
499 Inc(_b);
500 end;
501 end else
502 if (_b <= MaxB) then
503 begin
504 B[i] := MaxB;
505 CheckCharacter(APattern, AValue, ATarget_value, S, B);
506 Inc(AValue);
507 end;
508end;
509
510procedure NextS(Chan, i, MaxS, MaxB: Integer; var S, B: Array of Integer;
511 var AValue, ATarget_value: Integer; var APattern: String);
512var
513 _s: Integer;
514begin
515 if (i < Chan + 2) then
516 _s := 1
517 else
518 _s := MaxS;
519 while _s <= MaxS do
520 begin
521 S[i] := _s;
522 NextB(Chan, i, MaxB, MaxS + 1 - _s, S, B, AValue, ATarget_value, APattern);
523 Inc(_s);
524 end;
525end;
526
527{ Channel Code - According to ANSI/AIM BC12-1998 }
528function channel_code(ASymbol: PZintSymbol; const ASource: String): Integer;
529var
530 S: array[0..10] of Integer = (0,0,0,0,0,0,0,0,0,0,0);
531 B: array[0..10] of Integer = (0,0,0,0,0,0,0,0,0,0,0);
532 pattern: String = '';
533 value, target_value: Integer;
534 channels, i: Integer;
535 error_number, zeros, src_len: Integer;
536 outOfRange: Boolean;
537begin
538 src_len := Length(ASource);
539
540 if (src_len > 7) then
541 begin
542 ASymbol^.SetErrorText('Input too long');
543 Result := ERROR_TOO_LONG;
544 exit;
545 end;
546
547 error_number := is_sane(NEON, ASource);
548 if (error_number = ERROR_INVALID_DATA) then
549 begin
550 ASymbol^.SetErrorText('Invalid characters in data');
551 Result := error_number;
552 exit;
553 end;
554
555 if (ASymbol^.option_2 < 3) or (ASymbol^.option_2 > 8) then
556 channels := 0
557 else
558 channels := ASymbol^.option_2;
559 if (channels = 0) then
560 channels := src_len + 1;
561 if (channels = 2) then
562 channels := 3;
563
564 target_value := 0;
565 for i := 1 to src_len do
566 target_value := target_value * 10 + ctoi(ASource[i]);
567
568 outOfRange := false;
569 case channels of
570 3: if (target_value > 26) then outOfRange := true;
571 4: if (target_value > 292) then outOfRange := true;
572 5: if (target_value > 3493) then outOfRange := true;
573 6: if (target_value > 44072) then outOfRange := true;
574 7: if (target_value > 576688) then outOfRange := true;
575 8: if (target_value > 7742862) then outOfRange := true;
576 else outOfRange := true;
577 end;
578 if outOfRange then
579 begin
580 ASymbol^.SetErrorText('Value out of range');
581 Result := ERROR_INVALID_DATA;
582 exit;
583 end;
584
585 B[0] := 1;
586 S[1] := 1;
587 B[1] := 1;
588 S[2] := 1;
589 B[2] := 1;
590 value := 0;
591 NextS(channels, 3, channels, channels, S, B, value, target_value, pattern);
592
593 expand(ASymbol, pattern);
594
595 zeros := channels - 1 - src_len;
596 ASymbol^.SetText(StringOfChar('0', zeros) + ASource);
597
598 Result := error_number;
599end;
600
601
602end.
603
Note: See TracBrowser for help on using the repository browser.