[SOLVED] Reading black & white TIFF images?
lazarus / 39-Graphics

----------------------------------------------------------------------
BigChimp · 2013-02-22 07:15

Hi all,

Busy with my scanning program. It uses the sane scanning program on
Linux which outputs lineart/black and white images.

Turns out these can't be read by FPC's fpreadtiff.

Would it be (fairly) easy to patch fpreadtiff to support this format
or would it be easiest to use another image library (e.g. imagemagick,
vampyre imaging library) to read the file?
I have the feeling it's uncompressed as it zips up nicely

Attached an example.

----------------------------------------------------------------------
theo · 2013-02-22 10:02

Afaik, there are so many TIFF variants that only LibTIFF can read them
all. ;-)

I would convert it to PNG or BMP using PacalMagick
http://wiki.freepascal.org/PascalMagick

It is a FPC Package "ImageMagick", you don't need to download
anything.

uses magick_wand, ImageMagick;

----------------------------------------------------------------------
BigChimp · 2013-02-22 10:06

Thanks, theo, that certainly sounds like a good short-term [1]
solution

[1] Yes, an euphemism for long-term

----------------------------------------------------------------------
theo · 2013-02-22 15:47

Here is some code to use ImageMagick for Image loading to Bitmap
without converting to other format.

Use like

Code: [Select]if OpenDialog1.Execute then
   LoadMagickBitmap(OpenDialog1.FileName,Image1.Picture.Bitmap);  

Code: [Select]unit magicklcl;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Graphics;

procedure LoadMagickBitmap(FileName: string; Bmp: TBitmap);

implementation

uses magick_wand, ImageMagick, IntfGraphics, FPimage, LazUTF8;

procedure LoadMagickBitmap(FileName: string; Bmp: TBitmap);
var
  status: MagickBooleanType;
  wand: PMagickWand;
  img: Pimage;
  pack: PPixelPacket;
  limg: TLazIntfImage;
  i, j, wi, he: integer;
  colo: TFPColor;
  description: PChar;
  severity: ExceptionType;
begin
  wand := NewMagickWand;
  try
    status := MagickReadImage(wand, PChar(UTF8ToSys(FileName)));
    if (status = MagickFalse) then
    begin
      description := MagickGetException(wand, @severity);
      raise Exception.Create(Format('An error ocurred. Description:
%s',
        [description]));
      description := MagickRelinquishMemory(description);
    end;
    img := GetImageFromMagickWand(wand);
    he := MagickGetImageHeight(wand);
    wi := MagickGetImageWidth(wand);
    limg := TLazIntfImage.Create(0, 0);
    limg.DataDescription := GetDescriptionFromDevice(0, wi, he);
    pack := GetAuthenticPixels(img, 0, 0, wi, he, nil);
    for j := 0 to he - 1 do
      for i := 0 to wi - 1 do
      begin
        colo.red := pack^.red;
        colo.green := pack^.green;
        colo.blue := pack^.blue;
        colo.alpha := pack^.opacity;
        limg.Colors[i, j] := colo;
        Inc(pack);
      end;
    Bmp.LoadFromIntfImage(limg);
  finally
    limg.Free;
    wand := DestroyMagickWand(wand);
  end;
end;

initialization
  MagickWandGenesis;

finalization;
  MagickWandTerminus;

end.
I hope it works.

----------------------------------------------------------------------
BigChimp · 2013-02-23 08:44

Thanks a lot, Theo, seems it works: got an image - just have to start
scanning non-empty pages to properly test

As I receive a TMemoryStream from the web server, I adapted the code a
bit to eliminate intermediate files:
Code: [Select]function StreamToMemory(Stream: TStream): Pointer;
begin
  if Assigned(Stream) then
    begin
      Result := AllocMem(Stream.Size);
      Stream.Position := 0;
      Stream.Read(Result^, Stream.Size);
    end
  else
    Result := nil;
end;


procedure LoadMagickBitmap(ImageStream: TStream; Bmp: TBitmap);
// Let imagemagick convert an image and return a bitmap.
// Adapted from code from theo on the Lazarus forum.
var
  ImageBufferPtr: Pointer;
  status: MagickBooleanType;
  wand: PMagickWand;
  img: Pimage;
  pack: PPixelPacket;
  limg: TLazIntfImage;
  i, j, wi, he: integer;
  colo: TFPColor;
  description: PChar;
  severity: ExceptionType;
