tiflzw.pas

·ImageEn 2.3.0 ImageEn一组用于图像处理、查看和分析的Delphi控件。能够保存几种图像格式

unit tiflzw;

{$R-}
{$Q-}

// Example of TIFF-LZW decompression plug-in for ImageEn

{$I ie.inc}

interface

uses Windows, classes, sysutils, hyieutils;

function TIFFLZWDecompress(CompBuf: pbyte; LineSize: integer; var Id: integer): pbyte;
procedure TIFFLZWCompress(indata: pbyte; inputlen: integer; outstream: TStream; var id: integer);

implementation

{$R-}

const
  EOICODE = 257;
  CLEARCODE = 256;
  MAXPREALLOC = 8; // preallocated byte (min 3) (great is more quick)

type

  // string table
  TSItem = record
    Data: pbyte;
    Dim: integer;
    PreAlloc: array[0..MAXPREALLOC - 1] of byte; // preallocated bytes
  end;
  PSItem = ^TSItem;

  // LZW decompressor record
  TTIFLZWDec = record
    // single row decompressed (in-class allocated)
    fDecomp: pbyte;
    // compressed buffer (out-class allocated)
    fComp: pbyte;
    // row length in bytes. fComp is decompressed in blocks of fLineSize
    fLineSize: integer;
    // Position (in bit) of next code to read
    fNextCode: integer;
    // Length of current code
    fDimCode: integer;
    // position of next byte to write in fDecomp
    fWPos: integer;
    //
    OldCode: integer;
    // String table
    STableSize: integer; // number of elements in STable
    STable: array[0..4096] of TSItem; // max 12 bit
    //
    Aborting: boolean;
  end;
  PTIFLZWDec = ^TTIFLZWDec;

  ///////////////////////////////////////////////////////////////////////////////////////
  // return next code from fComp (based on fNextCode and fDimCode)
  // Note: fDimCode is from 9 to 12

function GetNextCode(plzw: PTIFLZWDec): integer;
var
  posb: integer;
begin
  with plzw^ do
  begin
    posb := (fNextCode shr 3); // position of initial byte (divide per 8)
    result := pinteger(@pbytearray(fComp)^[posb])^;
    // invert bytes of the word
    asm
	   	mov EAX,@result
	   	bswap EAX
	      mov @result,EAX

    end;
    result := (result shl (fNextCode and 7)) shr (32 - fDimCode);
    inc(fNextCode, fDimCode);
  end;
end;

///////////////////////////////////////////////////////////////////////////////////////
// Free table memory

procedure FreeTable(plzw: PTIFLZWDec);
var
  q: integer;
begin
  with plzw^ do
  begin
    for q := 256 to STableSize - 1 do
      if STable[q].Dim > MAXPREALLOC then
        freemem(STable[q].Data); // free string
    STableSize := 0;
  end;
end;

///////////////////////////////////////////////////////////////////////////////////////
// Init table

procedure InitializeTable(plzw: PTIFLZWDec);
begin
  FreeTable(plzw); // free table if allocated
  plzw^.STableSize := 258;
  plzw^.fDimCode := 9;
end;

///////////////////////////////////////////////////////////////////////////////////////
// CreateString + PutString + DestroyString / optimized

procedure PutCode(plzw: PTIFLZWDec; code: integer);
begin
  with plzw^ do
  begin
    if Aborting then
      exit;
    if code >= STableSize then
    begin
      Aborting := True;
      exit;
    end;
    if code < 256 then
    begin
      pbytearray(fDecomp)^[fWPos] := code;
      inc(fWPos);
    end
    else
      with STable[code] do
      begin
        CopyMemory(@(pbytearray(fDecomp)^[fWPos]), Data, Dim);
        inc(fWPos, Dim);
      end;
  end;
end;

///////////////////////////////////////////////////////////////////////////////////////
// Adds to table OldCode + the first char in Code

procedure AddConcatToTable(plzw: PTIFLZWDec; Code, OldCode: integer);
var
  sz: integer;
