unit Barcode;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, Buttons, ExtCtrls;

type

  TBarcodeForm = class(TForm)
    BarPanel: TBevel;
    StretchX: TScrollBar;
    StretchY: TScrollBar;
    InputBoxLabel: TLabel;
    Btn39: TBitBtn;
    BtnCodebar: TBitBtn;
    Btn25: TBitBtn;
    BtnPrint: TBitBtn;
    BtnQuit: TBitBtn;
    InputBox: TEdit;
    BtnUPCA: TBitBtn;

    procedure DrawUPCLeftBars(Sender: TObject;NumSys: string);
    procedure DrawUPCRightBars(Sender: TObject;Chk: string);
    procedure DrawUPCCenterBars(Sender: TObject);

    procedure Draw25StartingBars(Sender: TObject);
    procedure Draw25EndingBars(Sender: TObject);

    procedure DrawBar(Sender: TObject;BarType: integer);
    procedure DrawSpaceBar(Sender: TObject;BarType: integer);
    procedure DrawWideBar(Sender: TObject;BarType: integer);
    procedure DrawWideSpaceBar(Sender: TObject;BarType: integer);

    procedure Draw39(Sender: TObject);
    procedure DrawUPCA(Sender: TObject);
    procedure Draw25(Sender: TObject);
    procedure DrawCodeBar(Sender: TObject);

    procedure Reset39(Sender: TObject);
    procedure ResetUPCA(Sender: TObject);
    procedure Reset25(Sender: TObject);
    procedure ResetCodeBar(Sender: TObject);

    procedure Draw39BackGround(Sender: TObject;
                               BarCodeWidth: integer;
                               NumChar: integer);
    procedure DrawUPCABackGround(Sender: TObject;
                               BarCodeWidth: integer;
                               NumChar: integer);
    procedure Draw25BackGround(Sender: TObject;
                               BarCodeWidth: integer;
                               NumChar: integer);
    procedure DrawCodeBarBackGround(Sender: TObject;
                               BarCodeWidth: integer;
                               NumChar: integer);

    function Search39(Sender: TObject; TempStr: string):String;
    function SearchUPCA(Sender: TObject; TempStr: string):String;
    function Search25(Sender: TObject; TempStr: string):String;
    function SearchCodeBar(Sender: TObject; TempStr: string):String;

    procedure Btn39Click(Sender: TObject);
    procedure BtnUPCAClick(Sender: TObject);
    procedure Btn25Click(Sender: TObject);
    procedure BtnCodebarClick(Sender: TObject);

    procedure BtnQuitClick(Sender: TObject);
    procedure StretchXScroll(Sender: TObject; ScrollCode: TScrollCode;
      var ScrollPos: Integer);
    procedure StretchYScroll(Sender: TObject; ScrollCode: TScrollCode;
      var ScrollPos: Integer);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

Type
    TBarInfo = record
            BarX : integer;
            BarY : integer;
            BarHeight: integer;
    end;

    TBarTable = record
            BarChar: string[1];
            BarBits: string[9];
    end;

var
  BarcodeForm: TBarcodeForm;
  BarCodeType: integer;     {1: 3 of 9}
                            {3: UPC A}
  BarCodeWidth, WideBarWidth, NarrowBarWidth: integer;
  BarX, BarY, BarHeight: integer;
  DefaultNarrowBarWidth, DefaultWideBarwidth,
  DefaultBarHeight : integer;
  OddNum, EvenNum, ChkDigit : integer;
  ChkDigitStr, UPCNumberSystem: string;
  SearchIndx: integer;

implementation

{$R *.DFM}

{============================================================================}
function TBarcodeForm.Search39(Sender: TObject; TempStr: String):String;
{============================================================================}
var
  Bar39Table: array[0..43] of TBarTable;
  i, Loop : integer;
