早段时间 公司同事让帮忙整理的条形码
条形码：UPC(A)、UPC(E)、Code128码 对于这几种码的分类，规则等什么这里就不做赘述了
对于：前两种UPC(A)、UPC(E)基本网上有源代码当下来就可以用了。(后来客户也没反映什么问题)
对于：Code128码，网上只找到了Code128B码、后来客户反映有些条码扫不出来。想当然的就以为可能是需要Code128Auto码，然后就开始找浪费了一天的时间也是没有找到。后来不得不仔细研究编码规则，最后发现一个让人喷饭的问题就当下来的代码 所给出的编码集里 少了 () 这两个字符。故包含()的条码肯定是扫描不出来，问题就这样解决了。
度娘谷歌 都不是万能的，大家还是仔细的研究一下。下面就把代码都贴出来。
一、调用编码
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, StdCtrls, ExtCtrls, U_BarcodeFunc;
type
TForm1 = class(TForm)
Edit1: TEdit;
Button1: TButton;
Image1: TImage;
Button3: TButton;
Image2: TImage;
Edit2: TEdit;
Button4: TButton;
Image3: TImage;
Image4: TImage;
Button2: TButton;
Button5: TButton;
Button6: TButton;
procedure Button1Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
inChar: sTRING;
inRect: TRect;
begin
inRect.Left := 0;
inRect.Right := 224;
inRect.Top := 0;
inRect.Bottom := 100;
inChar := Trim(Edit1.Text);
CreateUPC_A(inChar,image1.Canvas,inRect,2,clBlack,clWhite);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
//
end;
procedure TForm1.Button3Click(Sender: TObject);
var
inChar: sTRING;
inRect: TRect;
begin
inRect.Left := 0;
inRect.Right := 136;
inRect.Top := 0;
inRect.Bottom := 68;
inChar := Trim(Edit2.Text);
CreateUPC_E(inChar,self.Image2.Canvas,inRect,2,clBlack,clWhite);
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
//
//Drawcode128B(image3.Canvas, '(2L) US94065+48000001', 10, 10, 90, 2);
Drawcode128B(image3.Canvas, '2LUS94065+48000001', 10, 10, 90, 1);
//Drawcode128B(image3.Canvas, 's95270078', 10, 10, 90, 2);
//Drawcode128B(image4.Canvas, 'Code 1281', 10, 10, 100, 2);
end;
procedure TForm1.Button6Click(Sender: TObject);
begin
//
end;
end.
二、编码源码：
unit U_BarcodeFunc;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, StdCtrls, ExtCtrls;
//UPC 校验码
function UPCCheck(InChar: String): String;
//UPC-A 转换二进制码
function UPC_AConvert(ConvertStr: String): String;
//UPC-E 转换二进制码
function UPC_EConvert(ConvertStr: String; CheckChar: Char): String;
//UPC-A 输出
function CreateUPC_A(InChar: String; CanvasArea: TCanvas; bcArea: TRect; bcStep: Integer; bcColorB: TColor = clBlack; bcColorW: TColor = clWhite): String;
//UPC-E 输出
function CreateUPC_E(InChar: String; CanvasArea: TCanvas; bcArea: TRect; bcStep: Integer; bcColorB: TColor = clBlack; bcColorW: TColor = clWhite): String;
//取CODE128逻辑码
function Return_Code128Blogic(Code: Char): String;
//返回给定字符串的CODE128 编码
function ReturnCode128B(s:String):String;
//画条码（条码内容,x0,y0: 起始点，height: 条码高度, Penwidth: 条码线宽）
procedure Drawcode128B(Canvas: TCanvas; Barcode:string;x0,y0, height,Penwidth: Integer);
procedure Drawline(Canvas: TCanvas; x1,y1,x2,y2,Penwidth:integer);
const
//UPC-A 左资料码（奇）
UPC_ALeft: array [0..9] of String =
( '0001101', '0011001', '0010011', '0111101', '0100011'
, '0110001', '0101111', '0111011', '0110111', '0001011'
);
//UPC-A 右资料码（偶）
UPC_ARight: array [0..9] of String =
( '1110010', '1100110', '1101100', '1000010', '1011100'
, '1001110', '1010000', '1000100', '1001000', '1110100'
);
//UPC-E 奇资料码 A
UPC_EOdd: array [0..9] of String =
( '0001101', '0011001', '0010011', '0111101', '0100011'
, '0110001', '0101111', '0111011', '0110111', '0001011'
);//UPC-E 偶资料码 B
UPC_EEven: array [0..9] of String =
( '0100111', '0110011', '0011011', '0100001', '0011101'
, '0111001', '0000101', '0010001', '0001001', '0010111'
);
implementation
//******************************************************************************
//*** UPC 校验码 ***
//*** C1 = 奇数位之和 ***
//*** C2 = 偶数位之和 ***
//*** CC = (C1 + (C2 * 3)) 取个位数 ***
//*** C (检查码) = 10 - CC (若值为10，则取0) ***
//******************************************************************************
function UPCCheck(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) = 0 then
c2 := StrToInt(InChar[i]) + c2
else
c1 := StrToInt(InChar[i]) + c1;
end;
cc := (c1 + (c2 * 3)) mod 10;
if cc = 0 then
Result := '0'
else
Result := IntToStr(10 - cc);
end;
//******************************************************************************
//*** UPC-A 转换二进制码 ***
//*** 左资料码 右资料码 ***
//*** 0001101 1110010 ***
//*** 0011001 1100110 ***
//*** 0010011 1101100 ***
//*** 0111101 1000010 ***
//*** 0100011 1011100 ***
//*** 0110001 1001110 ***
//*** 0101111 1010000 ***
//*** 0111011 1000100 ***
//*** 0110111 1001000 ***
//*** 0001011 1110100 ***
//******************************************************************************
function UPC_AConvert(ConvertStr: String): String;
var
i: Integer;
TempStr: String;
begin
TempStr := '';
for i := 1 to Length(ConvertStr) do
begin
if i < 7 then
TempStr := TempStr + UPC_ALeft[StrToInt(ConvertStr[i])]
else
TempStr := TempStr + UPC_ARight[StrToInt(ConvertStr[i])];
if i = 6 then
TempStr := TempStr + '01010';
end;
result := TempStr;
end;
//******************************************************************************
//***UPC-E 转换二进制码***
//***检查码数据码奇资料（A）偶资料（B）***
//***0BBBAAA00011010100111***
//***1BBABAA00110010110011***
//***2BBAABA00100110011011***
//***3BBAAAB01111010100001***
//***4BABBAA01000110011101***
//***5BAABBA01100010111001***
//***6BAAABB01011110000101***
//***7BABABA01110110010001***
//***8BABAAB01101110001001***
//***9BAABAB00010110010111***
//******************************************************************************
function UPC_EConvert(ConvertStr: String; CheckChar: Char): String;
var
i: Integer;
TempStr: String;
begin
TempStr := '';
case CheckChar of
'0'://BBBAAA
begin
for i := 1 to Length(ConvertStr) do
begin
if i <= 3 then
begin
TempStr := TempStr + UPC_EEven[StrToInt(ConvertStr[i])];
end
else
begin
TempStr := TempStr + UPC_EOdd[StrToInt(ConvertStr[i])];
end;
end;
end;
'1': //BBABAA
begin
for i := 1 to Length(ConvertStr) do
begin
case i of
1, 2, 4: TempStr := TempStr + UPC_EEven[StrToInt(ConvertStr[i])];
3, 5, 6: TempStr := TempStr + UPC_EOdd[StrToInt(ConvertStr[i])];
end;
end;
end;
'2': //BBAABA
begin
for i := 1 to Length(ConvertStr) do
begin
case i of
1, 2, 5: TempStr := TempStr + UPC_EEven[StrToInt(ConvertStr[i])];
3, 4, 6: TempStr := TempStr + UPC_EOdd[StrToInt(ConvertStr[i])];
end;
end;
end;
'3': //BBAAAB
begin
for i := 1 to Length(ConvertStr) do
begin
case i of
1, 2, 6: TempStr := TempStr + UPC_EEven[StrToInt(ConvertStr[i])];
3, 4, 5: TempStr := TempStr + UPC_EOdd[StrToInt(ConvertStr[i])];
end;
end;
end;
'4': //BABBAA
begin
for i := 1 to Length(ConvertStr) do
begin
case i of
1, 3, 4: TempStr := TempStr + UPC_EEven[StrToInt(ConvertStr[i])];
2, 5, 6: TempStr := TempStr + UPC_EOdd[StrToInt(ConvertStr[i])];
end;
end;
end;
'5': //BAABBA
begin
for i := 1 to Length(ConvertStr) do
begin
case i of
1, 4, 5: TempStr := TempStr + UPC_EEven[StrToInt(ConvertStr[i])];
2, 3, 6: TempStr := TempStr + UPC_EOdd[StrToInt(ConvertStr[i])];
end;
end;
end;
'6': //BAAABB
begin
for i := 1 to Length(ConvertStr) do
begin
case i of
1, 5, 6: TempStr := TempStr + UPC_EEven[StrToInt(ConvertStr[i])];
2, 3, 4: TempStr := TempStr + UPC_EOdd[StrToInt(ConvertStr[i])];
end;
end;
end;
'7': //BABABA
begin
for i := 1 to Length(ConvertStr) do
begin
case i of
1, 3, 5: TempStr := TempStr + UPC_EEven[StrToInt(ConvertStr[i])];
2, 4, 6: TempStr := TempStr + UPC_EOdd[StrToInt(ConvertStr[i])];
end;
end;
end;
'8': //BABAAB
begin
for i := 1 to Length(ConvertStr) do
begin
case i of
1, 3, 6: TempStr := TempStr + UPC_EEven[StrToInt(ConvertStr[i])];
2, 4, 5: TempStr := TempStr + UPC_EOdd[StrToInt(ConvertStr[i])];
end;
end;
end;
'9': //BAABAB
begin
for i := 1 to Length(ConvertStr) do
begin
case i of
1, 4, 6: TempStr := TempStr + UPC_EEven[StrToInt(ConvertStr[i])];
2, 3, 5: TempStr := TempStr + UPC_EOdd[StrToInt(ConvertStr[i])];
end;
end;
end;
end;
Result := TempStr;
end;//******************************************************************************
//******************************************************************************
//*** UPC-A 条码生成 ***
//*** 条码格式 Length(113) ***
//**左侧空白区、起始符、左数据符、中间线、右数据符、检查码、终止符、右侧空白区**
//** >=9 3 42 5 35 7 3 >=9 **
//**000 000 000, 101, 01010， 101 , 000 000 000**
//******************************************************************************
function CreateUPC_A(InChar: String; CanvasArea: TCanvas; bcArea: TRect; bcStep: Integer; bcColorB: TColor = clBlack; bcColorW: TColor = clWhite): String;
var
i, j: Integer;
CheckChar, OutsideBar, OutBar: String;
OutX, OutY, OutHeight: Word;
begin
if Length(InChar) <> 11 then
begin
ShowMessage('输入的不是11位数字！');
Abort;
end
else
begin
CheckChar := UPCCheck(Copy(InChar, 2, Length(InChar) - 1));
OutBar := InChar + CheckChar;
OutsideBar := '';
OutsideBar := '101' + UPC_AConvert(OutBar) + '101';
//设置输出条码起始点
CanvasArea.Pen.Color := bcColorW;
CanvasArea.Rectangle(bcArea);
OutX := ((bcArea.Right - bcArea.Left) div 2) - bcStep * 56;
OutY := ((bcArea.Bottom - bcArea.Top) div 2) - bcStep * 25; //28 17
OutHeight := bcStep * 50;
//设置字体
CanvasArea.Font.Name := 'OCR-B 10 BT';
CanvasArea.Font.Style := [fsBold];
CanvasArea.Font.Size := bcStep * 6;
//输出字符
for i := 1 to Length(OutBar) do
begin
case i of
1:
CanvasArea.TextOut(OutX + (bcStep * 4), OutY + OutHeight - Round(bcStep * 8.5), OutBar[i]);
2..6:
CanvasArea.TextOut(OutX + (bcStep * 19) + (bcStep * (7 * (i - 2))) + bcStep, OutY + OutHeight - Round(bcStep * 8.5), OutBar[i]);
7..11:
CanvasArea.TextOut(OutX + (bcStep * 24) + (bcStep * (7 * (i - 2))) + bcStep, OutY + OutHeight - Round(bcStep * 8.5), OutBar[i]);
12:
CanvasArea.TextOut(OutX + (bcStep * 104) + bcStep, OutY + OutHeight - Round(bcStep * 8.5), OutBar[i]);
end;
end;
//输出条形
for i := 1 to Length(OutsideBar) do
begin
if OutsideBar[i] = '0' then
CanvasArea.Pen.Color := bcColorW
else
CanvasArea.Pen.Color := bcColorB;
for j := 1 to bcStep do
begin
CanvasArea.MoveTo(OutX + (bcStep * (9 + (i - 1))) + (j - 1), OutY + (bcStep * 5));
if i in [1..10, 46..50, 86..95] then
CanvasArea.LineTo(OutX + (bcStep * (9 + (i - 1))) + (j - 1), OutY + OutHeight - (bcStep * 5))
else
CanvasArea.LineTo(OutX + (bcStep * (9 + (i - 1))) + (j - 1), OutY + OutHeight - (bcStep * 9));
end;
end;
end;
end;
//******************************************************************************
//***UPC-E 条码生成***
//***条码格式***
//***左侧空白区、起始符、数据符、终止符、右侧空白区***
//***>=93426>=7Length(67)***
//***000 000 000, 101 ,. 010101 , 000 000 0***
//******************************************************************************
function CreateUPC_E(InChar: String; CanvasArea: TCanvas; bcArea: TRect; bcStep: Integer; bcColorB: TColor = clBlack; bcColorW: TColor = clWhite): String;
var
i, j: Integer;
CheckChar, OutsideBar, OutBar: String;
OutX, OutY, OutHeight: Word;
begin
if Length(InChar) <> 6 then
begin
ShowMessage('输入的不是7位数字！');
Abort;
end
else
begin
CheckChar := UPCCheck(InChar);
OutBar := InChar;//输入的数据字符和检查码前面加上固定左护线 '0'
OutsideBar := '';
OutsideBar := UPC_EConvert(InChar, CheckChar[1]);
OutsideBar := '101' + OutsideBar + '010101';CanvasArea.Pen.Color := bcColorW;
CanvasArea.Rectangle(bcArea);
OutX := ((bcArea.Right - bcArea.Left) div 2) - (bcStep * 34);
OutY := ((bcArea.Bottom - bcArea.Top) div 2) - (bcStep * 17);
OutHeight := bcStep * 34;//设置条码字体
CanvasArea.Font.Name := 'OCR-B 10 BT';
CanvasArea.Font.Style := [fsBold];
CanvasArea.Font.Size := bcStep * 6;//输出字符
CanvasArea.TextOut(OutX + (bcStep * 4), OutY + OutHeight - Round(bcStep * 8.5), '0');//国别码
for i := 1 to Length(OutBar) do
begin//附加调整位置值
CanvasArea.TextOut(OutX + (bcStep * 12) + (bcStep * 7 * (i - 1)) + bcStep, OutY + OutHeight - Round(bcStep * 8.5), OutBar[i]);
end;
CanvasArea.TextOut(OutX + (bcStep * 61), OutY + OutHeight - Round(bcStep * 8.5), CheckChar);
//检查码
for i := 1 to Length(OutsideBar) do
begin
if OutsideBar[i] = '0' then
CanvasArea.Pen.Color := bcColorW
else
CanvasArea.Pen.Color := bcColorB;
for j := 1 to bcStep do
begin
CanvasArea.MoveTo(OutX + (bcStep * (9 + (i - 1))) + (j - 1), OutY + (bcStep * 5));//起始位置
if i in [1..3, 46..51] then
CanvasArea.LineTo(OutX + (bcStep * (9 + (i - 1))) + (j - 1), OutY + OutHeight - (bcStep * 5))
else
CanvasArea.LineTo(OutX + (bcStep * (9 + (i - 1))) + (j - 1), OutY + OutHeight - (bcStep * 9))
end;
end;
end;
end;
function Return_Code128Blogic(Code: Char): String;
begin
case Code of
'(': Result:= 'bsssbbssbss';
')': Result:= 'bbssbssbsss';
'0': Result:= 'bssbbbsbbss'; //code--0
'1': Result:= 'bssbbbssbbs'; //code--1
'2': Result:= 'bbssbbbssbs'; //code--2
'3': Result:= 'bbssbsbbbss'; //code--3
'4': Result:= 'bbssbssbbbs'; //code--4
'5': Result:= 'bbsbbbssbss'; //code--5
'6': Result:= 'bbssbbbsbss'; //code--6
'7': Result:= 'bbbsbbsbbbs'; //code--7
'8': Result:= 'bbbsbssbbss'; //code--8
'9': Result:= 'bbbssbsbbss'; //code--9
'+': Result:= 'bbsssbssbss'; //code--+
'-': Result:= 'bssbbsbbbss'; //code---
'*': Result:= 'bbssbsssbss'; //code--*
'/': Result:= 'bsbbbssbbss'; //code--/
'%': Result:= 'bsssbssbbss'; //code--%
'$': Result:= 'bssbsssbbss'; //code--$
'.': Result:= 'bssbbssbbbs'; //code--.
' ': Result:= 'bbsbbssbbss'; //code--空白
'A': Result:= 'bsbsssbbsss'; //code--A
'B': Result:= 'bsssbsbbsss'; //code--B
'C': Result:= 'bsssbsssbbs'; //code--C
'D': Result:= 'bsbbsssbsss'; //code--D
'E': Result:= 'bsssbbsbsss'; //code--E
'F': Result:= 'bsssbbsssbs'; //code--F
'G': Result:= 'bbsbsssbsss'; //code--G
'H': Result:= 'bbsssbsbsss'; //code--H
'I': Result:= 'bbsssbsssbs'; //code--I
'J': Result:= 'bsbbsbbbsss'; //code--J
'K': Result:= 'bsbbsssbbbs'; //code--K
'L': Result:= 'bsssbbsbbbs'; //code--L
'M': Result:= 'bsbbbsbbsss'; //code--M
'N': Result:= 'bsbbbsssbbs'; //code--N
'O': Result:= 'bsssbbbsbbs'; //code--O
'P': Result:= 'bbbsbbbsbbs'; //code--P
'Q': Result:= 'bbsbsssbbbs'; //code--Q
'R': Result:= 'bbsssbsbbbs'; //code--R
'S': Result:= 'bbsbbbsbsss'; //code--S
'T': Result:= 'bbsbbbsssbs'; //code--T
'U': Result:= 'bbsbbbsbbbs'; //code--U
'V': Result:= 'bbbsbsbbsss'; //code--V
'W': Result:= 'bbbsbsssbbs'; //code--W
'X': Result:= 'bbbsssbsbbs'; //code--X
'Y': Result:= 'bbbsbbsbsss'; //code--Y
'Z': Result:= 'bbbsbbsssbs'; //code--Z
'[': Result:= 'bbbsssbbsbs';
'\': Result:= 'bbbsbbbbsbs';
']': Result:= 'bbssbssssbs';
'^': Result:= 'bbbbsssbsbs';
'_': Result:= 'bsbssbbssss';
'`': Result:= 'bsbssssbbss';
'a': Result:= 'bssbsbbssss';
'b': Result:= 'bssbssssbbs';
'c': Result:= 'bssssbsbbss';
'd': Result:= 'bssssbssbbs';
'e': Result:= 'bsbbssbssss';
'f': Result:= 'bsbbssssbss';
'g': Result:= 'bssbbsbssss';
'h': Result:= 'bssbbssssbs';
'i': Result:= 'bssssbbsbss';
'j': Result:= 'bssssbbssbs';
'k': Result:= 'bbssssbssbs';
'l': Result:= 'bbssbsbssss';
'm': Result:= 'bbbbsbbbsbs';
'n': Result:= 'bbssssbsbss';
'o': Result:= 'bsssbbbbsbs';
'p': Result:= 'bsbssbbbbss';
'q': Result:= 'bssbsbbbbss';
'r': Result:= 'bssbssbbbbs';
's': Result:= 'bsbbbbssbss';
't': Result:= 'bssbbbbsbss';
'u': Result:= 'bssbbbbssbs';
'v': Result:= 'bbbbsbssbss';
'w': Result:= 'bbbbssbsbss';
'x': Result:= 'bbbbssbssbs';
'y': Result:= 'bbsbbsbbbbs';
'z': Result:= 'bbsbbbbsbbs';
'{': Result:= 'bbbbsbbsbbs';
'|': Result:= 'bsbsbbbbsss';
'}': Result:= 'bsbsssbbbbs';
'~': Result:= 'bsssbsbbbbs';
else
Result:= '0';
end;
end;
function ReturnCode128B(s:String):String;
var
code,c1:char;
printcode:string;
i,k,a,m:integer;
begin
k:=104;//code128B
for I := 1 to length(s) do
begin
code := s[i];
a := ord(code)-32;
k := k+a*i;
end;
m := k mod 103;
printcode:='bbsbssbssss';
for i:=1 to length(s) do
begin
printcode:=printcode+return_code128Blogic(s[i]);
end;
m:=m+32;
c1:=chr(m);
printcode:=printcode+return_code128Blogic(c1);
printcode:=printcode+'bbsssbbbsbsbb';
result:=printcode;
end;
procedure Drawcode128B(Canvas: TCanvas; Barcode:string;x0,y0, height,Penwidth: Integer);
var
i,j,x,y1,y2:Integer;
code:Char;
printcode:string;
begin
printcode:=returncode128B(barcode);
Canvas.pen.Width :=1;
Canvas.Pen.Color:=clBlack;
//image3.Canvas.Brush.Color:=clBlack;
x:=x0;//50
for i:=1 to length(printcode) do
begin
code:=printcode[i];
if code='b' then
begin
y1:=y0;
y2:=y0+(height);
//printer.Canvas.Rectangle(x1,y1,x2,y2);
for j:=0 to (Penwidth)-1 do
begin
Drawline(canvas, x+j,y1,x+j,y2,1);
end;
end;
x:=x+(Penwidth);
end;
end;
//画线：
procedure Drawline(Canvas: TCanvas; x1,y1,x2,y2,Penwidth: Integer);
begin
Canvas.Pen.Width :=Penwidth;
Canvas.MoveTo(x1,y1);
Canvas.LineTo(x2,y2);
end;
end.
