Barcode aus Bild auslesen

[himitsu]

So, hat mich etwas nerven gekostet, aber jetzt geht's

Delphi-Quellcode:

uses
  ZBar;

type
  TZbarSymbolTypes = set of zbar_symbol_type_e;

procedure ReadBarcode(Codes: TStrings; Source: TGraphic; AddBarType: Boolean = False;
  BarTypes: TZbarSymbolTypes = []; CheckDigit: Boolean = True; Density: Integer = 1);
var
  bmp: TBitmap;
  bytesPerLine, count, i: Integer;
  p, pg: PByte;
//processor: zbar_processor_t;
  scanner: zbar_image_scanner_t;
  image: zbar_image_t;
  stype: zbar_symbol_type_e;
  symbol: zbar_symbol_t;
  symboltype: zbar_symbol_type_t;
begin
  if BarTypes = [] then BarTypes := [ZBAR_EAN8, ZBAR_UPCE, ZBAR_ISBN10, ZBAR_UPCA, ZBAR_EAN13, ZBAR_ISBN13, ZBAR_I25, ZBAR_CODE39, ZBAR_CODE128];

  bmp := TBitmap.Create;
  bmp.PixelFormat := pf32bit;;
  try
    bmp.Width  := Source.Width;
    bmp.Height := Source.Height;
    bmp.Canvas.Draw(0, 0, Source);

  //processor := zbar_processor_create(0);
  //Assert(Assigned(processor), 'zbar-processor');
  //try
  //  if zbar_processor_init(processor, nil, Ord(False)) <> 0 then begin
  //    zbar_processor_error_spew(processor, 0);
  //    Assert(False, 'zbar-processor_init');
  //  end;
  //  zbar_processor_set_visible(processor, 0);

      scanner := zbar_image_scanner_create;
      Assert(Assigned(scanner), 'zbar-scanner');
      try
        zbar_image_scanner_set_config(scanner, ZBAR_NONE, ZBAR_CFG_ENABLE, 0);

        i := zbar_image_scanner_set_config(scanner, ZBAR_NONE, ZBAR_CFG_X_DENSITY, Density);
        Assert(i = 0, 'zbar-set_config');

        i := zbar_image_scanner_set_config(scanner, ZBAR_NONE, ZBAR_CFG_Y_DENSITY, Density);
        Assert(i = 0, 'zbar-set_config');

        for stype in BarTypes do begin
          i := zbar_image_scanner_set_config(scanner, stype, ZBAR_CFG_ENABLE, 1);
          Assert(i = 0, 'zbar-set_config');

          if CheckDigit then
            zbar_image_scanner_set_config(scanner, stype, ZBAR_CFG_ADD_CHECK, 1);
        end;

        image := zbar_image_create;
        Assert(Assigned(image), 'zbar-image');
        try
          bytesPerLine := bmp.Width;
          p  := bmp.ScanLine[bmp.Height - 1];  // die Bildzeilen gehen von unten nach oben
          pg := GetMemory(bmp.Height * bytesPerLine);
          try
            for i := bmp.Height * bytesPerLine downto 0 do
              pg[i] := Round(p[i*4]*0.3 + p[i*4+1]*0.59 + p[i*4+2]*0.11);

            zbar_image_set_format(image, 'Y800');
            zbar_image_set_size(image, bmp.Width, bmp.Height);
            zbar_image_set_data(image, pg, bmp.Height * bytesPerLine, nil);

            count := zbar_scan_image(scanner, image);
          //zbar_process_image(processor, image);  count := 1;
          finally
            FreeMemory(pg);
          end;

          if count > 0 then begin
            symbol := zbar_image_first_symbol(image);
            while Assigned(symbol) do begin
              symboltype := zbar_symbol_get_type(symbol);
              if AddBarType then
                Codes.Add(String(AnsiString(zbar_get_symbol_name(symboltype)) + AnsiString(zbar_get_addon_name(symboltype)))
                  + Codes.NameValueSeparator + String(AnsiString(zbar_symbol_get_data(symbol))))
              else
                Codes.Add(String(AnsiString(zbar_symbol_get_data(symbol))));

              symbol := zbar_symbol_next(symbol);
            end;
          end;
        finally
          zbar_image_destroy(image);
        end;
      finally
        zbar_image_scanner_destroy(scanner);
      end;
  //finally
  //  zbar_processor_destroy(processor);
  //end;
  finally
    bmp.Free;
  end;
end;

