uwinhelpfiles.pas

DelphiDoc is a program for automatic generation of documentation on a Delphi-Project. At the momen

        dec(run);                           //will compress also the end
        dec(len);                           //not a byte read
       end;

      inc(len);                           //another byte read
      if len > run then                  //enough bytes for chunk size reached?
       begin
        if match >= THRESHOLD then       //matching sequence already in buffer?
         begin
          buf[0] := Char(Ord(buf[0]) or mask);     //mark as a reference
                                                   //write reference and length
          PSmallInt(Integer(@buf) + size)^ := ((match - 3) shl 12) or
                                          ((index - matchpos - 1) and (N - 1));
          inc(Size, 2);                            //two other bytes in buffer
          dec(len, match);                         //some bytes processed
         end
        else
         begin
          buf[Size] := PChar(Integer(Buffer) + index)^; //write the simple byte
          inc(Size);                               //another byte in buffer
          dec(len);                                //one byte processed
         end;

        mask := mask shl 1;                 //move mask to the next bit
        if (mask and $FF) = 0 then          //all bits of byte used?
         begin
          ComprStream.WriteBuffer(buf, Size); //write current buffer
          Size := 1;                          //buffer empty besides index byte
          Mask := 1;                          //set mask to first bit again
          buf[0] := #0;                       //clear index byte
         end;
       end; //if len > run

      index := (index + 1) and (N - 1);   //increment current index in buffer

    until len <= 0;                     //until all bytes read and compressed

    assert(not Read);

    if Size > 1 then          //write buffer not empty (besides index byte)
     ComprStream.WriteBuffer(buf, Size);     //write the buffer

  finally
   FreeMem(Buffer);                     //free all used buffer/memory
  end;
 end;


 {Checks whether a stream was correctly compressed with the LZ77 algorithm.
 ~param Source      the original uncompressed data
 ~param ComprStream the compressed data }
 procedure ExpandCheck(Source, ComprStream: TStream);
 var       index      :Word;   //index in the buffer
           reference  :Word;   //index of reference inside the buffer
           len        :Word;   //number of references bytes
           bits       :Byte;   //index byte of data
           mask       :Byte;   //bit mask for each bit inside the index byte
           ch         :Byte;   //read data byte
           Buffer     :array[0..N - 1] of Byte;  //buffer to uncompress
 begin
  index := N - F;              //set index to the end of the buffer

  //while not all processed, get index byte
  while ComprStream.Read(bits, 1) = 1 do
   begin
    mask := $01;                 //first bit of the index byte
    while mask <> 0 do           //while not each bit processed
     begin
      if bits and mask <> 0 then   //is a reference?
       begin
        ComprStream.ReadBuffer(reference, 2);   //read reference and length
        len := ((reference shr 12) and 15) + 3; //extract the length and the
        reference := (index - (reference and $0FFF) - 1) and (N - 1); //index

        for len := 0 to len - 1 do   //for each referenced byte
         begin
          if Source.Read(Buffer[index], 1) <> 1 then //read original character
           assert(False);
          assert(Buffer[index] = Buffer[reference]);   //they have to be equal

          reference := (reference + 1) and (N - 1);    //increment reference
          index := (index + 1) and (N - 1);            //increment index
         end;
       end //if bits and mask <> 0
      else
       if ComprStream.Read(ch, 1) = 1 then     //just read one plain character
        begin
         if Source.Read(Buffer[index], 1) <> 1 then //read original character
          assert(False);
         assert(Buffer[index] = ch);             //they have to be equal

         index := (index + 1) and (N - 1);       //increment index
        end
       else
        mask := 0;                                //abort the loop

      mask := mask shl 1;                     //next bit in index byte
     end; //while mask <> 0
   end; //while ComprStream.Read(bits, 1) = 1

  assert(ComprStream.Read(ch, 1) = 0);    //sizes of the datas have to match
 end;

{$ENDIF}





var       Bytes      :Integer;   //number of bytes for each line
          CurLine    :PByte;     //each line in the bitmap

{$IFDEF UseRunLength}

var       BMPy       :Integer;   //counter through the lines/rows of the bitmap
          ByteIndex  :Integer;   //index of the byte in the lines

 {Gets a byte from the content of the bitmap.
 ~param TheByte the byte form the content (only if available) is returned
 ~result whether there was still a byte of data that could be returned }
 function GetNextByte(var TheByte: Byte): Boolean;
 begin
  if ByteIndex = Bytes then               //no data left in current line?
   begin
    Dec(BMPy);                              //go to the next line
    if BMPy >= 0 then                       //still a line available?
     begin
      CurLine := Bitmap.ScanLine[BMPy];       //get the next line
      ByteIndex := 0;                         //no bytes read yet
     end;
   end;
  Result := ByteIndex <> Bytes;           //return if some bytes available
  if Result then
   begin
    TheByte := CurLine^;                    //return the byte
    Inc(CurLine);                           //next byte
    Inc(ByteIndex);                         //one more byte read from line
   end;
 end;

{$ENDIF}



{$IFDEF UseSomeCompression}
          //content of bitmap compressed by the Run-Length algorithm
var       BMPContent :TMemoryStream;
{$ENDIF}

var       i          :Integer;   //general counter or index


{$IFDEF UseRunLength}
var       AByte      :Byte;      //a byte of the content of the bitmap
          B2, B3     :Byte;      //two other bytes from content of bitmap
          BufCount   :Integer;   //number of valid bytes in AByte, B2, B3
          WriteByte  :Byte;      //buffer to write the prefix byte
{$ENDIF}
begin
 Bytes := Bitmap.Width * 2;      //get number of bytes per line
 if Bitmap.PixelFormat = pf32bit then
  Bytes := Bytes * 2
 else
  Bytes := (Bytes + 3) and not 3;

