graphiccompression.pas

graphicex 增加对各种图形格式的支持

  AddCode(FBlackStates, 1, 11, G3_INVALID);
  AddCode(FBlackStates, 0, 12, G3_INVALID);
end;

//----------------- TCCITTFax3Decoder ----------------------------------------------------------------------------------

procedure TCCITTFax3Decoder.Decode(var Source, Dest: Pointer; PackedSize, UnpackedSize: Integer);

var
  RunLength: Integer;
  EOLCount: Integer;

  //--------------- local functions -------------------------------------------

  procedure SynchBOL;

  // synch bit stream to next line start

  var
    Count: Integer;

  begin
    // if no EOL codes have been read so far then do it now
    if EOLCount = 0 then
    begin
      // advance until 11 consecutive 0 bits have been found
      Count := 0;
      while (Count < 11) and (FPackedSize > 0) do
      begin
        if NextBit then Count := 0
                   else Inc(Count);
      end;
    end;

    // read 8 bit until at least one set bit is found
    repeat
      Count := 0;
      while (Count < 8) and (FPackedSize > 0) do
      begin
        if NextBit then Count := 9
                   else Inc(Count);
      end;
    until (Count > 8) or (FPackedSize = 0);

    // here we are already beyond the set bit and can restart scanning
    EOLCount := 0;
  end;

  //---------------------------------------------------------------------------

  procedure AdjustEOL;

  begin
    FIsWhite := False;
    if FFreeTargetBits in [1..7] then Inc(FTarget);
    FFreeTargetBits := 8;
    FRestWidth := FWidth;
  end;

  //--------------- end local functions ---------------------------------------

begin  
  // make all bits white
  FillChar(Dest^, UnpackedSize, 0);

  // swap all bits here, in order to avoid frequent tests in the main loop
  if FSwapBits then
  asm
         PUSH EBX
         LEA EBX, ReverseTable
         MOV ECX, [PackedSize]
         MOV EDX, [Source]
         MOV EDX, [EDX]
  @@1:
         MOV AL, [EDX]
         XLAT
         MOV [EDX], AL
         INC EDX
         DEC ECX
         JNZ @@1
         POP EBX
  end;

  // setup initial states
  // a row always starts with a (possibly zero-length) white run
  FSource := Source;
  FBitsLeft := 0;
  FPackedSize := PackedSize;

  // target preparation
  FTarget := Dest;
  FRestWidth := FWidth;
  FFreeTargetBits := 8;
  EOLCount := 0;

  // main loop
  repeat
    // synchronize to start of next line
    SynchBOL;
    // a line always starts with a white run
    FIsWhite := True;
    // decode one line
    repeat
      if FIsWhite then RunLength := FindWhiteCode
                  else RunLength := FindBlackCode;
      if RunLength >= 0 then
      begin
        if FillRun(RunLength) then Break;
        FIsWhite := not FIsWhite;
      end    
      else
        if RunLength = G3_EOL then Inc(EOLCount)
                              else Break;
    until (RunLength = G3_EOL) or (FPackedSize = 0);
    AdjustEOL;
  until (FPackedSize = 0) or (FTarget - PChar(Dest) >= UnpackedSize);
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TCCITTFax3Decoder.Encode(Source, Dest: Pointer; Count: Cardinal; var BytesStored: Cardinal);

begin

end;

//----------------- TCCITTMHDecoder ------------------------------------------------------------------------------------

procedure TCCITTMHDecoder.Decode(var Source, Dest: Pointer; PackedSize, UnpackedSize: Integer);

var
  RunLength: Integer;

  //--------------- local functions -------------------------------------------

  procedure AdjustEOL;

  begin
    FIsWhite := False;
    if FFreeTargetBits in [1..7] then Inc(FTarget);
    FFreeTargetBits := 8;
    FRestWidth := FWidth;
    if FBitsLeft < 8 then FBitsLeft := 0; // discard remaining bits
    if FWordAligned and Odd(Cardinal(FTarget)) then Inc(FTarget);
  end;

  //--------------- end local functions ---------------------------------------

begin
  // make all bits white
  FillChar(Dest^, UnpackedSize, 0);

  // swap all bits here, in order to avoid frequent tests in the main loop
  if FSwapBits then 
  asm
         PUSH EBX
         LEA EBX, ReverseTable
         MOV ECX, [PackedSize]
         MOV EDX, [Source]
         MOV EDX, [EDX]
  @@1:
         MOV AL, [EDX]
         XLAT
         MOV [EDX], AL
         INC EDX
         DEC ECX
         JNZ @@1
         POP EBX
  end;

  // setup initial states
  // a row always starts with a (possibly zero-length) white run
  FIsWhite := True;
  FSource := Source;
  FBitsLeft := 0;
  FPackedSize := PackedSize;

  // target preparation
  FTarget := Dest;
  FRestWidth := FWidth;
  FFreeTargetBits := 8;

  // main loop
  repeat
    if FIsWhite then RunLength := FindWhiteCode
                else RunLength := FindBlackCode;
    if RunLength > 0 then
      if FillRun(RunLength) then AdjustEOL;
    FIsWhite := not FIsWhite;
  until FPackedSize = 0;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TCCITTMHDecoder.Encode(Source, Dest: Pointer; Count: Cardinal; var BytesStored: Cardinal);

begin

end;

//----------------- TLZ77Decoder ---------------------------------------------------------------------------------------

constructor TLZ77Decoder.Create(FlushMode: Integer; AutoReset: Boolean);

begin
  FillChar(FStream, SizeOf(FStream), 0);
  FFlushMode := FlushMode;
  FAutoReset := AutoReset;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TLZ77Decoder.Decode(var Source, Dest: Pointer; PackedSize, UnpackedSize: Integer);