begin

   Loop := 43;                   {total of 44 chars}
   i := 0;

   Bar39Table[0].BarChar:= '0';
   Bar39Table[1].BarChar:= '1';
   Bar39Table[2].BarChar:= '2';
   Bar39Table[3].BarChar:= '3';
   Bar39Table[4].BarChar:= '4';
   Bar39Table[5].BarChar:= '5';
   Bar39Table[6].BarChar:= '6';
   Bar39Table[7].BarChar:= '7';
   Bar39Table[8].BarChar:= '8';
   Bar39Table[9].BarChar:= '9';
   Bar39Table[10].BarChar:= 'A';
   Bar39Table[11].BarChar:= 'B';
   Bar39Table[12].BarChar:= 'C';
   Bar39Table[13].BarChar:= 'D';
   Bar39Table[14].BarChar:= 'E';
   Bar39Table[15].BarChar:= 'F';
   Bar39Table[16].BarChar:= 'G';
   Bar39Table[17].BarChar:= 'H';
   Bar39Table[18].BarChar:= 'I';
   Bar39Table[19].BarChar:= 'J';
   Bar39Table[20].BarChar:= 'K';
   Bar39Table[21].BarChar:= 'L';
   Bar39Table[22].BarChar:= 'M';
   Bar39Table[23].BarChar:= 'N';
   Bar39Table[24].BarChar:= 'O';
   Bar39Table[25].BarChar:= 'P';
   Bar39Table[26].BarChar:= 'Q';
   Bar39Table[27].BarChar:= 'R';
   Bar39Table[28].BarChar:= 'S';
   Bar39Table[29].BarChar:= 'T';
   Bar39Table[30].BarChar:= 'U';
   Bar39Table[31].BarChar:= 'V';
   Bar39Table[32].BarChar:= 'W';
   Bar39Table[33].BarChar:= 'X';
   Bar39Table[34].BarChar:= 'Y';
   Bar39Table[35].BarChar:= 'Z';
   Bar39Table[36].BarChar:= '-';
   Bar39Table[37].BarChar:= '.';
   Bar39Table[38].BarChar:= ' ';
   Bar39Table[39].BarChar:= '*';
   Bar39Table[40].BarChar:= '$';
   Bar39Table[41].BarChar:= '/';
   Bar39Table[42].BarChar:= '+';
   Bar39Table[43].BarChar:= '%';

   Bar39Table[0].BarBits :='000110100';
   Bar39Table[1].BarBits :='100100001';
   Bar39Table[2].BarBits :='001100001';
   Bar39Table[3].BarBits :='101100000';
   Bar39Table[4].BarBits :='000110001';
   Bar39Table[5].BarBits :='100110000';
   Bar39Table[6].BarBits :='001110000';
   Bar39Table[7].BarBits :='000100101';
   Bar39Table[8].BarBits :='100100100';
   Bar39Table[9].BarBits :='001100100';
   Bar39Table[10].BarBits :='100001001';
   Bar39Table[11].BarBits :='001001001';
   Bar39Table[12].BarBits :='101001000';
   Bar39Table[13].BarBits :='000011001';
   Bar39Table[14].BarBits :='100011000';
   Bar39Table[15].BarBits :='001011000';
   Bar39Table[16].BarBits :='000001101';
   Bar39Table[17].BarBits :='100001100';
   Bar39Table[18].BarBits :='001001100';
   Bar39Table[19].BarBits :='000011100';
   Bar39Table[20].BarBits :='100000011';
   Bar39Table[21].BarBits :='001000011';
   Bar39Table[22].BarBits :='101000010';
   Bar39Table[23].BarBits :='000010011';
   Bar39Table[24].BarBits :='100010010';
   Bar39Table[25].BarBits :='001010010';
   Bar39Table[26].BarBits :='000000111';
   Bar39Table[27].BarBits :='100000110';
   Bar39Table[28].BarBits :='001000110';
   Bar39Table[29].BarBits :='000010110';
   Bar39Table[30].BarBits :='110000001';
   Bar39Table[31].BarBits :='011000001';
   Bar39Table[32].BarBits :='111000000';
   Bar39Table[33].BarBits :='010010001';
   Bar39Table[34].BarBits :='110010000';
   Bar39Table[35].BarBits :='011010000';
   Bar39Table[36].BarBits :='010000101';
   Bar39Table[37].BarBits :='110000100';
   Bar39Table[38].BarBits :='011000100';
   Bar39Table[39].BarBits :='010010100';
   Bar39Table[40].BarBits :='010101000';
   Bar39Table[41].BarBits :='010100010';
   Bar39Table[42].BarBits :='010001010';
   Bar39Table[43].BarBits :='000101010';

   if TempStr = '' then   {if no scanable char then must be chk digit}
     begin
      Search39 := Bar39Table[ChkDigit].BarBits;   {return char}
      ChkDigitStr := Bar39Table[ChkDigit].BarChar;{return bit pattern}
     end
   else
     for i:= 0 to Loop do {if not check digit then parse}
      begin
         if TempStr = Bar39Table[i].BarChar then
           begin                                  {found?}
             Search39  := Bar39Table[i].BarBits;  {return bit pattern}
             if TempStr = '*' then                {asterisk then }
                SearchIndx := 0                   {no check digit}
             else                                 {number will return}
                SearchIndx := i;                  {return check digit}
             Exit;                                {break out of loop}
           end
      end;

   if i = Loop then                               {loop exausted}
      Search39 := 'Not Found';                    {then no match found}
