有关图像格式转换的问题(100分)

;
    FTarget^ := FFirstChar;
    Inc(FTarget);
    FOldCode := Code;
    Result := True;
    Exit;
  end;

  // keep the passed LZW code
  InCode := Code;  

  // the first LZW code is always smaller than FFirstCode
  if Code = FFreeCode then
  begin
    FStackPointer^ := FFirstChar;
    Inc(FStackPointer);
    Code := FOldCode;
  end;

  // loop to put decoded bytes onto the stack
  while Code > FClearCode do
  begin
    FStackPointer^ := FSuffix[Code];
    Inc(FStackPointer);
    Code := FPrefix[Code];
  end;

  // place new code into code table
  FFirstChar := FSuffix[Code];
  FStackPointer^ := FFirstChar;
  Inc(FStackPointer);
  FPrefix[FFreeCode] := FOldCode;
  FSuffix[FFreeCode] := FFirstChar;
  if FFreeCode < 4096 then Inc(FFreeCode);

  // increase code size if necessary
  if (FFreeCode = FCodeMask) and
     (FCodeSize < 12) then
  begin
    Inc(FCodeSize);
    FCodeMask := (1 shl FCodeSize) - 1;
  end;

  // put decoded bytes (from the stack) into the target buffer
  FOldCode := InCode;
  repeat
    Dec(FStackPointer);
    FTarget^ := FStackPointer^;
    Inc(FTarget);
  until Cardinal(FStackPointer) <= Cardinal(@FStack);

  Result := True;
end;

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

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

var
  I: Integer;
  Data,           // current data
  Bits,           // counter for bit management
  Code: Cardinal; // current code value
  SourcePtr: PByte;

begin
  FTarget := Dest;
  SourcePtr := Source;

  // initialize parameter
  FClearCode := 1 shl 8;
  FEOICode := FClearCode + 1;
  FFreeCode := FClearCode + 2;
  FOldCode := NoLZWCode;
  FCodeSize := 9;
  FCodeMask := (1 shl FCodeSize) - 1; 

  // init code table
  for I := 0 to FClearCode - 1 do
  begin
    FPrefix[I] := NoLZWCode;
    FSuffix[I] := I;
  end;

  // initialize stack
  FStackPointer := @FStack;

  Data := 0;
  Bits := 0;  
  for I := 0 to PackedSize - 1 do
  begin
    // read code from bit stream
    Inc(Data, Cardinal(SourcePtr^) shl (24 - Bits));
    Inc(Bits, 8);
    while Bits >= FCodeSize do
    begin
      // current code
      Code := (Data and ($FFFFFFFF - FCodeMask)) shr (32 - FCodeSize);
      // mask it
      Data := Data shl FCodeSize;
      Dec(Bits, FCodeSize);

      // EOICode -> decoding finished, check also for badly written codes and
      // terminate the loop as soon as the target is filled up
      if (Code = FEOICode) or
         ((PChar(FTarget) - PChar(Dest)) >= UnpackedSize) then Exit;

      if not DecodeLZW(Code) then Break;
    end;
    Inc(SourcePtr);
  end;
end;

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

procedure TTIFFLZW.Encode(Source, Dest: Pointer; var FByteCounts: Cardinal);

begin

end;

//----------------- TPackbitsRLE ---------------------------------------------------------------------------------------

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

// decodes a simple run-length encoded strip of size PackedSize

var
  SourcePtr,
  TargetPtr: PByte;
  N: SmallInt;

begin
  TargetPtr := Dest;
  SourcePtr := Source;
  while PackedSize > 0 do
  begin
    N := ShortInt(SourcePtr^);
    Inc(SourcePtr);
    Dec(PackedSize);
    if N < 0 then // replicate next Byte -N + 1 times
    begin
      if N = -128 then Continue; // nop
      N := -N + 1;
      FillChar(TargetPtr^, N, SourcePtr^);
      Inc(SourcePtr);
      Inc(TargetPtr, N);
      Dec(PackedSize);
    end
    else
    begin // copy next N + 1 bytes literally
      Move(SourcePtr^, TargetPtr^, N + 1);
      Inc(TargetPtr, N + 1);
      Inc(SourcePtr, N + 1);
      Dec(PackedSize, N + 1);
    end;
  end;
end;

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

procedure TPackbitsRLE.Encode(Source, Dest: Pointer; var FByteCounts: Cardinal);

begin

end;

//----------------- TPCXRLE --------------------------------------------------------------------------------------------

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

var
  Count: Integer;
  SourcePtr,
  TargetPtr: PByte;
  
