spzlib.pas

DynamicSkinForm.v9.15.For.Delphi.BCB 很好的皮肤控件

    $01ff, $03ff, $07ff, $0fff, $1fff, $3fff, $7fff, $ffff);

{procedure GRABBITS(j : int);}
{procedure DUMPBITS(j : int);}
{procedure NEEDBITS(j : int);}


const
  LENGTH_CODES = 29;
  LITERALS = 256;
  L_CODES = (LITERALS+1+LENGTH_CODES);
  D_CODES = 30;
  BL_CODES = 19;
  HEAP_SIZE = (2*L_CODES+1);
  MAX_BITS = 15;

  INIT_STATE =  42;
  BUSY_STATE =  113;
  FINISH_STATE = 666;

type
  ct_data_ptr = ^ct_data;
  ct_data = record
    fc : record
      case byte of
      0:(freq : ush);       { frequency count }
      1:(code : ush);       { bit string }
    end;
    dl : record
      case byte of
      0:(dad : ush);        { father node in Huffman tree }
      1:(len : ush);        { length of bit string }
    end;
  end;

  ltree_type = array[0..HEAP_SIZE-1] of ct_data;    { literal and length tree }
  dtree_type = array[0..2*D_CODES+1-1] of ct_data;  { distance tree }
  htree_type = array[0..2*BL_CODES+1-1] of ct_data;  { Huffman tree for bit lengths }
  { generic tree type }
  tree_type = array[0..(MaxInt div SizeOf(ct_data))-1] of ct_data;

  tree_ptr = ^tree_type;
  ltree_ptr = ^ltree_type;
  dtree_ptr = ^dtree_type;
  htree_ptr = ^htree_type;


  static_tree_desc_ptr = ^static_tree_desc;
  static_tree_desc =
         record
    {const} static_tree : tree_ptr;     { static tree or NIL }
    {const} extra_bits : pzIntfArray;   { extra bits for each code or NIL }
            extra_base : int;           { base index for extra_bits }
            elems : int;                { max number of elements in the tree }
            max_length : int;           { max bit length for the codes }
          end;

  tree_desc_ptr = ^tree_desc;
  tree_desc = record
    dyn_tree : tree_ptr;    { the dynamic tree }
    max_code : int;            { largest code with non zero frequency }
    stat_desc : static_tree_desc_ptr; { the corresponding static tree }
  end;

  Pos = ush;
  Posf = Pos; {FAR}
  IPos = uInt;

  pPosf = ^Posf;

  zPosfArray = array[0..(MaxInt div SizeOf(Posf))-1] of Posf;
  pzPosfArray = ^zPosfArray;

  deflate_state_ptr = ^deflate_state;
  deflate_state = record
    strm : z_streamp;          { pointer back to this zlib stream }
    status : int;              { as the name implies }
    pending_buf : pzByteArray; { output still pending }
    pending_buf_size : ulg;    { size of pending_buf }
    pending_out : pBytef;      { next pending byte to output to the stream }
    pending : int;             { nb of bytes in the pending buffer }
    noheader : int;            { suppress zlib header and adler32 }
    data_type : Byte;          { UNKNOWN, BINARY or ASCII }
    method : Byte;             { STORED (for zip only) or DEFLATED }
    last_flush : int;          { value of flush param for previous deflate call }


    w_size : uInt;             { LZ77 window size (32K by default) }
    w_bits : uInt;             { log2(w_size)  (8..16) }
    w_mask : uInt;             { w_size - 1 }

    window : pzByteArray;
    window_size : ulg;

    prev : pzPosfArray;

    head : pzPosfArray;    { Heads of the hash chains or NIL. }

    ins_h : uInt;          { hash index of string to be inserted }
    hash_size : uInt;      { number of elements in hash table }
    hash_bits : uInt;      { log2(hash_size) }
    hash_mask : uInt;      { hash_size-1 }

    hash_shift : uInt;

    block_start : long;

    match_length : uInt;           { length of best match }
    prev_match : IPos;             { previous match }
    match_available : boolean;     { set if previous match exists }
    strstart : uInt;               { start of string to insert }
    match_start : uInt;            { start of matching string }
    lookahead : uInt;              { number of valid bytes ahead in window }

    prev_length : uInt;

    max_chain_length : uInt;

    level : int;    { compression level (1..9) }
    strategy : int; { favor or force Huffman coding}

    good_match : uInt;

    nice_match : int; { Stop searching when current match exceeds this }

    dyn_ltree : ltree_type;    { literal and length tree }
    dyn_dtree : dtree_type;  { distance tree }
    bl_tree : htree_type;   { Huffman tree for bit lengths }

    l_desc : tree_desc;                { desc. for literal tree }
    d_desc : tree_desc;                { desc. for distance tree }
    bl_desc : tree_desc;               { desc. for bit length tree }

    bl_count : array[0..MAX_BITS+1-1] of ush;

    heap : array[0..2*L_CODES+1-1] of int; { heap used to build the Huffman trees }
    heap_len : int;                   { number of elements in the heap }
    heap_max : int;                   { element of largest frequency }

    depth : array[0..2*L_CODES+1-1] of uch;

    l_buf : puchfArray;       { buffer for literals or lengths }

    lit_bufsize : uInt;

    last_lit : uInt;      { running index in l_buf }

    d_buf : pushfArray;

    opt_len : ulg;        { bit length of current block with optimal trees }
    static_len : ulg;     { bit length of current block with static trees }
    compressed_len : ulg; { total bit length of compressed file }
    matches : uInt;       { number of string matches in current block }
    last_eob_len : int;   { bit length of EOB code for last block }

    bi_buf : ush;

    bi_valid : int;

    case byte of
    0:(max_lazy_match : uInt);

    1:(max_insert_length : uInt);
  end;

