Код: Выделить всё
PROGRAM
MAP
MODULE('Windows API')
AddFontResource(*CSTRING FontName),RAW,LONG,PASCAL,NAME('AddFontResourceA')
END
EAN13(STRING Barcode), STRING
END
LOC:FontFileName CSTRING(20)
LOC:Barcode1 CSTRING(20)
LOC:Barcode2 CSTRING(20)
LOC:Barcode3 CSTRING(20)
Window WINDOW('Use EAN13 Font'),AT(,,161,140),FONT('MS Sans Serif',8,,FONT:regular),CENTER,GRAY,DOUBLE
STRING(@s20),AT(18,9),USE(LOC:Barcode1)
STRING(@s20),AT(18,48),USE(LOC:Barcode2)
STRING(@s20),AT(18,97),USE(LOC:Barcode3)
END
CODE
LOC:FontFileName = 'EANG000.TTF'
IF NOT AddFontResource(LOC:FontFileName)
MESSAGE('Error on load: ' & LOC:FontFileName,'Warning',ICON:Hand)
END
OPEN(Window)
?LOC:Barcode1{PROP:Font} = 'EanGnivc'
?LOC:Barcode1{PROP:FontSize} = 20
?LOC:Barcode2{PROP:Font} = 'EanGnivc'
?LOC:Barcode2{PROP:FontSize} = 30
?LOC:Barcode3{PROP:Font} = 'EanGnivc'
?LOC:Barcode3{PROP:FontSize} = 40
LOC:Barcode1 = EAN13(2340600973341)
LOC:Barcode2 = EAN13(6945198851772)
LOC:Barcode3 = EAN13(2901214010046)
ACCEPT
END
CLOSE(Window)
EAN13 FUNCTION(STRING Barcode)!, STRING
a LONG(48)
b LONG(65)
c LONG(97)
d LONG(35)
i LONG
Cod LONG,DIM(13,2)
f LONG,DIM(6,10)
strEAN13 STRING(20)
CODE
IF LEN(CLIP(BarCode)) <> 13
MESSAGE('Штрих код за пределами отведенного диапазона')
RETURN ''
END
f[1,0] = a; f[1,1] = a; f[1,2] = a; f[1,3] = a; f[1,4] = a
f[1,5] = a; f[1,6] = a; f[1,7] = a; f[1,8] = a; f[1,9] = a
f[2,0] = a; f[2,1] = a; f[2,2] = a; f[2,3] = a; f[2,4] = b
f[2,5] = b; f[2,6] = b; f[2,7] = b; f[2,8] = b; f[2,9] = b
f[3,0] = a; f[3,1] = b; f[3,2] = b; f[3,3] = b; f[3,4] = a
f[3,5] = b; f[3,6] = b; f[3,7] = a; f[3,8] = a; f[3,9] = b
f[4,0] = a; f[4,1] = a; f[4,2] = b; f[4,3] = b; f[4,4] = a
f[4,5] = a; f[4,6] = b; f[4,7] = b; f[4,8] = b; f[4,9] = a
f[5,0] = a; f[5,1] = b; f[5,2] = a; f[5,3] = b; f[5,4] = b
f[5,5] = a; f[5,6] = a; f[5,7] = a; f[5,8] = b; f[5,9] = b
f[6,0] = a; f[6,1] = b; f[6,2] = b; f[6,3] = a; f[6,4] = b
f[6,5] = b; f[6,6] = a; f[6,7] = b; f[6,8] = a; f[6,9] = a
LOOP i = 1 TO 13
Cod[i, 1] = SUB(BarCode, i, 1)
END
LOOP i = 2 TO 7
Cod[i, 2] = f[i - 1, Cod[1, 1]]
END
strEAN13 = CHR(Cod[1, 1] + 35)
strEAN13 = CLIP(strEAN13) & CHR(33)
LOOP i = 2 TO 7
strEAN13 = CLIP(strEAN13) & CHR(Cod[i, 1] + Cod[i, 2])
END
strEAN13 = CLIP(strEAN13) & CHR(45)
LOOP i = 8 TO 13
strEAN13 = CLIP(strEAN13) & CHR(Cod[i, 1] + c)
END
strEAN13 = CLIP(strEAN13) & CHR(33)
RETURN strEAN13