rsvk/Archiver Demo/CompressionStatsDlgUnit.pas

unit CompressionStatsDlgUnit;
{-------------------------------------------------------------------------------
  Compression Statistics Dialog Unit
  ----------------------------------

---------------------------------------------
reSource v2.6
Copyright (C) 1998-2001 Victor Kasenda / gruv
http://go.to/gruv
email: vickas@singnet.com.sg
---------------------------------------------

  Desc:
  The compression stats dialog shows compression stats and averages for the
  files in the archive.
  Useful for comparing against other archivers.

  Features:
  Able to print out the compression stats.
  Font can be changed.

  Workings:
  The stats are calculated just before the form is shown. (OnShow)
-------------------------------------------------------------------------------}


(**) interface (**)

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, StdCtrls, Buttons, ComCtrls;

type
  TCompressionStatsDlg = class(TForm)
    RichEdit: TRichEdit;
    PrintDialog: TPrintDialog;
    MainMenu: TMainMenu;
    File1: TMenuItem;
    MIPrint: TMenuItem;
    MIExit: TMenuItem;
    FontDialog: TFontDialog;
    RichEditPopup: TPopupMenu;
    MIFont: TMenuItem;
    N1: TMenuItem;
    MICopytoClipboard: TMenuItem;
    procedure MIPrintClick(Sender: TObject);
    procedure MIExitClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FontDialogApply(Sender: TObject; Wnd: Integer);
    procedure MIFontClick(Sender: TObject);
    procedure MICopytoClipboardClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  CompressionStatsDlg: TCompressionStatsDlg;

(**) implementation (**)
uses Main, ArchiveHeadersUnit, StructsUnit;

{$R *.DFM}

procedure TCompressionStatsDlg.MIPrintClick(Sender: TObject);
begin
  if PrintDialog.Execute then
  begin
    // print the statistics
    RichEdit.Print('Caption');
  end;
end;

procedure TCompressionStatsDlg.MIExitClick(Sender: TObject);
begin
  Close;
end;

procedure TCompressionStatsDlg.FormShow(Sender: TObject);

  procedure AddColLine(const s: string);
  begin
    // The tabs have to be set for every paragraph in Rich Edit.
    // Each line is a paragraph, so the tabs have to be set for every line.
    with RichEdit do
    begin
      SelStart := length(Text);
      With Paragraph do
      begin
        Tab[0] := 100;            // filename
        Tab[1] := Tab[0] + 80;    // uncompressed
        Tab[2] := Tab[1] + 80;    // compressed
        Tab[3] := Tab[2] + 80;    // ratio
        Tab[4] := Tab[3] + 80;    // bits per byte
      end;
      Lines.Add(s);
    end;
  end;


var
  i: integer;
  CentralFileHeader: TCentralFileHeader;
  s, ws: string;
  total_bits_per_byte: extended;
  bits_per_byte: extended;
  compression_ratio, total_ratio: integer;     // ratios
  total_raw_size, total_compressed_size: integer;
  num_files: integer;
begin
  CentreFormToMain(Self);
  
  with RichEdit.Lines, MainForm do
  begin
    num_files := Resource1.ArchiveMan.ArchiveFile.CentralDir.Count;
    total_bits_per_byte := 0;
    total_ratio := 0;
    total_raw_size := 0;
    total_compressed_size := 0;

    Clear;
    Add('reSource Engine ' + reSourceVerStr);
    Add('Burrows Wheeler Transformation (BWT) Compression');
    Add('');
    Add('Compression statistics for file: ' + Resource1.ArchiveMan.archive_file_full_path);
    Add('');
    if (num_files > 0) then
    begin
      AddColLine('File name' + #9 + 'Raw size' + #9 + 'Compressed' + #9 + 'Ratio' + #9  + 'Bits per byte');
      AddColLine('---------' + #9 + '--------' + #9 + '----------' + #9 + '-----' + #9  + '-------------');

      for i := 0 to num_files-1 do
      begin
        CentralFileHeader := Resource1.ArchiveMan.ArchiveFile.CentralDir[i] as TCentralFileHeader;
        with CentralFileHeader do
        begin
          // update bits per byte
          bits_per_byte := GetBitsPerByte(compressed_size, uncompressed_size);
          total_bits_per_byte := total_bits_per_byte + bits_per_byte;
          // update compression ratio
          compression_ratio := GetCompressionRatio(compressed_size, uncompressed_size);
          inc(total_ratio, compression_ratio);
          // update totals
          inc(total_raw_size, uncompressed_size);
          inc(total_compressed_size, compressed_size);

          s := '';
          s := filename + #9 +
               IntToStr(uncompressed_size) + #9 +
               IntToStr(compressed_size) + #9 +
               IntToStr(compression_ratio) + '%' + #9 +
               GetBitsPerByteStr(compressed_size, uncompressed_size);

          AddColLine(s);
        end;
      end;

      Str((total_bits_per_byte / num_files):5:3 {(total_compressed_size * 8 / total_raw_size):5:3}, ws);
      s := 'Average' + #9 +
           IntToStr(total_raw_size) + #9 +
           IntToStr(total_compressed_size) + #9 +
           IntToStr(total_ratio div num_files) + '%' + #9 +    // add average ratio
           ws;                                                     // add average bits per byte

      AddColLine('---------' + #9 + '------------' + #9 + '----------' + #9 + '-----' + #9  + '-------------');
      AddColLine(s);
      Add('');
      Add('Number of files: ' + IntToStr(num_files));
    end
    else
    begin
      Add('There are no files in this archive.');
    end;
  end; {with}

end;

procedure TCompressionStatsDlg.FontDialogApply(Sender: TObject;
  Wnd: Integer);
begin
  RichEdit.Font := FontDialog.Font;
end;

procedure TCompressionStatsDlg.MIFontClick(Sender: TObject);
begin
  FontDialog.Font := RichEdit.Font;
  if FontDialog.Execute then
    RichEdit.Font := FontDialog.Font;
end;

procedure TCompressionStatsDlg.MICopytoClipboardClick(Sender: TObject);
begin
  MainForm.ShowBusy;
  with RichEdit do
  begin
    SelectAll;         // select everything then copy to clipboard
    CopyToClipBoard;
    SelLength := 0;    // deselect everything
  end;
  MainForm.ShowReady;
end;

end.