Wer schräge Barcodes einscännen will/muß, der braucht einfach nur das Bild zu drehen, denn die ZBar-Barcode-Komponente scännt nur in 90°-Winkeln (wagerecht und senkrecht).
z.B. von 0° bis <90° in 10°-Schritten
oder einfach nur noch einmal 45°
oder 0°, 22°, 45° und 68°

Da könnte man z.B. direkt in den Block nach image := zbar_image_create; eine entsprechende Schleife einbauen.
Eventuell dann auch noch die StringListe mit .Sort:=True und .Duplicates:=dupIgnore .

Delphi-Quellcode:

procedure RotateBitmap(Dest, Source: TBitmap; Winkel: Double; Hintergrund: TColor = clWhite; GroesseAnpassen: Boolean = True);
type
//TArray = array[0..0] of Byte;  {pf8bit}
//TArray = array[0..0] of array[0..1] of Byte;  {pf16bit}
//TArray = array[0..0] of array[0..2] of Byte;  {pf24bit}
  TArray = array[0..0] of array[0..3] of Byte;  {pf32bit}
  PArray = ^TArray;
var
  rw: Boolean;
  CT, ST: Double;
  I, J, X, Y, SrcW, SrcH, SrcWD, SrcHD, SrcWD2, SrcHD2: Integer;
  ScanS, ScanD: array of PArray;
  XCT, XST: Integer;
  YCT, YST: array of Integer;
begin
//Source.PixelFormat := pf8bit;
//Source.PixelFormat := pf16bit;
//Source.PixelFormat := pf24bit;
  Source.PixelFormat := pf32bit;
  Dest.PixelFormat := Source.PixelFormat;
  Winkel := 360 - Winkel;
  while Winkel > 360 do Winkel := Winkel - 360;
  while Winkel < 0 do Winkel := Winkel + 360;
  Winkel := Winkel * PI / 180;
  ST := Sin(Winkel);
  CT := Cos(Winkel);
  rw := Frac(Winkel / 90) = 0;
  if not GroesseAnpassen then begin
    Dest.Width  := Source.Width;
    Dest.Height := Source.Height;
  end else if ST * CT < 0 then begin
    Dest.Width  := Round(Abs(Source.Width * CT - Source.Height * ST));
    Dest.Height := Round(Abs(Source.Width * ST - Source.Height * CT));
  end else begin
    Dest.Width  := Round(Abs(Source.Width * CT + Source.Height * ST));
    Dest.Height := Round(Abs(Source.Width * ST + Source.Height * CT));
  end;
  with Dest.Canvas do begin
    Brush.Style := bsSolid;
    Brush.Color := Hintergrund;
    FillRect(ClipRect);
  end;
  SrcWD  := Source.Width;
  SrcHD  := Source.Height;
  SrcWD2 := Source.Width  div 2;
  SrcHD2 := Source.Height div 2;
  if CT < 0 then Dec(SrcWD2);
  if ST < 0 then Dec(SrcHD2);
  SetLength(ScanS, Source.Height);
  SetLength(ScanD, Dest.Height);
  for I := Source.Height - 1 downto 0 do ScanS[I] := Source.ScanLine[I];
  for I := Dest.Height   - 1 downto 0 do ScanD[I] := Dest.ScanLine[I];
  SetLength(YCT, Dest.Height);
  SetLength(YST, Dest.Height);
  for J := 0 to Dest.Height - 1 do begin
    if rw then
      Y := Trunc(J - Dest.Height / 2 + 0.5)
    else
      Y := J - Dest.Height div 2;
    YCT[J] := Round(Y * CT * 4 + 2);
    YST[J] := Round(Y * ST * 4 + 2);
  end;
  for I := 0 to Dest.Width - 1 do begin
    if rw then
      X := Trunc(I - Dest.Width / 2)
    else
      X := I - Dest.Width div 2;
    XCT := Round((X * CT + SrcWD2) * 4);
    XST := Round((X * ST + SrcHD2) * 4);
    for J := 0 to Dest.Height - 1 do begin
      SrcW := (XCT - YST[J]) shr 2; {... div 4}
      SrcH := (XST + YCT[J]) shr 2;
      if (SrcH >= 0) and (SrcH < SrcHD) and (SrcW >= 0) and (SrcW < SrcWD) then
        ScanD[J][I] := ScanS[SrcH][SrcW];
    end;
  end;
end;

Benötigt wird nur die angehängte Zbar.pas und die libzbar-0.dll von zbar.sourceforge.net, bzw. aus dem Anhang.


Das die Zbar.pas wurde natürlich auch gleich mit auf Unicode angepaßt ... läuft aber weiterhin auch mit ANSI.