libtiffdelphi.pas

打开TIFF文件

  FillMemory(p,c,v);
end;

function bsearch(key: Pointer; base: Pointer; nelem: Cardinal; width: Cardinal; fcmp: TBsearchFcmp): Pointer; cdecl;
begin
  raise Exception.Create('LibTiffDelphi - call to bsearch - should presumably not occur');
end;

procedure qsort(base: Pointer; num: Cardinal; width: Cardinal; compare: TQSortCompare); cdecl;
var
  m: Pointer;
  n: Integer;
  o: Pointer;
  oa,ob,oc: Integer;
  p: Integer;
begin
  if num<2 then exit;
  GetMem(m,num*width);
  if compare(base,Pointer(Cardinal(base)+width))<=0 then
    CopyMemory(m,base,(width shl 1))
  else
  begin
    CopyMemory(m,Pointer(Cardinal(base)+width),width);
    CopyMemory(Pointer(Cardinal(m)+width),base,width);
  end;
  n:=2;
  while Cardinal(n)<num do
  begin
    o:=Pointer(Cardinal(base)+Cardinal(n)*width);
    if compare(m,o)>=0 then
      ob:=0
    else
    begin
      oa:=0;
      ob:=n;
      while oa+1<ob do
      begin
        oc:=((oa+ob) shr 1);
        p:=compare(Pointer(Cardinal(m)+Cardinal(oc)*width),o);
        if p<0 then
          oa:=oc
        else if p=0 then
        begin
          ob:=oc;
          break;
        end
        else
          ob:=oc;
      end;
    end;
    if ob=0 then
    begin
      MoveMemory(Pointer(Cardinal(m)+width),m,Cardinal(n)*width);
      CopyMemory(m,o,width);
    end
    else if ob=n then
      CopyMemory(Pointer(Cardinal(m)+Cardinal(n)*width),o,width)
    else
    begin
      MoveMemory(Pointer(Cardinal(m)+Cardinal(ob+1)*width),Pointer(Cardinal(m)+Cardinal(ob)*width),Cardinal(n-ob)*width);
      CopyMemory(Pointer(Cardinal(m)+Cardinal(ob)*width),o,width);
    end;
    Inc(n);
  end;
  CopyMemory(base,m,num*width);
  FreeMem(m,num*width);
end;

function _TIFFrealloc(p: Pointer; s: Longint): Pointer; cdecl;
var
  m: TMemoryManager;
begin
  GetMemoryManager(m);
  if p=nil then
    Result:=m.GetMem(s)
  else
    Result:=m.ReallocMem(p,s);
end;

function strncmp(a: Pointer; b: Pointer; c: Longint): Integer; cdecl;
var
  ma,mb: PByte;
  n: Integer;
begin
  ma:=a;
  mb:=b;
  n:=0;
  while n<c do
  begin
    if ma^<>mb^ then
    begin
      if ma^<mb^ then
        Result:=-1
      else
        Result:=1;
      exit;
    end;
    if ma^=0 then
    begin
      Result:=0;
      exit;
    end;
    Inc(ma);
    Inc(mb);
    Inc(n);
  end;
  Result:=0;
end;

function strcmp(a: Pointer; b: Pointer): Integer; cdecl;
var
  ma,mb: PByte;
begin
  ma:=a;
  mb:=b;
  while True do
  begin
    if ma^<>mb^ then
    begin
      if ma^<mb^ then
        Result:=-1
      else
        Result:=1;
      exit;
    end;
    if ma^=0 then
    begin
      Result:=0;
      exit;
    end;
    Inc(ma);
    Inc(mb);
  end;
  Result:=0;
end;

function strlen(s: Pointer): Cardinal; cdecl;
var
  m: PByte;
begin
  Result:=0;
  m:=s;
  while m^<>0 do
  begin
    Inc(Result);
    Inc(m);
  end;
end;

procedure _TIFFfree(p: Pointer); cdecl;
var
  m: TMemoryManager;
begin
  GetMemoryManager(m);
  m.FreeMem(p);
end;

procedure _TIFFmemcpy(d: Pointer; s: Pointer; c: Longint); cdecl;
begin
  CopyMemory(d,s,c);
end;

function pow(x: Double; y: Double): Double; cdecl;
begin
  Result:=Power(x,y);
end;

