aicencoder.pas

很好的源代码

unit AICEncoder;
{ Advanced Image Coding (AIC)
  ===========================
  The main encoder class }

interface

uses
  AICBase, AICCommon, AICCabacEncoder, Windows, Graphics, Classes;

type
  TAICEncoder = class(TAICBase)
  { The main encoder class }
  private
    FFwdQuant: TAICQuantTable;
    { The quantisation table used by the Forward Discrete Cosine Transform to
      quantize the DCT coefficients. The same quantisation table is used
      for all color components (Y, Cb and Cr) }
    FCabac: TAICCabacEncoder;
    { The Contact Adaptive Binary Arithmetic Encoder uses for encoding
      values to the stream }
    function IsGreyscalePalette(const Palette: HPalette): Boolean;
    { Helper function to check if the given palette is a greyscale palette.
      Is used to determine if the image should be stored as greyscale image
      or as color image }
    procedure PadChannelsToBlockSize;
    { When the bitmap isn't a multiple of 8 pixels in width or height, this
      method is used to pad the channels to the next multiple of 8 pixels.
      The last column of the bitmap is extruded to the right, and the last row
      is extruded to the bottom }
    procedure WriteHeader;
    { Writes the file header to the stream }
    procedure Encode;
    { The main encoding method }
    procedure TryPredict(const Mode: TAICPredictionMode; const XB, YB: Integer;
      var Predicted: TAICByteBlock; var BestMode: TAICPredictionMode;
      var BestSAE: Integer);
    { Calls the inherited Predict method to try out a prediction for the given
      prediction mode. The Sum of Absolute Errors (SAE) is calculated for the
      difference between the predicted block and the actual block. When this
      error is smaller then the smallest error encountered so far, BestSAE is
      set to this error, and BestMode is set to the given prediction mode.
      Eventually, for each block the prediction mode with the smallest error is
      used to make the prediction }
  protected
    procedure SetLinearQuality(const ScaleFactor: Integer); override;
    { Initializes the forward quantisation table }
  public
    constructor Create(const Src: TBitmap; const DstFilename: String;
      const Quality: TAICQuality); overload;
    { Creates the encoder and compresses the bitmap Src to file DstFilename
      using the given quality level }
    constructor Create(const Src: TBitmap; const DstStream: TStream;
      const Quality: TAICQuality); overload;
    { Creates the encoder and compresses the bitmap Src to stream DstStream
      using the given quality level }
    destructor Destroy; override;
    { Cleanup }

    class procedure Compress(const Src: TBitmap; const DstFilename: String;
      const Quality: TAICQuality); overload;
    { Helper class method to compress a bitmap to a file.
      Just uses this class to do the actual compression. }
    class procedure Compress(const Src: TBitmap; const DstStream: TStream;
      const Quality: TAICQuality); overload;
    { Helper class method to compress a bitmap to a stream.
      Just uses this class to do the actual compression. }
  end;

implementation

uses
  AICFwdColorConversion, AICFwdDCT, AICInvDCT;
  
{ TAICEncoder }

class procedure TAICEncoder.Compress(const Src: TBitmap;
  const DstFilename: String; const Quality: TAICQuality);
begin
  Self.Create(Src,DstFilename,Quality).Free;
end;

class procedure TAICEncoder.Compress(const Src: TBitmap;
  const DstStream: TStream; const Quality: TAICQuality);
begin
  Self.Create(Src,DstStream,Quality).Free;
end;

constructor TAICEncoder.Create(const Src: TBitmap;
  const DstFilename: String; const Quality: TAICQuality);
var
  Stream: TStream;
begin
  Stream := TFileStream.Create(DstFilename,fmCreate);
  Create(Src,Stream,Quality);
  OwnsStream := True;
end;

constructor TAICEncoder.Create(const Src: TBitmap;
  const DstStream: TStream; const Quality: TAICQuality);
var
  Bmp: TBitmap;
begin
  inherited Create(DstStream);

  if (Src.PixelFormat = pf8Bit) and IsGreyscalePalette(Src.Palette) then begin
    SetImageProperties(Src.Width,Src.Height,ifGreyscale,Quality);
    ConvertBitmapToGreyscaleChannel(Src,Channels[ctY],Width,Height);
  end else if Src.PixelFormat = pf24Bit then begin
    SetImageProperties(Src.Width,Src.Height,ifColor,Quality);
    ConvertBitmapToYCbCrChannels(Src,Channels,Width,Height);
  end else begin
    Bmp := TBitmap.Create;
    try
      Bmp.Assign(Src);
      Bmp.PixelFormat := pf24Bit;
      SetImageProperties(Bmp.Width,Bmp.Height,ifColor,Quality);
      ConvertBitmapToYCbCrChannels(Bmp,Channels,Width,Height);
    finally
      Bmp.Free;
    end;
  end;

  PadChannelsToBlockSize;
  WriteHeader;
  FCabac := TAICCabacEncoder.Create(Quality,Stream);
  Encode;
end;

destructor TAICEncoder.Destroy;
begin
  FCabac.Free;
  inherited;
end;

procedure TAICEncoder.Encode;
var
  X, Y, Z, XB, YB, XI, YI, BestSAE: Integer;
  BestMode, PredictedMode: TAICPredictionMode;
  Predicted: TAICByteBlock;
  DCT: TAICIntBlock;
  CT: TAICChannelType;
