Delphi-PRAXiS - Huffman Codierung (Text)

Code:

			unit uTHuffman;

interface

type

 TZeichenfeld = array[char] of cardinal;

 TCodes = array[char] of string;       

 THuffmanknoten = class

   Zeichen: char;

   Gewicht: cardinal;       //Häufigkeit

   next: THuffmanknoten;

   L,R: THuffmanknoten;

 end;

 THuffman = class

  private

   Haeufigkeiten: TZeichenfeld;

   Text: string;

   Codes: TCodes;

   Codestring: string;

   Huffmanliste: THuffmanknoten; //Anfang der Liste(Wurzel)

  public

//procedure WriteKnoten(Knoten: Thuffmanknoten);

  // ------------------

  procedure Durchlauf;

  //durchläuft den Baum und guckt, wo sich "Nil" befindet, um Baum aufzubauen

   procedure zaehlen(T: string);

    //T ist der zu komprimierende Text.

    //Bestimmt die Zeichenhäufigkeit und speichert diese im Attribut

    //"Häufigkeiten".

   procedure HuffmanlisteErzeugen;

   //Erstellt den Codebaum(Liste).

  //function HuffmanlisteAnzeigen

  function getcodestring: string;

  procedure speichern(Dateiname:string);

  procedure laden(Dateiname: string);

   private

    procedure KnotenEinsortieren(k: THuffmanknoten);

    //"K" existiert und wird in die Liste nach Gewicht(Sortierung)eingefügt.

    //"Leicht" nach ganz vorne.

  end;

implementation

procedure THuffman.Durchlauf;

 procedure charcode(N: THuffmanknoten; code: string);

 begin

  if (N <> nil) then

   if (N.L = nil) and (N.R = nil) then

    Codes[N.Zeichen]:= code

    else begin

      charcode(N.L, Code + '0');

      charcode(N.R, Code + '1');

  end;

end;

begin

   charcode(Huffmanliste,'');

end;

procedure THuffman.zaehlen(T:string);

//T ist der zu komprimierende Text.

//Bestimmt die Zeichenhäufigkeit und speichert diese im Attribut

//"Häufigkeiten".

var

  z: char;

  i: cardinal;

begin

   //Häufigkeiten löschen

   for z:=#0 to #255 do Haeufigkeiten[z]:=0;

   //Text durchlaufen und Häufigkeiten addieren ...

   for i:=1 to length(T) do inc(Haeufigkeiten[T[i]]);

   //wenn man auf einen Buchstaben trifft, erhöhe Häufigkeit(Index) aus dem Text um 1

   Text:=T;

end;

procedure THuffman.HuffmanlisteErzeugen;    //Feld auslesen falls Wert größer als 1 = einsortieren

//Erstellt den Codebaum(Liste).

//wir durchlaufen das Feld und erstellen für jedes Zeichen

//mit einer Häufigkeit +1 einen Knoten

var

  x: THuffmanknoten;

  c: char;

begin

   for c:=#0 to #255 do begin

    if Haeufigkeiten[c] > 0 then begin

     x:=Thuffmanknoten.create;

     x.Zeichen:=c;

     x.Gewicht:=Haeufigkeiten[c];

     KnotenEinsortieren(x);

    end;

   end;

      while (Huffmanliste <> nil) and (Huffmanliste.next <> nil) do begin

        x:=THuffmanknoten.create;

        x.Gewicht:= Huffmanliste.Gewicht + Huffmanliste.next.Gewicht;

        x.L:=Huffmanliste;

        x.R:=Huffmanliste.next;

        Huffmanliste:= Huffmanliste.next.next;

        KnotenEinsortieren(x);

        X.L.next:=nil;

        X.R.next:=nil;

      end;

end;

procedure THuffman.KnotenEinsortieren(k: THuffmanknoten);

//"K" existiert und wird in die Liste nach Gewicht(Sortierung)eingefügt.

//"Leicht" nach ganz vorne.

 procedure einsortieren(var Knoten: THuffmanknoten);

 begin

 if Knoten= nil then Knoten:= k

  else

   if Knoten.Gewicht < k.Gewicht then einsortieren(Knoten.next)

   else begin

    k.next:= Knoten;

    Knoten:=k;

   end;

  end;

begin

   einsortieren(Huffmanliste)

end;

{function Huffmanlisteanzeigen;

begin

  Codetabelle;

   ... :='';

  for i:= 1 to length(Huffmanliste) Codes[...]

end;}

function THuffman.getcodestring: string;

var

i: integer;

begin

 codestring:= '';

 for i:= 1 to length(text) do

  codestring:= Codestring + Codes[Text[i]];

 result:= Codestring;

end;

procedure THuffman.speichern(Dateiname:string);

 var

 Datei: file of byte;

 B: byte;

 procedure WriteKnoten(Knoten: THUffmanknoten);

 var

   b:byte

   begin

   b:=ord(Knoten.Zeichen);

   Write(Datei, b);

   if (Knoten.L <> nil) then WriteKnoten(Knoten.L);

   if (Knoten.R <> nil) then WriteKnoten(Knoten.R);

   end;