function floor(x: Double): Double; cdecl;
begin
  Result:=Trunc(x);
end;

function _TIFFmalloc(s: Longint): Pointer; cdecl;
var
  m: TMemoryManager;
begin
  GetMemoryManager(m);
  Result:=m.GetMem(s);
end;

{LibTiffDelphi}

function  LibTiffDelphiVersion: String;
var
  m: String;
  na,nb: Integer;
begin
  Result:='';
  m:=TIFFGetVersion;
  na:=1;
  while True do
  begin
    nb:=na;
    while nb<=Length(m) do
    begin
      if m[nb]=#10 then break;
      Inc(nb);
    end;
    Result:=Result+Copy(m,na,nb-na);
    if nb>Length(m) then break;
    Result:=Result+#13#10;
    na:=nb+1;
  end;
  Result:=Result+#13#10+LibTiffDelphiVersionString;
end;

procedure LibTiffDelphiWarningThrp(a: Pointer; b: Pointer; c: Pointer); cdecl;
var
  m: Integer;
  n: String;
begin
  if @FLibTiffDelphiWarningHandler<>nil then
  begin
    m:=sprintfsec(nil,b,@c);
    SetLength(n,m);
    sprintfsec(Pointer(n),b,@c);
    FLibTiffDelphiWarningHandler(PChar(a),n);
  end;
end;

procedure LibTiffDelphiErrorThrp(a: Pointer; b: Pointer; c: Pointer); cdecl;
var
  m: Integer;
  n: String;
begin
  if @FLibTiffDelphiErrorHandler<>nil then
  begin
    m:=sprintfsec(nil,b,@c);
    SetLength(n,m);
    sprintfsec(Pointer(n),b,@c);
    FLibTiffDelphiErrorHandler(PChar(a),n);
  end;
end;

function LibTiffDelphiGetWarningHandler: LibTiffDelphiErrorHandler;
begin
  Result:=FLibTiffDelphiWarningHandler;
end;

function LibTiffDelphiSetWarningHandler(Handler: LibTiffDelphiErrorHandler): LibTiffDelphiErrorHandler;
begin
  Result:=FLibTiffDelphiWarningHandler;
  FLibTiffDelphiWarningHandler:=Handler;
end;

function LibTiffDelphiGetErrorHandler: LibTiffDelphiErrorHandler;
begin
  Result:=FLibTiffDelphiErrorHandler;
end;

function LibTiffDelphiSetErrorHandler(Handler: LibTiffDelphiErrorHandler): LibTiffDelphiErrorHandler;
begin
  Result:=FLibTiffDelphiErrorHandler;
  FLibTiffDelphiErrorHandler:=Handler;
end;

{tif_read}

procedure _TIFFSwab16BitData(tif: Pointer; buf: Pointer; cc: Integer); cdecl; external;
procedure _TIFFSwab32BitData(tif: Pointer; buf: Pointer; cc: Integer); cdecl; external;
procedure _TIFFSwab64BitData(tif: Pointer; buf: Pointer; cc: Integer); cdecl; external;
procedure _TIFFNoPostDecode(tif: Pointer; buf: Pointer; cc: Integer); cdecl; external;
function  TIFFReadTile(tif: Pointer; buf: Pointer; x: Cardinal; y: Cardinal; z: Cardinal; s: Word): Integer; cdecl; external;

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

{tif_dirinfo}

function  _TIFFSampleToTagType(tif: Pointer): Integer; cdecl; external;
procedure _TIFFSetupFieldInfo(tif: Pointer); cdecl; external;
function  _TIFFCreateAnonFieldInfo(tif: Pointer; tag: Cardinal; field_type: Integer): Pointer; cdecl; external;

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

{tif_dirwrite}

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

{tif_flush}

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

{tif_write}

function  TIFFFlushData1(tif: Pointer): Integer; cdecl; external;
function  TIFFSetupStrips(tif: Pointer): Integer; cdecl; external;

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

{tif_dumpmode}

function  TIFFInitDumpMode(tif: Pointer; scheme: Integer): Integer; cdecl; external;

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

{tif_compress}

function  TIFFSetCompressionScheme(tif: Pointer; scheme: Integer): Integer; cdecl; external;
procedure _TIFFSetDefaultCompressionState(tif: Pointer); cdecl; external;

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

{tif_dirread}