libtiffdelphi.pas

打开TIFF文件

  end;
end;

function TIFFcallvjpeg_jpeg_destroy(cinfo: PRJpegCommonStruct): Integer; cdecl;
begin
  try
    jpeg_destroy(cinfo);
    Result:=1;
  except
    Result:=0;
  end;
end;

type
  jpeg_alloc_sarray = function(cinfo: PRJpegCommonStruct; pool_id: Integer; samplesperrow: Cardinal; numrows: Cardinal): Pointer; cdecl;

function TIFFcalljpeg_alloc_sarray(alloc_sarray: jpeg_alloc_sarray; cinfo: PRJpegCommonStruct; pool_id: Integer; samplesperrow: Cardinal;
                    numrows: Cardinal): Pointer; cdecl;
begin
  try
    Result:=alloc_sarray(cinfo,pool_id,samplesperrow,numrows);
  except
    Result:=nil;
  end;
end;

function  TIFFInitJPEG(tif: PTIFF; scheme: Integer): Integer; cdecl; external;

{$IFDEF LIBTIFF_DEBUG}
{$L LibTiffDelphi\debug\tif_jpeg.obj}
{$ELSE}
{$L LibTiffDelphi\release\tif_jpeg.obj}
{$ENDIF}

{tif_luv}

function  TIFFInitSGILog(tif: PTIFF; scheme: Integer): Integer; cdecl; external;

{$IFDEF LIBTIFF_DEBUG}
{$L LibTiffDelphi\debug\tif_luv.obj}
{$ELSE}
{$L LibTiffDelphi\release\tif_luv.obj}
{$ENDIF}

{tif_lzw}

function  TIFFInitLZW(tif: PTIFF; scheme: Integer): Integer; cdecl; external;

{$IFDEF LIBTIFF_DEBUG}
{$L LibTiffDelphi\debug\tif_lzw.obj}
{$ELSE}
{$L LibTiffDelphi\release\tif_lzw.obj}
{$ENDIF}

{tif_next}

function  TIFFInitNeXT(tif: PTIFF; scheme: Integer): Integer; cdecl; external;

{$IFDEF LIBTIFF_DEBUG}
{$L LibTiffDelphi\debug\tif_next.obj}
{$ELSE}
{$L LibTiffDelphi\release\tif_next.obj}
{$ENDIF}

{tif_packbits}

function  TIFFInitPackBits(tif: PTIFF; scheme: Integer): Integer; cdecl; external;

{$IFDEF LIBTIFF_DEBUG}
{$L LibTiffDelphi\debug\tif_packbits.obj}
{$ELSE}
{$L LibTiffDelphi\release\tif_packbits.obj}
{$ENDIF}

{tif_pixarlog}

function  TIFFInitPixarLog(tif: PTIFF; scheme: Integer): Integer; cdecl; external;

{$IFDEF LIBTIFF_DEBUG}
{$L LibTiffDelphi\debug\tif_pixarlog.obj}
{$ELSE}
{$L LibTiffDelphi\release\tif_pixarlog.obj}
{$ENDIF}

{tif_thunder}

function  TIFFInitThunderScan(tif: PTIFF; scheme: Integer): Integer; cdecl; external;

{$IFDEF LIBTIFF_DEBUG}
{$L LibTiffDelphi\debug\tif_thunder.obj}
{$ELSE}
{$L LibTiffDelphi\release\tif_thunder.obj}
{$ENDIF}

{tif_version}

{$IFDEF LIBTIFF_DEBUG}
{$L LibTiffDelphi\debug\tif_version.obj}
{$ELSE}
{$L LibTiffDelphi\release\tif_version.obj}
{$ENDIF}

{tif_zip}

function  TIFFInitZIP(tif: PTIFF; scheme: Integer): Integer; cdecl; external;

{$IFDEF LIBTIFF_DEBUG}
{$L LibTiffDelphi\debug\tif_zip.obj}
{$ELSE}
{$L LibTiffDelphi\release\tif_zip.obj}
{$ENDIF}

{tif_codec}

function NotConfigured(tif: PTIFF; scheme: Integer): Integer; cdecl; external;

