belajar huffman

ini ialah hasil otodidakq selama berhari2 meski tak diterima dosenq, tapi ini sungguh hasil kerja kerasq...
source code enkripsi huffman tapi dgn asumsi yg pembuat ialah pemula yaaa.. hehe...99x


unit Unit1;

interface

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

type
TForm1 = class(TForm)
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
Label1: TLabel;
Label2: TLabel;
Memo1: TMemo;
Edit1: TEdit;
GroupBox1: TGroupBox;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
BitBtn3: TBitBtn;
BitBtn4: TBitBtn;
OpenDialog1: TOpenDialog;
Label15: TLabel;
TabSheet3: TTabSheet;
GroupBox3: TGroupBox;
GroupBox2: TGroupBox;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
Label10: TLabel;
Label11: TLabel;
Label12: TLabel;
Label13: TLabel;
Label14: TLabel;
Label16: TLabel;
Label17: TLabel;
Label32: TLabel;
Label33: TLabel;
Label34: TLabel;
Label35: TLabel;
Label36: TLabel;
Label37: TLabel;
Label38: TLabel;
Label39: TLabel;
Label40: TLabel;
Label41: TLabel;
Label42: TLabel;
Label43: TLabel;
Label18: TLabel;
Label19: TLabel;
Label20: TLabel;
Label21: TLabel;
Label22: TLabel;
Label23: TLabel;
Label24: TLabel;
Label25: TLabel;
Label26: TLabel;
Label27: TLabel;
Label28: TLabel;
Label29: TLabel;
Label30: TLabel;
Label31: TLabel;
Label44: TLabel;
Label45: TLabel;
Label46: TLabel;
Label47: TLabel;
Label48: TLabel;
Label49: TLabel;
Label50: TLabel;
Label51: TLabel;
Label52: TLabel;
Label53: TLabel;
Label54: TLabel;
Label55: TLabel;
StringGrid1: TStringGrid;
BitBtn5: TBitBtn;
BitBtn6: TBitBtn;
GroupBox4: TGroupBox;
BitBtn7: TBitBtn;
StringGrid2: TStringGrid;
GroupBox5: TGroupBox;
StringGrid3: TStringGrid;
BitBtn8: TBitBtn;
BitBtn9: TBitBtn;
GroupBox6: TGroupBox;
Label56: TLabel;
Button1: TButton;
Label57: TLabel;
memo2: TMemo;
memo3: TMemo;
Label58: TLabel;
procedure BitBtn1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure BitBtn3Click(Sender: TObject);
procedure BitBtn4Click(Sender: TObject);
procedure BitBtn6Click(Sender: TObject);
procedure BitBtn5Click(Sender: TObject);
procedure BitBtn7Click(Sender: TObject);
procedure BitBtn8Click(Sender: TObject);
procedure BitBtn9Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

uses Unit4, Unit2;

{$R *.dfm}



procedure TForm1.BitBtn1Click(Sender: TObject);
var F: TextFile;
text1:string;
begin
if opendialog1.Execute then
begin
edit1.Text:=opendialog1.Files.GetText;
edit1.Text:=copy(edit1.Text,1,length(edit1.Text)-2);
if FileExists(edit1.Text) then
begin
memo1.Clear;
AssignFile(F, edit1.Text);
Reset(F);
while not eoln(f) do
begin
readln(F,text1);
memo1.Lines.add(text1);
end;
CloseFile(F);
end
else
ShowMessage('File '+edit1.Text+'tidak ditemukan');
end;
end;



