Nadesłany przez Tomasz Lubiński, 27 grudnia 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 EAN2
// 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;
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
EAN2 : array [0..1] of Byte;
bars : array [0..19] 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)
)
);
checksumTable: array [0..3] of array [0..1] of Byte = (
(0, 0),
(0, 1),
(1, 0),
(1, 1)
);
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
var
i, j,addCheckSum : Integer;
begin
if Length(Kod.Text) <> 2 then
begin
ShowMessage('Incorrect EAN2 number');
exit;
end;
for i:=0 to 1 do
EAN2[i] := StrToInt(Kod.Text[i+1]);
for i:=0 to 19 do
bars[i] := 0;
addCheckSum := EAN2[0]*10 + EAN2[1];
addCheckSum := (addCheckSum mod 4);
bars[0] := 1;
bars[1] := 0;
bars[2] := 1;
bars[3] := 1;
for i:=0 to 1 do
begin
for j:=0 to 7 do
bars[i*9 + 4 + j] := leftValues[checksumTable[addCheckSum, i], EAN2[i], j];
if i<1 then
begin
bars[i*9 + 11] := 0;
bars[i*9 + 12] := 1;
end;
end;
DrawBars;
end;
procedure TForm1.DrawBars;
var
i: Integer;
begin
Image1.Canvas.Brush.Color := clWhite;
Image1.Canvas.Rectangle(0, 0, 121, 121);
Image1.Canvas.Brush.Color := clBlack;
Image1.Canvas.Font.Size := 10;
Image1.Canvas.Brush.Color := clWhite;
Image1.Canvas.Font.Color := clBlack;
for i:=0 to 19 do
if bars[i] = 1 then
Image1.Canvas.Rectangle(i*2 + 20, 40, i*2 + 22, 100);
for i:=0 to 1 do
Image1.Canvas.TextOut(i*16 + 26, 20, IntToStr(EAN2[i]));
end;
end.