begin
  wand := NewMagickWand;
  try
    // First convert stream to regular chunk of memory
    ImageBufferPtr:=StreamToMemory(ImageStream);
    if ImageBufferPtr=nil then
    begin
      raise Exception.Create('LoadMagickBitmap: could not read image.
Details: stream conversion failed.');
    end
    else
    begin
      try
        status := MagickReadImageBlob(wand, ImageBufferPtr,
ImageStream.Size);
      finally
        FreeMem(ImageBufferPtr);
      end;
    end;

    if (status = MagickFalse) then
    begin
      description := MagickGetException(wand, @severity);
      raise Exception.Create(Format('LoadMagickBitmap: an error
ocurred. Description: %s',
        [description]));
      description := MagickRelinquishMemory(description);
    end;
    img := GetImageFromMagickWand(wand);
    he := MagickGetImageHeight(wand);
    wi := MagickGetImageWidth(wand);
    limg := TLazIntfImage.Create(0, 0);
    limg.DataDescription := GetDescriptionFromDevice(0, wi, he);
    pack := GetAuthenticPixels(img, 0, 0, wi, he, nil);
    for j := 0 to he - 1 do
      for i := 0 to wi - 1 do
      begin
        colo.red := pack^.red;
        colo.green := pack^.green;
        colo.blue := pack^.blue;
        colo.alpha := pack^.opacity;
        limg.Colors[i, j] := colo;
        Inc(pack);
      end;
    Bmp.LoadFromIntfImage(limg);
  finally
    limg.Free;
    wand := DestroyMagickWand(wand);
  end;
end;

----------------------------------------------------------------------
theo · 2013-02-23 11:05

Great.
If you would use a TMemoryStream as Parameter,  you could access
  MS.Memory
directly without the StreamToMemory function which doubles memory
usage, no?

----------------------------------------------------------------------
BigChimp · 2013-02-23 11:33

Tried that but got an imagemagick error saying the blob could not be
read: no decode delegate for this image format.

So I assumed a memorystream must have some extra data in front of it
for accounting purposes etc but perhaps  I'm wrong.

Used this kind of code:
Code: [Select]procedure LoadMagickBitmap(ImageStream: TMemoryStream;
Bmp: TBitmap);
// Let imagemagick convert an image and return a bitmap.
// Adapted from code from theo on the Lazarus forum.
var
....same...
begin
  wand := NewMagickWand;
  try
    ImageStream.Position:=0;
    status := MagickReadImageBlob(wand, @ImageStream,
ImageStream.Size);
//passing @ or not doesn't matter, same error message

What am I doing wrong

----------------------------------------------------------------------
theo · 2013-02-23 11:35

I wrote above pass

ImageStream.Memory

to the function. It's already a pointer.

----------------------------------------------------------------------
BigChimp · 2013-02-23 12:18

Argh. Sorry. Yep, that works.

----------------------------------------------------------------------
theo · 2013-02-23 12:19

The next version below. Please test.

Code: [Select]unit magicklcl;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Graphics;

procedure LoadMagickBitmap(FileName: string; Bmp: TBitmap); overload;
procedure LoadMagickBitmap(Strm: TMemoryStream; Bmp: TBitmap);
overload;

implementation

uses magick_wand, ImageMagick, IntfGraphics, FPimage, LazUTF8;

procedure LoadMagickBitmapWand(Wand: PMagickWand; Bmp: TBitmap);
var
  img: Pimage;
  pack: PPixelPacket;
  limg: TLazIntfImage;
  i, j, wi, he: integer;
  colo: TFPColor;
begin
  img := GetImageFromMagickWand(wand);
  he := MagickGetImageHeight(wand);
  wi := MagickGetImageWidth(wand);
  limg := TLazIntfImage.Create(0, 0);
  try
    limg.DataDescription := GetDescriptionFromDevice(0, wi, he);
    pack := GetAuthenticPixels(img, 0, 0, wi, he, nil);
    for j := 0 to he - 1 do
      for i := 0 to wi - 1 do
      begin
        colo.red := pack^.red;
        colo.green := pack^.green;
        colo.blue := pack^.blue;
        colo.alpha := pack^.opacity;
        limg.Colors[i, j] := colo;
        Inc(pack);
      end;
    Bmp.LoadFromIntfImage(limg);
  finally
    limg.Free;
  end;
end;

procedure LoadMagickBitmap(FileName: string; Bmp: TBitmap);
var
  wand: PMagickWand;
  status: MagickBooleanType;
  description: PChar;
  severity: ExceptionType;
begin
  wand := NewMagickWand;
  try
    status := MagickReadImage(wand, PChar(UTF8ToSys(FileName)));
    if (status = MagickFalse) then
    begin
      description := MagickGetException(wand, @severity);
      raise Exception.Create(Format('An error ocurred. Description:
%s',
        [description]));
      description := MagickRelinquishMemory(description);
    end else LoadMagickBitmapWand(wand, Bmp);
  finally
    wand := DestroyMagickWand(wand);
  end;
end;

procedure LoadMagickBitmap(Strm: TMemoryStream; Bmp: TBitmap);
var
  wand: PMagickWand;
  status: MagickBooleanType;
  description: PChar;
  severity: ExceptionType;
begin
  wand := NewMagickWand;
  try
    Strm.Position := 0;
    status := MagickReadImageBlob(wand, Strm.Memory, Strm.Size);
    if (status = MagickFalse) then
    begin
      description := MagickGetException(wand, @severity);
      raise Exception.Create(Format('An error ocurred. Description:
%s',
        [description]));
      description := MagickRelinquishMemory(description);
    end else LoadMagickBitmapWand(wand, Bmp);
  finally
    wand := DestroyMagickWand(wand);
  end;
end;

initialization
  MagickWandGenesis;

finalization;
  MagickWandTerminus;

end.

----------------------------------------------------------------------
BigChimp · 2013-03-11 09:44

FYI, FPC trunk has support for 1 bit TIFF images (uncompressed and
some compressions. Missing are CCIT Group 3/4 fax compression)