主题：VFP条型码打印源程序
gxh4663
[专家分：0] 发布于 2009-01-27 13:09:00
VFP条型码打印源程序 能否发一份,多谢了!
MAIL:gxh4663@126.com
回复列表 （共13个回复）
沙发
foxdb [专家分：1830] 发布于 2009-01-27 21:15:00
［源码］纯VFP实现EAN-13条码
* 函 数 名：EAN13()
* 功 能：根据条EAN-13码符号字符串生成条码位图
* 参 数：BM 字符型(12位EAN-13码符号字符串 如：'690102818039')
* 返 回 值：生成的条码位图的文件名
* 运行环境：WIN95以上版本。Visual FoxPro 6.0,7.0,8.0,9.0
* 算法制作：行者孙(QQ:310727570)-VFP应用程式算法群(12787940)
* 说 明：转载请保留出处！
Function EAN13(BM As String )
Private BM
Dimension EAN_code[10,3]
EAN_code[1,1]='00000011110011'
EAN_code[1,2]='00110000111111'
EAN_code[1,3]='11111100001100'
EAN_code[2,1]='00001111000011'
EAN_code[2,2]='00111100001111'
EAN_code[2,3]='11110000111100'
EAN_code[3,1]='00001100001111'
EAN_code[3,2]='00001111001111'
EAN_code[3,3]='11110011110000'
EAN_code[4,1]='00111111001100'
EAN_code[4,2]='00001111110011'
EAN_code[4,3]='11000000001100'
EAN_code[5,1]='00110000001111'
EAN_code[5,2]='00001111110011'
EAN_code[5,3]='11001111110000'
EAN_code[6,1]='00111100000011'
EAN_code[6,2]='00111111000011'
EAN_code[6,3]='11000011111100'
EAN_code[7,1]='00110011111111'
EAN_code[7,2]='00000011001111'
EAN_code[7,3]='11001100000000'
EAN_code[8,1]='00111111001111'
EAN_code[8,2]='00001100000011'
EAN_code[8,3]='11000000110000'
EAN_code[9,1]='00111100111111'
EAN_code[9,2]='00000011000011'
EAN_code[9,3]='11000011000000'
EAN_code[10,1]='00000011001111'
EAN_code[10,2]='00001100111111'
EAN_code[10,3]='11111100110000'
Dimension EAN_left[10]
板凳
foxdb [专家分：1830] 发布于 2009-01-27 21:15:00
EAN_left[1]='111111'
EAN_left[2]='112122'
EAN_left[3]='112212'
EAN_left[4]='112221'
EAN_left[5]='121122'
EAN_left[6]='122112'
EAN_left[7]='122211'
EAN_left[8]='121212'
EAN_left[9]='121221'
EAN_left[10]='122121'
Dimension EAN_mode[8]
Store '' To EAN_mode
If Len(Alltrim(BM))<>12 .And. Val(BM)>0
Messagebox('EAN-13编码长度不规范',268,'信息提示')
Return ''
Else
EAN_mode[1]='000000000000000000'
EAN_mode[2]='110011'
For i=0 To 9
If Val(Substr(BM,1,1))=i
For ii=1 To 6
BMZ=Val(Substr(BM,ii+1,1))
MODE=Val(Substr(EAN_left[i+1],ii,1))
EAN_mode[3]=EAN_mode[3]+EAN_code[BMZ+1,MODE]
Endf
Endi
Endf
EAN_mode[4]='0011001100'
For i=1 To 5
BMZ=Val(Substr(BM,i+7,1))
EAN_mode[5]=EAN_mode[5]+EAN_code[BMZ+1,3]
Endf
JY_A=0
JY_B=0
For i=1 To 12
If i%2=0
JY_A=JY_A+Val(Substr(BM,i,1))
Else
JY_B=JY_B+Val(Substr(BM,i,1))
Endif
Endf
JYM=10-(JY_A*3+JY_B)%10
If JYM=10
JYM=1
Endi
EAN_mode[6]=EAN_code[JYM+1,3]
EAN_mode[7]='110011'
EAN_mode[8]='000000000000000000'
EAN_code=EAN_mode[1]+EAN_mode[2]+EAN_mode[3]++EAN_mode[4]+EAN_mode[5]+EAN_mode[6]+EAN_mode[7]+EAN_mode[8]
Dimension BMP[4]
BMP[4]=90
BMP[3]=224
BMP[2]=Int((BMP[3]*3+3)/4)*4*BMP[4]+54
BMP[1]=BMP[2]-54
Dimension BMP_T[4]
For i=1 To 4
k1='0x'+Subs(Righ(Tran(BMP,"@0"),8 ),7,2)
k2='0x'+Subs(Righ(Tran(BMP,"@0"),8 ),5,2)
k3='0x'+Subs(Righ(Tran(BMP,"@0"),8 ),3,2)
k4='0x'+Subs(Righ(Tran(BMP,"@0"),8 ),1,2)
BMP_T=Chr(&k1)+Chr(&k2)+Chr(&k3)+Chr(&k4)
Endf
st1='BM'+BMP_T[2]+Chr(0)+Chr(0)+Chr(0)+Chr(0)+Chr(54)+Chr(0)+Chr(0)+Chr(0);
+Chr(40)+Chr(0)+Chr(0)+Chr(0)+BMP_T[3]+BMP_T[4]+Chr(1)+Chr(0)+Chr(24)+Chr(0)+Chr(0)+Chr(0)+Chr(0)+Chr(0)+BMP_T[1]+Chrt(Spac(16),' ',Chr(0))
st2=Chrt(Spac(224*10*3),' ',Chr(255))
st3=''
For i=11 To 70
For k1=1 To 224
If Substr(EAN_code,k1,1)=='1'
st3=st3+Chr(0)+Chr(0)+Chr(0)
Else
st3=st3+Chr(255)+Chr(255)+Chr(255)
Endi
Endf
Endf
Pb=Chr(0)+Chr(0)+Chr(0)
Pw=Chr(255)+Chr(255)+Chr(255)
st4=Chrt(Spac(18*3),' ',Chr(255))+Pb+Pb+Pw+Pw+Pb+Pb+Chrt(Spac(84*3),' ',Chr(255))+Pw+Pw+Pb+Pb+Pw+Pw+Pb+Pb+Pw+Pw+Chrt(Spac(84*3),' ',Chr(255))+Pb+Pb+Pw+Pw+Pb+Pb+Chrt(Spac(16*3),' ',Chr(255))
st4=st4+st4
3 楼
foxdb [专家分：1830] 发布于 2009-01-27 21:15:00
Dimension T_D[11]
T_D[1]='11111000111111111100000111111110111100111111101111101111111011111011111110111110111111101111101111'+;
'11101111101111111011111011111110111110111111101111101111111011110011111111000001111111111000111111'
T_D[2]='11111110111111111111001111111111100011111111100000111111111011101111111111111011111111111110111111'+;
'11111110111111111111101111111111111011111111111110111111111111101111111111111011111111111110111111'
T_D[3]='11111000111111111000000111111110111110111111101111101111111111111011111111111110111111111111011111'+;
'11111110011111111111001111111111100111111111110011111111111001111111111110000000111111000000001111'
T_D[4]='11111000111111111100000111111110011100111111101111101111111111110111111111110011111111111100011111'+;
'11111111101111111111111011111111111110111111101111101111111011110011111111000001111111111000111111'
T_D[5]='11111111011111111111100111111111111001111111111100011111111110110111111111011101111111110111011111'+;
'11101111011111110111110111111100000000011111000000000111111111110111111111111101111111111111011111'
T_D[6]='11110000001111111100000011111111011111111111110111111111111000001111111110000001111111101111101111'+;
'11111111101111111111111011111111111110111111101111101111111011110011111111000001111111111000111111'
T_D[7]='11111000111111111100000111111110011110111111101111111111111011001111111110000001111111100111001111'+;
'11101111101111111011111011111110111110111111101111101111111001111011111111000001111111111000111111'
T_D[8]='11000000001111110000000011111111111100111111111111011111111111101111111111111011111111111101111111'+;
'11111101111111111110011111111111101111111111111011111111111110111111111111101111111111110011111111'
T_D[9]='11111000111111111100000111111110011100111111101111101111111011111011111110011100111111110000011111'+;
'11110000011111111011111011111110111110111111101111101111111011111011111110000001111111111000111111'
T_D[10]='11111000111111111100000111111110111100111111101111101111111011111011111110111110111111101111101111'+;
'11101111001111111100000011111111100110111111111111101111111011110111111110000001111111111001111111'
T_D[11]='11111111111111111111111111111111111111111111111111001111111111000011111111000001111111100111111111'+;
'11100111111111111100000111111111110000111111111111001111111111111111111111111111111111111111111111'
Dimension td[14]
Store '' To td
For i=1 To 14
For k1=1 To 13
zh=Val(Substr(BM+Alltrim(Str(JYM)),k1,1))+1
td=td+Substr(T_D[zh],14*i-13,14)
Endf
td=td+Substr(T_D[11],14*i-13,14)
Endf
For i=1 To 7
td='11'+Subs(td,1,14)+'11'+'001100'+Subs(td,15,84)+'1100110011'+Subs(td,99,84)+'001100'+Subs(td,183,14)+'11'
Endf
For i=8 To 14
td='11'+Subs(td,1,14)+'11'+'111111'+Subs(td,15,84)+'1111111111'+Subs(td,99,84)+'111111'+Subs(td,183,14)+'11'
Endf
For i=1 To 14
td=Strtran(td,'1',Chr(255)+Chr(255)+Chr(255))
td=Strtran(td,'0',Chr(0)+Chr(0)+Chr(0))
Endf
st5=Chrt(Spac(224*4*3),' ',Chr(255))
h=Fcreate(BM+Alltrim(Str(JYM))+'.bmp')
=Fwrite(h,st1)
=Fwrite(h,st5)
For i=14 To 1 Step -1
=Fwrite(h,td)
Endf
=Fwrite(h,st4)
=Fwrite(h,st3)
=Fwrite(h,st2)
Fclose(h)
Return BM+Alltrim(Str(JYM))+'.bmp'
Endif
调用方法：如如：thisform.image1.picture=EAN13('6901028039')
4 楼
foxdb [专家分：1830] 发布于 2009-01-27 21:18:00
楼主抱歉!因回贴字数限制,所以分三段发给你参考!希望对你有用!祝新春愉快!
5 楼
rt1440 [专家分：0] 发布于 2009-01-31 19:12:00
还不如用条码字体省事.有免费的93码.缺点是条码占的位置太大.
6 楼
jinlonggao [专家分：17130] 发布于 2009-02-01 22:37:00
谢谢FOXDB,先复制学习了.!
--------------------------------------
FOZDB先生,试过了,但产生的图像过大,长宽都在万以上像素,打不开,提示不支持
7 楼
oufeiwen [专家分：910] 发布于 2009-02-03 21:51:00
我近期也编写过一个条码的,也是纯VFP的,原理是造一个BMP文件,是黑白格式,长度10来K.但我岗位上没有条码枪,还未验算[em57].我现在补休假,过两天带回贴上交流。我用的是39码。
8 楼
oufeiwen [专家分：910] 发布于 2009-02-09 18:38:00
[quote]
我近期也编写过一个条码的,也是纯VFP的,原理是造一个BMP文件,是黑白格式,长度10来K.但我岗位上没有条码枪,还未验算[em57].我现在补休假,过两天带回贴上交流。我用的是39码。[/quote]
*function code39
para chrs01,bars_h,bmp_filename &&输入条码字符,条码高度,生成文件的文件名
private c001,chrs01
dimension sys_code39(2,44)
sys_code39(1,1)='0'
sys_code39(2,1)='101001101101' && 字符0
sys_code39(1,2)='1'
sys_code39(2,2)='110100101011' && 字符1
sys_code39(1,3)='2'
sys_code39(2,3)='101100101011' && 字符2
sys_code39(1,4)='3'
sys_code39(2,4)='110110010101' && 字符3
sys_code39(1,5)='4'
sys_code39(2,5)='101001101011' && 字符4
sys_code39(1,6)='5'
sys_code39(2,6)='110100110101' && 字符5
sys_code39(1,7)='6'
sys_code39(2,7)='101100110101' && 字符6
sys_code39(1,8)='7'
sys_code39(2,8)='101001011011' && 字符7
sys_code39(1,9)='8'
sys_code39(2,9)='110100101101' && 字符8
sys_code39(1,10)='9'
sys_code39(2,10)='101100101101' && 字符9
sys_code39(1,11)='A'
sys_code39(2,11)='110101001011' && 字符A
sys_code39(1,12)='B'
sys_code39(2,12)='101101001011' && 字符B
sys_code39(1,13)='C'
sys_code39(2,13)='110110100101' && 字符C
sys_code39(1,14)='D'
sys_code39(2,14)='101011001011' && 字符D
sys_code39(1,15)='E'
sys_code39(2,15)='110101100101' && 字符E
sys_code39(1,16)='F'
sys_code39(2,16)='101101100101' && 字符F
sys_code39(1,17)='G'
sys_code39(2,17)='101010011011' && 字符G
sys_code39(1,18)='H'
sys_code39(2,18)='110101001101' && 字符H
sys_code39(1,19)='I'
sys_code39(2,19)='101101001101' && 字符I
sys_code39(1,20)='J'
sys_code39(2,20)='101011001101' && 字符J
sys_code39(1,21)='K'
sys_code39(2,21)='110101010011' && 字符K
sys_code39(1,22)='L'
sys_code39(2,22)='101101010011' && 字符L
sys_code39(1,23)='M'
sys_code39(2,23)='110110101001' && 字符M
sys_code39(1,24)='N'
sys_code39(2,24)='101011010011' && 字符N
sys_code39(1,25)='O'
sys_code39(2,25)='110101101001' && 字符O
sys_code39(1,26)='P'
sys_code39(2,26)='101101101001' && 字符P
sys_code39(1,27)='Q'
sys_code39(2,27)='101010110011' && 字符Q
sys_code39(1,28)='R'
sys_code39(2,28)='110101011001' && 字符R
sys_code39(1,29)='S'
sys_code39(2,29)='101101011001' && 字符S
sys_code39(1,30)='T'
sys_code39(2,30)='101011011001' && 字符T
sys_code39(1,31)='U'
sys_code39(2,31)='110010101011' && 字符U
sys_code39(1,32)='V'
sys_code39(2,32)='100110101011' && 字符V
sys_code39(1,33)='W'
sys_code39(2,33)='110011010101' && 字符W
sys_code39(1,34)='X'
sys_code39(2,34)='100101101011' && 字符X
sys_code39(1,35)='Y'
sys_code39(2,35)='110010110101' && 字符Y
sys_code39(1,36)='Z'
sys_code39(2,36)='100110110101' && 字符Z
sys_code39(1,37)='-'
sys_code39(2,37)='100101011011' && 字符-
sys_code39(1,38)='.'
sys_code39(2,38)='110010101101' && 字符.
sys_code39(1,39)=' '
sys_code39(2,39)='100110101101' && 字符 空格
sys_code39(1,40)='$'
sys_code39(2,40)='100100100101' && 字符$
sys_code39(1,41)='/'
sys_code39(2,41)='100100101001' && 字符/
sys_code39(1,42)='+'
sys_code39(2,42)='100101001001' && 字符+
sys_code39(1,43)='%'
sys_code39(2,43)='101001001001' && 字符%
sys_code39(1,44)='*'
sys_code39(2,44)='100101101101' && 字符*
chrs01=allt(chrs01)
c001=''
for n001=1 to len(chrs01)
c001=c001+'00'+sys_code39(2,ascan(sys_code39,substr(chrs01,n001,1)))
endfor
c001=sys_code39(2,44)+c001+'00'+sys_code39(2,44)
if mod(len(c001),8)=0
dime chr_n(int(len(c001)/8))
else
dime chr_n(int(len(c001)/8)+1)
c001=c001+'0000000'
endif
for n001=1 to int(len(c001)/8)
chr_n(n001)=255-bar001(substr(c001,(n001-1)*8+1,8))
endfor
=bw_bmp(bmp_filename,alen(chr_n)*8,bars_h,'chr_n')
9 楼
oufeiwen [专家分：910] 发布于 2009-02-09 18:39:00
function bw_bmp
para bmpfilename,biwidth,biheight,dat_arry_name && 接收参数：图位文件名，图位宽度，图位高度
dime bmp_chrs(31)
private bmpfilename,biwidth,biheight,DataSizePerLine,bmpfilesize,dat_arry_name,n001,n002,n003,n004,add0,bmpfilename,biwidth,biheight,dat_arry_name
bibitcount=1
DataSizePerLine_=biWidth/8 &&每行为4的倍数,要调整
add0=4-mod(DataSizePerLine_,4)
add0=iif(add0=4,0,add0)
DataSizePerLine=DataSizePerLine_+iif(mod(DataSizePerLine_,4)=0,0,4-mod(DataSizePerLine_,4))
DataSize=DataSizePerLine*biHeight
bmp_chrs(1)='BM'
bmp_chrs(15)=chr(1)+chr(0)
bmpfilesize=31*2+DataSize
bmp_chrs(2)=chr(fun10to16(bmpfilesize,1))+chr(fun10to16(bmpfilesize,2))
bmp_chrs(3)=chr(fun10to16(bmpfilesize,3))+chr(fun10to16(bmpfilesize,4))
bmp_chrs(4)=chr(0)+chr(0)
bmp_chrs(5)=chr(0)+chr(0)
bmp_chrs(6)=chr(62)+chr(0) &&单色是31个字，31X2字节
bmp_chrs(7)=chr(0)+chr(0)
bmp_chrs(8)=chr(40)+chr(0)
bmp_chrs(9)=chr(0)+chr(0)
bmp_chrs(10)=chr(fun10to16(biWidth,1))+chr(fun10to16(biWidth,2))
bmp_chrs(11)=chr(fun10to16(biWidth,3))+chr(fun10to16(biWidth,4))
bmp_chrs(12)=chr(biHeight)+chr(0)
bmp_chrs(13)=chr(0)+chr(0)
bmp_chrs(14)=chr(1)+chr(0)
bmp_chrs(16)=chr(0)+chr(0)
bmp_chrs(17)=chr(0)+chr(0)
bmp_chrs(18)=chr(fun10to16(DataSize,1))+chr(fun10to16(DataSize,2))
bmp_chrs(19)=chr(fun10to16(DataSize,3))+chr(fun10to16(DataSize,4))
bmp_chrs(20)=chr(0)+chr(0)
stor chr(0)+chr(0) to bmp_chrs(20),bmp_chrs(21),bmp_chrs(22),bmp_chrs(23),bmp_chrs(24),bmp_chrs(25),bmp_chrs(26),;
bmp_chrs(27),bmp_chrs(28),bmp_chrs(29)
bmp_chrs(30)=chr(256-1)+chr(256-1)
bmp_chrs(31)=chr(256-1)+chr(0)
strtofile(bmp_chrs(1),bmpfilename)
for f001=2 to 31
strtofile(bmp_chrs(f001),bmpfilename,.t.)
endfor
n004=alen(&dat_arry_name)
if n004>=DataSizePerLine_*biHeight
for n003=1 to biheight
for n001=1 to DataSizePerLine_
strtofile(chr(&dat_arry_name((n003-1)*DataSizePerLine_+n001)),bmpfilename,.t.)
endfor
for n001=1 to add0
strtofile(chr(0),bmpfilename,.t.)
endfor
endfor
else
if n004>=DataSizePerLine_
for n002=1 to biheight
for n001=1 to DataSizePerLine_
strtofile(chr(&dat_arry_name(n001)),bmpfilename,.t.)
endfor
for n001=1 to add0
strtofile(chr(0),bmpfilename,.t.)
endfor
endfor
else
for n002=1 to biheight
for n001=1 to n004
strtofile(chr(&dat_arry_name(n001)),bmpfilename,.t.)
endfor
for n001=1 to DataSizePerLine_-n004+add0
strtofile(chr(0),bmpfilename,.t.)
endfor
endfor
endif
endif
function fun10to16
para n001,n002
private n001,n002
do case
case n002=1
retu mod(n001,16*16)
case n002=2
retu mod(int(n001/(16*16)),16*16)
case n002=3
retu mod(int(n001/(16*16*16*16)),16*16)
case n002=4
retu mod(int(n001/(16*16*16*16*16*16)),16*16)
endcase
function bar001
para bar001
private bar001,bat,n001
dime bat(8)
bat(1)=128
bat(2)=64
bat(3)=32
bat(4)=16
bat(5)=8
bat(6)=4
bat(7)=2
bat(8)=1
tota001=0
for n001=1 to 8
tota001=tota001+val(substr(bar001,n001,1))*bat(n001)
endfor
retu tota001
&& end &&
假设程度（过程）文件名为code39,则执行如下形式的命令即得出条码文件
=code39('ABC1234567',20,'我的条码.bmp')
希望得到各位交流！
10 楼
狐说八道 [专家分：860] 发布于 2009-02-11 10:56:00
测试：
EAN-13条码：一片黑？！
code39：OK!
我来回复
您所在位置：社区首页 — Visual Foxpro讨论区 — VFP条型码打印源程序