procedure TForm1.FormCreate(Sender: TObject);
begin
memo1.Text:='';
edit1.text:='';
begin
with StringGrid1 do
begin
cells[1,1]:='0';
cells[1,2]:='0';
cells[1,3]:='0';
cells[1,4]:='0';
cells[1,5]:='0';
cells[1,6]:='0';
cells[1,7]:='0';
cells[1,8]:='0';
cells[1,9]:='0';
cells[1,10]:='0';
cells[1,11]:='0';
cells[1,12]:='0';
cells[1,13]:='0';
cells[1,14]:='0';
cells[1,15]:='0';
cells[1,16]:='0';
cells[1,17]:='0';
cells[1,18]:='0';
cells[1,19]:='0';
cells[1,20]:='0';
cells[1,21]:='0';
cells[1,22]:='0';
cells[1,23]:='0';
cells[1,24]:='0';
cells[1,25]:='0';
cells[1,26]:='0';
cells[0,1]:=label3.Caption;
cells[0,2]:=label4.Caption;
cells[0,3]:=label5.Caption;
cells[0,4]:=label6.Caption;
cells[0,5]:=label7.Caption;
cells[0,6]:=label8.Caption;
cells[0,7]:=label9.Caption;
cells[0,8]:=label10.Caption;
cells[0,9]:=label11.Caption;
cells[0,10]:=label12.Caption;
cells[0,11]:=label13.Caption;
cells[0,12]:=label14.Caption;
cells[0,13]:=label16.Caption;
cells[0,14]:=label17.Caption;
cells[0,15]:=label32.Caption;
cells[0,16]:=label33.Caption;
cells[0,17]:=label34.Caption;
cells[0,18]:=label35.Caption;
cells[0,19]:=label36.Caption;
cells[0,20]:=label37.Caption;
cells[0,21]:=label38.Caption;
cells[0,22]:=label39.Caption;
cells[0,23]:=label40.Caption;
cells[0,24]:=label41.Caption;
cells[0,25]:=label42.Caption;
cells[0,26]:=label43.Caption;
END;
end;
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
memo1.Text:='';
edit1.text:='';
label18.Caption:='0';
label19.Caption:='0';
label20.Caption:='0';
label21.Caption:='0';
label22.Caption:='0';
label23.Caption:='0';
label24.Caption:='0';
label25.Caption:='0';
label26.Caption:='0';
label27.Caption:='0';
label28.Caption:='0';
label29.Caption:='0';
label30.Caption:='0';
label31.Caption:='0';
label44.Caption:='0';
label45.Caption:='0';
label46.Caption:='0';
label47.Caption:='0';
label48.Caption:='0';
label49.Caption:='0';
label50.Caption:='0';
label51.Caption:='0';
label52.Caption:='0';
label53.Caption:='0';
label54.Caption:='0';
label55.Caption:='0';
end;

procedure TForm1.BitBtn3Click(Sender: TObject);
begin
profil.show;
end;

procedure TForm1.BitBtn4Click(Sender: TObject);
var counter,i:integer;
s:string;
begin
s:=memo1.lines.GetText;//kalimat yang lengkapnya
counter:=0; //index ke..
for i:=1 to length(s) do
begin
//tambah a till z
if s[i]='A' then //yang dicari
inc(counter);
label18.Caption:=inttostr(counter);
END; counter:=0;
for i:=1 to length(s) do
begin
if s[i]='B' then //yang dicari
inc(counter);
label19.Caption:=inttostr(counter)
end; counter:=0;
for i:=1 to length(s) do
begin
if s[i]='C' then //yang dicari
inc(counter);
label20.Caption:=inttostr(counter);
end; counter:=0;
for i:=1 to length(s) do
begin
if s[i]='D' then //yang dicari
inc(counter);
label21.Caption:=inttostr(counter);
end; counter:=0;
for i:=1 to length(s) do
begin
if s[i]='E' then //yang dicari
inc(counter);
label22.Caption:=inttostr(counter);
end; counter:=0;
for i:=1 to length(s) do
begin
if s[i]='F' then //yang dicari
inc(counter);
label23.Caption:=inttostr(counter);
end; counter:=0;
for i:=1 to length(s) do
begin
if s[i]='G' then //yang dicari
inc(counter);
label24.Caption:=inttostr(counter);
end; counter:=0;
for i:=1 to length(s) do
begin
if s[i]='H' then //yang dicari
inc(counter);
label25.Caption:=inttostr(counter);
end; counter:=0;
for i:=1 to length(s) do
begin
if s[i]='I' then //yang dicari
inc(counter);
label26.Caption:=inttostr(counter);
end; counter:=0;
for i:=1 to length(s) do
begin
if s[i]='J' then //yang dicari
inc(counter);
label27.Caption:=inttostr(counter);
end; counter:=0;
for i:=1 to length(s) do
begin
if s[i]='K' then //yang dicari
inc(counter);
label28.Caption:=inttostr(counter);
end; counter:=0;
for i:=1 to length(s) do
begin
if s[i]='L' then //yang dicari
inc(counter);
label29.Caption:=inttostr(counter);
end; counter:=0;
for i:=1 to length(s) do
begin
if s[i]='M' then //yang dicari
inc(counter);
label30.Caption:=inttostr(counter);
end; counter:=0;
for i:=1 to length(s) do
begin
if s[i]='N' then //yang dicari
inc(counter);
label31.Caption:=inttostr(counter);
end; counter:=0;
for i:=1 to length(s) do
begin
if s[i]='O' then //yang dicari
inc(counter);
label44.Caption:=inttostr(counter);
end; counter:=0;
for i:=1 to length(s) do
begin
if s[i]='P' then //yang dicari
inc(counter);
label45.Caption:=inttostr(counter);
end; counter:=0;
for i:=1 to length(s) do
begin
if s[i]='Q' then //yang dicari
inc(counter);
label46.Caption:=inttostr(counter);
end; counter:=0;
for i:=1 to length(s) do
begin
if s[i]='R' then //yang dicari
inc(counter);
label47.Caption:=inttostr(counter);
end; counter:=0;
for i:=1 to length(s) do
begin
if s[i]='S' then //yang dicari
inc(counter);
label48.Caption:=inttostr(counter);
end; counter:=0;
for i:=1 to length(s) do
begin
if s[i]='T' then //yang dicari
inc(counter);
label49.Caption:=inttostr(counter);
end; counter:=0;
for i:=1 to length(s) do
begin
if s[i]='U' then //yang dicari
inc(counter);
label50.Caption:=inttostr(counter);
end; counter:=0;
for i:=1 to length(s) do
begin
if s[i]='V' then //yang dicari
inc(counter);
label51.Caption:=inttostr(counter);
end; counter:=0;
for i:=1 to length(s) do
begin
if s[i]='W' then //yang dicari
inc(counter);
label52.Caption:=inttostr(counter);
end; counter:=0;
for i:=1 to length(s) do
begin
if s[i]='X' then //yang dicari
inc(counter);
label53.Caption:=inttostr(counter);
end; counter:=0;
for i:=1 to length(s) do
begin
if s[i]='Y' then //yang dicari
inc(counter);
label54.Caption:=inttostr(counter);
end; counter:=0;
for i:=1 to length(s) do
begin
if s[i]='Z' then //yang dicari
inc(counter);
label55.Caption:=inttostr(counter);
end;
end;

