EAN13条形码绘制(Delphi版)

2023-11-15

单元声明:

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.

效果图:

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

本文内容由网友自发贡献,版权归原作者所有,本站不承担相应法律责任。如您发现有涉嫌抄袭侵权的内容,请联系:hwhale#tublm.com(使用前将#替换为@)

EAN13条形码绘制(Delphi版) 的相关文章

  • JS 元素遍历

    1 循环遍历从getElementsByClassName返回的所有元素 var elements document getElementsByClassName classname Array prototype forEach call
  • 多语言版本 UI资源切换

    1 如果窗体资源和源码里面所使用的字符串资源 都已经存在于资源视图里面 则通过下面方式来实现 LANGID lid GetSystemDefaultLangID if 0x0809 lid 英语 0x0809 SetThreadUILang
  • C++ 多语言切换

    如果设置UI资源文件非重点不做介绍 设置英文版接口 SetThreadUILanguage MAKELANGID LANG ENGLISH SUBLANG ENGLISH US 此时如果操作系统的语言选择的是简体中文 那么掉系统的AfxMe
  • OpenGL GLFW入门篇 - 画凸多边形

    效果图 主体代码 void DrawPolygon void glPushMatrix glLoadIdentity glTranslatef 0 0 0 0 0 f 蓝色 glColor3f 0 f 0 f 1 f glBegin GL
  • GPAC MP4文件写入(支持H264、H265)

    1 GPAC模块下载链接https github com gpac gpac或https gpac wp imt fr downloads 2 编译指导https github com gpac gpac wiki Build Introd
  • C++ 正则表达式regex(一)

    匹配字符串的基本规则 1 匹配固定的字符串 regex e abc 2 匹配固定字符串 不区分大小写 regex e abc regex constants icase 3 匹配固定字符串之外多一个字符 不区分大小写 regex e abc
  • C++类上使用属性(__declspec property)

    原始代码如下 class A private int m nIndex public int getIndex return m nIndex void setIndex int value m nIndex value 如果采用属性方式实
  • OpenGL GLFW入门篇 - 画点集

    效果图 主体代码 void DrawPoints void int i GLfloat x y glPushMatrix 另一个相对的Z平移可以分离对象 glLoadIdentity glTranslatef 0 0 0 0 0 f 设置点
  • VC++ 在任务栏图标上显示进度条效果

    该功能主要是通过COM接口ITaskbarList3 来实现进度效果显示功能 头文件定义 CSWTaskBarList h pragma once include
  • 微信网页版接口详解

    一 网页版微信提供的HTTP接口 1 获取uuid 说明 用于获取显示二维码以及登录所需的uuid 标识获取二维码和扫码的为同一个用户 请求方式 GET 地址 https login wx qq com jslogin get参数 参数 示
  • OpenGL GLFW入门篇 - 画矩形

    效果图 主体代码 void DrawRectangle void GLfloat xl yt xr yb w h glPushMatrix glLoadIdentity glTranslatef 0 0 0 0 0 f w 1 2 h 1
  • C++ 可扩展的内存缓冲区

    类声明 CMemBuffer h pragma once class CMemBuffer public CMemBuffer DWORD dwSize 0 CMemBuffer void 申请内存 BOOL Realloc DWORD d
  • GDI+ 显示GIF图像

    头文件定义 pragma once include
  • Node.js EventEmitter事件

    Node js EventEmitter Node js 所有的异步 I O 操作在完成时都会发送一个事件到事件队列 Node js 里面的许多对象都会分发事件 一个 net Server 对象会在每次有新连接时触发一个事件 一个 fs r
  • vim/vi常用命令集

    格式 指令 或指令 参数 指令解释 文件操作 vim vi 打开一个空文件 vim vi a txt 打开当前目录中的a txt文件 若文件不存在则创建一个名为a txt的文件 指定保存位置为当前目录 vim vi home a txt 打
  • CStdioFile扩展(支持Ansi、Unicode、Utf-8等文本格式)

    头文件声明 CStdioFileEx h StdioFileEx h interface for the CStdioFileEx class Version 1 1 23 August 2003 Incorporated fixes fr
  • QT 中文版信息提示框

    引言 在QT设计UI程序过程中 整套系统都是中文版本 然而信息提示默认只有中文 难免有点小纠结 这里针对QMessageBox稍微做了一点点改进 使其支持完美的中文提示框 调用方式非常简单 只需要将QMessageBox调用地方 改为QSh
  • VC++ OpenCV+ZBar二维码识别

    利用OpenCV处理图像的优势 结合ZBar提高二维码识别结果 接口定义 include
  • MetaEditor 编译原理之MQ4文件语法解析

    语法解析 顾名思义就是将一个文件或者一段代码 按照语法结构拆分为一个一个的单词 比如 extern int TakeProfit 50 int start int i 0 while i lt TakeProfit i return i 正
  • C++ StrCmpLogicalW文件名排序

    打开资源管理器 文件列表如下 搜索文件列表 include

