graphiccompression.pas

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

  end;

  // finally fill remaining bits
  if Run > 0 then
  begin
    FFreeTargetBits := 8 - Run;
    if not FIsWhite then FTarget^ := ((1 shl Run) - 1) shl FFreeTargetBits;
  end;

  // this will throw an exception if the sum of the run lengths for a row is not
  // exactly the row size (the documentation speaks of an unrecoverable error)
  if Cardinal(RunLength) > FRestWidth then RunLength := FRestWidth;
  Dec(FRestWidth, RunLength);
  Result := FRestWidth = 0;
end;

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

function TCCITTDecoder.FindBlackCode: Integer;

// Executes the state machine to find the run length for the next bit combination.
// Returns the run length of the found code.

var
  State,
  NewState: Cardinal;
  Bit: Boolean;
  
begin
  State := 0;
  Result := 0;
  repeat
    // advance to next byte in the input Buffer if necessary
    if FBitsLeft = 0 then
    begin
      if FPackedSize = 0 then Break;
      FBits := FSource^;
      Inc(FSource);
      Dec(FPackedSize);
      FMask := $80;
      FBitsLeft := 8;
    end;
    Bit := (FBits and FMask) <> 0;

    // advance the state machine
    NewState := FBlackStates[State].NewState[Bit];
    if NewState = 0 then
    begin
      Inc(Result, FBlackStates[State].RunLength);
      if FBlackStates[State].RunLength < 64 then Break
                                            else
      begin
        NewState := FBlackStates[0].NewState[Bit];
      end;
    end;
    State := NewState;

    // address next bit
    FMask := FMask shr 1;
    if FBitsLeft > 0 then Dec(FBitsLeft);
  until False;
end;

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

function TCCITTDecoder.FindWhiteCode: Integer;

// Executes the state machine to find the run length for the next bit combination.
// Returns the run length of the found code.

var
  State,
  NewState: Cardinal;
  Bit: Boolean;

begin
  State := 0;
  Result := 0;
  repeat
    // advance to next byte in the input Buffer if necessary
    if FBitsLeft = 0 then
    begin
      if FPackedSize = 0 then Break;
      FBits := FSource^;
      Inc(FSource);
      Dec(FPackedSize);
      FMask := $80;
      FBitsLeft := 8;
    end;
    Bit := (FBits and FMask) <> 0;

    // advance the state machine
    NewState := FWhiteStates[State].NewState[Bit];
    if NewState = 0 then
    begin
      // a code has been found
      Inc(Result, FWhiteStates[State].RunLength);
      // if we found a terminating code then exit loop, otherwise continue
      if FWhiteStates[State].RunLength < 64 then Break
                                            else
      begin
        // found a make up code, continue state machine with current bit (rather than reading the next one)
        NewState := FWhiteStates[0].NewState[Bit];
      end;
    end;
    State := NewState;

    // address next bit
    FMask := FMask shr 1;
    if FBitsLeft > 0 then Dec(FBitsLeft);
  until False;
end;

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

function TCCITTDecoder.NextBit: Boolean;

// Reads the current bit and returns True if it is set, otherwise False.
// This method is only used in the process to synchronize the bit stream in descentants.

begin
  // advance to next byte in the input Buffer if necessary
  if (FBitsLeft = 0) and (FPackedSize > 0) then
  begin
    FBits := FSource^;
    Inc(FSource);
    Dec(FPackedSize);
    FMask := $80;
    FBitsLeft := 8;
  end;
  Result := (FBits and FMask) <> 0;

  // address next bit
  FMask := FMask shr 1;
  if FBitsLeft > 0 then Dec(FBitsLeft);
end;

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

type
  TCodeEntry = record
    Code, Len: Cardinal;
  end;