const

  _TIFFBuiltinCODECS: array[0..17] of TIFFCodec = (
       (name:'None'; scheme: COMPRESSION_NONE; init: TIFFInitDumpMode),
       (name:'LZW'; scheme: COMPRESSION_LZW; init: TIFFInitLZW),
       (name:'PackBits'; scheme: COMPRESSION_PACKBITS; init: TIFFInitPackBits),
       (name:'ThunderScan'; scheme: COMPRESSION_THUNDERSCAN; init: TIFFInitThunderScan),
       (name:'NeXT'; scheme: COMPRESSION_NEXT; init: TIFFInitNeXT),
       (name:'JPEG'; scheme: COMPRESSION_JPEG; init: TIFFInitJPEG),
       (name:'Old-style JPEG'; scheme: COMPRESSION_OJPEG; init: NotConfigured),
       (name:'CCITT RLE'; scheme: COMPRESSION_CCITTRLE; init: TIFFInitCCITTRLE),
       (name:'CCITT RLE/W'; scheme: COMPRESSION_CCITTRLEW; init: TIFFInitCCITTRLEW),
       (name:'CCITT Group 3'; scheme: COMPRESSION_CCITTFAX3; init: TIFFInitCCITTFax3),
       (name:'CCITT Group 4'; scheme: COMPRESSION_CCITTFAX4; init: TIFFInitCCITTFax4),
       (name:'ISO JBIG'; scheme: COMPRESSION_JBIG; init: NotConfigured),
       (name:'Deflate'; scheme: COMPRESSION_DEFLATE; init: TIFFInitZIP),
       (name:'AdobeDeflate'; scheme: COMPRESSION_ADOBE_DEFLATE; init: TIFFInitZIP),
       (name:'PixarLog'; scheme: COMPRESSION_PIXARLOG; init: TIFFInitPixarLog),
       (name:'SGILog'; scheme: COMPRESSION_SGILOG; init: TIFFInitSGILog),
       (name:'SGILog24'; scheme: COMPRESSION_SGILOG24; init: TIFFInitSGILog),
       (name:nil; scheme:0; init:nil));

{$IFDEF LIBTIFF_DEBUG}
{$L LibTiffDelphi\debug\tif_codec.obj}
{$ELSE}
{$L LibTiffDelphi\release\tif_codec.obj}
{$ENDIF}

{LibTiffDelphi}

function  TIFFFileReadProc(Fd: Cardinal; Buffer: Pointer; Size: Integer): Integer; cdecl; forward;
function  TIFFFileWriteProc(Fd: Cardinal; Buffer: Pointer; Size: Integer): Integer; cdecl; forward;
function  TIFFFileSizeProc(Fd: Cardinal): Cardinal; cdecl; forward;
function  TIFFFileSeekProc(Fd: Cardinal; Off: Cardinal; Whence: Integer): Cardinal; cdecl; forward;
function  TIFFFileCloseProc(Fd: Cardinal): Integer; cdecl; forward;

function  TIFFStreamReadProc(Fd: Cardinal; Buffer: Pointer; Size: Integer): Integer; cdecl; forward;
function  TIFFStreamWriteProc(Fd: Cardinal; Buffer: Pointer; Size: Integer): Integer; cdecl; forward;
function  TIFFStreamSizeProc(Fd: Cardinal): Cardinal; cdecl; forward;
function  TIFFStreamSeekProc(Fd: Cardinal; Off: Cardinal; Whence: Integer): Cardinal; cdecl; forward;
function  TIFFStreamCloseProc(Fd: Cardinal): Integer; cdecl; forward;

function  TIFFNoMapProc(Fd: Cardinal; PBase: PPointer; PSize: PCardinal): Integer; cdecl; forward;
procedure TIFFNoUnmapProc(Fd: Cardinal; Base: Pointer; Size: Cardinal); cdecl; forward;

function TIFFFileCloseProc(Fd: Cardinal): Integer; cdecl;
begin
  if CloseHandle(Fd)=True then
    Result:=0
  else
    Result:=-1;
end;

function TIFFFileSizeProc(Fd: Cardinal): Cardinal; cdecl;
begin
  Result:=GetFileSize(Fd,nil);
end;

function TIFFFileSeekProc(Fd: Cardinal; Off: Cardinal; Whence: Integer): Cardinal; cdecl;
const
  SEEK_SET = 0;
  SEEK_CUR = 1;
  SEEK_END = 2;
var
  MoveMethod: Cardinal;
begin
  if Off=$ffffffff then
  begin
    Result:=$ffffffff;
    exit;
  end;
  case Whence of
    SEEK_SET: MoveMethod:=FILE_BEGIN;
    SEEK_CUR: MoveMethod:=FILE_CURRENT;
    SEEK_END: MoveMethod:=FILE_END;
  else
    MoveMethod:=FILE_BEGIN;
  end;
  Result:=SetFilePointer(Fd,Off,nil,MoveMethod);
