пʼятниця, 8 березня 2013 р.

ZBAR reading bar codes in Delphi



{*------------------------------------------------------------------------
 *  Copyright 2007-2010 (c) Jeff Brown 
 *
 *  This file is part of the ZBar Bar Code Reader.
 *
 *  The ZBar Bar Code Reader is free software; you can redistribute it
 *  and/or modify it under the terms of the GNU Lesser Public License as
 *  published by the Free Software Foundation; either version 2.1 of
 *  the License, or (at your option) any later version.
 *
 *  The ZBar Bar Code Reader is distributed in the hope that it will be
 *  useful, but WITHOUT ANY WARRANTY; without even the implied warranty
 *  of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 *  GNU Lesser Public License for more details.
 *
 *  You should have received a copy of the GNU Lesser Public License
 *  along with the ZBar Bar Code Reader; if not, write to the Free
 *  Software Foundation, Inc., 51 Franklin St, Fifth Floor,
 *  Boston, MA  02110-1301  USA
 *
 *  http://sourceforge.net/projects/zbar
 *
 * Conversion to Delphi Copyright 2013 (c) Aleksandr Nazaruk 
 *------------------------------------------------------------------------*}
program zbarimg_;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils,
  ZBar in '../ZBar.pas',
  magick_wand in '../../ImageMagick/wand/magick_wand.pas',
  ImageMagick in '../../ImageMagick/magick/ImageMagick.pas';

const note_usage =
    'usage: zbarimg [options] ...'+#10#13+
    #10#13+
    'scan and decode bar codes from one or more image files'+#10#13+
    #10#13+
    'options:'+#10#13+
    '    -h, --help      display this help text'+#10#13+
    '    --version       display version information and exit'+#10#13+
    '    -q, --quiet     minimal output, only print decoded symbol data'+#10#13+
    '    -v, --verbose   increase debug output level'+#10#13+
    '    --verbose=N     set specific debug output level'+#10#13+
    '    -d, --display   enable display of following images to the screen'+#10#13+
    '    -D, --nodisplay disable display of following images (default)'+#10#13+
    '    --xml, --noxml  enable/disable XML output format'+#10#13+
    '    --raw           output decoded symbol data without symbology prefix'+#10#13+
    '    -S[=], --set [=]'+#10#13+
    '                    set decoder/scanner  to  (or 1)'+#10#13;

const warning_not_found =
    #10#13+
    'WARNING: barcode data was not detected in some image(s)'+#10#13+
    '  things to check:'+#10#13+
    '    - is the barcode type supported?'+
    '  currently supported symbologies are:'+#10#13+
    '      EAN/UPC (EAN-13, EAN-8, EAN-2, EAN-5, UPC-A, UPC-E,'+#10#13+
    '      ISBN-10, ISBN-13), Code 128, Code 93, Code 39, DataBar,'+#10#13+
    '      DataBar Expanded, and Interleaved 2 of 5'+#10#13+
    '    - is the barcode large enough in the image?'+#10#13+
    '    - is the barcode mostly in focus?'+#10#13+
    '    - is there sufficient contrast/illumination?'+#10#13;

const xml_head =
    '';

const xml_foot =
    '';

var
  notfound : integer = 0;
  exit_code : integer = 0;
  num_images :integer = 0;
  num_symbols : integer = 0;
  xmllvl : integer = 0;
  xmlbuf : PAnsichar = nil;
  xmlbuflen : Cardinal = 0;
  processor : zbar_processor_t = nil;

Function dump_error(wand : PMagickWand): integer; inline;
const
  sevdesc: array[0..2] of AnsiString = ('WARNING', 'ERROR', 'FATAL');
var
  desc: PAnsiChar;
  severity: ExceptionType;
begin
    desc := MagickGetException(wand, @severity);
    if(severity >= FatalErrorException) then
        exit_code := 2
    else if(severity >= ErrorException) then
        exit_code := 1
    else
        exit_code := 0;
    writeln(format('%s: %s', [sevdesc[exit_code], desc]));
    MagickRelinquishMemory(desc);
    result:=exit_code;