end;

{============================================================================}
function TBarcodeForm.SearchUPCA(Sender: TObject; TempStr: String):String;
{============================================================================}
var
  BarUPCATable: array[0..9] of TBarTable;
  i, Loop : integer;
begin

   Loop := 9;                   {total of 10 chars}

   BarUPCATable[0].BarChar:= '0';
   BarUPCATable[1].BarChar:= '1';
   BarUPCATable[2].BarChar:= '2';
   BarUPCATable[3].BarChar:= '3';
   BarUPCATable[4].BarChar:= '4';
   BarUPCATable[5].BarChar:= '5';
   BarUPCATable[6].BarChar:= '6';
   BarUPCATable[7].BarChar:= '7';
   BarUPCATable[8].BarChar:= '8';
   BarUPCATable[9].BarChar:= '9';

   BarUPCATable[0].BarBits :='0001101';
   BarUPCATable[1].BarBits :='0011001';
   BarUPCATable[2].BarBits :='0010011';
   BarUPCATable[3].BarBits :='0111101';
   BarUPCATable[4].BarBits :='0100011';
   BarUPCATable[5].BarBits :='0110001';
   BarUPCATable[6].BarBits :='0101111';
   BarUPCATable[7].BarBits :='0111011';
   BarUPCATable[8].BarBits :='0110111';
   BarUPCATable[9].BarBits :='0001011';

   for i:= 0 to Loop do            {start parsing}
     if TempStr = BarUPCATable[i].BarChar then
        begin                      {found match then return pattern}
           SearchUPCA  := BarUPCATable[i].BarBits;
           SearchIndx := i;        {used to calc check digit}
           Exit;
        end; { end-for}

   if i = Loop then
      SearchUPCA := 'Not Found';   {make sure 9 chars}
end;

{============================================================================}
function TBarcodeForm.Search25(Sender: TObject; TempStr: String):String;
{============================================================================}
var
  Bar25Table: array[0..9] of TBarTable;
  i, Loop : integer;
begin

   Loop := 9;                   {total of 10 chars}

   Bar25Table[0].BarChar:= '0';
   Bar25Table[1].BarChar:= '1';
   Bar25Table[2].BarChar:= '2';
   Bar25Table[3].BarChar:= '3';
   Bar25Table[4].BarChar:= '4';
   Bar25Table[5].BarChar:= '5';
   Bar25Table[6].BarChar:= '6';
   Bar25Table[7].BarChar:= '7';
   Bar25Table[8].BarChar:= '8';
   Bar25Table[9].BarChar:= '9';

   Bar25Table[0].BarBits :='00110';
   Bar25Table[1].BarBits :='10001';
   Bar25Table[2].BarBits :='01001';
   Bar25Table[3].BarBits :='11000';
   Bar25Table[4].BarBits :='00101';
   Bar25Table[5].BarBits :='10100';
   Bar25Table[6].BarBits :='01100';
   Bar25Table[7].BarBits :='00011';
   Bar25Table[8].BarBits :='10010';
   Bar25Table[9].BarBits :='01010';

   for i:= 0 to Loop do            {start parsing}
     if TempStr = Bar25Table[i].BarChar then
        begin                      {found match then return pattern}
           Search25  := Bar25Table[i].BarBits;
           SearchIndx := i;        {used to calc check digit}
           Exit;
        end; { end-for}

   if i = Loop then
      Search25 := 'Not';   {make sure 9 chars}
end;

