Nadesłany przez Tomasz Lubiński, 27 października 2005 01:00
Kod przedstawiony poniżej przedstawia główną część rozwiązania problemu.Pobierz pełne rozwiązanie.
Jeżeli nie odpowiada Ci sposób formatowania kodu przez autora skorzystaj z pretty printer'a i dostosuj go automatycznie do siebie.
Kody Kreskowe - Delphi/Unit1.pas:
//--------------------------------------------------------------------------- // Generowanie kodow kreskowych EAN13 // www.algorytm.org // (c)2005 Tomasz Lubinski unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls; type TForm1 = class(TForm) Image1: TImage; Button1: TButton; Kod: TEdit; procedure Button1Click(Sender: TObject); private procedure DrawBars; function Check: Boolean; { Private declarations } public { Public declarations } end; var Form1: TForm1; EAN13 : array [0..12] of Byte; bars : array [0..94] of Byte; parityTable : array [0..9] of array [0..5] of Byte = ( (0, 0, 0, 0, 0, 0), (0, 0, 1, 0, 1, 1), (0, 0, 1, 1, 0, 1), (0, 0, 1, 1, 1, 0), (0, 1, 0, 0, 1, 1), (0, 1, 1, 0, 0, 1), (0, 1, 1, 1, 0, 0), (0, 1, 0, 1, 0, 1), (0, 1, 0, 1, 1, 0), (0, 1, 1, 0, 1, 0) ); rightValues : array [0..9] of array [0..6] of Byte = ( (1, 1, 1, 0, 0, 1, 0), (1, 1, 0, 0, 1, 1, 0), (1, 1, 0, 1, 1, 0, 0), (1, 0, 0, 0, 0, 1, 0), (1, 0, 1, 1, 1, 0, 0), (1, 0, 0, 1, 1, 1, 0), (1, 0, 1, 0, 0, 0, 0), (1, 0, 0, 0, 1, 0, 0), (1, 0, 0, 1, 0, 0, 0), (1, 1, 1, 0, 1, 0, 0) ); leftValues : array [0..1] of array [0..9] of array [0..6] of Byte = ( ( (0, 0, 0, 1, 1, 0, 1), (0, 0, 1, 1, 0, 0, 1), (0, 0, 1, 0, 0, 1, 1), (0, 1, 1, 1, 1, 0, 1), (0, 1, 0, 0, 0, 1, 1), (0, 1, 1, 0, 0, 0, 1), (0, 1, 0, 1, 1, 1, 1), (0, 1, 1, 1, 0, 1, 1), (0, 1, 1, 0, 1, 1, 1), (0, 0, 0, 1, 0, 1, 1) ), ( (0, 1, 0, 0, 1, 1, 1), (0, 1, 1, 0, 0, 1, 1), (0, 0, 1, 1, 0, 1, 1), (0, 1, 0, 0, 0, 0, 1), (0, 0, 1, 1, 1, 0, 1), (0, 1, 1, 1, 0, 0 ,1), (0, 0, 0, 0, 1, 0, 1), (0, 0, 1, 0, 0, 0 ,1), (0, 0, 0, 1, 0, 0, 1), (0, 0, 1, 0, 1, 1, 1) ) ); implementation {$R *.DFM} procedure TForm1.Button1Click(Sender: TObject); var i, j : Integer; begin if Length(Kod.Text) <> 13 then begin ShowMessage('Incorrect EAN13 number'); exit; end; for i:=0 to 12 do EAN13[i] := StrToInt(Kod.Text[i+1]); for i:=0 to 94 do bars[i] := 0; if Check() = false then begin ShowMessage('Incorrect EAN13 number'); exit; end; bars[0] := 1; bars[1] := 0; bars[2] := 1; for i:=1 to 6 do for j:=0 to 6 do bars[(i-1)*7 + 3 + j] := leftValues[parityTable[EAN13[0], i-1], EAN13[i], j]; bars[45] := 0; bars[46] := 1; bars[47] := 0; bars[48] := 1; bars[49] := 0; for i:=7 to 12 do for j:=0 to 6 do bars[(i-7)*7 + 50 + j] := rightValues[EAN13[i], j]; bars[92] := 1; bars[93] := 0; bars[94] := 1; DrawBars; end; procedure TForm1.DrawBars; var i, length : Integer; begin Image1.Canvas.Brush.Color := clWhite; Image1.Canvas.Rectangle(0, 0, 225, 121); Image1.Canvas.Brush.Color := clBlack; for i:=0 to 94 do begin if (((i >= 0) and (i<= 2)) or ((i >= 45) and (i<= 49)) or ((i >= 92) and (i<= 94))) then length := 110 else length := 100; if bars[i] = 1 then Image1.Canvas.Rectangle(i*2 + 20, 10, i*2 + 22, length); end; Image1.Canvas.Font.Size := 10; Image1.Canvas.Brush.Color := clWhite; Image1.Canvas.Font.Color := clBlack; for i:=1 to 6 do Image1.Canvas.TextOut(i*14 + 17, 100, IntToStr(EAN13[i])); for i:=7 to 12 do Image1.Canvas.TextOut(i*14 + 27, 100, IntToStr(EAN13[i])); Image1.Canvas.TextOut(7, 90, IntToStr(EAN13[0])); end; function TForm1.Check: Boolean; var sum, sum_even, sum_uneven, i: Integer; begin sum_even := 0; sum_uneven := 0; for i:=0 to 11 do if (i mod 2) = 0 then sum_even := sum_even + EAN13[i] else sum_uneven := sum_uneven + EAN13[i]; sum := sum_uneven*3 + sum_even; sum := sum mod 10; sum := 10 - sum; sum := sum mod 10; if EAN13[12] = sum then Result := true else Result := false; end; end.