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空白)
}
interfaceusesGraphics, 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;
vari, c1, c2, cc: Integer;
beginc1 := 0;c2 := 0;cc := 0;for i := 1 to 12 dobeginif (i mod 2) = 1 thenc1 := c1 + StrToInt(InChar[i])elsec2 := c2 + StrToInt(InChar[i]);end;cc := (c1 + (c2 * 3)) mod 10;if cc = 0 thenresult := '0'elseresult := 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;
vari: Integer;TempStr, LeftStr, RightStr: string;
beginTempStr := '';LeftStr := Copy(ConvertStr, 2, 6);RightStr := Copy(ConvertStr, 8, 6);//############################ 左资料编码 Start  #############################case ConvertStr[1] of'1':beginfor i := 1 to Length(LeftStr) dobegin//TempStr := TempStr + EAN_A[StrToInt(LeftStr[i])];case i of1, 2, 4: TempStr := TempStr + EAN_A[StrToInt(LeftStr[i])];3, 5, 6: TempStr := TempStr + EAN_B[StrToInt(LeftStr[i])];end;end;end;'2':beginfor i := 1 to Length(LeftStr) dobegincase i of1, 2, 5: TempStr := TempStr + EAN_A[StrToInt(LeftStr[i])];3, 4, 6: TempStr := TempStr + EAN_B[StrToInt(LeftStr[i])];end;end;end;'3':beginfor i := 1 to Length(LeftStr) dobegincase i of1, 2, 6: TempStr := TempStr + EAN_A[StrToInt(LeftStr[i])];3, 4, 5: TempStr := TempStr + EAN_B[StrToInt(LeftStr[i])];end;end;end;'4':beginfor i := 1 to Length(LeftStr) dobegincase i of1, 3, 4: TempStr := TempStr + EAN_A[StrToInt(LeftStr[i])];2, 5, 6: TempStr := TempStr + EAN_B[StrToInt(LeftStr[i])];end;end;end;'5':beginfor i := 1 to Length(LeftStr) dobegincase i of1, 4, 5: TempStr := TempStr + EAN_A[StrToInt(LeftStr[i])];2, 3, 6: TempStr := TempStr + EAN_B[StrToInt(LeftStr[i])];end;end;end;'6':beginfor i := 1 to Length(LeftStr) dobegincase i of1, 5, 6: TempStr := TempStr + EAN_A[StrToInt(LeftStr[i])];2, 3, 4: TempStr := TempStr + EAN_B[StrToInt(LeftStr[i])];end;end;end;'7':beginfor i := 1 to Length(LeftStr) dobegincase i of1, 3, 5: TempStr := TempStr + EAN_A[StrToInt(LeftStr[i])];2, 4, 6: TempStr := TempStr + EAN_B[StrToInt(LeftStr[i])];end;end;end;'8':beginfor i := 1 to Length(LeftStr) dobegincase i of1, 3, 6: TempStr := TempStr + EAN_A[StrToInt(LeftStr[i])];2, 4, 5: TempStr := TempStr + EAN_B[StrToInt(LeftStr[i])];end;end;end;'9':beginfor i := 1 to Length(LeftStr) dobegincase i of1, 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) dobeginTempStr := 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;
varCheckChar, OutBar, OutsideBar: string;OutX, OutY, OutHeight: Word;i: Integer;BarLeft, BarTop, BarRight, BarBottom, BarHeight, BarWidth, TextDistance: Integer;BarArea, TextArea: TRect;sText: string;
beginresult := true;if (Length(InChar) <> 13) and (Length(InChar) <> 12) thenbeginExit;ShowMessage('输入的不是有效数字！');Abort;end;//验证校验位OutBar := InChar;CheckChar := EANCheck(InChar);if Length(InChar)=13 then beginif CheckChar <> InChar[13] thenbeginExit;ShowMessage('校验位不合法');Abort;end;endelse beginOutBar := 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) dobeginTextDistance := 30;BarArea.Left := BarLeft + BarWidth * (i-1);BarArea.Right := BarArea.Left + BarWidth;if i<=11 then                     // 左侧空白区BarArea.Bottom := BarBottom - TextDistanceelse if (i>=12) and (i<=14) then  // 起始符BarArea.Bottom := BarBottomelse if (i>=15) and (i<=56) then  // 左侧数据符BarArea.Bottom := BarBottom - TextDistanceelse if (i>=57) and (i<=61) then  // 中间分隔符BarArea.Bottom := BarBottomelse if (i>=62) and (i<=103) then  // 右侧数据符 + 效验符BarArea.Bottom := BarBottom - TextDistanceelse if (i>=104) and (i<=106) then // 终止符BarArea.Bottom := BarBottomelseBarArea.Bottom := BarBottom - TextDistance;// 右侧空白区if OutsideBar[i] = '1' thenCanvasArea.Brush.Color := clrBarelseCanvasArea.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 beginTextArea.Right := TextArea.Left + BarWidth * 7;sText := OutBar[1];endelse if (i=15) then beginTextArea.Right := TextArea.Left + BarWidth * 7;sText := OutBar[2];endelse if (i=22) then beginTextArea.Right := TextArea.Left + BarWidth * 7;sText := OutBar[3];endelse if (i=29) then beginTextArea.Right := TextArea.Left + BarWidth * 7;sText := OutBar[4];endelse if (i=36) then beginTextArea.Right := TextArea.Left + BarWidth * 7;sText := OutBar[5];endelse if (i=43) then beginTextArea.Right := TextArea.Left + BarWidth * 7;sText := OutBar[6];endelse if (i=50) then beginTextArea.Right := TextArea.Left + BarWidth * 7;sText := OutBar[7];endelse if (i=62) then beginTextArea.Right := TextArea.Left + BarWidth * 7;sText := OutBar[8];endelse if (i=69) then beginTextArea.Right := TextArea.Left + BarWidth * 7;sText := OutBar[9];endelse if (i=76) then beginTextArea.Right := TextArea.Left + BarWidth * 7;sText := OutBar[10];endelse if (i=83) then beginTextArea.Right := TextArea.Left + BarWidth * 7;sText := OutBar[11];endelse if (i=90) then beginTextArea.Right := TextArea.Left + BarWidth * 7;sText := OutBar[12];endelse if (i=97) then beginTextArea.Right := TextArea.Left + BarWidth * 7;sText := OutBar[13];endelse if (i=107) then beginTextArea.Right := TextArea.Left + BarWidth * 7;sText := '>';end;if sText <>'' thenCanvasArea.TextRect(TextArea, sText, [tfSingleLine, tfCenter, tfTop]);end;
end;end.

