Распознание QR Код Zbar.pas

uses
  ZBar;
 
type
  TZbarSymbolTypes = set of zbar_symbol_type_e;
 
var
  CodStr: TStrings;
 
procedure ReadBarcode(Codes: TStrings; Source: TGraphic; AddBarType: Boolean = False);
var
  p: PByte;
  bmp: TBitmap;
  count, i, j: Integer;
  ba, pa: array of Byte;
  symboltype: zbar_symbol_type_t;
  scanner: zbar_image_scanner_t;
  stype: zbar_symbol_type_e;
  symbol: zbar_symbol_t;
  image: zbar_image_t;
  blob: PByte;
begin
  bmp := TBitmap.Create;
  bmp.PixelFormat := pf24bit; //pf8bit;
  try
    bmp.Width := Source.Width;
    bmp.Height := Source.Height;
    bmp.Canvas.Draw(0, 0, Source);
    if bmp.Width = 0 then Exit;
    Codes.Clear;
 
    scanner := zbar_image_scanner_create;
    try
      i := zbar_image_scanner_set_config(scanner, ZBAR_NONE, ZBAR_CFG_ENABLE, 1);
      image := zbar_image_create;
      try
        blob := GetMemory((bmp.Height)*(bmp.Width));
        PByte(ba) := blob;
        for i := 0 to bmp.Height - 1 do begin
          p := bmp.ScanLine[i];  PByte(pa) := p;
          if bmp.PixelFormat = pf8bit then CopyMemory(@ba[i*bmp.Width], p, bmp.Width)
          else for j := 0 to bmp.Width - 1 do
            ba[j+i*bmp.Width] := Round(pa[j*3]*0.3 + pa[j*3+1]*0.59 + pa[j*3+2]*0.11);
        end;
        zbar_image_set_format(image, 'Y800');
        zbar_image_set_size(image, bmp.Width, bmp.Height);
        zbar_image_set_data(image, blob, bmp.Height * bmp.Width, nil);
 
        count := zbar_scan_image(scanner, image);
 
        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)))
                + '=' + 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
        PByte(pa) := nil;
        zbar_image_destroy(image);
      end;
    finally
      zbar_image_scanner_destroy(scanner);
    end;
  finally
    bmp.Free;
  end;
end;

procedure Grayscale2(pBuf: pInteger; Count: integer);
var
  Color: integer;
begin;
  repeat;
    Color:=pBuf^;
    pBuf^:=(( Color * (150 * 256)
           + (Color and $00FF00FF) * (29 * 256 * 256 - 150 * 256 + 77)
            ) shr 24
           ) * $00010101;
    dec(Count);
    inc(pBuf);
    until Count<=0;
  end;
 
procedure ShaBitmapToGrayscale2(Bitmap: TBitmap);
var
  p, q: pInteger;
begin;
  with Bitmap do begin;
    p:=ScanLine[Height-1];
    q:=ScanLine[0];
    if cardinal(p)>cardinal(q) then p:=q;
    Grayscale2(p, Height * Width);
    end;
  end;

(String(AnsiString(

procedure TForm1.ScanImageButtonClick(Sender: TObject);
begin
if OpenPictureDialog1.Execute then
Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
ReadBarcode(memo1.Lines, image1.Picture.Graphic, True);
 
end;

procedure Grayscale2(pBuf: pInteger; Count: integer);
var
  Color: integer;
begin;
  repeat;
    Color:=pBuf^;
    pBuf^:=(( Color * (150 * 256)
           + (Color and $00FF00FF) * (29 * 256 * 256 - 150 * 256 + 77)
            ) shr 24
           ) * $00010101;
    dec(Count);
    inc(pBuf);
    until Count<=0;
  end;
 
procedure ShaBitmapToGrayscale2(Bitmap: TBitmap);
var
  p, q: pInteger;
begin;
  with Bitmap do begin;
    p:=ScanLine[Height-1];
    q:=ScanLine[0];
    if cardinal(p)>cardinal(q) then p:=q;
    Grayscale2(p, Height * Width);
    end;
  end;

procedure TForm1.btnDisableClick(Sender: TObject);
begin
  FImageScanner.Free;
end;
 
procedure TForm1.btnEnableClick(Sender: TObject);
var
  Res: integer;
  Major, Minor: cardinal;
begin
  Res := zbar_version(Major, Minor);
 
  FImageScanner := TImageScanner.Create;
end;