begin
  SourcePtr := Source;
  TargetPtr := Dest;
  while UnpackedSize > 0 do
  begin
    if (SourcePtr^ and $C0) = $C0 then
    begin
      // RLE-Code
      Count := SourcePtr^ and $3F;
      Inc(SourcePtr);
      if UnpackedSize < Count then Count := UnpackedSize;
      FillChar(TargetPtr^, Count, SourcePtr^);
      Inc(SourcePtr);
      Inc(TargetPtr, Count);
      Dec(UnpackedSize, Count);
    end
    else
    begin
      // not compressed
      TargetPtr^ := SourcePtr^;
      Inc(SourcePtr);
      Inc(TargetPtr);
      Dec(UnpackedSize);
    end;
  end;
end;

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

procedure TPCXRLE.Encode(Source, Dest: Pointer; var FByteCounts: Cardinal);

begin

end;

//----------------- TSGIRLE --------------------------------------------------------------------------------------------

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

var
  SourcePtr,
  TargetPtr: PByte;
  Source16Ptr: ^Word;
  Pixel: Byte;
  Pixel16: Word;
  RunLength: Cardinal;

begin
  if SampleSize = 1 then
  begin
    SourcePtr := Source;
    TargetPtr := Dest;
    while True do
    begin
      Pixel := SourcePtr^;
      Inc(SourcePtr);
      RunLength := Pixel and $7F;
      if RunLength = 0 then Break;

      if (Pixel and $80) <> 0 then
      begin
        Move(SourcePtr^, TargetPtr^, RunLength);
        Inc(TargetPtr, RunLength);
        Inc(SourcePtr, RunLength);
      end
      else
      begin
        Pixel := SourcePtr^;
        Inc(SourcePtr);
        FillChar(TargetPtr^, RunLength, Pixel);
        Inc(TargetPtr, RunLength);
      end;
    end;
  end
  else
  begin
    // 16 bits per sample
    Source16Ptr := Source;
    TargetPtr := Dest;
    while True do
    begin
      Pixel16 := Swap(Source16Ptr^);
      Inc(Source16Ptr);
      RunLength := Pixel16 and $7F;
      if RunLength = 0 then Break;

      if (Pixel16 and $80) <> 0 then
      begin
        while RunLength > 0 do
        begin
          // swapping to little endian and doing a shift right 8 bits is the same as
          // just taking the lower 8 bits
          TargetPtr^ := Byte(Source16Ptr^);
          Inc(TargetPtr);
          Inc(Source16Ptr);
          Dec(RunLength);
        end;
      end
      else
      begin
        Pixel := Byte(Source16Ptr^);
        Inc(Source16Ptr);
        FillChar(TargetPtr^, RunLength, Pixel);
        Inc(TargetPtr, RunLength);
      end;
    end;
  end;
end;

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

procedure TSGIRLE.Encode(Source, Dest: Pointer; var FByteCounts: Cardinal);

begin
end;

//----------------- TCUTRLE --------------------------------------------------------------------------------------------

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

var
  TargetPtr: PByte;
  Pixel: Byte;
  RunLength: Cardinal;

begin
  TargetPtr := Dest;
  // skip first two bytes per row (I don't know their meaning)
  Inc(PByte(Source), 2);
  while True do
  begin
    Pixel := PByte(Source)^;
    Inc(PByte(Source));
    if Pixel = 0 then Break;

    RunLength := Pixel and $7F;
    if (Pixel and $80) = 0 then
    begin
      Move(Source^, TargetPtr^, RunLength);
      Inc(TargetPtr, RunLength);
      Inc(PByte(Source), RunLength);
    end
    else
    begin
      Pixel := PByte(Source)^;
      Inc(PByte(Source));
      FillChar(TargetPtr^, RunLength, Pixel);
      Inc(TargetPtr, RunLength);
    end;
  end;
end;

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

procedure TCUTRLE.Encode(Source, Dest: Pointer; var FByteCounts: Cardinal);

begin

end;

//----------------- TGIFLZW --------------------------------------------------------------------------------------------

function TGIFLZW.DecodeLZW(Code: Cardinal): Boolean;

var
  InCode: Cardinal; // buffer for passed code