procedure _tr_init (var s : deflate_state);

function _tr_tally (var s : deflate_state;
                    dist : unsigned;
                    lc : unsigned) : boolean;

function _tr_flush_block (var s : deflate_state;
                          buf : pcharf;
                          stored_len : ulg;
			  eof : boolean) : ulg;

procedure _tr_align(var s : deflate_state);

procedure _tr_stored_block(var s : deflate_state;
                           buf : pcharf;
                           stored_len : ulg;
                           eof : boolean);


implementation

{$IFDEF CALLDOS}
{ reduce your application memory footprint with $M before using this }
function dosAlloc (Size : Longint) : Pointer;
var
  regs: TRegisters;
begin
  regs.bx := (Size + 15) div 16; { number of 16-bytes-paragraphs }
  regs.ah := $48;                { Allocate memory block }
  msdos(regs);
  if regs.Flags and FCarry <> 0 then
    DosAlloc := NIL
  else
    DosAlloc := Ptr(regs.ax, 0);
end;


function dosFree(P : pointer) : boolean;
var
  regs: TRegisters;
begin
  dosFree := FALSE;
  regs.bx := Seg(P^);             { segment }
  if Ofs(P) <> 0 then
    exit;
  regs.ah := $49;                { Free memory block }
  msdos(regs);
  dosFree := (regs.Flags and FCarry = 0);
end;
{$ENDIF}

type
  LH = record
    L, H : word;
  end;

{$IFDEF HugeMem}
  {$define HEAP_LIST}
{$endif}

{$IFDEF HEAP_LIST} {--- to avoid Mark and Release --- }
const
  MaxAllocEntries = 50;
type
  TMemRec = record
    orgvalue,
    value : pointer;
    size: longint;
  end;
const
  allocatedCount : 0..MaxAllocEntries = 0;
var
  allocatedList : array[0..MaxAllocEntries-1] of TMemRec;

 function NewAllocation(ptr0, ptr : pointer; memsize : longint) : boolean;
 begin
   if (allocatedCount < MaxAllocEntries) and (ptr0 <> NIL) then
   begin
     with allocatedList[allocatedCount] do
     begin
       orgvalue := ptr0;
       value := ptr;
       size := memsize;
     end;
     Inc(allocatedCount);  { we don't check for duplicate }
     NewAllocation := TRUE;
   end
   else
     NewAllocation := FALSE;
 end;
{$ENDIF}

{$IFDEF HugeMem}

{ The code below is extremely version specific to the TP 6/7 heap manager!!}
type
  PFreeRec = ^TFreeRec;
  TFreeRec = record
    next: PFreeRec;
    size: Pointer;
  end;
type
  HugePtr = voidpf;


 procedure IncPtr(var p:pointer;count:word);
 { Increments pointer }
 begin
   inc(LH(p).L,count);
   if LH(p).L < count then
     inc(LH(p).H,SelectorInc);  { $1000 }
 end;

 procedure DecPtr(var p:pointer;count:word);
 { decrements pointer }
 begin
   if count > LH(p).L then
     dec(LH(p).H,SelectorInc);
   dec(LH(p).L,Count);
 end;

 procedure IncPtrLong(var p:pointer;count:longint);
 { Increments pointer; assumes count > 0 }
 begin
   inc(LH(p).H,SelectorInc*LH(count).H);
   inc(LH(p).L,LH(Count).L);
   if LH(p).L < LH(count).L then
     inc(LH(p).H,SelectorInc);
 end;

 procedure DecPtrLong(var p:pointer;count:longint);
 { Decrements pointer; assumes count > 0 }
 begin
   if LH(count).L > LH(p).L then
     dec(LH(p).H,SelectorInc);
   dec(LH(p).L,LH(Count).L);
   dec(LH(p).H,SelectorInc*LH(Count).H);
 end;
 { The next section is for real mode only }

function Normalized(p : pointer)  : pointer;
var
  count : word;
begin
  count := LH(p).L and $FFF0;
  Normalized := Ptr(LH(p).H + (count shr 4), LH(p).L and $F);
end;

procedure FreeHuge(var p:HugePtr; size : longint);
const
  blocksize = $FFF0;
var
  block : word;
begin
  while size > 0 do
  begin
    { block := minimum(size, blocksize); }
    if size > blocksize then
      block := blocksize
    else
      block := size;

    dec(size,block);
    freemem(p,block);
    IncPtr(p,block);    { we may get ptr($xxxx, $fff8) and 31 bytes left }
    p := Normalized(p); { to free, so we must normalize }
  end;
end;

function FreeMemHuge(ptr : pointer) : boolean;
var
  i : integer; { -1..MaxAllocEntries }
begin
  FreeMemHuge := FALSE;
  i := allocatedCount - 1;
  while (i >= 0) do
  begin
    if (ptr = allocatedList[i].value) then
    begin
      with allocatedList[i] do
        FreeHuge(orgvalue, size);

      Move(allocatedList[i+1], allocatedList[i],
           SizeOf(TMemRec)*(allocatedCount - 1 - i));
      Dec(allocatedCount);
      FreeMemHuge := TRUE;
      break;
    end;
    Dec(i);
  end;
end;

procedure GetMemHuge(var p:HugePtr;memsize:Longint);
const
  blocksize = $FFF0;
var
  size : longint;