{============================================================================}
function TBarcodeForm.SearchCodeBar(Sender: TObject; TempStr: String):String;
{============================================================================}
var
  CodeBarTable: array[0..20] of TBarTable;
  i, Loop : integer;
begin

   Loop := 19;                   {total of 19 chars}

   CodeBarTable[0].BarChar:= '0';
   CodeBarTable[1].BarChar:= '1';
   CodeBarTable[2].BarChar:= '2';
   CodeBarTable[3].BarChar:= '3';
   CodeBarTable[4].BarChar:= '4';
   CodeBarTable[5].BarChar:= '5';
   CodeBarTable[6].BarChar:= '6';
   CodeBarTable[7].BarChar:= '7';
   CodeBarTable[8].BarChar:= '8';
   CodeBarTable[9].BarChar:= '9';
   CodeBarTable[10].BarChar:= '-';
   CodeBarTable[11].BarChar:= '$';
   CodeBarTable[12].BarChar:= ':';
   CodeBarTable[13].BarChar:= '/';
   CodeBarTable[14].BarChar:= '.';
   CodeBarTable[15].BarChar:= '+';
   CodeBarTable[16].BarChar:= 'A';
   CodeBarTable[17].BarChar:= 'B';
   CodeBarTable[18].BarChar:= 'C';
   CodeBarTable[19].BarChar:= 'D';

   CodeBarTable[0].BarBits :='0000011';
   CodeBarTable[1].BarBits :='0000110';
   CodeBarTable[2].BarBits :='0001001';
   CodeBarTable[3].BarBits :='1100000';
   CodeBarTable[4].BarBits :='0010010';
   CodeBarTable[5].BarBits :='1000010';
   CodeBarTable[6].BarBits :='0100001';
   CodeBarTable[7].BarBits :='0100100';
   CodeBarTable[8].BarBits :='0110000';
   CodeBarTable[9].BarBits :='1001000';
   CodeBarTable[10].BarBits :='0001100';
   CodeBarTable[11].BarBits :='0011000';
   CodeBarTable[12].BarBits :='1000101';
   CodeBarTable[13].BarBits :='1010001';
   CodeBarTable[14].BarBits :='1010100';
   CodeBarTable[15].BarBits :='0010101';
   CodeBarTable[16].BarBits :='0011010';
   CodeBarTable[17].BarBits :='0101001';
   CodeBarTable[18].BarBits :='0001011';
   CodeBarTable[19].BarBits :='0001110';

   for i:= 0 to Loop do            {start parsing}
     if TempStr = CodeBarTable[i].BarChar then
        begin                      {found match then return pattern}
           SearchCodeBar  := CodeBarTable[i].BarBits;
           SearchIndx := i;        {used to calc check digit}
           Exit;
        end; { end-for}

   if i = Loop then
      SearchCodeBar := 'Not';   {make sure 9 chars}
end;

{============================================================================}
procedure TBarcodeForm.DrawBar(Sender: TObject;BarType: integer);
{============================================================================}
var LongBar : integer;
begin
    LongBar := BarType*(Canvas.TextHeight('H') div 2);

    Canvas.Pen.Color := clBlack;
    Canvas.Brush.Color := clBlack;
    Canvas.Brush.Style := bsSolid;
    Canvas.Rectangle(BarX,
                     BarY,
                     BarX + NarrowBarWidth,
                     BarY + BarHeight + LongBar);

    BarX := BarX + NarrowBarWidth;

end;

{============================================================================}
procedure TBarcodeForm.DrawSpaceBar(Sender: TObject;BarType: integer);
{============================================================================}
var LongBar : integer;
begin
    LongBar := BarType*(Canvas.TextHeight('H') div 2);

    Canvas.Pen.Color := clwhite;
    Canvas.Brush.Color := clWhite;
    Canvas.Brush.Style := bsSolid;
    Canvas.Rectangle(BarX,
                     BarY,
                     BarX + NarrowBarWidth,
                     BarY + BarHeight + LongBar);

    BarX := BarX + NarrowBarWidth;

end;