效果图：

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

EAN13条形码绘制（Delphi版）相关推荐

EAN-13条形码编码规则演示程序web版
之前翻译了一篇关于EAN-13编码规则的文章(<EAN-13条形码编码规则>),为了配合这篇文章,FuWaer使用html+javascript+vml编写了一个web版的EAN-13条形 ...
NeHe的OpenGL教程7（Bang翻译Delphi版）－如何使用光源
NeHe的OpenGL教程7(Bang翻译Delphi版)-如何使用光源在这一课里,我将教会你如何用光源照亮立方体的六个面,如下图: 将下图放在应用程序data目录下,起名NeHe.bmp prog ...
NeHe的OpenGL教程8（Bang翻译Delphi版）－如何制作立体透明效果
NeHe的OpenGL教程8(Bang翻译Delphi版)-如何制作立体透明效果在这一课里,我将教会你如何制作立体透明效果,如下图: 将下图放在应用程序data目录下,起名NeHe.bmp prog ...
OpenGL教程8（Bang翻译Delphi版）－如何制作立体透明效果 .
OpenGL教程8(Bang翻译Delphi版)-如何制作立体透明效果在这一课里,我将教会你如何制作立体透明效果,如下图: 将下图放在应用程序data目录下,起名NeHe.bmp program l ...
通过崩溃地址找错误行数之Delphi版
通过崩溃地址找错误行数之Delphi版 2009-5-11 17:42:35 来源: 转载作者:网络访问:360 次被顶:2 次字号:[大中小] 核心提示:什么是 MAP 文件?简单地讲, ...
从内存中加载DLL Delphi版(转)
源:从内存中加载DLL DELPHI版原文 : http://www.2ccc.com/article.asp?articleid=5784 MemLibrary.pas //从内存中加载DLL D ...
WinAPI【远程注入】利用远程线程注入DLLDelphi版
{ WinAPI[远程注入]利用远程线程注入DLLDelphi版} (okwary) 小叹的学习园地 ( SDK文档里是这样描述的:进程是一个正在运行的程序,它拥有自己的地址空间,拥有自己的 ...
Delphi 版的IIF函数
Delphi 版的IIF函数不少编程语言都有 IIF 函数,我们也可以构造自己的IIF函数: // ------------------------------------------------- ...
Delphi 版 everything、光速搜索代码
近日没啥事情,研究了一下 everything.光速搜索原理.花了一个礼拜时间,终于搞定. 废话不多说,直接上代码: unit uMFTSearchFile; {dbyoung@sina.com201 ...

EAN13条形码绘制（Delphi版）

EAN13条形码绘制（Delphi版）相关推荐

最新文章

热门文章