简介：这份资源面向仍在使用 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 而不是 TCustomControl

Delphi 里做自定义绘制控件，通常从 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): TArray<Integer>; 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): TArray<Integer>; var I, Sum, CheckCode: Integer; Codes: TArray<Integer>; 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: TArray<Integer>; 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): TArray<Integer>; 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 用例，把已知数据的校验位硬编码进去，每次改完跑一遍。

从那以后我每次改条形码编码逻辑，都强制走一遍「在线对比 + 扫描枪实测 + 放大测量」的流程，不再只靠肉眼看着差不多就交付。希望帮到你。

本文还有配套的精品资源，点击获取