プログラムは、入力ファイルとして、in.txt
圧縮ファイルとして comp.txt 展開ファイルは out.txt となっています。実行ファイルと同じ場所に置くことでファイルにアクセスできます。
ファイルの指定をしたい場合は、TOpenDialog、TSaveDialogを追加して下さい。
連長圧縮 ランレングス圧縮
データーの圧縮方法の一つで、一つの値と、その値が連続している数データーを圧縮する方法です。
モノクロ画像の圧縮や、ファックスデーターの送信に使われています、ファックスの場合、白か黒のデーターしかなく一番適した圧縮方法です。
グレースケールや、カラー画象の場合は、連続したデーターが少ないので、この方法は適していません。
文章は、殆ど連続したデーターは無く、逆にデーターが増えてしまいます。
例えば
AAAAAAAABBBBBCCCCCCCCCDDDD を圧縮すると
A8B5C9D4 の様になります。
パソコンのデーターはバイト単位8ビットのなっているので、8ビットのコードと、8ビットで表すことの出来る数1～255ので表現されます。
連続したしたデーターが255個を超える場合は、A255A23 (数値は1バイト(8ビット)の値) の様になります。
プログラムは、入力ファイルとして、in.txt
圧縮ファイルとして comp.txt 展開ファイルは out.txt となっています。
実行ファイルと同じ場所に置くことでファイルにアクセスできます。
ファイルの指定をしたい場合は、TOpenDialog、TSaveDialogを追加して下さい。
プログラム
unit main;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
var
infile, outfile : Thandle; // 入力ファイル, 出力ファイル
// 圧縮
procedure encode;
var
ir, x : byte;
c, gets, puts : integer;
n : byte;
cf : double;
begin
gets := 0;
puts := 0;
c := fileread(infile, ir, 1); // 一バイト読み込み
if c <= 0 then exit; // 読み込めなかったら終了
inc(gets);
repeat
n := 0;
x := ir;
while n < 255 do begin // 個数の最大値は8bit 255 $FF 越えたら1から
inc(n); // 前の読み込みに対するカウント
c := fileread(infile, ir, 1); // 一バイト読み込み
if c <= 0 then break; // 読み込めなかったらブレーク
inc(gets);
if ir <> x then break; // 前と違ったらブレーク
end;
if filewrite(outfile, x, 1) <= 0 then break; // 値書き込み
inc(puts);
if filewrite(outfile, n, 1) <= 0 then break; // 個数書き込み
inc(puts);
until c <= 0;
Form1.Memo1.Lines.Append('読み込んだバイト数= ' + intTostr(gets));
Form1.Memo1.Lines.Append('書きこんだバイト数= ' + intTostr(puts));
cf := (puts / gets) * 1000;
cf := round(cf);
cf := cf / 1000;
Form1.Memo1.Lines.Append('圧縮率 = ' + floatTostr(cf));
end;
// 復元
procedure decode;
var
c, i, gets, puts :integer;
n, ir : byte;
begin
gets := 0;
puts := 0;
repeat
c := fileread(infile, ir, 1); // 一バイト読み込み 値
if c <= 0 then break;
inc(gets);
c := fileread(infile, n, 1); // 一バイト読み込み 個数
if c <= 0 then break;
inc(gets);
for i := 1 to n do begin // 個数分同じ値書き込み
c := filewrite(outfile, ir, 1);
if c <= 0 then break;
inc(puts);
end;
until c <= 0;
Form1.Memo1.Lines.Append('読み込んだバイト数= ' + intTostr(gets));
Form1.Memo1.Lines.Append('書きこんだバイト数= ' + intTostr(puts));
end;
// 圧縮
procedure TForm1.Button1Click(Sender: TObject);
var
comp, text : string;
begin
text := 'in.txt'; // 入力ファイル名
comp := 'comp.txt'; // 圧縮ファイル名
infile := fileopen(text, fmOpenRead); // 入力ファイルopen
if infile = INVALID_HANDLE_VALUE then begin
application.MessageBox('入力ファイル開けません。','注意',0);
exit;
end;
outfile := filecreate(comp, fmOpenWrite, 0); // 出力ファイル作成 既存のファイルがあったらopen
if outfile = INVALID_HANDLE_VALUE then begin
application.MessageBox('圧縮先ファイル開けません。','注意',0);
fileclose(infile);
exit;
end;
memo1.Clear;
encode;
fileclose(infile);
fileclose(outfile);
end;
// 展開
procedure TForm1.Button2Click(Sender: TObject);
var
comp, text : string;
begin
comp := 'comp.txt'; // 圧縮ファイル名
text := 'out.txt'; // 出力ファイル名
infile := fileopen(comp, fmOpenRead); // 圧縮ファイルopen
if infile = INVALID_HANDLE_VALUE then begin
application.MessageBox('圧縮ファイル開けません。','注意',0);
exit;
end;
outfile := filecreate(text, fmOpenWrite, 0); // 出力ファイル作成 既存のファイルがあったらopen
if outfile = INVALID_HANDLE_VALUE then begin
application.MessageBox('出力先ファイル開けません。','注意',0);
fileclose(infile);
exit;
end;
memo1.Clear;
decode;
fileclose(infile);
fileclose(outfile);
end;
end.
Run_Length_Encoding.zip
三角関数、逆三角関数、その他関数 に戻る