fdualimage.pas

很好的源代码

unit FDualImage;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls;

type
  TFrameDualImage = class(TFrame)
    PnlOrig: TPanel;
    PnlCompressed: TPanel;
    PnlOrigTop: TPanel;
    PnlCompressedTop: TPanel;
    SBOrig: TScrollBox;
    PnlOrigBottom: TPanel;
    PnlCompressedBottom: TPanel;
    SBCompressed: TScrollBox;
    ImgOriginal: TImage;
    ImgCompressed: TImage;
    LblOrigFormat: TLabel;
    LblOrigSize: TLabel;
    LblCompressedQuality: TLabel;
    LblCompressedSize: TLabel;
    LblCompressedFormat: TLabel;
    procedure FrameResize(Sender: TObject);
  private
    { Private declarations }
    FPixelCount: Integer;
    FOrigSize: Integer;
    FScanlineSize: Integer;
    FPSNR: Double;
    FBPP: Double;
    procedure UpdateImagePositions;
    procedure UpdateImagePosition(const Image: TImage);
    function CalculatePSNR: Double;
  public
    { Public declarations }
    procedure SetOriginal(const Bitmap: TBitmap);
    procedure SetCompressed(const Bitmap: TBitmap; const FormatDesc: String;
      const Quality, CompressedSize: Integer);

    property PSNR: Double read FPSNR;
    property BPP: Double read FBPP;
  end;

implementation

{$R *.dfm}

uses
  Math;

function TFrameDualImage.CalculatePSNR: Double;
var
  MSE: Double;
  X, Y, Z, Temp: Integer;
  SrcBitmap, DstBitmap: TBitmap;
  S, D: PByte;
begin
  SrcBitmap := ImgOriginal.Picture.Bitmap;
  DstBitmap := ImgCompressed.Picture.Bitmap;
  MSE := 0;
  for Y := 0 to SrcBitmap.Height - 1 do begin
    S := SrcBitmap.ScanLine[Y];
    D := DstBitmap.ScanLine[Y];
    Temp := 0;
    for X := 0 to FScanlineSize - 1 do begin
      Z := S^ - D^;
      Inc(S);
      Inc(D);
      Inc(Temp,Z * Z);
    end;
    MSE := MSE + Temp;
  end;
  MSE := MSE / FOrigSize;
  if MSE = 0 then
    Result := 0
  else begin
    Result := (255 * 255) / MSE;
    Result := 10 * Log10(Result);
  end;
end;

procedure TFrameDualImage.FrameResize(Sender: TObject);
begin
  PnlOrig.Width := ClientWidth div 2;
  UpdateImagePositions;
end;

procedure TFrameDualImage.SetCompressed(const Bitmap: TBitmap;
  const FormatDesc: String; const Quality, CompressedSize: Integer);
begin
  ImgCompressed.Picture.Bitmap := Bitmap;
  ImgCompressed.Picture.Bitmap.PixelFormat := pf24Bit;
  UpdateImagePosition(ImgCompressed);
  FPSNR := CalculatePSNR;
  FBPP := (CompressedSize * 8) / FPixelCount;
  LblCompressedFormat.Caption := FormatDesc;
  LblCompressedSize.Caption := Format('Size: %d bytes, %.2f BPP',
    [CompressedSize,FBPP]);
  if FPSNR = 0 then
    LblCompressedQuality.Caption := Format('Quality: %d, PSNR: infinite',
      [Quality])
  else
    LblCompressedQuality.Caption := Format('Quality: %d, PSNR: %f db',
      [Quality,FPSNR]);
end;

procedure TFrameDualImage.SetOriginal(const Bitmap: TBitmap);
var
  BPP: Integer;
begin
  ImgOriginal.Picture.Bitmap := Bitmap;
  ImgOriginal.Picture.Bitmap.PixelFormat := pf24Bit;
  UpdateImagePosition(ImgOriginal);

  FPixelCount := Bitmap.Width * Bitmap.Height;
  if Bitmap.PixelFormat > pf8Bit then
    BPP := 24
  else
    BPP := 8;
  FOrigSize := (FPixelCount * BPP) div 8;
  FScanlineSize := Bitmap.Width * 3;
  LblOrigFormat.Caption := 'Original';
  LblOrigSize.Caption := Format('Size: %d bytes, %d BPP',[FOrigSize,BPP]);
end;

procedure TFrameDualImage.UpdateImagePosition(const Image: TImage);
begin
  if Image.Width < Image.Parent.Width then
    Image.Left := (Image.Parent.Width - Image.Width) div 2
  else
    Image.Left := 0;

  if Image.Height < Image.Parent.Height then
    Image.Top := (Image.Parent.Height - Image.Height) div 2
  else
    Image.Top := 0;
end;

procedure TFrameDualImage.UpdateImagePositions;
begin
  UpdateImagePosition(ImgOriginal);
  UpdateImagePosition(ImgCompressed);
end;

end.