Delphi 6 纯代码条形码控件：Code39/Code128 编码与绘制实战

简介这份资源面向仍在使用 Delphi 6 的开发者提供一套无需任何外部插件即可生成一维条形码的控件源码适用于库存管理、产品标识、标签打印等需要条码输出的场景。包内共 17 个文件约 239KB以 pas 源码、dcu 编译单元、dfm 窗体、dpr 工程文件为主另含 bmp 位图、res 资源、htm 说明及可执行文件覆盖从编码逻辑到界面演示的完整结构。控件支持 Code 39 与 Code 128 等常见一维码制通过代码直接绘制条纹并实现打印输出不依赖第三方组件便于移植与二次开发。目前已有 1272 人学习下载。读者可从中理解字符到条纹模式的转换、起始码与校验码计算、GDI 绘图与打印布局等关键实现并直接复用源码集成到自己的 Delphi 项目中。1. 拆开一个 Delphi 6 条形码控件为什么老项目还在用它接手一个 Delphi 6 的老系统时最头疼的不是业务逻辑而是打印模块里那堆条形码。客户要求支持 Code39 和 Code128还不能装任何第三方插件因为现场机器是内网装不了额外运行库。翻了一圈发现有人用纯 Delphi 代码实现了一维条形码控件直接编译进 exe不依赖外部 DLL 或 ActiveX。这个思路对维护老系统的开发者来说很实用代码量不大逻辑清晰改起来也方便。它适合两类人一是还在维护 Delphi 6/7 遗留项目的工程师二是想理解条形码编码原理、不想被商业控件绑定的开发者。下面从代码结构、编码实现、绘制逻辑到二次开发完整拆一遍。2. 控件架构与核心单元从 TGraphicControl 继承出来的条形码2.1 为什么选择 TGraphicControl 而不是 TCustomControlDelphi 里做自定义绘制控件通常从 TGraphicControl 或 TCustomControl 继承。TGraphicControl 没有窗口句柄占用资源少适合纯绘制型控件TCustomControl 有句柄能接收焦点和键盘事件但开销大。条形码控件只需要在 Canvas 上画条纹和文字不需要交互所以 TGraphicControl 是更合理的选择。常见做法是重写 Paint 方法在里面根据当前编码类型计算条纹宽度和间距然后逐条绘制。type TBarCode class(TGraphicControl) private FCodeType: TBarCodeType; // 编码类型Code39 / Code128 FData: string; // 待编码的原始数据 FShowText: Boolean; // 是否在条纹下方显示可读文本 FBarWidth: Integer; // 单条最细条纹的像素宽度 procedure DrawBarCode; protected procedure Paint; override; procedure SetData(const Value: string); public constructor Create(AOwner: TComponent); override; published property Data: string read FData write SetData; property CodeType: TBarCodeType read FCodeType write FCodeType; property ShowText: Boolean read FShowText write FShowText; property BarWidth: Integer read FBarWidth write FBarWidth; end;这段声明里FBarWidth 控制最细条纹的像素宽度通常设为 1 或 2。FShowText 决定是否在条纹下方绘制可读字符。SetData 方法里要做校验如果传入的字符不在当前编码类型的字符集里就清空或抛异常。Paint 方法调用 DrawBarCode后者根据 FCodeType 分派到 Code39 或 Code128 的编码函数拿到一个布尔数组或宽度序列再在 Canvas 上画矩形。2.2 单元文件划分与依赖关系一个干净的实现通常拆成两个单元BarCodeTypes.pas 放编码表和类型定义BarCode.pas 放控件类。BarCodeTypes 里定义 TBarCodeType 枚举、Code39 的字符集常量数组、Code128 的编码表。这样拆的好处是编码逻辑和界面绘制解耦以后要加 Code93 或 EAN-13只改 BarCodeTypes 和 DrawBarCode 里的分派分支不用动控件属性。unit BarCodeTypes; interface type TBarCodeType (bcCode39, bcCode128); const // Code39 字符集0-9 A-Z 和几个特殊符号共 43 个字符 Code39Chars: array[0..42] of Char (0,1,2,3,4,5,6,7,8,9, A,B,C,D,E,F,G,H,I,J, K,L,M,N,O,P,Q,R,S,T, U,V,W,X,Y,Z,-,., ,$,/,,%); // 每个字符对应的 9 位条纹模式1 表示宽条0 表示窄条 Code39Patterns: array[0..42] of string[9] ( 000110100, 100100001, 001100001, 101100000, // ... 其余模式省略实际代码里要补全 001100100);Code39 的每个字符由 9 个元素组成其中 3 个是宽条6 个是窄条。宽窄比例通常取 2:1 或 3:1。Code128 更复杂有三套字符集A、B、C需要根据数据内容动态切换还要计算校验位。实现时一般先写一个 GetCode128Patterns 函数返回每个字符对应的 11 位模式串。3. 编码实现细节Code39 与 Code128 的算法拆解3.1 Code39 编码起始符、数据符、终止符的拼接Code39 的编码规则相对简单每个字符对应 9 位模式其中 3 位宽、6 位窄。起始符和终止符都是 *。编码时先把原始数据转成大写然后拼成*DATA*的形式再逐字符查表得到模式串最后把模式串转成条纹宽度序列。function TBarCode.GetCode39Patterns(const AData: string): TArrayInteger; var I, J: Integer; S: string; Pattern: string[9]; begin S : * UpperCase(AData) *; SetLength(Result, 0); for I : 1 to Length(S) do begin // 查找字符在 Code39Chars 中的位置 for J : 0 to 42 do if Code39Chars[J] S[I] then begin Pattern : Code39Patterns[J]; Break; end; // 把 9 位模式转成宽度序列0 表示窄条1 表示宽条 for J : 1 to 9 do begin if Pattern[J] 1 then Result : Result [FBarWidth * 3] // 宽条 else Result : Result [FBarWidth]; // 窄条 end; // 字符之间加一个窄间隔 Result : Result [FBarWidth]; end; end;这里有个细节Code39 的字符间隔通常是一个窄条宽度。如果 BarWidth 设为 2那么窄条 2 像素宽条 6 像素间隔 2 像素。绘制时交替画黑条和白条黑条宽度从 Result 数组里取白条宽度固定为窄条宽度。注意数组里存的是每个元素的宽度不是布尔值这样绘制时更灵活。3.2 Code128 编码字符集切换与校验位计算Code128 比 Code39 复杂得多。它有三套字符集A 集包含大写字母和控制字符B 集包含大小写字母和数字C 集只包含数字且每两个数字压缩成一个字符。编码时要根据数据内容选择最紧凑的字符集必要时在数据中间切换。校验位计算是起始符的值加上每个数据符的值乘以位置权重最后对 103 取模。function TBarCode.GetCode128Patterns(const AData: string): TArrayInteger; var I, Sum, CheckCode: Integer; Codes: TArrayInteger; CurrentSet: Char; begin // 简化版假设数据全是数字直接用 C 集 CurrentSet : C; SetLength(Codes, 0); Codes : Codes [105]; // Start C I : 1; while I Length(AData) do begin // 每两个数字转成一个值 Codes : Codes [StrToInt(Copy(AData, I, 2))]; Inc(I, 2); end; // 计算校验位 Sum : Codes[0]; for I : 1 to High(Codes) do Sum : Sum Codes[I] * I; CheckCode : Sum mod 103; Codes : Codes [CheckCode]; Codes : Codes [106]; // Stop // 查表得到每个值的 11 位模式再转成宽度序列 Result : Code128ToWidths(Codes); end;实际实现里字符集切换逻辑要复杂得多。常见做法是写一个 AnalyzeData 函数先扫描数据决定用哪套字符集再生成编码序列。校验位计算容易出错的地方是权重起始符的权重是 1第一个数据符权重是 1第二个是 2以此类推。如果算错了扫描枪读出来的就是乱码。3.3 绘制逻辑Canvas 上的条纹与文字布局拿到宽度序列后绘制就简单了。遍历数组交替画黑色和白色矩形。黑色矩形的宽度从数组取白色矩形的宽度固定为窄条宽度。如果 ShowText 为 True在条纹下方用 TextOut 输出原始数据。procedure TBarCode.DrawBarCode; var X, Y, I: Integer; Widths: TArrayInteger; IsBlack: Boolean; begin Widths : GetPatterns(FData); X : 0; Y : 0; IsBlack : True; for I : 0 to High(Widths) do begin if IsBlack then begin Canvas.Brush.Color : clBlack; Canvas.FillRect(Rect(X, Y, X Widths[I], Y Height - 20)); end; Inc(X, Widths[I]); IsBlack : not IsBlack; end; if FShowText then begin Canvas.Brush.Style : bsClear; Canvas.Font.Name : Arial; Canvas.Font.Size : 8; Canvas.TextOut(0, Height - 18, FData); end; end;这里把条纹高度设为 Height - 20给下方文字留空间。文字位置和字体大小要根据控件实际尺寸调整否则打印出来会重叠。如果控件宽度不够条纹会画到边界外需要在 SetData 或 Paint 里做裁剪或自动缩放。4. 避坑与常见问题编码、绘制、打印里的翻车点4.1 校验位算错导致扫描枪读不出现象条形码看起来正常但扫描枪读出来是乱码或直接不识别。原因Code128 的校验位计算时权重搞错或者起始符的值用错。解决打印一份校验位对照表手动验算几个短数据的校验位确认公式是(Start Σ(Data[i] * i)) mod 103。注意起始符的权重是 1不是 0。4.2 宽窄比例不对导致识别率低现象扫描枪偶尔能读出来但需要反复对准。原因宽条和窄条的比例小于 2:1或者打印时分辨率不够窄条被压缩成 1 像素。解决BarWidth 至少设为 2宽窄比设为 3:1。如果是热敏打印机先测试打印一条用尺子量实际宽度再调整 BarWidth。4.3 控件宽度不够导致条纹被截断现象条形码右边少了一截扫描枪完全读不出。原因控件宽度小于所有条纹宽度之和。解决在 SetData 里计算总宽度如果超过控件宽度自动缩小 BarWidth 或弹出提示。常见做法是重写 SetBounds在尺寸变化时重新计算。4.4 中文或特殊字符导致编码失败现象传入包含中文的字符串程序报错或画出空白。原因Code39 和 Code128 只支持 ASCII 字符集中文无法直接编码。解决在 SetData 里做字符校验遇到非 ASCII 字符就抛异常或过滤掉。如果业务需要中文得用二维码一维码做不到。4.5 打印时条纹模糊或粘连现象屏幕上正常打印出来条纹糊在一起。原因打印机分辨率低或者 Canvas 的 Pen 模式导致矩形边缘被抗锯齿。解决绘制时用 FillRect 而不是 LineTo确保边缘锐利。打印前设置 Printer.Canvas.Pen.Mode 为 pmCopy避免颜色混合。5. 二次开发与改造从固定编码到动态配置5.1 增加 Code93 或 EAN-13 支持如果业务需要更多编码类型扩展方式很直接在 TBarCodeType 枚举里加新类型在 BarCodeTypes.pas 里加对应的字符集和模式表然后在 DrawBarCode 里加一个分支。以 EAN-13 为例它的编码规则是每 7 位一个字符左侧奇偶校验、右侧固定模式校验位计算是前 12 位加权求和后取模。实现时先写一个 GetEAN13Patterns 函数返回 95 位模式串再复用现有的绘制逻辑。function TBarCode.GetEAN13Patterns(const AData: string): TArrayInteger; var I, Sum, CheckDigit: Integer; LeftPattern, RightPattern: string; begin // 计算校验位 Sum : 0; for I : 1 to 12 do begin if Odd(I) then Sum : Sum StrToInt(AData[I]) else Sum : Sum StrToInt(AData[I]) * 3; end; CheckDigit : (10 - (Sum mod 10)) mod 10; // 根据第一位数字选择左侧奇偶模式 LeftPattern : GetEAN13LeftPattern(AData[1]); // 拼接左侧 6 位和右侧 6 位的模式 // ... 省略具体查表逻辑 Result : PatternToWidths(LeftPattern RightPattern); end;改造时注意EAN-13 的条纹宽度只有 1、2、3、4 四种和 Code39 的宽窄两档不同PatternToWidths 函数要能处理多档宽度。另外 EAN-13 的起始符和终止符是固定的 101 模式不要漏掉。5.2 把控件改成动态库或 ActiveX如果其他语言的项目也要用这个条形码功能可以把编码逻辑抽成一个独立的 DLL。Delphi 里用library关键字创建工程导出function GenerateBarCodePatterns(CodeType: Integer; Data: PChar): PChar; stdcall;这样的函数返回模式串。调用方拿到模式串后自己绘制。这样 C#、VB、甚至 Python 都能通过 ctypes 调用。注意内存管理返回的 PChar 要用CoTaskMemAlloc分配调用方负责释放否则会内存泄漏。5.3 验证改造是否正确的三个方法改完编码逻辑后别急着集成到打印模块。先用三个方法验证第一用在线条形码生成器生成同样的数据对比条纹模式是否一致第二用扫描枪实测连续扫 20 次看识别率是否 100%第三打印到 PDF放大 400%用尺子量宽窄比例是否符合规格。我一般会在单元测试里写一个 TestCode128CheckDigit 用例把已知数据的校验位硬编码进去每次改完跑一遍。从那以后我每次改条形码编码逻辑都强制走一遍「在线对比 扫描枪实测 放大测量」的流程不再只靠肉眼看着差不多就交付。希望帮到你。本文还有配套的精品资源点击获取