Delphi 实现EAN-13条码

之前在网站上看到很多Delphi 的EAN-13条码实现，在实际中也很好用。就是在实际测试中发现第一位如果是1，2，3的情况下识别不了。

下面是从网上找到的示例，然后修改的。供大家参考。

 

unit UnitEAN;

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 CreateEAN_13(InChar: string; CanvasArea: TCanvas; bcArea: TRect;
  bcStep: Integer; bcColorB: TColor = clBlack; bcColorW: TColor = clWhite; IsBarCode: Boolean = true): 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 Length(InChar) 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)               **
//**左空白、起始符、系统码、左数据符、中间线、右数据符、检查码、终止符、右空白**
//** >=9      3       0        42       5        35       7       3      >=9  **
//**         101                      01010                      101          **
//**
//**参数：InChar        12位条码
//**      CanvasArea    画布
//**      BcArea        矩形区域
//**      BcStep        步长
//**      BcColorB      颜色（默认黑色）
//**      BcColorW      颜色（默认白色）
//**      IsBarCode     是否显示条码
//******************************************************************************

function CreateEAN_13(InChar: string; CanvasArea: TCanvas; bcArea: TRect;
  bcStep: Integer; bcColorB: TColor = clBlack; bcColorW: TColor = clWhite; IsBarCode: Boolean = true): Boolean;
var
  CheckChar, OutBar, OutsideBar: string;
  OutX, OutY, OutHeight: Word;
  i, j: Integer;
  brush: TBrush;
  R: TRect;
begin
  result := true;
  try
    if Length(InChar) <> 12 then
    begin
      ShowMessage('输入的不是12位数字！');
      Abort;
    end;
    //验证校验位
    CheckChar := EANCheck(InChar);
    OutBar := InChar + CheckChar;
    OutsideBar := '101' + EAN_13Convert(OutBar) + '101';
    //设置画布
    CanvasArea.Pen.Color := bcColorW;
    CanvasArea.Rectangle(bcArea);
    OutX := 1; // ((bcArea.Right - bcArea.Left) div 2) - bcStep * 5;
    OutY := 1; // ((bcArea.Bottom - bcArea.Top) div 2) - bcStep * 5;
    OutHeight := bcStep * 50;

    //输出条码
    for i := 1 to Length(OutsideBar) do
    begin
      if OutsideBar[i] = '1' then
        CanvasArea.Pen.Color := bcColorB
      else
        CanvasArea.Pen.Color := bcColorW;
      for j := 1 to bcStep do
      begin
        CanvasArea.MoveTo(OutX + bcStep * 9 + (bcStep * (i - 1)) + (j - 1), OutY + (bcStep * 5));
        if i in [1..3, 46..50, 93..95] then
          CanvasArea.LineTo(OutX + bcStep * 9 + (bcStep * (i - 1)) + (j - 1), OutY + OutHeight - (bcStep * 5))
        else
          CanvasArea.LineTo(OutX + bcStep * 9 + (bcStep * (i - 1)) + (j - 1), OutY + OutHeight - (bcStep * 5));
      end;
    end;
    if IsBarCode = True then begin
      //先画个白色区域
      CanvasArea.Brush.Color := bcColorW;
      r.Left := 1;
      r.Top := 1;
      r.Right := 90;
      r.Bottom := bcStep * 4;
      CanvasArea.fillrect(r);
      //设置字体
      CanvasArea.Font.Name := '宋体';
      //CanvasArea.Font.Style := [fsBold];
      CanvasArea.Font.Size := bcStep * 4;

      //输出字符
      for i := 1 to Length(OutBar) do
      begin
        CanvasArea.TextOut(OutX + 10 + bcStep + i * 5, OutY + 10, OutBar[i]);
      end;
    end;
  except on E: Exception do
    begin
      result := False;
    end;
  end;
end;


end.

 

转载于:https://www.cnblogs.com/YoungMei/p/3497494.html