{$IFDEF UseRunLength}
 BMPy := Bitmap.Height;          //start in the last line (+ 1)
 ByteIndex := Bytes;             //no data left (so get next line)
{$ENDIF}

{$IFDEF UseSomeCompression}
 BMPContent := TMemoryStream.Create; //create buffer for RunLength compressing
 try
{$ENDIF}



{$IFDEF UseRunLength}

   //
   //     compress content of bitmap with run-length compression
   //

   BufCount := 0;                  //no bytes read and buffered so far
   while (BufCount <> 0) or GetNextByte(AByte) do //while not all read
    begin
     if BufCount = 0 then            //is a byte was read in while-expression
      inc(BufCount);                   //one byte buffered
     if (BufCount < 2) and GetNextByte(B2) then     //we need three bytes
      inc(BufCount);
     if (BufCount < 3) and GetNextByte(B3) then
      inc(BufCount);
     if BufCount = 3 then                  //at least three bytes left?
      begin
       if AByte = B2 then                    //first two bytes are equal?
        begin
         WriteByte := $02;                     //two bytes equal so far
         if B3 = AByte then                    //third also the same value?
          begin
           inc(WriteByte);                       //loop until all read
           //read a maximum 127 = $7F bytes
           while (WriteByte < $7F) and GetNextByte(B3) and (B3 = AByte) do
            inc(WriteByte);
          end;
         BMPContent.WriteBuffer(WriteByte, 1); //write code of the same bytes
         BMPContent.WriteBuffer(AByte, 1);     //and the byte
         BufCount := Ord(B3 <> AByte);         //get number of buffered bytes
         AByte := B3;                          //assign read byte
        end
       else
        begin
         i := BMPContent.Position;             //get number of bytes position
         WriteByte := $81;                     //assume only one byte
         BMPContent.WriteBuffer(WriteByte, 1); //write this number
         BMPContent.WriteBuffer(AByte, 1);     //write the one byte

         AByte := B2;                          //advance buffer content
         B2 := B3;
         //loop until 127 = $7F bytes transfered or three bytes are equal
         while (WriteByte < $FF) and GetNextByte(B3) and
               ((B2 <> AByte) or (B2 <> B3)) do
          begin
           BMPContent.WriteBuffer(AByte, 1);     //write first byte in buffer
           AByte := B2;                          //advance bytes in buffer
           B2 := B3;
           inc(B3);                        //B2 and B3 have to be different!
           inc(WriteByte);                       //another byte transfered
          end;

         //end of file reached?
         if (WriteByte < $FF) and ((B2 <> AByte) or (B2 <> B3)) then
          begin
           BMPContent.WriteBuffer(AByte, 1);   //transfer byte from buffer
           inc(WriteByte);
           if WriteByte < $FF then             //another byte fits?
            begin
             BMPContent.WriteBuffer(B2, 1);      //write the last byte
             inc(WriteByte);
             BufCount := 0;                      //buffer empty
            end
           else
            begin
             AByte := B2;                        //buffer holds only the
             BufCount := 1;                      //second byte
            end;
          end
         else
          if WriteByte = $FF then              //maximum reached?
           BufCount := 2                         //only two bytes buffered
          else
           BufCount := 3;                        //three equal bytes

         //set code for the number of bytes
         PByte(Integer(BMPContent.Memory) + i)^ := WriteByte;
        end;
      end //if BufCount = 3
     else
      if (BufCount > 1) and (AByte = B2) then //two equal bytes?
       begin
        WriteByte := $02;                       //code for two equal bytes
        BMPContent.WriteBuffer(WriteByte, 1);   //write code
        BMPContent.WriteBuffer(AByte, 1);       //write the byte(s)
       end
      else
       begin
        WriteByte := $80 + BufCount;        //code with number of bytes left
        BMPContent.WriteBuffer(WriteByte, 1);   //write code
        BMPContent.WriteBuffer(AByte, 1);       //write first byte
        if BufCount > 1 then                    //second byte buffered?
         BMPContent.WriteBuffer(B2, 1);           //write it, too
       end;
    end; //while (BufCount <> 0) or GetNextByte(AByte)

{$ELSE}


   //just copy content of bitmap
   for i := Bitmap.Height - 1 downto 0 do    //for each line
    begin
     CurLine := Bitmap.ScanLine[i];            //get it
 {$IFDEF UseLZ77}
     BMPContent.WriteBuffer(CurLine^, Bytes);    //copy all pixels
 {$ELSE}
     Compressed.WriteBuffer(CurLine^, Bytes);    //copy all pixels
 {$ENDIF}
    end;

{$ENDIF}




{$IFDEF UseLZ77}

   //
   //     compress the compressed data with LZ77 now
   //

   BMPContent.Position := 0;          //reset compressed stream
   Compress(BMPContent, Compressed);  //compress it with LZ77


{
   BMPContent.Position := 0;          //reset compressed stream
   ExpandCheck(BMPContent, Compressed);  //check if compression is correct
}

{$ELSE}

 {$IFDEF UseRunLength}

   Compressed.CopyFrom(BMPContent, 0); //just copy RunLength compressed data

 {$ENDIF}

{$ENDIF}



{$IFDEF UseSomeCompression}
 finally
  BMPContent.Free;               //free RunLength compressed content
 end;
{$ENDIF}
end;