end;

function TIFFFileReadProc(Fd: Cardinal; Buffer: Pointer; Size: Integer): Integer; cdecl;
var
  m: Cardinal;
begin
  if ReadFile(Fd,Buffer^,Cardinal(Size),m,nil)=False then
    Result:=0
  else
    Result:=m;
end;

function TIFFFileWriteProc(Fd: Cardinal; Buffer: Pointer; Size: Integer): Integer; cdecl;
var
  m: Cardinal;
begin
  if WriteFile(Fd,Buffer^,Cardinal(Size),m,nil)=False then
    Result:=0
  else
    Result:=m;
end;

function TIFFStreamCloseProc(Fd: Cardinal): Integer; cdecl;
begin
  Result:=0;
end;

function TIFFStreamSizeProc(Fd: Cardinal): Cardinal; cdecl;
begin
  try
    Result:=TStream(Fd).Size;
  except
    Result:=0;
  end;
end;

function TIFFStreamSeekProc(Fd: Cardinal; Off: Cardinal; Whence: Integer): Cardinal; cdecl;
const
  SEEK_SET = 0;
  SEEK_CUR = 1;
  SEEK_END = 2;
var
  MoveMethod: Word;
begin
  if Off=$ffffffff then
  begin
    Result:=$ffffffff;
    exit;
  end;
  case Whence of
    SEEK_SET: MoveMethod:=soFromBeginning;
    SEEK_CUR: MoveMethod:=soFromCurrent;
    SEEK_END: MoveMethod:=soFromEnd;
  else
    MoveMethod:=soFromBeginning;
  end;
  try
    Result:=TStream(Fd).Seek(Off,MoveMethod);
  except
    Result:=0;
  end;
end;

function TIFFStreamReadProc(Fd: Cardinal; Buffer: Pointer; Size: Integer): Integer; cdecl;
begin
  try
    Result:=TStream(Fd).Read(Buffer^,Size);
  except
    Result:=0;
  end;
end;

function TIFFStreamWriteProc(Fd: Cardinal; Buffer: Pointer; Size: Integer): Integer; cdecl;
begin
  try
    Result:=TStream(Fd).Write(Buffer^,Size);
  except
    Result:=0;
  end;
end;

function TIFFNoMapProc(Fd: Cardinal; PBase: PPointer; PSize: PCardinal): Integer; cdecl;
begin
  Result:=0;
end;

procedure TIFFNoUnmapProc(Fd: Cardinal; Base: Pointer; Size: Cardinal); cdecl;
begin
end;

function TIFFOpen(const Name: String; const Mode: String): PTIFF;
const
  Module: String = 'TIFFOpen';
  O_RDONLY = 0;
  O_WRONLY = 1;
  O_RDWR = 2;
  O_CREAT = $0100;
  O_TRUNC = $0200;
var
  m: Integer;
  DesiredAccess: Cardinal;
  CreateDisposition: Cardinal;
  FlagsAndAttributes: Cardinal;
  fd: THandle;
begin
  m:=_TIFFgetMode(PChar(Mode),PChar(Module));
  if m=o_RDONLY then
    DesiredAccess:=GENERIC_READ
  else
    DesiredAccess:=(GENERIC_READ or GENERIC_WRITE);
  case m of
    O_RDONLY: CreateDisposition:=OPEN_EXISTING;
    O_RDWR: CreateDisposition:=OPEN_ALWAYS;
    (O_RDWR or O_CREAT): CreateDisposition:=OPEN_ALWAYS;
    (O_RDWR or O_TRUNC): CreateDisposition:=CREATE_ALWAYS;
    (O_RDWR or O_CREAT or O_TRUNC): CreateDisposition:=CREATE_ALWAYS;
  else
    Result:=nil;
    exit;
  end;
  if m=O_RDONLY then
    FlagsAndAttributes:=FILE_ATTRIBUTE_READONLY
  else
    FlagsAndAttributes:=FILE_ATTRIBUTE_NORMAL;
  fd:=CreateFile(PChar(Name),DesiredAccess,FILE_SHARE_READ,nil,CreateDisposition,FlagsAndAttributes,0);
  if fd=INVALID_HANDLE_VALUE then
  begin
    TiffError(PChar(Module),PChar('%s: Cannot open'),PChar(Name));
    Result:=nil;
    exit;
  end;
  Resu