begin
  FStream.NextInput := Source;
  FStream.AvailableInput := PackedSize;
  if FAutoReset then FZLibResult := InflateReset(FStream);
  if FZLibResult = Z_OK then
  begin
    FStream.NextOutput := Dest;
    FStream.AvailableOutput := UnpackedSize;
    FZLibResult := Inflate(FStream, FFlushMode);
    // advance pointers so used input can be calculated
    Source := FStream.NextInput;
    Dest := FStream.NextOutput;
  end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TLZ77Decoder.DecodeEnd;

begin
  if InflateEnd(FStream) < 0 then CompressionError(gesLZ77Error);
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TLZ77Decoder.DecodeInit;

begin
  if InflateInit(FStream) < 0 then CompressionError(gesLZ77Error);
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TLZ77Decoder.Encode(Source, Dest: Pointer; Count: Cardinal; var BytesStored: Cardinal);

begin

end;

//----------------------------------------------------------------------------------------------------------------------

function TLZ77Decoder.GetAvailableInput: Integer;

begin
  Result := FStream.AvailableInput;
end;

//----------------------------------------------------------------------------------------------------------------------

function TLZ77Decoder.GetAvailableOutput: Integer;

begin
  Result := FStream.AvailableOutput;
end;

//----------------- TTIFFJPEGDecoder ---------------------------------------------------------------------------------------


// Libjpeg interface layer needed to provide access from the JPEG coder class.

// This routine is invoked only for warning messages, since error_exit does its own thing
// and trace_level is never set > 0.

procedure Internaljpeg_output_message(cinfo: j_common_ptr);

var
  Buffer: array[0..JMSG_LENGTH_MAX] of Char;
  State: PJPEGState;

begin
  State := Pointer(cinfo);
	State.Error.format_message(@State.General.common, Buffer);
  MessageBox(0, Buffer, PChar(gesWarning), MB_OK or MB_ICONWARNING);
end;

//----------------------------------------------------------------------------------------------------------------------
{
procedure Internaljpeg_create_compress(var State: TJPEGState);

begin
	// initialize JPEG error handling
  State.General.Common.err := @State.Error;
	State.Error.output_message := Internaljpeg_output_message;

	jpeg_createCompress(@State.General.c, JPEG_LIB_VERSION, SizeOf(State.General.c));
end;
}
//----------------------------------------------------------------------------------------------------------------------

// JPEG library source data manager. These routines supply compressed data to libjpeg.

procedure std_init_source(cinfo: j_decompress_ptr); 

var
  State: PJPEGState;

begin
  State := Pointer(cinfo);

	State.SourceManager.next_input_byte := State.RawBuffer;
	State.SourceManager.bytes_in_buffer := State.RawBufferSize;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure std_fill_input_buffer(cinfo: j_decompress_ptr); 

const
  Dummy_EOI: array[0..1] of JOCTET = ($FF, JPEG_EOI);

var
  State: PJPEGState;

begin
  State := Pointer(cinfo);

	// Should never get here since entire strip/tile is read into memory before the
  // decompressor is called, and thus was supplied by init_source.
	MessageBox(0, PChar(gesJPEGEOI), PChar(gesWarning), MB_OK or MB_ICONWARNING);

	// insert a fake EOI marker
	State.SourceManager.next_input_byte := @Dummy_EOI;
	State.SourceManager.bytes_in_buffer := 2;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure std_skip_input_data(cinfo: j_decompress_ptr; num_bytes: Integer); 

var
  State: PJPEGState;

begin
  State := Pointer(cinfo);

	if num_bytes > 0 then
  begin
		if num_bytes > State.SourceManager.bytes_in_buffer then
    begin
			// oops, buffer overrun
			std_fill_input_buffer(cinfo);
		end
    else
    begin
			Inc(State.SourceManager.next_input_byte, num_bytes);
			Dec(State.SourceManager.bytes_in_buffer, num_bytes);
		end;
	end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure std_term_source(cinfo: j_decompress_ptr); 

// No work necessary here.

begin
end;

//----------------------------------------------------------------------------------------------------------------------

procedure Internaljpeg_data_src(var State: TJPEGState);

begin
  with State do
  begin
    // set data source manager
    General.d.src := @SourceManager;
    
    // fill in fields in our data source manager
    SourceManager.init_source := @std_init_source;
    SourceManager.fill_input_buffer := @std_fill_input_buffer;
    SourceManager.skip_input_data := @std_skip_input_data;
    SourceManager.resync_to_restart := @jpeg_resync_to_restart;
    SourceManager.term_source := @std_term_source;
    SourceManager.bytes_in_buffer := 0;		// for safety
    SourceManager.next_input_byte := nil;
  end;
end;

//----------------------------------------------------------------------------------------------------------------------

// Alternate source manager for reading from JPEGTables.
// We can share all the code except for the init routine.

procedure tables_init_source(cinfo: j_decompress_ptr);

var
  State: PJPEGState;

begin
  State := Pointer(cinfo);

	State.SourceManager.next_input_byte := State.JPEGTables;
	State.SourceManager.bytes_in_buffer := State.JTLength;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure Internaljpeg_tables_src(var State: TJPEGState);

begin
	Internaljpeg_data_src(State);
	State.SourceManager.init_source := @tables_init_source;
end;

//----------------------------------------------------------------------------------------------------------------------

constructor TTIFFJPEGDecoder.Create(Properties: Pointer);

begin
  FImageProperties := Properties;
  with PImageProperties(Properties)^ do
  begin
    if Assigned(JPEGTables) then
    begin
      FState.JPEGTables := @JPEGTables[0];
      FState.JTLength := Length(JPEGTables);
    end;
    // no else branch, rely on class initialization
  end;
end;

//--------------------------------------------------------------------------------------------------------