procedure SortStringGrid(var GenStrGrid: TStringGrid; ThatCol: Integer);
const
TheSeparator = '@';
var
CountItem, I, J, K, ThePosition: integer;
MyList: TStringList;
MyString, TempString: string;
begin
CountItem := GenStrGrid.RowCount; //jmlh data
MyList := TStringList.Create;//disimpan di memory
MyList.Sorted := false; //asumsi awal
try
begin
for I := 1 to (CountItem - 1) do //looping sd jmlh data
MyList.Add(GenStrGrid.Rows[I].Strings[ThatCol] + TheSeparator +
GenStrGrid.Rows[I].Text);
Mylist.Sort;
for K := 1 to Mylist.Count do
begin
MyString := MyList.Strings[(K - 1)];
ThePosition := Pos(TheSeparator, MyString);
TempString := '';
{Eliminate the Text of the column on which we have sorted the StringGrid}
TempString := Copy(MyString, (ThePosition + 1), Length(MyString));
MyList.Strings[(K - 1)] := '';
MyList.Strings[(K - 1)] := TempString;
end;
for J := 1 to (CountItem - 1) do
GenStrGrid.Rows[J].Text := MyList.Strings[(J - 1)];
end;
finally
MyList.Free;
end;
end;
//listbox1.Items.ValueFromIndex[3]:=form1.caption;

procedure TForm1.BitBtn6Click(Sender: TObject);
begin
SortStringGrid(StringGrid1, 1);
end;

