aicbase.pas

很好的源代码

unit AICBase;
{ Advanced Image Coding (AIC)
  ===========================
  Base class for AIC encoder and decoder.
  Parts of the code in this unit are based on the H.264 reference software.
  See JM.txt for license details. }

interface

uses
  AICCommon, Classes;

type
  TAICBase = class
  { Base class for AIC encoder and decoder.
    Contains functionality shared by both encoder and decoder. }
  private
    FStream: TStream;
    FOwnsStream: Boolean;
    FImageFormat: TAICImageFormat;
    FctMax: TAICChannelType;
    FQuality: TAICQuality;
    FWidth: Integer;
    FHeight: Integer;
    FPaddedHeight: Integer;
    FPaddedWidth: Integer;
    procedure InitializeQuantisationTables;
  protected
    Channels: TAICChannels;
    { The channels containing the pixel values of the image.
      For greyscale images, only the first channel is used.
      For color images, all three channels (Y, Cb and Cr) are used. }
    PreviousPredictionModes: array of array of TAICPredictionMode;
    { Contains the prediction modes of previously encoded/decoded blocks.
      Is used to predict the next prediction mode (see PredictPredictionMode) }
    InvQuant: TAICQuantTable;
    { The quantisation table used by the Inverse Discrete Cosine Transform do
      dequantize the DCT coefficients. The same quantisation table is used
      for all color components (Y, Cb and Cr) }
    procedure SetImageProperties(const AWidth, AHeight: Integer;
      const AImageFormat: TAICImageFormat; const AQuality: TAICQuality);
    { Sets the dimensions, format and quality of the images. Initializes the
      channels and quantisation tables accordingly.
      Must be called before encoding or decoding the image. }
    procedure SetLinearQuality(const ScaleFactor: Integer); virtual;
    { Is called by SetImageProperties to set the values of the quantisation
      tables. Set the InvQuant table by default. Is overridden by the encoder
      to set the forward quantisation table (FwdQuant) too. }
    procedure SetQuantisationTable(const ScaleFactor: Integer;
      out QuantTable: TAICQuantTable; const Inverse: Boolean);
    { Is called by SetLinearQuality to initialize the quantisation table
      QuantTable with values appropriate for the given quality (ScaleFactor).
      Inverse must be True when the table is used for inverse quantisation,
      or False otherwise }
    function Predict(const Mode: TAICPredictionMode; const C: TAICChannel;
      const XB, YB: Integer; var Predicted: TAICByteBlock): Boolean;
    { Makes a prediction of the current block of pixels (Predicted) at position
      (XB, YB) in the channel C, based on previously encoded or decoded blocks.
      The prediction mode Mode is used to specify the kind of prediction. See
      the web site for an explanation of these modes. }
    function PredictPredictionMode(const XI, YI: Integer): TAICPredictionMode;
    { Predicts the prediction mode of the current block, based on the prediction
      modes used by previously encoded blocks. XI and YI are the coordinates of
      the block, in block units (that is the pixel coordinates divided by 8) }

    property Stream: TStream read FStream;
    { The stream used to read or write an AIC image }
    property OwnsStream: Boolean read FOwnsStream write FOwnsStream;
    { True when this class owns the stream (and is thus responsible for
      cleaning it up }
    property ImageFormat: TAICImageFormat read FImageFormat;
    { Specifies if the image is in color or greyscale }
    property ctMax: TAICChannelType read FctMax write FctMax;
    { The maximum channel type.
      For greyscale images: ctY (only luminance)
      For color images: ctCr (also Cb and Cr chrominance channels) }
    property Quality: TAICQuality read FQuality;
    { The quality of the image, ranging from 1..100 }
    property Width: Integer read FWidth;
    { The actual width of the image (without padding) }
    property Height: Integer read FHeight;
    { The actual height of the image (without padding) }
    property PaddedWidth: Integer read FPaddedWidth;
    { The width of the image padded to the next multiple of 8 }
    property PaddedHeight: Integer read FPaddedHeight;
    { The height of the image padded to the next multiple of 8 }
  public
    constructor Create(const AStream: TStream);
    destructor Destroy; override;
  end;

implementation

uses
  Math;
  
{ TAICBase }

constructor TAICBase.Create(const AStream: TStream);
begin
  inherited Create;
  FStream := AStream;
end;

destructor TAICBase.Destroy;
begin
  if FOwnsStream then
    FStream.Free;
  Channels[ctY] := nil;
  Channels[ctCb] := nil;
  Channels[ctCr] := nil;
  PreviousPredictionModes := nil;
  inherited;
end;

procedure TAICBase.InitializeQuantisationTables;
var
  Q: Integer;
begin
  Assert(Quality > 0);
  { Calculate a scale factor to initialize the quantisation tables, based on
    the quality. Higher qualities lead to lower scale factors.
    Qualities 1..49 lead to factors 5000..102.
    Qualities 50..100 lead to factors 100..0. }
  if Quality <= 50 then
    Q := 5000 div Quality
  else
    Q := 200 - (Quality * 2);
  SetLinearQuality(Q);
end;

function TAICBase.Predict(const Mode: TAICPredictionMode;
  const C: TAICChannel; const XB, YB: Integer;
  var Predicted: TAICByteBlock): Boolean;
var
  A, X, Y, Z: Integer;
  P: Byte;
begin
  Result := False;
  case Mode of
    pmVert:
      if YB > 0 then begin
        for X := 0 to 7 do begin
          P := C[YB - 1,XB + X];
          for Y := 0 to 7 do
            Predicted[Y*8+X] := P;
        end;
      end else
        Exit;
    pmHorz:
      if XB > 0 then begin
        for Y := 0 to 7 do begin
          P := C[YB + Y,XB - 1];
          for X := 0 to 7 do
            Predicted[Y*8+X] := P;
        end;
      end else
        Exit;
    pmDC:
      begin
        Z := 0;
        if XB > 0 then
          if YB > 0 then begin
            for A := 0 to 7 do
              Inc(Z,C[YB - 1,XB + A] + C[YB + A,XB - 1]);
            P := (Z + 8) shr 4;
          end else begin
            for Y := 0 to 7 do
              Inc(Z,C[YB + Y,XB - 1]);
            P := (Z + 4) shr 3;
          end
        else
          if YB > 0 then begin
            for X := 0 to 7 do
              Inc(Z,C[YB - 1,XB + X]);
            P := (Z + 4) shr 3;
          end else
            P := 128;
        for Y := 0 to 7 do
          for X := 0 to 7 do
            Predicted[Y*8+X] := P;
      end;
    pmDiagonalDownLeft:
      if (YB > 0) and (XB <= PaddedWidth - 16) then begin
        for Y := 0 to 7 do
          for X := 0 to 7 do
            if (X = 7) and (Y = 7) then
              Predicted[7*8+7] := (C[YB - 1,XB + 14] +
                3 * C[YB - 1,XB + 15] + 2) shr 2
            else
              Predicted[Y*8+X] := (C[YB - 1,XB + X + Y] +
                2 * C[YB - 1,XB + X + Y + 1] +
                C[YB - 1,XB + X + Y + 2] + 2) shr 2;
      end else
        Exit;
    pmDiagonalDownRight:
      if (XB > 0) and (YB > 0) then begin
        for Y := 0 to 7 do
          for X := 0 to 7 do
            if X > Y then
              Predicted[Y*8+X] := (C[YB - 1,XB + X - Y - 2] +
                2 * C[YB - 1,XB + X - Y - 1] +
                C[YB - 1,XB + X - Y] + 2) shr 2
            else if X < Y then
              Predicted[Y*8+X] := (C[YB + Y - X - 2,XB - 1] +
                2 * C[YB + Y - X - 1,XB - 1] +
                C[YB + Y - X,XB - 1] + 2) shr 2
            else
              Predicted[Y*8+X] := (C[YB - 1,XB] +
                2 * C[YB - 1,XB - 1] +
                C[YB,XB - 1] + 2) shr 2;
      end else
        Exit;
    pmVerticalRight:
      if (XB > 0) and (YB > 0) then begin
        for Y := 0 to 7 do
          for X := 0 to 7 do begin
            Z := 2 * X - Y;
            if (Z >= 0) then
              if Odd(Z) then
                Predicted[Y*8+X] := (C[YB - 1,XB + X - (Y shr 1) - 2] +
                  2 * C[YB - 1,XB + X - (Y shr 1) - 1] +
                  C[YB - 1,XB + X - (Y shr 1)] + 2) shr 2
              else
                Predicted[Y*8+X] := (C[YB - 1,XB + X - (Y shr 1) - 1] +
                  C[YB - 1,XB + X - (Y shr 1)] + 1) shr 1
            else
              if Z = -1 then
                Predicted[Y*8+X] := (C[YB,XB - 1] +
                  2 * C[YB - 1,XB - 1] +
                  C[YB - 1,XB] + 2) shr 2
              else
                Predicted[Y*8+X] := (C[YB + Y - X - 1,XB - 1] +
                  2 * C[YB + Y - X - 2,XB - 1] +
                  C[YB + Y - X - 3,XB - 1] + 2) shr 2;
          end;
      end else
        Exit;
    pmHorizontalDown:
      if (XB > 0) and (YB > 0) then begin
        for Y := 0 to 7 do
          for X := 0 to 7 do begin
            Z := 2 * Y - X;
            if (Z >= 0) then
              if Odd(Z) then
                Predicted[Y*8+X] := (C[YB + Y - (X shr 1) - 2,XB - 1] +
                  2 * C[YB + Y - (X shr 1) - 1,XB - 1] +
                  C[YB + Y - (X shr 1),XB - 1] + 2) shr 2
              else
                Predicted[Y*8+X] := (C[YB + Y - (X shr 1) - 1,XB - 1] +
                  C[YB + Y - (X shr 1),XB - 1] + 1) shr 1
            else
              if Z = -1 then
                Predicted[Y*8+X] := (C[YB,XB - 1] +
                  2 * C[YB - 1,XB - 1] +
                  C[YB - 1,XB] + 2) shr 2
              else
                Predicted[Y*8+X] := (C[YB - 1,XB + X - Y - 1] +
                  2 * C[YB - 1,XB + X - Y - 2] +
                  C[YB - 1,XB + X - Y - 3] + 2) shr 2;
          end;
      end else
        Exit;
    pmVerticalLeft:
      if (YB > 0) and (XB <= PaddedWidth - 16) then begin
        for Y := 0 to 7 do
          if Odd(Y) then
            for X := 0 to 7 do
              Predicted[Y*8+X] := (C[YB - 1,XB + X + (Y shr 1)] +
                2 * C[YB - 1,XB + X + (Y shr 1) + 1] +
                C[YB - 1,XB + X + (Y shr 1) + 2] + 2) shr 2
          else
            for X := 0 to 7 do
              Predicted[Y*8+X] := (C[YB - 1,XB + X + (Y shr 1)] +
                C[YB - 1,XB + X + (Y shr 1) + 1] + 1) shr 1;
      end else
        Exit;
    pmHorizontalUp:
      if XB > 0 then begin
        for Y := 0 to 7 do
          for X := 0 to 7 do begin
            Z := X + 2 * Y;
            if (Z < 13) then
              if Odd(Z) then
                Predicted[Y*8+X] := (C[YB + Y + (X shr 1),XB - 1] +
                  2 * C[YB + Y + (X shr 1) + 1,XB - 1] +
                  C[YB + Y + (X shr 1) + 2,XB - 1] + 2) shr 2
              else
                Predicted[Y*8+X] := (C[YB + Y + (X shr 1),XB - 1] +
                  C[YB + Y + (X shr 1) + 1,XB - 1] + 1) shr 1
            else
              if (Z = 13) then
                Predicted[Y*8+X] := (C[YB + 6,XB - 1] +
                  3 * C[YB + 7,XB - 1] + 2) shr 2
              else
                Predicted[Y*8+X] := C[YB + 7,XB - 1];
          end;
      end else
        Exit;
  end;
  Result := True;
end;

function TAICBase.PredictPredictionMode(const XI,
  YI: Integer): TAICPredictionMode;
var
  ModeA, ModeB: TAICPredictionMode;
begin
  { A = prediction mode of left block }
  if XI = 0 then
    ModeA := pmDC
  else
    ModeA := PreviousPredictionModes[YI,XI - 1];
  { B = prediction mode of above block }
  if YI = 0 then
    ModeB := pmDC
  else
    ModeB := PreviousPredictionModes[YI - 1,XI];
  { Choose lesser of A and B as prediction for BestMode }
  if ModeB < ModeA then
    Result := ModeB
  else
    Result := ModeA;
end;

procedure TAICBase.SetImageProperties(const AWidth, AHeight: Integer;
  const AImageFormat: TAICImageFormat; const AQuality: TAICQuality);
begin
  FWidth := AWidth;
  FHeight := AHeight;
  FImageFormat := AImageFormat;
  FQuality := AQuality;

  { Set PaddedWidth and PaddedHeight to the size padded to the next multiple
    of RowColSize (8) pixels }
  FPaddedWidth := ((FWidth + RowColSize - 1) div RowColSize) * RowColSize;
  FPaddedHeight := ((FHeight + RowColSize - 1) div RowColSize) * RowColSize;

  SetLength(Channels[ctY],FPaddedHeight,FPaddedWidth);
  if FImageFormat = ifColor then begin
    FctMax := High(TAICChannelType);
    SetLength(Channels[ctCb],FPaddedHeight,FPaddedWidth);
    SetLength(Channels[ctCr],FPaddedHeight,FPaddedWidth);
  end else
    FctMax := ctY;
  SetLength(PreviousPredictionModes,
    FPaddedHeight div RowColSize,FPaddedWidth div RowColSize);

  InitializeQuantisationTables;
end;

procedure TAICBase.SetLinearQuality(const ScaleFactor: Integer);
begin
  SetQuantisationTable(ScaleFactor,InvQuant,True);
end;

procedure TAICBase.SetQuantisationTable(const ScaleFactor: Integer;
  out QuantTable: TAICQuantTable; const Inverse: Boolean);
const
  StdQuant = 18;
const
  AANScaleFactor: array [0..7] of Double = (
	  1.0, 1.387039845, 1.306562965, 1.175875602,
	  1.0, 0.785694958, 0.541196100, 0.275899379);
var
  X, Y: Integer;
  Tmp: Double;
begin
  { The quantisation tables use uniform values for all positions in the table
    (unlike the JPEG standard which uses higher values in the bottom-right
    parts of the matrix). The values are only scaled by AANScaleFactor
    constants, since this needed by the AAN DCT/IDCT algorithms. }
  for Y := 0 to 7 do
    for X := 0 to 7 do begin
      Tmp := (StdQuant * ScaleFactor + 50) / 100;
      Tmp := EnsureRange(Tmp,1,32767);
      if Inverse then
        QuantTable[Y*8+X] := Tmp * AANScaleFactor[Y] * AANScaleFactor[X]
      else
        QuantTable[Y*8+X] := 1.0 / (Tmp * AANScaleFactor[Y] * AANScaleFactor[X] * 8);
    end;
end;

end.