EAN13条形码绘制（Delphi版）

单元声明：

unit UnitEAN;

{
  https://wenku.baidu.com/view/d61eec0dc4da50e2524de518964bcf84b9d52d0d.html
  共有95+18=113条数据模块，1表示黑，0表示白
  左侧空白区  + 起始符  +   左侧数据符  +   中间分隔符  +   右侧数据符  +   效验符  +   终止符  +   右侧空白区
  11个空白区    101(3)     6*(7)           01010(5)        5*(7)        (7)          101       0000000(至少7空白)
}
interface

uses
  Graphics, Windows, SysUtils, Dialogs;

const
  //EAN 左资料码 A 类编码
  EAN_A: array[0..9] of string =
  ('0001101', '0011001', '0010011', '0111101', '0100011'
    , '0110001', '0101111', '0111011', '0110111', '0001011'
    );

  //EAN 左资料码 B 类编码
  EAN_B: array[0..9] of string =
  ('0100111', '0110011', '0011011', '0100001', '0011101'
    , '0111001', '0000101', '0010001', '0001001', '0010111'
    );

  //EAN 右资料码 C 类编码
  EAN_C: array[0..9] of string =
  ('1110010', '1100110', '1101100', '1000010', '1011100'
    , '1001110', '1010000', '1000100', '1001000', '1110100'
    );

  EAN_Pattern: array[0..9] of string =
  ('aaaaaa', 'aababb', 'aabbab', 'aabbba', 'abaabb', 'abbaab'
    , 'abbbaa', 'ababab', 'ababba', 'abbaba'
    );

//EAN 检查码
function EANCheck(InChar: string): string;
//EAN-13 转换二进制码
function EAN_13Convert(ConvertStr: string): string;
//输出EAN-13码
function DrawEAN13BarCode(InChar: string; CanvasArea: TCanvas; rcArea: TRect;
  nStep: Integer; clrBar: TColor = clBlack; clrBk: TColor = clWhite): Boolean;

implementation
//******************************************************************************
//***                           EAN 检查码                                   ***
//***                   C1 = 奇数位之和                                      ***
//***                   C2 = 偶数位之和                                      ***
//***                   CC = (C1 + (C2 * 3))　取个位数                       ***
//***                   C (检查码) = 10 - CC　 (若值为10，则取0)             ***
//******************************************************************************

function EANCheck(InChar: string): string;
var
  i, c1, c2, cc: Integer;
begin
  c1 := 0;
  c2 := 0;
  cc := 0;
  for i := 1 to 12 do
  begin
    if (i mod 2) = 1 then
      c1 := c1 + StrToInt(InChar[i])
    else
      c2 := c2 + StrToInt(InChar[i]);
  end;
  cc := (c1 + (c2 * 3)) mod 10;
  if cc = 0 then
    result := '0'
  else
    result := IntToStr(10 - cc);
end;
//******************************************************************************
//***                          EAN-13 转换二进制码                           ***
//***        导入值   左资料码   值      A          B      右资料码C         ***
//***                            0    0001101    0100111    1110010          ***
//***          1       AAAAAA    1    0011001    0110011    1100110          ***
//***          2       AABABB    2    0010011    0011011    1101100          ***
//***          3       AABBAB    3    0111101    0100001    1000010          ***
//***          4       ABAABB    4    0100011    0011101    1011100          ***
//***          5       ABBAAB    5    0110001    0111001    1001110          ***
//***          6       ABBBAA    6    0101111    0000101    1010000          ***
//***          7       ABABAB    7    0111011    0010001    1000100          ***
//***          8       ABABBA    8    0110111    0001001    1001000          ***
//***          9       ABBABA    9    0001011    0010111    1110100          ***
//******************************************************************************

function EAN_13Convert(ConvertStr: string): string;
var
  i: Integer;
  TempStr, LeftStr, RightStr: string;