end;


Function scan_image (filename : PAnsiChar) : integer;
type
  cuint32 = LongWord;
type
  size_t = cuint32;

var
  found : integer;
  images : PMagickWand;
  seq, n : cardinal;
  zimage: zbar_image_t;
  width           : integer;
  height          : integer;
  bloblen         : size_t;
  blob            : PByte;
  sym: zbar_symbol_t;
  typ: zbar_symbol_type_t;
  len : integer;
begin
  found := 0;

    if(exit_code = 3) then
        result:=-1;

    images := NewMagickWand();
      if  ((MagickReadImage(images, filename) = MagickFalse) and (dump_error(images)>0)) then
        result:=-1;

    {if(!MagickReadImage(images, filename) && dump_error(images))
        return(-1); }

    n := MagickGetNumberImages(images);
    for seq := 0 to n-1 do
    begin
      if(exit_code = 3) then
        result:=-1;

      if((MagickSetImageIndex(images, seq) = MagickFalse) and (dump_error(images)>0)) then
        result:=-1;

      zimage := zbar_image_create;
      Assert(Assigned(zimage), 'zbar-image');
      zbar_image_set_format(zimage, 'Y800');

      width := MagickGetImageWidth(images);
      height := MagickGetImageHeight(images);
      zbar_image_set_size(zimage, width, height);
      zbar_image_set_size(zimage, Width, Height);

      // extract grayscale image pixels
      // FIXME color!! ...preserve most color w/422P
      // (but only if it's a color image)
      bloblen := width * height;
      blob := GetMemory(bloblen);
      zbar_image_set_data(zimage, blob, bloblen, nil);

      if MagickGetImagePixels(images, 0, 0, width, height,'I', CharPixel, blob)= MagickFalse then
        result:=-1;

      if(xmllvl = 1) then
      begin
        inc(xmllvl);
        writeln(Format('', [filename]));
      end;

      zbar_process_image(processor, zimage);

        // output result data
      sym := zbar_image_first_symbol(zimage);
      while Assigned(sym) do
      begin
        typ := zbar_symbol_get_type(sym);
        //len := zbar_symbol_get_data_length(sym);
        if typ = ZBAR_PARTIAL then  continue;

        if(xmllvl <= 0) then
        begin
          if xmllvl=0 then
            write(Format('%s:', [zbar_get_symbol_name(typ)]));
          writeln(String(AnsiString(zbar_symbol_get_data(sym))))
        end else
        begin
          if(xmllvl < 3) then
          begin
            inc(xmllvl);
            writeLN(Format('', [seq]));
          end;
          zbar_symbol_xml(sym, xmlbuf, xmlbuflen);
          writeln(xmlbuf);
        end;
        inc(found);
        inc(num_symbols);
        sym := zbar_symbol_next(sym);
      end;

      if(xmllvl > 2) then
      begin
        dec(xmllvl);
        writeLN('');
      end;

      //writetofile;
      zbar_image_destroy(zimage);
      inc(num_images);
      if zbar_processor_is_visible(processor)=1 then
        zbar_processor_user_wait(processor, -1);
    end;

    if(xmllvl > 1) then
    begin
      dec(xmllvl);
      writeLN('');
    end;

    if found=0 then inc(notfound);
    DestroyMagickWand(images);
    result:=0;
end;


Function usage (rc : integer; msg : PAnsiChar; arg: PAnsiChar): integer;
begin
  if length(msg)>0 then
  begin
    write(format('%s', [msg]));
    if length(arg)>0 then
      write(format('%s', [arg]));
    writeln('');
  end;
  writeln(format('%s', [note_usage]));
  result:=rc;
end;