begin
  { Process all 8x8 blocks in the image }
  for CT := ctY to ctMax do begin
    YB := 0; YI := 0;
    while YB < PaddedHeight do begin
      XB := 0; XI := 0;
      while XB < PaddedWidth do begin
        if CT = ctY then begin
          { The prediction mode is only determined for Y-channels }
          BestSAE := MaxInt;
          BestMode := pmVert;

          TryPredict(pmVert,XB,YB,Predicted,BestMode,BestSAE);
          TryPredict(pmHorz,XB,YB,Predicted,BestMode,BestSAE);
          TryPredict(pmDC,XB,YB,Predicted,BestMode,BestSAE);
          TryPredict(pmDiagonalDownLeft,XB,YB,Predicted,BestMode,BestSAE);
          TryPredict(pmDiagonalDownRight,XB,YB,Predicted,BestMode,BestSAE);
          TryPredict(pmVerticalRight,XB,YB,Predicted,BestMode,BestSAE);
          TryPredict(pmHorizontalDown,XB,YB,Predicted,BestMode,BestSAE);
          TryPredict(pmVerticalLeft,XB,YB,Predicted,BestMode,BestSAE);
          TryPredict(pmHorizontalUp,XB,YB,Predicted,BestMode,BestSAE);

          PredictedMode := PredictPredictionMode(XI,YI);
          PreviousPredictionModes[YI,XI] := BestMode;

          if PredictedMode = BestMode then
            X := -1
          else if BestMode < PredictedMode then
            X := Ord(BestMode)
          else
            X := Ord(BestMode) - 1; // Limit to 3 bits
          FCabac.WritePredictionMode(X);
        end else
          { Cb and Cr channels use the same prediction mode as for the
            corresponding block in the Y channel }
          BestMode := PreviousPredictionModes[YI,XI];

        Predict(BestMode,Channels[CT],XB,YB,Predicted);

        Z := 0;
        for Y := 0 to RowColSize - 1 do
          for X := 0 to RowColSize - 1 do begin
            DCT[Z] := Channels[CT,YB + Y,XB + X] - Predicted[Z];
            Inc(Z);
          end;

        ForwardDCTAndQuantize(DCT,FFwdQuant);
        FCabac.WriteCoefficients(CT,DCT);

        { To prevent propagation of errors, inverse transform and update channel
          so future predictions are based on decoded values. }

        DequantizeAndInverseDCT(DCT,InvQuant);

        Z := 0;
        for Y := 0 to RowColSize - 1 do
          for X := 0 to RowColSize - 1 do begin
            Channels[CT,YB + Y,XB + X] := AICByteClip[Predicted[Z] + DCT[Z]];
            Inc(Z);
          end;

        Inc(XB,RowColSize); Inc(XI);
      end;
      Inc(YB,RowColSize); Inc(YI);
    end;
  end;
end;

function TAICEncoder.IsGreyscalePalette(const Palette: HPalette): Boolean;
var
  Entries: array [0..255] of TPaletteEntry;
  I: Integer;
begin
  Result := (GetPaletteEntries(Palette,0,256,Entries) > 0);
  if Result then
    for I := 0 to 255 do
      with Entries[I] do begin
        Result := (peRed = I) and (peGreen = I) and (peBlue = I);
        if not Result then
          Exit;
      end;
end;

procedure TAICEncoder.PadChannelsToBlockSize;
var
  X, Y: Integer;
begin
  if Width <> PaddedWidth then
    for Y := 0 to Height - 1 do
      for X := Width to PaddedWidth - 1 do begin
        Channels[ctY,Y,X] := Channels[ctY,Y,Width - 1];
        if ImageFormat = ifColor then begin
          Channels[ctCb,Y,X] := Channels[ctCb,Y,Width - 1];
          Channels[ctCr,Y,X] := Channels[ctCr,Y,Width - 1];
        end;
      end;

  for Y := Height to PaddedHeight - 1 do begin
    Move(Channels[ctY,Height - 1,0],Channels[ctY,Y,0],PaddedWidth);
    if ImageFormat = ifColor then begin
      Move(Channels[ctCb,Height - 1,0],Channels[ctCb,Y,0],PaddedWidth);
      Move(Channels[ctCr,Height - 1,0],Channels[ctCr,Y,0],PaddedWidth);
    end;
  end;
end;

procedure TAICEncoder.SetLinearQuality(const ScaleFactor: Integer);
begin
  inherited;
  SetQuantisationTable(ScaleFactor,FFwdQuant,False);
end;

procedure TAICEncoder.TryPredict(const Mode: TAICPredictionMode; const XB,
  YB: Integer; var Predicted: TAICByteBlock; var BestMode: TAICPredictionMode;
  var BestSAE: Integer);
var
  SAE, X, Y, Z: Integer;
begin
  if Predict(Mode,Channels[ctY],XB,YB,Predicted) then begin
    SAE := 0;
    Z := 0;
    for Y := 0 to RowColSize - 1 do
      for X := 0 to RowColSize - 1 do begin
        Inc(SAE,Abs(Channels[ctY,YB + Y,XB + X] - Predicted[Z]));
        Inc(Z);
      end;
    if SAE < BestSAE then begin
      BestSAE := SAE;
      BestMode := Mode;
    end;
  end;
end;

procedure TAICEncoder.WriteHeader;
var
  Header: TAICFileHeader;
begin
  Header.FileID      := AICFileID;
  Header.FileVersion := AICFileVersion;
  Header.ImageWidth  := Width;
  Header.ImageHeight := Height;
  Header.ImageFormat := ImageFormat;
  Header.Quality     := Quality;
  Stream.WriteBuffer(Header,SizeOf(Header));
end;

end.