ftester.pas

很好的源代码

unit FTester;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  FDualImage, ComCtrls, ExtCtrls, StdCtrls, FSelectCodecs, EvBGraphics,
  TeeProcs, TeEngine, Series, Chart;

type
  TFrmAlgorithmTester = class(TForm)
    PnlTop: TPanel;
    PnlClient: TPanel;
    PageControl: TPageControl;
    TSImage: TTabSheet;
    FrameDualImage: TFrameDualImage;
    PnlTopLeft: TPanel;
    LblTest: TLabel;
    CBQualityInterval: TComboBox;
    LblQualityLevel: TLabel;
    PnlTopClient: TPanel;
    BtnSelectCodecs: TButton;
    BtnGo: TButton;
    LblCodec: TLabel;
    LblTotalProgress: TLabel;
    PBOverall: TProgressBar;
    PBCodec: TProgressBar;
    TSChart: TTabSheet;
    Chart: TChart;
    procedure PnlTopClientResize(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure BtnSelectCodecsClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure BtnGoClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
    FSelectCodecsForm: TFrmSelectCodecs;
    FSrcBitmap, FDstBitmap: TEvBBitmap;
    FStream: TStream;
    FAborted: Boolean;
    FPBOverallOffset: Integer;
    FSeries: TLineSeries;
    procedure TestAlgorithms;
    procedure TestAlgorithm(const CodecInfo: TEvBBitmapFileFormatInfo;
      const Quality: TEvBCompressionQuality);
    procedure InitializeChart(const Chart: TChart);
  public
    { Public declarations }
    procedure Initialize(const Bitmap: TBitmap);
  end;

procedure AlgorithmTesterDialog(const Bitmap: TBitmap);

implementation

{$R *.dfm}

const
  SeriesColors: array [0..2] of TColor = (clGreen,clRed,clBlue);

procedure AlgorithmTesterDialog(const Bitmap: TBitmap);
var
  F: TFrmAlgorithmTester;
begin
  F := TFrmAlgorithmTester.Create(Application);
  try
    F.Initialize(Bitmap);
    F.ShowModal;
  finally
    F.Release;
  end;
end;

{ TFrmAlgorithmTester }

procedure TFrmAlgorithmTester.FormCreate(Sender: TObject);
begin
  FSelectCodecsForm := TFrmSelectCodecs.Create(Self);
  FSrcBitmap := TEvBBitmap.Create;
  FDstBitmap := TEvBBitmap.Create;
  FStream := TMemoryStream.Create;
  PageControl.ActivePage := TSImage;
end;

procedure TFrmAlgorithmTester.FormDestroy(Sender: TObject);
begin
  FSrcBitmap.Free;
  FDstBitmap.Free;
  FStream.Free;
end;

procedure TFrmAlgorithmTester.Initialize(const Bitmap: TBitmap);
begin
  FrameDualImage.SetOriginal(Bitmap);
  FSrcBitmap.Assign(Bitmap);
  FStream.Size := Bitmap.Width * Bitmap.Height * 3;
end;

procedure TFrmAlgorithmTester.PnlTopClientResize(Sender: TObject);
begin
  PBCodec.Width := PnlTopClient.Width - PBCodec.Left - 4;
  PBOverall.Width := PBCodec.Width;
end;

procedure TFrmAlgorithmTester.BtnSelectCodecsClick(Sender: TObject);
begin
  FSelectCodecsForm.ShowModal
end;

procedure TFrmAlgorithmTester.BtnGoClick(Sender: TObject);
begin
  if BtnGo.Tag = 0 then begin
    BtnGo.Tag := 1;
    BtnGo.Caption := 'Cancel';
    FAborted := False;
    BtnSelectCodecs.Enabled := False;
    CBQualityInterval.Enabled := False;
    TestAlgorithms;
  end else
    FAborted := True;
end;

procedure TFrmAlgorithmTester.TestAlgorithms;
var
  I, Quality, QualityInterval: Integer;
  CodecInfo: TEvBBitmapFileFormatInfo;
begin
  PBOverall.Position := 0;
  PBCodec.Position := 0;
  PBOverall.Max := FSelectCodecsForm.CheckedCodecCount * 100;
  QualityInterval := 1 shl CBQualityInterval.ItemIndex;
  InitializeChart(Chart);

  FPBOverallOffset := 0;
  for I := 0 to FSelectCodecsForm.CheckedCodecCount - 1 do begin
    CodecInfo := FSelectCodecsForm[I];
    LblCodec.Caption := 'Codec: ' + CodecInfo.Extension;

    FSeries := Chart.AddSeries(TLineSeries) as TLineSeries;
    FSeries.Title := CodecInfo.Description;
    FSeries.LinePen.Width := 1;
    if I < Length(SeriesColors) then
      FSeries.Color := SeriesColors[I];

    Quality := MinCompressionQuality;
    while Quality < MaxCompressionQuality do begin
      TestAlgorithm(CodecInfo,Quality);
      if FAborted then
        Break;
      Inc(Quality,QualityInterval);
    end;
    if FAborted then
      Break;
    TestAlgorithm(CodecInfo,MaxCompressionQuality);
    Inc(FPBOverallOffset,100);
  end;

  BtnGo.Tag := 0;
  BtnGo.Caption := 'Go!';
  BtnSelectCodecs.Enabled := True;
  CBQualityInterval.Enabled := True;
end;

procedure TFrmAlgorithmTester.TestAlgorithm(const CodecInfo: TEvBBitmapFileFormatInfo;
  const Quality: TEvBCompressionQuality);
var
  CompressedSize: Integer;
begin
  FStream.Position := 0;
  FSrcBitmap.Quality := Quality;
  FSrcBitmap.SaveToStream(FStream,CodecInfo.Extension);
  CompressedSize := FStream.Position;

  FStream.Position := 0;
  FDstBitmap.LoadFromStream(FStream);
  FrameDualImage.SetCompressed(FDstBitmap,CodecInfo.Description,
    Quality,CompressedSize);

  FSeries.AddXY(FrameDualImage.BPP,FrameDualImage.PSNR);

  PBCodec.Position := Quality;
  PBOverall.Position := FPBOverallOffset + Quality;
  Application.ProcessMessages;
end;

procedure TFrmAlgorithmTester.InitializeChart(const Chart: TChart);
var
  I: Integer;
begin
  for I := Chart.SeriesCount - 1 downto 0 do
    Chart.Series[I].Free;
  Chart.Color := $CCFFFF;
  Chart.BackWall.Transparent := False;
  Chart.BackWall.Color := clWhite;
  Chart.BottomAxis.Increment := 0.5;
end;

procedure TFrmAlgorithmTester.FormShow(Sender: TObject);
begin
  FrameDualImage.FrameResize(nil);
end;

end.