algorytm.org

Implementacja w Delphi/Pascal

Baza Wiedzy
wersja offline serwisu przeznaczona na urządzenia z systemem Android
Darowizny
darowiznaWspomóż rozwój serwisu
Nagłówki RSS
Artykuły
Implementacje
Komentarze
Forum
Bookmarki






Sonda
Implementacji w jakim języku programowania poszukujesz?

EAN-2 - Implementacja w Delphi/Pascal
Ocena użytkownikóww: *****  / 2
SłabyŚwietny
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.
Dodaj komentarz