{============================================================================}
procedure TBarcodeForm.DrawWideBar(Sender: TObject;BarType: integer);
{============================================================================}
var LongBar : integer;
begin
    LongBar := BarType*(Canvas.TextHeight('H') div 2);

    Canvas.Pen.Color := clBlack;
    Canvas.Brush.Color := clBlack;
    Canvas.Brush.Style := bsSolid;
    Canvas.Rectangle(BarX,
                     BarY,
                     BarX + WideBarWidth,
                     BarY + BarHeight + LongBar);
    BarX := BarX + WideBarWidth;

end;

{============================================================================}
procedure TBarcodeForm.DrawWideSpaceBar(Sender: TObject;BarType: integer);
{============================================================================}
var LongBar : integer;
begin
    LongBar := BarType*(Canvas.TextHeight('H') div 2);

    Canvas.Pen.Color := clwhite;
    Canvas.Brush.Color := clWhite;
    Canvas.Brush.Style := bsSolid;
    Canvas.Rectangle(BarX,
                     BarY,
                     BarX + WideBarWidth,
                     BarY + BarHeight + LongBar);

    BarX := BarX + WideBarWidth;

end;

{============================================================================}
procedure TBarcodeForm.DrawUPCLeftBars(Sender: TObject; NumSys: string);
{============================================================================}
begin
    Canvas.Pen.Color := clBlack;     {write readable text}
    Canvas.Brush.Color := clWhite;   {at the bottom of the BAR}

    Canvas.TextOut(
           BarX,
           BarY + BarHeight,
           NumSys);                 {get the first char}

    BarX := BarX + Canvas.TextWidth('W') + NarrowBarWidth;

    DrawBar(Sender,1);       {type 1: long bar}
    DrawSpaceBar(Sender,1);  {type 0: short bar}
    DrawBar(Sender,1);
end;

{============================================================================}
procedure TBarcodeForm.DrawUPCCenterBars(Sender: TObject);
{============================================================================}
begin
    DrawSpaceBar(Sender,1);
    DrawBar(Sender,1);
    DrawSpaceBar(Sender,1);
    DrawBar(Sender,1);
    DrawSpaceBar(Sender,1);
end;

{============================================================================}
procedure TBarcodeForm.DrawUPCRightBars(Sender: TObject; Chk: string);
{============================================================================}
begin
    DrawBar(Sender,1);
    DrawSpaceBar(Sender,1);
    DrawBar(Sender,1);

    BarX := BarX + Canvas.TextWidth(Chk) - NarrowBarWidth;

    Canvas.Pen.Color := clBlack;     {write readable text}
    Canvas.Brush.Color := clWhite;   {at the bottom of the BAR}

    Canvas.TextOut(
           BarX + NarrowBarWidth,
           BarY + BarHeight,
           Chk);                     {get chk digit}
end;

{============================================================================}
procedure TBarcodeForm.Draw25EndingBars(Sender: TObject);
{============================================================================}
begin
    DrawWideBar(Sender,0);
    DrawSpaceBar(Sender,0);  {type 0: short bar}
    DrawBar(Sender,0);
end;

{============================================================================}
procedure TBarcodeForm.Draw25StartingBars(Sender: TObject);
{============================================================================}
begin
    DrawBar(Sender,0);       {type 1: long bar}
    DrawSpaceBar(Sender,0);  {type 0: short bar}
    DrawBar(Sender,0);
    DrawSpaceBar(Sender,0);  {type 0: short bar}
end;

{============================================================================}
procedure TBarcodeForm.Draw39BackGround(Sender: TObject;
                                      BarCodeWidth: integer;
                                      NumChar: integer);
{============================================================================}
begin
    Canvas.Pen.Color := clWhite;
    Canvas.Brush.Color := clWhite;
    Canvas.Brush.Style := bsSolid;
    Canvas.Rectangle(BarX - WideBarWidth,                    {quiet zone}
                     BarY - 4,
                     BarX + WideBarWidth                     {quiet zone}
                          + BarCodeWidth * (NumChar + 1)     {bar width}
                          + NarrowBarWidth * NumChar,  {inter char gap}
                     BarY + BarHeight + Canvas.TextHeight('H'));
end;