随机推荐

  • 深度学习超分辨率重建(总结)

    本文为概述 详情翻看前面文章 1 SRCNN 2 3改进 开山之作 三个卷积层 输入图像是低分辨率图像经过双三次 bicubic 插值和高分辨率一个尺寸后输入CNN 图像块的提取和特征表示 特征非线性映射和最终的重建 使用均方误差 MSE
  • linux time 和/usr/bin/time

    http codingstandards iteye com blog 798788 用途说明 time命令常用于测量一个命令的运行时间 注意不是用来显示和修改系统时间的 这是date命令干的事情 但是今天我通过查看time命令的手册页 发
  • LeetCode #124 二叉树中的最大路径和

    124 二叉树中的最大路径和 路径 被定义为一条从树中任意节点出发 沿父节点 子节点连接 达到任意节点的序列 同一个节点在一条路径序列中 至多出现一次 该路径 至少包含一个 节点 且不一定经过根节点 路径和 是路径中各节点值的总和 给你一个
  • ADO方法操作数据库

    一 ADO连接数据库步骤 1 这行不能少 import C Program Files Common Files system ado msado60 tlb no namespace rename EOF adoEOF 2 初始化ado组
  • 让HTML img垂直居中的三种办法:

    声明 原文来自DIVCSS5 其次原文代码存在一些引起误解的地方 已经进行修改和测试 下文会注明引起误解的地方 主要收藏为方便下次阅读 故进行转发 如有侵权 请私聊本人 定立即删除 原文连接 DIVCSS5 让html img垂直居中的三种
  • 2018腾讯移动游戏技术评审标准与实践案例

    文档下载点这里 lt lt lt lt lt lt lt lt lt lt lt lt lt lt lt lt lt lt lt lt lt lt 下载文档 gt gt gt gt gt gt gt gt gt gt gt gt gt gt
  • webpack系列 —— 打包原理

    为什么要使用webpack 如今的很多网页其实可以看做是功能丰富的应用 它们拥有着复杂的JavaScript代码和一大堆依赖包 为了简化开发的复杂度 前端社区涌现出了很多好的实践方法 模块化 让我们可以把复杂的程序细化为小的文件 类似于Ty
  • java中的字符串常量池_java字符串常量池

    字符串常量池SCP jdk1 6是放在永久代 8中叫方法区或叫元空间 中 jdk1 7 中 字符串常量池放入了堆中 注意运行时常量依然存放在方法区 例如 Integer a 40 Java在编译的时候会直接将代码封装成Integer a I
  • Vue中使用z-tree插件 —— 点击展开事件异步加载子节点

    在vue中使用z tree插件 执行异步加载时候 API文档提示必须写上 async enable true url nodes php autoParam id name 琢磨了好久 写出来的 首先 要弄清楚这两个事件的方法 1 节点展开
  • Nodejs 实现爬虫的改造:Promise优化、动态页面数据的获取、多个页面并发爬取

    跟着Scott老师把上一次的那个爬虫代码进行改造 主要包括单个网页爬取变为多个网页爬取 使用Promise来优化多层回调 动态数据的获取 Scott老师视频中没有的 自己乱搞一个晚上出来的 首先来介绍一下Promise Promise可以将
  • SimpleDateFormat案例

    package Java project 1 import java text ParseException import java text SimpleDateFormat import java util Date public cl
  • 使用VS创建的C#winfrom窗体窗体设计界面突然不见了解决方法

    使用VS创建的C winfrom窗体窗体设计界面突然不见了解决方法 原因 在主窗体的类前面添加了一个新类 这样会导致原来的窗体设计界面无法显示 正常可以显示的情况下如下图所示 但是如果在主窗体类的前面再添加一个类之后 窗体设计界面就会无法显
  • Java-面向对象2-向下转型

    多态的补充 有了对象的多态性以后 内存中实际上是加载了子类特有的属性和方法的 但是由于变量声明为父类类型 导致编译时 只能调用父类中声明的属性和方法 子类特有的属性和方法不能调用 如何才能调用子类特有的属性和方法 向下转型 使用强制类型转换
  • 将现有MySQL数据库改为大小写不敏感

    摘要 用过MySQL的应该都会注意到 默认情况下 Linux下安装的MySQL是大小写敏感的 也就是说Table1和table1可以同时存在 而Windows下的MySQL却是大小写不敏感的 所有表名和数据库名都会变成小写 用过MySQL的
  • Java中try catch的原则

    一 使用try catch的场合 如果不使用这种try结构时 代码报错退出就无bai法继续执行 有的代码出错就应该退出 有的出错尚可以补救 就不应该退出 对于这种出错不应该退出的就需要使用这种结构 在catch中进行补救 二 使用try c
  • 项目作品展示

    本人本科所读专业 机械设计专业 对于结构设计有一定的经验 读研期间的主要方向为机器视觉 以及以目标检测为代表的深度学习在日常生活中以及工业上的应用 1 基于机器视觉的测量系统 2 基于机器视觉的玻璃缺陷检测系统 3 基于机器视觉的油墨测量
  • day02

    springboot注解 ApiOperation 接口文档注解功能 PathVariable 获取requestMapping中的参数值 转载于 https www cnblogs com lik99999 p 11460401 html
  • MGRE GRE PPP协议综合运用

    题目 题目要求 思路 1 拿到拓扑图 我们先看第一个要求 r5是isp isp是网络服务运营商 不能被通告进路由协议 所以在配置时 要写一条静态缺省 指向isp 2 从拓扑图我们可以看出 在实验前需要先加2SA板卡 连接成串线 3 在完成前
  • B-tree/B+tree/B*tree

    B 树 1 前言 动态查找树主要有 二叉查找树 Binary Search Tree 平衡二叉查找树 Balanced Binary Search Tree 红黑树 Red Black Tree B tree B tree B tree B
  • EAN13条形码绘制(Delphi版)

    单元声明 unit UnitEAN https wenku baidu com view d61eec0dc4da50e2524de518964bcf84b9d52d0d html 共有95 18 113条数据模块 1表示黑 0表示白 左侧