begin
  // handling of clear codes
  if Code = FClearCode then
  begin
    // reset of all variables
    FCodeSize := InitialCodeSize + 1;
    FCodeMask := (1 shl FCodeSize) - 1;
    FFreeCode := FClearCode + 2;
    FOldCode := NoLZWCode;
    Result := True;
    Exit;
  end;

  // check whether it is a valid, already registered code
  if Code > FFreeCode then
    raise Exception.Create('GIF LZW: invalid opcode.');
  
  // handling for the first LZW code: print and keep it
  if FOldCode = NoLZWCode then
  begin
    FFirstChar := FSuffix[Code];
    FTarget^ := FFirstChar;
    Inc(FTarget);
    FOldCode := Code;
    Result := True;
    Exit;
  end;

  // keep the passed LZW code
  InCode := Code;  

  // the first LZW code is always smaller than FFirstCode
  if Code = FFreeCode then
  begin
    FStackPointer^ := FFirstChar;
    Inc(FStackPointer);
    Code := FOldCode;
  end;

  // loop to put decoded bytes onto the stack
  while Code > FClearCode do
  begin
    FStackPointer^ := FSuffix[Code];
    Inc(FStackPointer);
    Code := FPrefix[Code];
  end;

  // place new code into code table
  FFirstChar := FSuffix[Code];
  FStackPointer^ := FFirstChar;
  Inc(FStackPointer);
  FPrefix[FFreeCode] := FOldCode;
  FSuffix[FFreeCode] := FFirstChar;

  // increase code size if necessary
  if (FFreeCode = FCodeMask) and
     (FCodeSize < 12) then
  begin
    Inc(FCodeSize);
    FCodeMask := (1 shl FCodeSize) - 1;
  end;
  if FFreeCode < 4095 then Inc(FFreeCode);

  // put decoded bytes (from the stack) into the target buffer
  FOldCode := InCode;
  repeat
    Dec(FStackPointer);
    FTarget^ := FStackPointer^;
    Inc(FTarget);
  until FStackPointer = @FStack;

  Result := True;
end;

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

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

var
  I: Integer;
  Data,           // current data
  Bits,           // counter for bit management
  Code: Cardinal; // current code value
  SourcePtr: PByte;

begin
  FTarget := Dest;
  SourcePtr := Source;

  // initialize parameter
  FCodeSize := InitialCodeSize + 1;
  FClearCode := 1 shl InitialCodeSize;
  FEOICode := FClearCode + 1;
  FFreeCode := FClearCode + 2;
  FOldCode := NoLZWCode;
  FCodeMask := (1 shl FCodeSize) - 1;

  // init code table
  for I := 0 to FClearCode - 1 do
  begin
    FPrefix[I] := NoLZWCode;
    FSuffix[I] := I;
  end;

  // initialize stack
  FStackPointer := @FStack;

  Data := 0;
  Bits := 0;
  while PackedSize > 0 do
  begin
    // read code from bit stream
    Inc(Data, SourcePtr^ shl Bits);
    Inc(Bits, 8);
    while Bits >= FCodeSize do
    begin
      // current code
      Code := Data and FCodeMask;
      // prepare next run
      Data := Data shr FCodeSize;
      Dec(Bits, FCodeSize);

      // EOICode -> decoding finished, check also for badly written codes and
      // terminate the loop as soon as the target is filled up
      if (Code = FEOICode) or
         ((PChar(FTarget) - PChar(Dest)) >= UnpackedSize) then Exit;

      if not DecodeLZW(Code) then Break;
    end;
    Inc(SourcePtr);
    Dec(PackedSize);
  end;
end;

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

procedure TGIFLZW.Encode(Source, Dest: Pointer; var FByteCounts: Cardinal);

begin
end;

//----------------- TRLADecoder ----------------------------------------------------------------------------------------

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

// decodes a simple run-length encoded strip of size PackedSize
// this is very similar to TPackbitsRLE 

var
  SourcePtr,
  TargetPtr: PByte;
  N: SmallInt;

begin
  TargetPtr := Dest;
  SourcePtr := Source;
  while PackedSize > 0 do
  begin
    N := ShortInt(SourcePtr^);
    Inc(SourcePtr);
    Dec(PackedSize);
    if N >= 0 then // replicate next Byte N + 1 times
    begin
      FillChar(TargetPtr^, N + 1, SourcePtr^);
      Inc(TargetPtr, N + 1);
      Inc(SourcePtr);
      Dec(PackedSize);
    end
    else
    begin // copy next -N bytes literally
      Move(SourcePtr^, TargetPtr^, -N);
      Inc(TargetPtr, -N);
      Inc(SourcePtr, -N);
      Inc(PackedSize, N);
    end;
  end;
end;

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

procedure TRLADecoder.Encode(Source, Dest: Pointer; var FByteCounts: Cardinal);

begin
end;

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

end.