begin

 assignfile(Datei, Dateiname);

 rewrite(datei);

 B:=length(Codestring) mod 8;

 Write (Datei, B);

 writeKnoten(Huffmanliste);

 //hier fehlt was

end;

procedure THuffman.laden(Dateiname: string);

var

Datei: file of byte;

b: byte;

i: integer;

begin

 assignfile(Datei, Dateiname);

 reset(datei);

 codestring:='';

 Huffmanliste:= // BAUM LÖSCHEN;

 CreateKnoten(Huffmanliste);

 read(Datei, b, 1);

  for i:=0 to 7 do begin //Bits nach links rausschieben und Bit 7 prüfen:

   if (b and 128 = 0) then Codestring:=Codestring + '0'

   else Codestring:=Codestring + '1';

    b:=b shl 1;

  end;

end;

end.

Formular:

Code:

			unit GUI;

interface

uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

  uTHuffman, StdCtrls, Menus;

type

  TForm1 = class(TForm)

    MEingabe: TMemo;

    Button1: TButton;

    Label1: TLabel;

    Button2: TButton;

    Datei1: TMenuItem;

    Beenden1: TMenuItem;

    N1: TMenuItem;

    Druckereinrichtung1: TMenuItem;

    Drucken1: TMenuItem;

    N2: TMenuItem;

    Speichernunter1: TMenuItem;

    Speichern1: TMenuItem;

    N3: TMenuItem;

    Schlieen1: TMenuItem;

    ffnen1: TMenuItem;

    Neu1: TMenuItem;

    N4: TMenuItem;

    Komprimiertspeichern1: TMenuItem;

    N5: TMenuItem;

    Komprimiertffnen1: TMenuItem;

    OpenDialog1: TOpenDialog;

    SaveDialog1: TSaveDialog;

    Label3: TLabel;

    MAusgabe: TMemo;

    Ausgabe: TLabel;

    Button3: TButton;

    m: TMainMenu;

    procedure FormCreate(Sender: TObject);

    procedure FormDestroy(Sender: TObject);

    procedure Button1Click(Sender: TObject);

    procedure Neu1Click(Sender: TObject);

    procedure ffnen1Click(Sender: TObject);

    procedure Schlieen1Click(Sender: TObject);

    procedure Beenden1Click(Sender: TObject);

    procedure Speichern1Click(Sender: TObject);

    procedure Button3Click(Sender: TObject);

    procedure Button2Click(Sender: TObject);

  private

    { Private-Deklarationen }

    Huffman: THuffman;

  public

    { Public-Deklarationen }

  end;

var

  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.ffnen1Click(Sender: TObject);

 {procedure LoadFromFile(const FileName: string);

  begin

  // ShellExecute(Application.Handle, 'open', PChar('C:\x.doc'), nil, nil, SW_NORMAL);

  end;

  begin

  end;}

  begin

  OpenDialog1.Filter:='Textdateien (*.txt) |*.TXT|alle Dateien (*.*) |*.*';     //Aus Delphi Hilfe entnommen

  OpenDialog1.Title:= 'Öffnen';

  if OpenDialog1.Execute then MEingabe.Lines.LoadfromFile(Opendialog.FileName);

  end;

procedure TForm1.FormCreate(Sender: TObject);

begin

   Huffman:=THuffman.Create; //Klassenbezeichner erstellen (Objekt)

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

    Huffman.free;  //Ebenfalls mit Klassenbezeichner machen, wenn erstellt

end;

procedure TForm1.Neu1Click(Sender: TObject);

begin

MEingabe.text:='';

MAusgabe.text:='';

end;

procedure TForm1.Schlieen1Click(Sender: TObject);

begin

close;

end;

procedure TForm1.Beenden1Click(Sender: TObject);

begin

close;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

   Huffman.zaehlen(MEingabe.lines.text);

   Huffman.HuffmanlisteErzeugen;

end;

procedure TForm1.Speichern1Click(Sender: TObject);

 procedure SaveToFile(const FileName: string); //virtual;

  begin

  Savedialog1.defaultext:='txt';

  SaveDialog1.Filter:='Textdateien (*.txt) | *.TXT|alle dateien (*.*) | *.*';

  SaveDialog1.Title:='Baum in eine Textdatei exportieren';

  if SaveDialog1.Execute then MEingabe.Lines.SaveToFile(SaveDialog1.FileName);

  end;

begin

end;

procedure TForm1.Button3Click(Sender: TObject);

begin

//MAusgabe.lines.text:= THuffman.HuffmanlisteAnzeigen;

//MAusgabe.lines.text:='';

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

 Huffman.Durchlauf;

 Showmessage(Huffman.getcodestring);

end;

end.

Zugehörige Aufgabe:
Die fehlenden Funktionalitäten zum Schreiben, Lesen der Binärdateien und die Dekompression sind in der Klasse „THuffman“ zu ergänzen (Dazu gibt es im Folgenden einige Hinweise…). (Braucht ihr die)

Danke im Voraus