begin
  TempStr := '';
  LeftStr := Copy(ConvertStr, 2, 6);
  RightStr := Copy(ConvertStr, 8, 6);
  //############################ 左资料编码 Start  #############################
  case ConvertStr[1] of
    '1':
      begin
        for i := 1 to Length(LeftStr) do
        begin
          //TempStr := TempStr + EAN_A[StrToInt(LeftStr[i])];
          case i of
            1, 2, 4: TempStr := TempStr + EAN_A[StrToInt(LeftStr[i])];
            3, 5, 6: TempStr := TempStr + EAN_B[StrToInt(LeftStr[i])];
          end;
        end;
      end;
    '2':
      begin
        for i := 1 to Length(LeftStr) do
        begin
          case i of
            1, 2, 5: TempStr := TempStr + EAN_A[StrToInt(LeftStr[i])];
            3, 4, 6: TempStr := TempStr + EAN_B[StrToInt(LeftStr[i])];
          end;
        end;
      end;
    '3':
      begin
        for i := 1 to Length(LeftStr) do
        begin
          case i of
            1, 2, 6: TempStr := TempStr + EAN_A[StrToInt(LeftStr[i])];
            3, 4, 5: TempStr := TempStr + EAN_B[StrToInt(LeftStr[i])];
          end;
        end;
      end;
    '4':
      begin
        for i := 1 to Length(LeftStr) do
        begin
          case i of
            1, 3, 4: TempStr := TempStr + EAN_A[StrToInt(LeftStr[i])];
            2, 5, 6: TempStr := TempStr + EAN_B[StrToInt(LeftStr[i])];
          end;
        end;
      end;
    '5':
      begin
        for i := 1 to Length(LeftStr) do
        begin
          case i of
            1, 4, 5: TempStr := TempStr + EAN_A[StrToInt(LeftStr[i])];
            2, 3, 6: TempStr := TempStr + EAN_B[StrToInt(LeftStr[i])];
          end;
        end;
      end;
    '6':
      begin
        for i := 1 to Length(LeftStr) do
        begin
          case i of
            1, 5, 6: TempStr := TempStr + EAN_A[StrToInt(LeftStr[i])];
            2, 3, 4: TempStr := TempStr + EAN_B[StrToInt(LeftStr[i])];
          end;
        end;
      end;
    '7':
      begin
        for i := 1 to Length(LeftStr) do
        begin
          case i of
            1, 3, 5: TempStr := TempStr + EAN_A[StrToInt(LeftStr[i])];
            2, 4, 6: TempStr := TempStr + EAN_B[StrToInt(LeftStr[i])];
          end;
        end;
      end;
    '8':
      begin
        for i := 1 to Length(LeftStr) do
        begin
          case i of
            1, 3, 6: TempStr := TempStr + EAN_A[StrToInt(LeftStr[i])];
            2, 4, 5: TempStr := TempStr + EAN_B[StrToInt(LeftStr[i])];
          end;
        end;
      end;
    '9':
      begin
        for i := 1 to Length(LeftStr) do
        begin
          case i of
            1, 4, 6: TempStr := TempStr + EAN_A[StrToInt(LeftStr[i])];
            2, 3, 5: TempStr := TempStr + EAN_B[StrToInt(LeftStr[i])];
          end;
        end;
      end;
  end;
  //############################  左资料编码  End  #############################
  TempStr := TempStr + '01010'; //中线编码
  //############################ 右资料编码 Start  #############################
  for i := 1 to Length(RightStr) do
  begin
    TempStr := TempStr + EAN_C[StrToInt(RightStr[i])];
  end;
  //############################  右资料编码  End  #############################
  result := TempStr;
end;
//******************************************************************************
//**                           EAB-13 条码生成                                **
//**                              条码格式          Length(113)               **
//**左空白、起始符、系统码、左数据符、中间线、右数据符、检查码、终止符、右空白**
//** >=11      3       0        42       5        35       7       3      >=7  **
//**         101                      01010                      101          **
//**
//**参数：InChar        13位/12位条码
//**      CanvasArea    画布
//**      rcArea        矩形区域
//**      nStep        步长
//**      clrBar      颜色（默认黑色）
//**      clrBk      颜色（默认白色）
//******************************************************************************

function DrawEAN13BarCode(InChar: string; CanvasArea: TCanvas; rcArea: TRect;
  nStep: Integer; clrBar: TColor = clBlack; clrBk: TColor = clWhite): Boolean;
var
  CheckChar, OutBar, OutsideBar: string;
  OutX, OutY, OutHeight: Word;
  i: Integer;

  BarLeft, BarTop, BarRight, BarBottom, BarHeight, BarWidth, TextDistance: Integer;
  BarArea, TextArea: TRect;
  sText: string;