procedure TForm1.BitBtn5Click(Sender: TObject);
begin
with StringGrid1 do
begin
cells[1,1]:='0';
cells[1,2]:='0';
cells[1,3]:='0';
cells[1,4]:='0';
cells[1,5]:='0';
cells[1,6]:='0';
cells[1,7]:='0';
cells[1,8]:='0';
cells[1,9]:='0';
cells[1,10]:='0';
cells[1,11]:='0';
cells[1,12]:='0';
cells[1,13]:='0';
cells[1,14]:='0';
cells[1,15]:='0';
cells[1,16]:='0';
cells[1,17]:='0';
cells[1,18]:='0';
cells[1,19]:='0';
cells[1,20]:='0';
cells[1,21]:='0';
cells[1,22]:='0';
cells[1,23]:='0';
cells[1,24]:='0';
cells[1,25]:='0';
cells[1,26]:='0';
cells[0,1]:=label3.Caption;
cells[0,2]:=label4.Caption;
cells[0,3]:=label5.Caption;
cells[0,4]:=label6.Caption;
cells[0,5]:=label7.Caption;
cells[0,6]:=label8.Caption;
cells[0,7]:=label9.Caption;
cells[0,8]:=label10.Caption;
cells[0,9]:=label11.Caption;
cells[0,10]:=label12.Caption;
cells[0,11]:=label13.Caption;
cells[0,12]:=label14.Caption;
cells[0,13]:=label16.Caption;
cells[0,14]:=label17.Caption;
cells[0,15]:=label32.Caption;
cells[0,16]:=label33.Caption;
cells[0,17]:=label34.Caption;
cells[0,18]:=label35.Caption;
cells[0,19]:=label36.Caption;
cells[0,20]:=label37.Caption;
cells[0,21]:=label38.Caption;
cells[0,22]:=label39.Caption;
cells[0,23]:=label40.Caption;
cells[0,24]:=label41.Caption;
cells[0,25]:=label42.Caption;
cells[0,26]:=label43.Caption;
cells[1,1]:=label18.Caption;
cells[1,2]:=label19.Caption;
cells[1,3]:=label20.Caption;
cells[1,4]:=label21.Caption;
cells[1,5]:=label22.Caption;
cells[1,6]:=label23.Caption;
cells[1,7]:=label24.Caption;
cells[1,8]:=label25.Caption;
cells[1,9]:=label26.Caption;
cells[1,10]:=label27.Caption;
cells[1,11]:=label28.Caption;
cells[1,12]:=label29.Caption;
cells[1,13]:=label30.Caption;
cells[1,14]:=label31.Caption;
cells[1,15]:=label44.Caption;
cells[1,16]:=label45.Caption;
cells[1,17]:=label46.Caption;
cells[1,18]:=label47.Caption;
cells[1,19]:=label48.Caption;
cells[1,20]:=label49.Caption;
cells[1,21]:=label50.Caption;
cells[1,22]:=label51.Caption;
cells[1,23]:=label52.Caption;
cells[1,24]:=label53.Caption;
cells[1,25]:=label54.Caption;
cells[1,26]:=label55.Caption;
end;
end;
procedure TForm1.BitBtn7Click(Sender: TObject);
var i,j,k,m,n,z:integer;
bd:string;
begin
with stringgrid1 do
begin
for i:=1 to ColCount - 1 do
for j:=1 to rowCount - 1 do
begin
if cells[i,j]<>inttostr(0) then
begin
k:=i-1;
m:=i-1;
n:=rowcount-j;
bd:=cells[k,j];
with stringgrid2 do
begin
cells[m,n]:=bd;
for z:=1 to n do
cells[i,n]:=inttostr(z);
end;
end;
end;
end;
end;


procedure TForm1.BitBtn8Click(Sender: TObject);
var i,j:integer;
begin
for i:=1 to 26 do
begin
stringgrid3.Cells[0,i]:=stringgrid2.Cells[0,i];
end;
for i:=1 to i do
BEGIN
if StringGrid2.Cells[1,i]<>'' then
begin
form1.StringGrid3.Cells[1,i]:=form2.StringGrid1.Cells[1,i];
end;
end;
end;
procedure TForm1.BitBtn9Click(Sender: TObject);
var i:integer;
begin
form2.show;
with form2.StringGrid1 do
begin
for i:=1 to rowcount-1 do
begin
cells[0,i]:=inttostr(i);
end;
cells[1,1]:='00001';
cells[1,2]:='00010';
cells[1,3]:='00011';
cells[1,4]:='00100';
cells[1,5]:='00101';
cells[1,6]:='00110';
cells[1,7]:='00111';
cells[1,8]:='01000';
cells[1,9]:='01001';
cells[1,10]:='01010';
cells[1,11]:='01011';
cells[1,12]:='01100';
cells[1,13]:='01101';
cells[1,14]:='01110';
cells[1,15]:='01111';
cells[1,16]:='10000';
cells[1,17]:='10001';
cells[1,18]:='10010';
cells[1,19]:='10011';
cells[1,20]:='10100';
cells[1,21]:='10101';
cells[1,22]:='10110';
cells[1,23]:='10111';
cells[1,24]:='11000';
cells[1,25]:='11001';
cells[1,26]:='11010';
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var i:integer;
bd,new,j:string;
aaa:tpoint;
begin
label57.Caption:=inttostr(length(memo2.lines.GetText));
bd:=memo2.lines.GetText;
for i:=1 to length(memo2.Lines.GetText) do
begin
if bd[i]='A' then
j:=form1.caption;
memo3.Lines[1]:=j;
{aaa:=memo3.CaretPos;
new:=memo3.Lines[aaa.y];
new:=Copy(new,0,aaa.x)+memo2.Text+Copy(new,aaa.x+1,Length(new));
memo3.Lines[aaa.X]:=new;
counter:=0; //index ke..
for i:=1 to length(s) do
begin
//tambah a till z
if s[i]='A' then //yang dicari
inc(counter);
label18.Caption:=inttostr(counter);
END; counter:=0;
var
CurPoint: TPoint;
cText: string;
cLine: string;
begin
cLine:='Hello Adam';
CurPoint:=Memo1.CaretPos;
cText:=Memo1.Lines[CurPoint.y];
cText:=Copy(cText,0,CurPoint.x)+cLine+Copy(cText,C urPoint.x+1,Length(cText));
Memo1.Lines[CurPoint.y]:=cText;
end;
}
end;
end;

end.