const // CCITT code tables
  WhiteCodes: array[0..103] of TCodeEntry = (
    (Code : $0035; Len : 8),
    (Code : $0007; Len : 6),
    (Code : $0007; Len : 4),
    (Code : $0008; Len : 4),
    (Code : $000B; Len : 4),
    (Code : $000C; Len : 4),
    (Code : $000E; Len : 4),
    (Code : $000F; Len : 4),
    (Code : $0013; Len : 5),
    (Code : $0014; Len : 5),
    (Code : $0007; Len : 5),
    (Code : $0008; Len : 5),
    (Code : $0008; Len : 6),
    (Code : $0003; Len : 6),
    (Code : $0034; Len : 6),
    (Code : $0035; Len : 6),
    (Code : $002A; Len : 6),
    (Code : $002B; Len : 6),
    (Code : $0027; Len : 7),
    (Code : $000C; Len : 7),
    (Code : $0008; Len : 7),
    (Code : $0017; Len : 7),
    (Code : $0003; Len : 7),
    (Code : $0004; Len : 7),
    (Code : $0028; Len : 7),
    (Code : $002B; Len : 7),
    (Code : $0013; Len : 7),
    (Code : $0024; Len : 7),
    (Code : $0018; Len : 7),
    (Code : $0002; Len : 8),
    (Code : $0003; Len : 8),
    (Code : $001A; Len : 8),
    (Code : $001B; Len : 8),
    (Code : $0012; Len : 8),
    (Code : $0013; Len : 8),
    (Code : $0014; Len : 8),
    (Code : $0015; Len : 8),
    (Code : $0016; Len : 8),
    (Code : $0017; Len : 8),
    (Code : $0028; Len : 8),
    (Code : $0029; Len : 8),
    (Code : $002A; Len : 8),
    (Code : $002B; Len : 8),
    (Code : $002C; Len : 8),
    (Code : $002D; Len : 8),
    (Code : $0004; Len : 8),
    (Code : $0005; Len : 8),
    (Code : $000A; Len : 8),
    (Code : $000B; Len : 8),
    (Code : $0052; Len : 8),
    (Code : $0053; Len : 8),
    (Code : $0054; Len : 8),
    (Code : $0055; Len : 8),
    (Code : $0024; Len : 8),
    (Code : $0025; Len : 8),
    (Code : $0058; Len : 8),
    (Code : $0059; Len : 8),
    (Code : $005A; Len : 8),
    (Code : $005B; Len : 8),
    (Code : $004A; Len : 8),
    (Code : $004B; Len : 8),
    (Code : $0032; Len : 8),
    (Code : $0033; Len : 8),
    (Code : $0034; Len : 8),
    (Code : $001B; Len : 5),
    (Code : $0012; Len : 5),
    (Code : $0017; Len : 6),
    (Code : $0037; Len : 7),
    (Code : $0036; Len : 8),
    (Code : $0037; Len : 8),
    (Code : $0064; Len : 8),
    (Code : $0065; Len : 8),
    (Code : $0068; Len : 8),
    (Code : $0067; Len : 8),
    (Code : $00CC; Len : 9),
    (Code : $00CD; Len : 9),
    (Code : $00D2; Len : 9),
    (Code : $00D3; Len : 9),
    (Code : $00D4; Len : 9),
    (Code : $00D5; Len : 9),
    (Code : $00D6; Len : 9),
    (Code : $00D7; Len : 9),
    (Code : $00D8; Len : 9),
    (Code : $00D9; Len : 9),
    (Code : $00DA; Len : 9),
    (Code : $00DB; Len : 9),
    (Code : $0098; Len : 9),
    (Code : $0099; Len : 9),
    (Code : $009A; Len : 9),
    (Code : $0018; Len : 6),
    (Code : $009B; Len : 9),
    (Code : $0008; Len : 11),
    (Code : $000C; Len : 11),
    (Code : $000D; Len : 11),
    (Code : $0012; Len : 12),
    (Code : $0013; Len : 12),
    (Code : $0014; Len : 12),
    (Code : $0015; Len : 12),
    (Code : $0016; Len : 12),
    (Code : $0017; Len : 12),
    (Code : $001C; Len : 12),
    (Code : $001D; Len : 12),
    (Code : $001E; Len : 12),
    (Code : $001F; Len : 12)
    // EOL codes are added "manually"
  );

  BlackCodes: array[0..103] of TCodeEntry = (
    (Code : $0037; Len : 10),
    (Code : $0002; Len : 3),
    (Code : $0003; Len : 2),
    (Code : $0002; Len : 2),
    (Code : $0003; Len : 3),
    (Code : $0003; Len : 4),
    (Code : $0002; Len : 4),
    (Code : $0003; Len : 5),
    (Code : $0005; Len : 6),
    (Code : $0004; Len : 6),
    (Code : $0004; Len : 7),
    (Code : $0005; Len : 7),
    (Code : $0007; Len : 7),
    (Code : $0004; Len : 8),
    (Code : $0007; Len : 8),
    (Code : $0018; Len : 9),
    (Code : $0017; Len : 10),
    (Code : $0018; Len : 10),
    (Code : $0008; Len : 10),
    (Code : $0067; Len : 11),
    (Code : $0068; Len : 11),
    (Code : $006C; Len : 11),
    (Code : $0037; Len : 11),
    (Code : $0028; Len : 11),
    (Code : $0017; Len : 11),
    (Code : $0018; Len : 11),
    (Code : $00CA; Len : 12),
    (Code : $00CB; Len : 12),
    (Code : $00CC; Len : 12),
    (Code : $00CD; Len : 12),
    (Code : $0068; Len : 12),
    (Code : $0069; Len : 12),
    (Code : $006A; Len : 12),
    (Code : $006B; Len : 12),
    (Code : $00D2; Len : 12),
    (Code : $00D3; Len : 12),
    (Code : $00D4; Len : 12),
    (Code : $00D5; Len : 12),
    (Code : $00D6; Len : 12),
    (Code : $00D7; Len : 12),
    (Code : $006C; Len : 12),
    (Code : $006D; Len : 12),
    (Code : $00DA; Len : 12),
    (Code : $00DB; Len : 12),
    (Code : $0054; Len : 12),
    (Code : $0055; Len : 12),
    (Code : $0056; Len : 12),
    (Code : $0057; Len : 12),
    (Code : $0064; Len : 12),
    (Code : $0065; Len : 12),
    (Code : $0052; Len : 12),
    (Code : $0053; Len : 12),
    (Code : $0024; Len : 12),
    (Code : $0037; Len : 12),
    (Code : $0038; Len : 12),
    (Code : $0027; Len : 12),
    (Code : $0028; Len : 12),
    (Code : $0058; Len : 12),
    (Code : $0059; Len : 12),
    (Code : $002B; Len : 12),
    (Code : $002C; Len : 12),
    (Code : $005A; Len : 12),
    (Code : $0066; Len : 12),
    (Code : $0067; Len : 12),
    (Code : $000F; Len : 10),
    (Code : $00C8; Len : 12),
    (Code : $00C9; Len : 12),
    (Code : $005B; Len : 12),
    (Code : $0033; Len : 12),
    (Code : $0034; Len : 12),
    (Code : $0035; Len : 12),
    (Code : $006C; Len : 13),
    (Code : $006D; Len : 13),
    (Code : $004A; Len : 13),
    (Code : $004B; Len : 13),
    (Code : $004C; Len : 13),
    (Code : $004D; Len : 13),
    (Code : $0072; Len : 13),
    (Code : $0073; Len : 13),
    (Code : $0074; Len : 13),
    (Code : $0075; Len : 13),
    (Code : $0076; Len : 13),
    (Code : $0077; Len : 13),
    (Code : $0052; Len : 13),
    (Code : $0053; Len : 13),
    (Code : $0054; Len : 13),
    (Code : $0055; Len : 13),
    (Code : $005A; Len : 13),
    (Code : $005B; Len : 13),
    (Code : $0064; Len : 13),
    (Code : $0065; Len : 13),
    (Code : $0008; Len : 11),
    (Code : $000C; Len : 11),
    (Code : $000D; Len : 11),
    (Code : $0012; Len : 12),
    (Code : $0013; Len : 12),
    (Code : $0014; Len : 12),
    (Code : $0015; Len : 12),
    (Code : $0016; Len : 12),
    (Code : $0017; Len : 12),
    (Code : $001C; Len : 12),
    (Code : $001D; Len : 12),
    (Code : $001E; Len : 12),
    (Code : $001F; Len : 12)
    // EOL codes are added "manually"
  );

