mainfrm.pas

HUFFMAN SUANFA SHI YONG JAVA BIAB DE

unit MainFrm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, ExtCtrls, ComCtrls, StdCtrls, Grids, Buttons, HCodes, ToolWin,
  ClassLib, HuffmanTree, RXSpin, Gauges;

type
  TMainForm = class(TForm)
    MainMenu: TMainMenu;
    FileMenu         : TMenuItem;
    OpenFileMenuItem : TMenuItem;
    CloseFileMenuItem: TMenuItem;
    N1               : TMenuItem;
    ExitFileMenuItem : TMenuItem;
    Grid: TStringGrid;
    FileOpenDialog: TOpenDialog;
    Label1: TLabel;
    FileNameLbl: TLabel;
    ToolBar: TToolBar;
    OpenToolBtn: TToolButton;
    ToolButton1: TToolButton;
    ExitToolBtn: TToolButton;
    ToolButton3: TToolButton;
    StartToolBtn: TToolButton;
    Label9: TLabel;
    BitSizeLabel: TLabel;
    Label10: TLabel;
    CodedBitSizeLabel: TLabel;
    Label11: TLabel;
    AvrBitPerSymLabel: TLabel;
    Label12: TLabel;
    SpinEdit: TRxSpinEdit;
    ToolButton2: TToolButton;
    ToolButton4: TToolButton;
    ToolBarImages: TImageList;
    TreeCodeLenLbl: TLabel;
    Label2: TLabel;
    AlfabetCardLbl: TLabel;
    Label3: TLabel;
    ToolButton5: TToolButton;
    StatusBar: TStatusBar;
    Progress: TGauge;
    TotalCodedLenLbl: TLabel;
    Label4: TLabel;
    PercentLbl: TLabel;
    StartMenu: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure OpenFileMenuItemClick(Sender: TObject);
    procedure CloseFileMenuItemClick(Sender: TObject);
    procedure ExitFileMenuItemClick(Sender: TObject);
    procedure StartToolBtnClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    C: TCode;
    BitStream: TBitStream;
    CodeBuffer: TCodeBuffer;
    CountBuffer: TCountBuffer;
    HuffmanBuffer: TCodeBuffer;
    Total: Cardinal;
    CodedLen: Cardinal;
    Loaded: boolean;
    OutFile: TextFile;
    procedure FillData(BitLen: Indexes);
    procedure ShowData;
    procedure SortByCount;
    procedure BuildHuffmanCodes;
  end;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}
{$R *.RES}
function Compare(var R1,R2): integer;
begin
     if (TCode(pointer(R1)^).N = TCode(pointer(R2)^).N) and
        IsEqual(TCode(pointer(R1)^).Code, TCode(pointer(R2)^).Code, (TCode(pointer(R1)^).N-1) div 8 +1)
     then Result := 0
     else Result := -1
end;
{$F+}
procedure InitHuffmanCode(var Rec);
  var pC: PCode;
begin
     {TCode(pointer(Rec)^).Free;}
     pC := new(PCode);
     pC^ := TCode.Create(0);
     PCode(Rec) := pC
     {TCode(pointer(Rec)^).Create(1)}
end;
{$F-}

{............................... TMainForm ....................................}

procedure TMainForm.FormCreate(Sender: TObject);
begin
     Loaded := false;
     CodeBuffer := TCodeBuffer.Create;
     CountBuffer := TCountBuffer.Create;
     HuffmanBuffer := TCodeBuffer.Create;
     Grid.Cells[0,0] := '