Nadesłany przez Tomasz Lubiński, 29 sierpnia 2007 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 UPC-E
// www.algorytm.org
// (c)2007 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;
UPCE : array [0..7] of Byte;
bars : array [0..50] of Byte;
parityTable : array [0..1] of array [0..9] of array [0..5] of Byte = (
(
(1, 1, 1, 0, 0, 0),
(1, 1, 0, 1, 0, 0),
(1, 1, 0, 0, 1, 0),
(1, 1, 0, 0, 0, 1),
(1, 0, 1, 1, 0, 0),
(1, 0, 0, 1, 1, 0),
(1, 0, 0, 0, 1, 1),
(1, 0, 1, 0, 1, 0),
(1, 0, 1, 0, 0, 1),
(1, 0, 0, 1, 0, 1)
),
(
(0, 0, 0, 1, 1, 1),
(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)
)
);
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) <> 8 then
begin
ShowMessage('Incorrect UPC-E number');
exit;
end;
for i:=0 to 7 do
UPCE[i] := StrToInt(Kod.Text[i+1]);
for i:=0 to 50 do
bars[i] := 0;
if Check() = false then
begin
ShowMessage('Incorrect UPCE 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[UPCE[0], UPCE[7], i-1], UPCE[i], j];
bars[45] := 0;
bars[46] := 1;
bars[47] := 0;
bars[48] := 1;
bars[49] := 0;
bars[50] := 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<= 50))) 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 + 16, 100, IntToStr(UPCE[i]));
Image1.Canvas.TextOut(7, 90, IntToStr(UPCE[0]));
Image1.Canvas.TextOut(125, 90, IntToStr(UPCE[7]));
end;
function TForm1.Check: Boolean;
var
sum: Integer;
upca: array [1..12] of Integer;
begin
//check system number
if ((upce[0] <> 0) and (upce[0] <> 1)) then
begin
Result := False;
exit;
end;
//convert UPC-E to UPC-A
if ((upce[6] >= 0) and (upce[6] <= 2)) then
begin
upca[4] := upce[7];
upca[5] := 0;
upca[6] := 0;
upca[7] := 0;
upca[8] := 0;
upca[9] := upce[4];
upca[10] := upce[5];
upca[11] := upce[6];
end
else if ((upce[6] = 3) and (upce[3] >= 3) and (upce[3] <= 9)) then
begin
upca[4] := upce[4];
upca[5] := 0;
upca[6] := 0;
upca[7] := 0;
upca[8] := 0;
upca[9] := 0;
upca[10] := upce[5];
upca[11] := upce[6];
end
else if (upce[6] = 4) then
begin
upca[4] := upce[4];
upca[5] := upce[5];
upca[6] := 0;
upca[7] := 0;
upca[8] := 0;
upca[9] := 0;
upca[10] := 0;
upca[11] := upce[6];
end
else if ((upce[6] >= 5) and (upce[6] <= 9)) then
begin
upca[4] := upce[4];
upca[5] := upce[5];
upca[6] := upce[6];
upca[7] := 0;
upca[8] := 0;
upca[9] := 0;
upca[10] := 0;
upca[11] := upce[7];
end
else
begin
Result := false;
exit;
end;
//copy two first digits of producer code
upca[2] := upce[1];
upca[3] := upce[2];
//copy system numer and chec digit
upca[1] := upce[0];
upca[12] := upce[7];
//control check digit
sum := 3 * upca[1] +
1 * upca[2] +
3 * upca[3] +
1 * upca[4] +
3 * upca[5] +
1 * upca[6] +
3 * upca[7] +
1 * upca[8] +
3 * upca[9] +
1 * upca[10] +
3 * upca[11];
sum := sum mod 10;
sum := 10 - sum;
sum := sum mod 10;
if (sum <> upca[12]) then
Result := false
else
Result := true;
end;
end.