procedure TCCITTDecoder.MakeStates;

// creates state arrays for white and black codes
// These state arrays are so designed that they have at each state (starting with state 0) a new state index
// into the same array according to the bit for which the state is current.

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

  procedure AddCode(var Target: TStateArray; Bits: Cardinal; BitLen, RL: Integer);

  // interprets the given string as a sequence of bits and makes a state chain from it

  var
    State,
    NewState: Integer;
    Bit: Boolean;

  begin
    // start state
    State := 0;
    // prepare bit combination (bits are given right align, but must be scanned from left)
    Bits := Bits shl (32 - BitLen);
    while BitLen > 0 do
    begin
      // determine next state according to the bit string
      asm
        SHL [Bits], 1
        SETC [Bit]
      end;
      NewState := Target[State].NewState[Bit];
      // Is it a not yet assigned state?
      if NewState = 0 then
      begin
        // if yes then create a new state at the end of the array
        NewState := Length(Target);
        Target[State].NewState[Bit] := NewState;
        SetLength(Target, Length(Target) + 1);
      end;
      State := NewState;

      Dec(BitLen);
    end;
    // at this point State indicates the final state where we must store the run length for the
    // particular bit combination
    Target[State].RunLength := RL;
  end;

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

var
  I: Integer;

begin
  // set an initial entry in each state array
  SetLength(FWhiteStates, 1);
  SetLength(FBlackStates, 1);

  // with codes
  for I := 0 to 63 do
    with WhiteCodes[I] do AddCode(FWhiteStates, Code, Len, I);
  for I := 64 to 103 do
    with WhiteCodes[I] do AddCode(FWhiteStates, Code, Len, (I - 63) * 64);

  AddCode(FWhiteStates, 1, 12, G3_EOL);
  AddCode(FWhiteStates, 1, 9, G3_INVALID);
  AddCode(FWhiteStates, 1, 10, G3_INVALID);
  AddCode(FWhiteStates, 1, 11, G3_INVALID);
  AddCode(FWhiteStates, 0, 12, G3_INVALID);

  // black codes
  for I := 0 to 63 do
    with BlackCodes[I] do AddCode(FBlackStates, Code, Len, I);
  for I := 64 to 103 do
    with BlackCodes[I] do AddCode(FBlackStates, Code, Len, (I - 63) * 64);

  AddCode(FBlackStates, 1, 12, G3_EOL);
  AddCode(FBlackStates, 1, 9, G3_INVALID);
  AddCode(FBlackStates, 1, 10, G3_INVALID);