算術編碼是把一個信源表示為實軸上0和1之間的一個區間，信源集合中的每一個元素都用來縮短這個區間。
算術編碼的過程如下：
（1） 設定編碼區間的高段為h，編碼區間的長度為g，EndC為編碼字符分配的高段，StartC
為字符分配區間的低端。
（2） 根據有限的信源估算出各元素的概率。
（3） 杜宇編碼的元素A1，根據（2）估算的概率和區間，計算出該元素編碼後的新的l，和h。其公式如下：
h = StartC + g* K;
l = Endc + g* K1;
其具體程序如下：
const Ca = 0.2; Ce = 0.3;
Ci = 0.2; Co = 0.2;
Cu = 0.1;
var
Form1: TForm1;
s: string;
StartC, EndC: Extended;
implementation
{$R *.dfm}
procedure ConvertTo(s: string; var StartC, EndC: Extended);{將字符串變為數值}
var n, i: integer;
c: char;
g: Extended;
begin
StartC := 0;
EndC := 1;
n := Strlen(Pchar(s));
for i := 1 to n do
begin
c := s[i];
g := EndC - StartC;
case C of
'a':
begin
EndC :=StartC + g * Ca;
StartC := StartC + g * 0;
end;
'e':
begin
EndC := StartC + g * (Ca + Ce);
StartC := StartC + g * Ca;
end;
'i':
begin
EndC := StartC + g * (Ca + Ce + Ci);
StartC := StartC + g * (Ca + Ce);
end;
'o':
begin
EndC := StartC + g * (Ca + Ce + Ci + Co);
StartC := StartC + g * (Ca + Ce + Ci);
end;
'u':
begin
EndC := StartC + g * (Ca + Ce + Ci + Co + Cu);
StartC := StartC + g * (Ca + Ce + Ci + Co);
end;
else
begin
Showmessage(' 輸入的字符串有誤 ');
exit;
end;
end;
end;
end;
procedure NemuricalToStr(var s: String; var StartC, EndC: Extended);
{將數值轉換為字符串}
const eps = -1e-5;
begin
if StartC-0.2 < -eps then
if (EndC- 0.2<= -eps) and (EndC > StartC) then
begin
StartC := StartC / 0.2;
EndC := EndC / 0.2;
s := s + 'a';
if (StartC <>0) or (EndC <> 1) then
NemuricaltoStr(s,StartC,EndC);
end;
if (StartC- 0.2 >= eps) and (StartC-0.5 < -eps) then
if (EndC-0.5<= -eps) and (EndC>StartC) then
begin
StartC := StartC - 0.2;
EndC := EndC - 0.2;
StartC := StartC / 0.3;
EndC := EndC / 0.3;
s := s + 'e';
if (StartC <>0) or (EndC <> 1) then
NemuricaltoStr(s,StartC,EndC);
end ;
if (StartC- 0.5>= eps) and (StartC- 0.7< -eps) then
if (EndC-0.7<= -eps) and (EndC>StartC) then
begin
StartC := StartC - 0.5;
EndC := EndC - 0.5;
StartC := StartC / 0.2;
EndC := EndC / 0.2;
s := s + 'i';
if (StartC <>0) or (EndC <> 1) then
NemuricaltoStr(s,StartC,EndC);
end ;
if (StartC-0.7 >= eps) and (StartC-0.9 < -eps) then
if (EndC-0.9<=-eps) and (EndC>StartC) then
begin
StartC := StartC - 0.7;
EndC := EndC - 0.7;
StartC := StartC / 0.2;
EndC := EndC / 0.2;
s := s + 'o';
if (StartC <>0) or (EndC <> 1) then
NemuricaltoStr(s,StartC,EndC);
end ;
if (StartC -0.9>=eps) and (StartC-1 < -eps) then
if (EndC-1<= -eps) and (EndC>StartC) then
begin
StartC := StartC - 0.9;
EndC := EndC - 0.9;
StartC := StartC / 0.1;
EndC := EndC / 0.1;
s := s + 'u';
if (StartC <>0) or (EndC <> 1) then
NemuricaltoStr(s,StartC,EndC);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
s := Edit1.Text;
ConvertTo(s,StartC,EndC);
Edit2.Text := FloattoStr(StartC);
Edit3.Text := FloattoStr(EndC);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
s := '';
StartC := StrToFloat(Edit2.Text);
EndC := StrtoFloat(Edit3.Text);
NemuricalToStr(s,StartC,Endc);
Edit1.Text := s;
end;