Function parse_config (cfgstr : PAnsiChar; arg: PAnsiChar): integer;
begin
  if length(cfgstr)>0 then
    result:=usage(1, 'ERROR: need argument for option: ', arg);

  if zbar_processor_parse_config(processor, cfgstr)=0 then
    result:=usage(1, 'ERROR: invalid configuration setting:', cfgstr);
end;


var
  i,j :integer;
  quiet : integer=0;
  display : integer=0;
  arg : array[0..255] of AnsiChar;
  major, minor : cardinal;
begin
  try
    { TODO -oUser -cConsole Main : Insert code here }
    for i := 1 to ParamCount do
    begin
      fillchar(arg, sizeof(arg), #0);
      StrPCopy(arg, ParamStr(i));
      if ((arg[0]<>'-') or (arg[1]='')) then
      begin
        inc(num_images);
      end else
      if arg[1]<>'-' then
      begin
        for j := 1 to length(arg)-1 do
        begin
          if arg[j]='S' then
          begin
            ;
          end;
          if arg[j]='h' then
          begin
            usage(0,'','');
            exit;
          end
          else
          if arg[j]='q' then
          begin
            quiet:=1;
            break;
          end
          else
          if arg[j]='v' then
          begin
            zbar_increase_verbosity();
            break
          end
          else
          if arg[j]='d' then
          begin
            display:=1;
            break
          end
          else
          if arg[j]='D' then break
          else
          begin
            usage(1, 'ERROR: unknown bundled option: -', arg);
            //exit;
          end;
        end;
      end else
      if AnsiCompareStr(arg, '--help')=0 then
      begin
        usage(0, '', '');
        exit;
      end else
      if AnsiCompareStr(arg, '--version')=0 then
      begin
        zbar_version(major, minor);
        writeln(format('%d.%d',[ major, minor]));
        exit;
      end else
      if AnsiCompareStr(arg, '--quiet')=0 then
      begin
        quiet:=1;
       // exit; //-----------?
      end else
      if AnsiCompareStr(arg, '--verbose')=0 then
      begin
        zbar_increase_verbosity();
      end else
      if AnsiCompareStr(copy(arg,1,10), '--verbose=')=0 then
      begin
        try
          zbar_set_verbosity(strtoint(copy(arg,11,length(arg)-10)));
        except
           zbar_set_verbosity(0);
        end;
      end else
      if AnsiCompareStr(arg, '--display')=0 then
      begin
        inc(display);
      end else
      if ((AnsiCompareStr(arg, '--nodisplay')=0) or
      (AnsiCompareStr(arg, '--set')=0) or
      (AnsiCompareStr(arg, '--xml')=0) or
      (AnsiCompareStr(arg, '--noxml')=0) or
      (AnsiCompareStr(arg, '--raw')=0)) then
      begin
        continue;
      end else
        usage(1, 'ERROR: unknown option: ', arg);
    end;

    if num_images=0 then
    begin
      usage(1, 'ERROR: specify image file(s) to scan', '');
      exit;
    end;
    num_images:=0;

    //InitializeMagick('zbarimg');

    processor := zbar_processor_create(0);
    Assert(Assigned(processor), 'zbar-processor');
    if zbar_processor_init(processor, nil, 1)=1 then
    begin
      zbar_processor_error_spew(processor, 0);
    end;



    for i := 1 to ParamCount do
    begin
      fillchar(arg, sizeof(arg), #0);
      StrPCopy(arg, ParamStr(i));
      if length(arg)<=0 then continue;
      if ((arg[0]<>'-') or (arg[1]='')) then
      begin
        scan_image(arg);
      end else
      if arg[1]<>'-' then
      begin
        for j := 0 to length(arg)-1 do
        begin
          if arg[j]='S' then
          begin
            ;
          end else
          if arg[j]='d' then
          begin
            zbar_processor_set_visible(processor, 1);
            break
          end
          else
          if arg[j]='D' then
          begin
            zbar_processor_set_visible(processor, 0);
            break;
          end
        end;
      end else
      if AnsiCompareStr(arg, '--display')=0 then
      begin
        zbar_processor_set_visible(processor, 1);
      end else
      if AnsiCompareStr(arg, '--nodisplay')=0 then
      begin
        zbar_processor_set_visible(processor, 0);
      end else
      if AnsiCompareStr(arg, '--xml')=0 then
      begin
        if(xmllvl < 1) then
        begin
          xmllvl := 1;
          //fflush(stdout);
          //_setmode(_fileno(stdout), _O_BINARY);
          writeln(Format('%s', [xml_head]));
        end;
      end else
      if ((AnsiCompareStr(arg, '--noxml')=0) or (AnsiCompareStr(arg, '--raw')=0)) then
      begin
      if(xmllvl > 0) then
        begin
          xmllvl := 0;
          //fflush(stdout);
          //_setmode(_fileno(stdout), _O_BINARY);
          writeln(Format('%s', [xml_head]));
        end;
        if AnsiCompareStr(arg, '--raw')=0 then
        begin
          xmllvl := -1;
        end;
      end else
      if AnsiCompareStr(arg, '--')=0 then
        break;
    end;

    for i := i to ParamCount do
    begin
      scan_image(PansiChar(ParamStr(i)));
    end;

    //* ignore quit during last image *//
    if(exit_code = 3) then
      exit_code := 0;


    if(xmllvl > 0) then
    begin
      xmllvl := -1;
      writeln(Format('%s', [xml_foot]));
      //fflush(stdout);
    end;

  //  if Assigned(xmlbuf) then
  //      freeMem(xmlbuf);



    if((num_images>0) and  (quiet=0) and (xmllvl <= 0)) then
    begin
      writeln(Format('scanned %d barcode symbols from %d images', [num_symbols, num_images]));
      if(notfound>0) then
        writeln(Format('%s', [warning_not_found]));
    end;


    if ((num_images>0) and (notfound>0) and (exit_code<>0))  then
        exit_code := 4;

    zbar_processor_destroy(processor);
    //DestroyMagick();
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.

Stand: 
  • Windows 8 Enterprise 64Bit Eng
  • Delphi XE3

Links: 
  • ZBar is an open source software suite for reading bar codes from various sources, such as video streams, image files and raw intensity sensors. It supports many popular symbologies (types of bar codes) including EAN-13/UPC-A, UPC-E, EAN-8, Code 128, Code 39, Interleaved 2 of 5 and QR Code.
  • ZBar Pascal Header - Conversion to Delphi Copyright 2009 (c) Stephen Boyd.
  • ImageMagick® is a software suite to create, edit, compose, or convert bitmap images. It can read and write images in a variety of formats (over 100) including DPX, EXR, GIF, JPEG, JPEG-2000, PDF, PhotoCD, PNG, Postscript, SVG, and TIFF. Use ImageMagick to resize, flip, mirror, rotate, distort, shear and transform images, adjust image colors, apply various special effects, or draw text, lines, polygons, ellipses and Bézier curves.
  • ZBarImg Delphi

6 коментарів:

  1. Thanks for the zbar and imagemagick example.

    ВідповістиВидалити
  2. please update file http://www.freehand.com.ua/Projects/ZBar/Project.zip, because not found

    ВідповістиВидалити
    Відповіді
    1. freehand.com.ua site is temporarily not working, now it should work

      Видалити
  3. Hi,

    I am trying to use ZBar.pas but I have no units DLL96V1, DLLSP96:

    implementation

    uses Windows, SysUtils, Graphics, DLL96V1, DLLSP96;

    var
    DllHandle: THandle;

    Where can I get them?

    ВідповістиВидалити
    Відповіді
    1. Hi,

      uses
      Windows, SysUtils, Classes, Graphics {, dbc, DLL96V1, DLLSP96};

      Видалити
  4. DLL96V1, DLLSP96 come from ImageLib Corporate Suite. Just get the lib.

    ВідповістиВидалити