[Perl]生成Code39条码

There's more than one way to do it!

[Perl]生成Code39条码

帖子523066680 » 2016-06-26 8:51

暂时只包含 0-9 的数字,字符的编码表没有加进去

Code39编码一般在条码的开头和末尾分别加入* 的对应条码,中间是数据,每个数字的条码中间用一个单位的白色数线分隔

Syntax: [ Download ] [ Hide ]
=info
    Edit: vicyang
    Mail: 523066680@163.com
    Date: 2016-06
=cut

use utf8;
use IO::Handle;
STDOUT->autoflush(1);
binmode(STDOUT, ":encoding(gbk)");

my $file = "Code39.bmp";

open $WRT, ">:raw", $file or die $!;

our $multiple = 2.0;
our $width  = 155;
our $height = 103;
our @coord;
our @code = split("", "*012*");

our %list =
(
   '0' => [1,1,1,2,2,1,2,1,1, 1],
   '1' => [2,1,1,2,1,1,1,1,2, 1],
   '2' => [1,1,2,2,1,1,1,1,2, 1],
   '3' => [2,1,2,2,1,1,1,1,1, 1],
   '4' => [1,1,1,2,2,1,1,1,2, 1],
   '5' => [2,1,1,2,2,1,1,1,1, 1],
   '6' => [1,1,2,2,2,1,1,1,1, 1],
   '7' => [1,1,1,2,1,1,2,1,2, 1],
   '8' => [2,1,1,2,1,1,2,1,1, 1],
   '9' => [1,1,2,2,1,1,2,1,1, 1],
   '*' => [1,2,1,1,2,1,2,1,1, 1],
);

my $sum = 0;
for my $e ( @code )
{
    grep { $sum += $_ * $multiple } @{$list{$e} };
}

$width = $sum;
printf "width: %d, bytes in line: %d\n", $width, $width * 3;

#补充字节长度(每行字节数必须整除4)
our $byte_plus;

if ( ($width * 3) % 4 != 0 )  #每个像素包含24位色深 = 3 bytes
{
    $byte_plus = 4 - ($width * 3) % 4;
}
else
{
    $byte_plus = 0;
}

printf "byte plus: %d\n", $byte_plus;

FILL_ZERO(\@coord, $width, $height);

my $x = 0.0;
my $y = 0.0;      #起点
my $h = $height;  #高度 同图片高度
my $color;

my $i = 0;

for my $e ( @code )
{
    for my $w ( @{$list{$e} } )
    {
        if ($i == 0)
        {
            $color = "\x00\x00\x00";
        }
        else
        {
            $color = "\xFF\xFF\xFF";
        }

        DRAW_RECT(\@coord, $x, $x+$w * $multiple, $y, $y+$h, $color);
        $x += $w * $multiple;

        $i = 1 - $i;
    }
}

WRITE_HEAD($width, $height, $file);
WRITE_BMP(\@coord, $width, $height, $file);

exit;

sub WRITE_HEAD
{
    my ($width, $height, $file) = @_;

    open $WRT, ">>:raw", $file or die $!;

    our $v;
    our ($type, $bfSize, $res1, $res2, $offset) =
        (0x4d42, 0,      0,     0,     122    );

    $v = pack '(SLSSL)', ($type, $bfSize, $res1, $res2, $offset);

    print $WRT $v;

    our ($headSize, $piWidth, $piHeight, $planes, $bitCount, $Compress, $PixSize, $BC, $BD, $BE, $BF) =
        (108,       $width,   $height,      1,       24,        0,         0,      0,   0,   0,   0);
        #Compress = 0 时, PixSize可以填0

    $v = pack '(L3S2L6)',
        ($headSize, $piWidth, $piHeight, $planes, $bitCount, $Compress, $PixSize, $BC, $BD, $BE, $BF);

    print $WRT $v;

    #Windows的BMP规定一行所占的字节数须是 4字节的倍数,不足的以0填充
    print $WRT "\x00"x(122-54);  #文件头部分补充

    close $WRT;
}

sub DRAW_RECT
{
    my ($ref, $x1, $x2, $y1, $y2, $color) = @_;

    for my $ROW ( $y1 .. $y2 )
    {
        for my $COL ( $x1 .. $x2 )
        {
            $coord[$ROW][$COL] = $color;
        }
    }
}

sub FILL_ZERO
{
    my ($ref, $width, $height) = @_;

    for my $ROW (0 .. $height-1 )
    {
        for my $COL (0 .. $width - 1 )
        {
            $ref->[$ROW][$COL] = "\xFF\xFF\xFF";
        }
    }
}

sub WRITE_BMP
{
    our $byte_plus;
    my ($ref, $width, $height, $file) = @_;
    open $WRT, ">>:raw", $file or die $!;

    for my $ROW (0 .. $height-1)
    {
        for my $COL (0 .. $width - 1 )
        {
            print $WRT $ref->[$ROW][$COL];
        }
        print $WRT "\x00"x$byte_plus;
    }

    close $WRT;
}

sub xcode {
    $_[1]='x' if (not defined $_[1]);
    for my $v ( split(//,$_[0]) ) {
        print sprintf ("%l$_[1] ",ord($v));
    }
    print "\n\n";
}


=INFO
    规则
    每个字符用九条竖线(空白部分也算
    两个字符条码之间 用一个单位宽度的白色竖线表示
=cut
 


生成结果:
图片
论坛已转移 Code-By.Org 群号 322023604
头像
523066680
版主
 
帖子: 1680
注册: 2012-03-06 15:08

回到 Perl

在线用户

正在浏览此版面的用户:没有注册用户 和 1 位游客

cron
Not able to open ./cache/data_global.php