{============================================================================}
procedure TBarcodeForm.DrawUPCABackGround(Sender: TObject;
                                      BarCodeWidth: integer;
                                      NumChar: integer);
{============================================================================}
begin
    Canvas.Pen.Color := clWhite;
    Canvas.Brush.Color := clWhite;
    Canvas.Brush.Style := bsSolid;
    Canvas.Rectangle(BarX - NarrowBarWidth*2,
                     BarY - 4,
                     BarX + BarCodeWidth * (NumChar + 2)
                          + Canvas.TextWidth('W')
                          + 14 * NarrowBarWidth,
                     BarY + BarHeight + Canvas.TextHeight('H'));
end;

{============================================================================}
procedure TBarcodeForm.Draw25BackGround(Sender: TObject;
                                      BarCodeWidth: integer;
                                      NumChar: integer);
{============================================================================}
begin
    Canvas.Pen.Color := clWhite;
    Canvas.Brush.Color := clWhite;
    Canvas.Brush.Style := bsSolid;
    Canvas.Rectangle(BarX - WideBarWidth,
                     BarY - 4,
                     BarX + BarCodeWidth * NumChar
                          + 6 * NarrowBarWidth,
                     BarY + BarHeight + Canvas.TextHeight('H'));
end;

{============================================================================}
procedure TBarcodeForm.DrawCodeBarBackGround(Sender: TObject;
                                      BarCodeWidth: integer;
                                      NumChar: integer);
{============================================================================}
begin
    Canvas.Pen.Color := clWhite;
    Canvas.Brush.Color := clWhite;
    Canvas.Brush.Style := bsSolid;
    Canvas.Rectangle(BarX - Canvas.TextWidth('W'),
                     BarY - 4,
                     BarX + BarCodeWidth * NumChar
                          + Canvas.TextWidth('W'),
                     BarY + BarHeight + Canvas.TextHeight('H'));
end;

{============================================================================}
procedure TBarcodeForm.Reset39(Sender: TObject);
{============================================================================}
begin

     DefaultNarrowBarWidth := 2;               {set default bars}
     DefaultWideBarwidth := 6;                 {1:3 ratio}
     DefaultBarHeight := 40;

     WideBarWidth   := DefaultWideBarWidth;    {for stretch bars}
     NarrowBarWidth := DefaultNarrowBarWidth;  {stretch propotionally}
     BarHeight := DefaultBarHeight;
                                               {reset stretch bars}
     StretchX.Position := 0;
     StretchY.Position := 0;

end;

{============================================================================}
procedure TBarcodeForm.ResetUPCA(Sender: TObject);
{============================================================================}
begin

     DefaultNarrowBarWidth := 2;               {set default bars}
     DefaultWideBarwidth := 6;                 {1:3 ratio}
     DefaultBarHeight := 40;

     WideBarWidth   := DefaultWideBarWidth;    {for stretch bars}
     NarrowBarWidth := DefaultNarrowBarWidth;  {stretch propotionally}
     BarHeight := DefaultBarHeight;
                                               {reset stretch bars}
     StretchX.Position := 0;
     StretchY.Position := 0;

     UPCNumberSystem := '0';                   {if 7, take number system}
end;                                           {into account when calc}
                                               {check digit}
{============================================================================}
procedure TBarcodeForm.Reset25(Sender: TObject);
{============================================================================}
begin

     DefaultNarrowBarWidth := 2;               {set default bars}
     DefaultWideBarwidth := 6;                 {1:3 ratio}
     DefaultBarHeight := 40;

     WideBarWidth   := DefaultWideBarWidth;    {for stretch bars}
     NarrowBarWidth := DefaultNarrowBarWidth;  {stretch propotionally}
     BarHeight := DefaultBarHeight;
                                               {reset stretch bars}
     StretchX.Position := 0;
     StretchY.Position := 0;

end;                                           {into account when calc}

{============================================================================}
procedure TBarcodeForm.ResetCodeBar(Sender: TObject);
{============================================================================}
begin

     DefaultNarrowBarWidth := 2;               {set default bars}
     DefaultWideBarwidth := 6;                 {1:3 ratio}
     DefaultBarHeight := 40;

     WideBarWidth   := DefaultWideBarWidth;    {for stretch bars}
     NarrowBarWidth := DefaultNarrowBarWidth;  {stretch propotionally}
     BarHeight := DefaultBarHeight;
                                               {reset stretch bars}
     StretchX.Position := 0;
     StretchY.Position := 0;

end;                                           {into account when calc}