begin
  result := true;

  if (Length(InChar) <> 13) and (Length(InChar) <> 12) then
  begin
    Exit;
    ShowMessage('输入的不是有效数字！');
    Abort;
  end;

  //验证校验位
  OutBar := InChar;
  CheckChar := EANCheck(InChar);
  if Length(InChar)=13 then begin
    if CheckChar <> InChar[13] then
     begin
      Exit;
      ShowMessage('校验位不合法');
      Abort;
    end;
  end
  else begin
    OutBar := InChar + CheckChar;
  end;

  OutsideBar := '101' + EAN_13Convert(OutBar) + '101';
  //设置画布
  CanvasArea.Pen.Color := clrBk;
  CanvasArea.Rectangle(rcArea);
  OutX := 1;//((rcArea.Right - rcArea.Left) div 2) - nStep * 5;
  OutY := 1;//((rcArea.Bottom - rcArea.Top) div 2) - nStep * 5;
  OutHeight := nStep * 50;

  {
    https://wenku.baidu.com/view/d61eec0dc4da50e2524de518964bcf84b9d52d0d.html
    共有95+18=113条数据模块，1表示黑，0表示白
    左侧空白区  + 起始符  +   左侧数据符  +   中间分隔符  +   右侧数据符  +   效验符  +   终止符  +   右侧空白区
    11个空白区    101(3)        6*(7)           01010(5)          5*(7)        (7)          101       0000000(至少7空白)
    ISBN 978-7-229-01217-5
  }

  BarHeight := rcArea.Height - 5 * 2;  // 上下各留5个像素单位
  BarWidth := (rcArea.Width - 5 * 2) div 113;// 左右各预留5个像素单位
  BarLeft := rcArea.Left + 5;
  BarTop := rcArea.Top + 5;
  BarRight := BarLeft + 113 * BarWidth;
  BarBottom := rcArea.Bottom - 100;
  BarArea.Left := BarLeft;
  BarArea.Top := BarTop;
  BarArea.Right := BarArea.Left + BarWidth;
  BarArea.Bottom := BarBottom;

  OutsideBar := '00000000000' + OutsideBar + '0000000';
  for i := 1 to Length(OutsideBar) do
  begin
    TextDistance := 30;
    BarArea.Left := BarLeft + BarWidth * (i-1);
    BarArea.Right := BarArea.Left + BarWidth;
    if i<=11 then                     // 左侧空白区
      BarArea.Bottom := BarBottom - TextDistance
    else if (i>=12) and (i<=14) then  // 起始符
      BarArea.Bottom := BarBottom
    else if (i>=15) and (i<=56) then  // 左侧数据符
      BarArea.Bottom := BarBottom - TextDistance
    else if (i>=57) and (i<=61) then  // 中间分隔符
      BarArea.Bottom := BarBottom
    else if (i>=62) and (i<=103) then  // 右侧数据符 + 效验符
      BarArea.Bottom := BarBottom - TextDistance
    else if (i>=104) and (i<=106) then // 终止符
      BarArea.Bottom := BarBottom
    else
      BarArea.Bottom := BarBottom - TextDistance;// 右侧空白区

    if OutsideBar[i] = '1' then
      CanvasArea.Brush.Color := clrBar
    else
      CanvasArea.Brush.Color := clrBk;
    CanvasArea.FillRect(BarArea);

    TextDistance := 1;
    CanvasArea.Font.Name := '宋体';
    CanvasArea.Font.Color := clrBar;
    CanvasArea.Brush.Color := clrBk;
    //CanvasArea.Font.Style := [fsBold];
    CanvasArea.Font.Size := nStep * 4;

    TextArea.Left := BarArea.Left;
    TextArea.Top := BarArea.Bottom;
    TextArea.Right := TextArea.Left + BarWidth * 11;
    TextArea.Bottom := rcArea.Bottom;
    sText := '';

    if (i=5) then begin
      TextArea.Right := TextArea.Left + BarWidth * 7;sText := OutBar[1];
    end
    else if (i=15) then begin
      TextArea.Right := TextArea.Left + BarWidth * 7;sText := OutBar[2];
    end
    else if (i=22) then begin
      TextArea.Right := TextArea.Left + BarWidth * 7;sText := OutBar[3];
    end
    else if (i=29) then begin
      TextArea.Right := TextArea.Left + BarWidth * 7;sText := OutBar[4];
    end
    else if (i=36) then begin
      TextArea.Right := TextArea.Left + BarWidth * 7;sText := OutBar[5];
    end
    else if (i=43) then begin
      TextArea.Right := TextArea.Left + BarWidth * 7;sText := OutBar[6];
    end
    else if (i=50) then begin
      TextArea.Right := TextArea.Left + BarWidth * 7;sText := OutBar[7];
    end

    else if (i=62) then begin
      TextArea.Right := TextArea.Left + BarWidth * 7;sText := OutBar[8];
    end
    else if (i=69) then begin
      TextArea.Right := TextArea.Left + BarWidth * 7;sText := OutBar[9];
    end
    else if (i=76) then begin
      TextArea.Right := TextArea.Left + BarWidth * 7;sText := OutBar[10];
    end
    else if (i=83) then begin
      TextArea.Right := TextArea.Left + BarWidth * 7;sText := OutBar[11];
    end
    else if (i=90) then begin
      TextArea.Right := TextArea.Left + BarWidth * 7;sText := OutBar[12];
    end
    else if (i=97) then begin
      TextArea.Right := TextArea.Left + BarWidth * 7;sText := OutBar[13];
    end
    else if (i=107) then begin
      TextArea.Right := TextArea.Left + BarWidth * 7;sText := '>';
    end;

    if sText <>'' then
      CanvasArea.TextRect(TextArea, sText, [tfSingleLine, tfCenter, tfTop]);
  end;
end;

end.

效果图：

需改进的地方：条形码下面的凹条高度和字体大小，可改为根据画布大小，自动调整参数。