begin
  with plzw^ do
  begin
    if Aborting then
      exit;
    with STable[STableSize] do
    begin
      if OldCode < 256 then
      begin
        sz := 1;
        Dim := 2;
        Data := @PreAlloc;
        pbytearray(Data)^[0] := OldCode;
      end
      else
      begin
        if OldCode >= STableSize then
        begin
          Aborting := True;
          exit;
        end;
        sz := STable[OldCode].Dim;
        Dim := sz + 1;
        if Dim > MAXPREALLOC then
          getmem(Data, Dim)
        else
          Data := @PreAlloc;
        CopyMemory(Data, STable[OldCode].Data, sz);
      end;
      if Code < 256 then
        pbytearray(Data)^[sz] := Code
      else
      begin
        if Code >= STableSize then
        begin
          Aborting := True;
          exit;
        end;
        pbytearray(Data)^[sz] := STable[Code].Data^; // first char
      end;
    end;
    inc(STableSize);
    case STableSize of
      511: fDimCode := 10;
      1023: fDimCode := 11;
      2047: fDimCode := 12;
    end;
    if STableSize > high(STable) then
    begin
      Aborting := True;
      exit;
    end;
  end;
end;

///////////////////////////////////////////////////////////////////////////////////////
// decompress fLineSize bytes

function GetNextline(plzw: PTIFLZWDec): pbyte;
var
  Code: integer;
begin
  with plzw^ do
  begin
    if fWPos > fLineSize then
    begin
      // copy the rest of previous row
        //CopyMemory(fDecomp,@(pbytearray(fDecomp)^[fLineSize]),fWPos-fLineSize);
      move(pbytearray(fDecomp)^[fLineSize], fDecomp^, fWPos - fLineSize);
      fWPos := fWPos - fLineSize;
    end
    else
      fWPos := 0;
    while fWPos < fLineSize do
    begin
      Code := GetNextCode(plzw);
      if OldCode = -1 then
        OldCode := Code;
      if Code = CLEARCODE then
      begin
        InitializeTable(plzw);
        Code := GetNextCode(plzw);
        if Code = EOICODE then
          break;
        PutCode(plzw, Code);
        OldCode := Code;
      end
      else if Code = EOICODE then
        break
      else
      begin
        if Code < STableSize then
        begin
          PutCode(plzw, Code);
          AddConcatToTable(plzw, Code, OldCode);
          OldCode := Code;
        end
        else
        begin
          AddConcatToTable(plzw, OldCode, OldCode);
          PutCode(plzw, STableSize - 1);
          OldCode := Code;
        end;
      end;
      if Aborting then
      begin
        result := nil;
        exit;
      end;
    end;
    result := fDecomp;
  end;
end;

///////////////////////////////////////////////////////////////////////////////////////
// buf = compressed buffer data
// LineSize = length of one line in buf (in bytes)

function CreateLzw(buf: pbyte; LineSize: integer): PTIFLZWDec;
begin
  result := allocmem(sizeof(TTIFLZWDec)); // zero filled
  with result^ do
  begin
    getmem(fDecomp, LineSize * 50); // *5 (CRITICAL !!!)
    fComp := buf;
    fLineSize := LineSize;
    fNextCode := 0;
    InitializeTable(result);
    OldCode := -1;
    fWPos := 0;
    Aborting := false;
  end;
end;

///////////////////////////////////////////////////////////////////////////////////////

procedure DestroyLzw(plzw: PTIFLZWDec);
begin
  FreeTable(plzw);
  freemem(plzw^.fDecomp);
  freemem(plzw);
end;

///////////////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////////////
// CompBuf: compressed buf (of full image)
// LineSize: row size in bytes (this isn't the size of the image)
// Id: is a reference variable (where I store the pointer to TTIFLZWDec object)
// IMPORTANT:
//		- In the first call "Id" is ZERO.
//    - In the nexts call "Id" will be the some returned in the first call
//		- In the last call "CompBuf" will be NIL (you will free your allocated objects)
// rest: the decompressed row (you have not to free it) or nil if error detected

function TIFFLZWDecompress(CompBuf: pbyte; LineSize: integer; var Id: integer): pbyte;
var
  plzw: PTIFLZWDec;
begin
  result := nil;
  if Id <> 0 then
  begin
    plzw := PTIFLZWDec(Id);
    if CompBuf = nil then
    begin
      DestroyLzw(plzw);
      exit; // EXIT POINT
    end;
  end
  else
  begin
    plzw := CreateLzw(CompBuf, LineSize);
    Id := integer(plzw);
  end;
  if assigned(plzw) then
    result := GetNextLine(plzw);
end;

/////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////