unit1.pas

用delhi做的程序实现了哈夫曼编码

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    ListBox1: TListBox;
    Button1: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    XPManifest1: TXPManifest;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  s1,s2:integer;
  b:array of real;
 type huff=record
   weight:real;
   parent,lchild,rchild:integer;
  end;


implementation

{$R *.dfm}



procedure select(shuzu:array of huff;k:integer);//有问题
var
x,z:integer;
min:real;
begin
  min:=1000000;
  for x:=0 to k-1 do
   begin
     if unit1.b[x]<min then
     begin
       min:=unit1.b[x];
       unit1.s1:=x;
     end;
   end;
   unit1.b[unit1.s1]:=1000000;
    min:=1000000;
  for z:=0 to k-1 do
   begin
     if unit1.b[z]<min then
     begin
       min:=unit1.b[z];
       unit1.s2:=z;
     end;
   end;
  unit1.b[s2]:=1000000;




end;

procedure TForm1.Button1Click(Sender: TObject);
var
s,q:string;
i,j,k,l,m,n,ci:integer;
a:array of huff;
p:array of huff;
np:array of string;
begin
 listbox1.Items.Clear;
 q:='';
 m:=1;
 if edit1.Text<>'' then begin
 s:=edit1.Text;
 for i:=1 to length(s) do
 begin
  if s[i]=' ' then
    m:=m+1;
 end;
 setlength(a,m);
 for j:=0 to (m-1) do
 begin
   if pos(' ',s)<>0 then
   begin
   n:=pos(' ',s);
   for k:=1 to (n-1) do
    begin
      q:=q+s[k];
   end;
   a[j].weight:=strtofloat(q);
    q:='';
    delete(s,1,n);
   end
   else
   begin
    for k:=1 to length(s) do
    begin
     q:=q+s[k];
    end;
    a[j].weight:=strtofloat(q);
    q:='';
   end;
 end;
end;
  l:=2*m-1;
  setlength(p,l);
  for i:=0 to m-1 do
  begin
   p[i].weight:=a[i].weight;
   p[i].parent:=0;
   p[i].lchild:=0;
   p[i].rchild:=0;

   end;
  for j:=m to l-1 do
  begin
    p[j].weight:=0;
    p[j].parent:=0;
    p[j].lchild:=0;
    p[j].rchild:=0;

  end;
   setlength(b,l);
   for i:=0 to l-1 do
    b[i]:=p[i].weight;
  for i:=m to l-1 do
  begin
    select(p,i);
    p[s1].parent:=i;
    p[s2].parent:=i;
    p[i].lchild:=s1;
    p[i].rchild:=s2;
    p[i].weight:=p[s1].weight+p[s2].weight;
    b[i]:=p[i].weight;
  end;

   listbox1.Items.Add('结构状态图....');

  for i:=0 to (l-1) do
   listbox1.Items.Add('NO:'+inttostr(i)+'    '+'W:'+floattostr(p[i].weight)+'    '+'P:'+inttostr(p[i].parent)+'    '+'L:'+inttostr(p[i].lchild)+'    '+'R:'+inttostr(p[i].rchild));
    listbox1.Items.Add('');
   listbox1.Items.Add('赫夫曼编码....');
   setlength(np,m);
   for i:=0 to m-1 do
   begin
     ci:=i;
     while p[ci].parent<>0 do
       begin
         if p[p[ci].parent].lchild=ci then
          np[i]:='0'+np[i];
         if p[p[ci].parent].rchild=ci then
           np[i]:='1'+np[i];
          ci:=p[ci].parent;
       end;
   end;


   for i:=0 to m-1 do
    listbox1.Items.Add('NO:'+inttostr(i)+'    '+'Cod:'+np[i]);





   



end;
end.