{============================================================================}
procedure TBarcodeForm.Draw39(Sender: TObject);
{============================================================================}
var BarStr, InputStr: string;
    i, j, Loop : integer;
    Encode :  array[0..32] of string[9];  {max of 32 chars + chk digit}
    TempStr: array[0..32] of string[1];
    ExitProcFlag, AltBar : boolean;
begin

   Refresh;                                   {clr scr}
   BarCodeType := 1;                          {type = 1}
   BarcodeForm.Caption := '3 Of 9';           {window caption}
   ChkDigit := 0;                             {init check digit}
   ExitProcFlag := false;                     {reset exit flag}

   InputStr := InputBox.Text;                 {get input str}
   Loop := length(InputStr) - 1;              {get len of input str}

   if Loop < 0 then                           {nothing entered}
     begin
        BarcodeForm.Caption := 'Please enter valid 39 code...';
        exit;                                 {exit-proc}
     end;

   BarX := BarPanel.Top + 40;                 {set starting x,y}
   BarY := BarPanel.Left+ 20;

   BarCodeWidth := WideBarWidth * 3 + NarrowBarWidth * 6; {for one char}
   Draw39BackGround(Sender, BarCodeWidth, Loop + 1);      {paint white backgrn}

   for i:= 0 to Loop do                       {char length - 1}
     begin
       TempStr[i] := Copy(InputStr,i+1,1);       {get next char}
       Encode[i] := Search39(Sender, TempStr[i]);{save returned string}

       if Encode[i] = 'Not Found' then        {no such char}
         begin                                {gen err msg}
           BarcodeForm.Caption := '3 Of 9: Invalid character entered...';
           ExitProcFlag := true;              {set exit flag}
           Exit                               {break out of for loop}
         end
       else
           ChkDigit := ChkDigit + SearchIndx;
     end;

   if ExitProcFlag then                       {exit-proc}
      Exit;
                                              {calc check digit}
   ChkDigit := ChkDigit mod 43;

   Encode[i+1] := Search39(Sender, '');       {get pattern for chk digit}
   TempStr[i+1] := ChkDigitStr;               {get corresponding chk digit char}

   for i:= 0 to Loop + 1 do                   {add 1 because of check digit}
     begin
       AltBar := true;                        {start with bar}

       for j:= 0 to 8 do                      {9 bars}
         begin
           BarStr := Copy(Encode[i],j+1,1);   {get next char}

           if BarStr = '1' then               {wide bar?}
              begin
                if AltBar then                {bar?}
                   DrawWideBar(Sender,0)      {draw short bar}
                else
                   DrawWideSpaceBar(Sender,0);{no, draw short space bar}
              end  {end-if}
           else                               {else narrow bar!}
              begin
                if AltBar then                {bar?}
                   DrawBar(Sender,0)
                else
                   DrawSpaceBar(Sender,0);    {no}
              end; {end-else}

                AltBar := AltBar xor true;   {alternate bar/space}
         end;  {end-for j}

         Canvas.Pen.Color := clBlack;     {write readable text}
         Canvas.Brush.Color := clWhite;   {at the bottom of the BAR}
         Canvas.TextOut(
                  BarX - BarCodeWidth + (BarCodeWidth - Canvas.TextWidth('W')) div 2,
                  BarY + BarHeight,
                  TempStr[i]);                   {get the first char}

         DrawSpaceBar(Sender,0);            {draw inter charater gap}
     end;{end-for i}

end;

{============================================================================}
procedure TBarcodeForm.DrawUPCA(Sender: TObject);
{============================================================================}
var BarStr, InputStr: string;
    i, j, Loop, LongBar : integer;
    Encode :  array[0..11] of string[7];  {num sys + 10 digits + chk digit}
    TempStr:  array[0..11] of string[1];  {num sys + 10 digits + chk digit}
    ExitProcFlag: boolean;
begin
                                              {clr scr}
   Refresh;
   BarCodeType := 3;                          {barcode type}
   ExitProcFlag := false;                     {reset exit flag}
   BarcodeForm.Caption := 'UPC A';            {set window caption}

   OddNum  := 0;                              {init}
   EvenNum := 0;                              {used to calc chk digit}

   InputStr := InputBox.Text;                 {get input str}

   Loop := length(InputStr)    ;              {get len of input str}

   if Loop <> 10 then                         {takes 10 chars only}
     begin
       BarcodeForm.Caption := 'Code UPC A: Must enter 10 char input';
       Exit;                                  {exit-proc}
     end;

   BarX := BarPanel.Top + 40;                 {set starting x,y}
   BarY := BarPanel.Left+ 20;

   BarCodeWidth := NarrowBarWidth * 7;        {for one char}

   TempStr[0] := UPCNumberSystem;             {1st: UPC number system}
   Encode[0] := SearchUPCA(Sender, TempStr[0]);{get bars for UPC num sys}

   for i:= 1 to Loop do                       {Scan all + Num sys num}
     begin
       TempStr[i] := Copy(InputStr,i,1);      {get next char}
       Encode[i] := SearchUPCA(Sender, TempStr[i]); {save returned string}

       if Encode[i] = 'Not Found' then        {no such char}
         begin                                {gen err msg}
           BarcodeForm.Caption := 'Invalid character entered...';
           ExitProcFlag := true;              {set exit flag}
           Exit                               {break out of for loop}
         end
       else
         begin
           if (i - 1) mod 2 = 0 then          { start from 0: even number}
              EvenNum := EvenNum + SearchIndx {add all even seq numbers}
           else
              OddNum  := OddNum  + SearchIndx;{add all odd seq numbers}
         end;
     end;

   if ExitProcFlag  then
      Exit;                                   {get out of this proc}

   OddNum := OddNum * 3;                      {odd number X 3}
   ChkDigit := EvenNum + OddNum;              {add odd and even nums}
   ChkDigit := ChkDigit mod 10;               {modulus by 10 to get}
                                              {remainder}
   if ChkDigit = 0 then                       {remainder = 0?}
   else
      ChkDigit := 10 - ChkDigit;              {get num close 10}

   DrawUPCABackGround(Sender, BarCodeWidth, Loop + 2);  {paint white backgrn}
                                              {left guard bar}
   DrawUPCLeftBars(Sender,TempStr[0]);

   for i:= 0 to 5 do
       begin
         for j:= 0 to 6 do                    {7 bars}
           begin
                 BarStr := Copy(Encode[i],j+1,1);  {get next char}
                 if (i = 0) or (i = 1) then   {make 1st and 2nd bars}
                    LongBar := 1              {longer}
                 else
                    LongBar := 0;             {other bars are short}

                 if BarStr = '1' then         {bar?}
                    DrawBar(Sender,LongBar)
                 else
                    DrawSpaceBar(Sender,LongBar);  {space?}

           end;   {end-for j}

         if i = 0 then
           {UPC number system then do not print on the bottom}
         else
           begin
             Canvas.Pen.Color := clBlack;     {write readable text}
             Canvas.Brush.Color := clWhite;   {at the bottom of the BAR}
             Canvas.TextOut(
                  BarX - BarCodeWidth + (BarCodeWidth - Canvas.TextWidth('W')) div 2,
                  BarY + BarHeight,
                  TempStr[i]);                {get the first char}
           end;
       end;

   DrawUPCCenterBars(Sender);                 {draw center bars}

   TempStr[11] := IntToStr(ChkDigit);         {get chk digit char}
   Encode[11] := SearchUPCA(Sender, TempStr[11]); {chk digit pattern}

   for i:= 6 to 11 do
       begin
         for j:= 0 to 6 do                     {7 bars}
               begin
                 BarStr := Copy(Encode[i],j+1,1);  {get next char}
                 if (i = 10) or (i = 11) then  {last 2: chk digit}
                    LongBar := 1               {& right guard bars}
                 else                          {are longer}
          

우선
1)바코드 업체에 바코드 소스[샘플]를 달라고 하십시요.
   대부분 바코드 업체에는 C++,델파이,비쥬얼베이직등 구현 할 수 있는
   소스들이 있습니다.

2) 델파이 자료실에 보면 바코드 컴포넌트가 있습니다.
    그걸 사용하시면 되구요.
    바코드 컴포넌트도 팔더군요.

3) 예전의 질답 게시판에 보면 여러가지 답변들이 있군요!

하나씩 보시면 터득을 할 실수 있다고 봅니다.
홧튕~ 아흑~ 답변 오랫만에 다는군요!