26.10.2012, 21:12 | #1 (permalink) |
Новичок
Регистрация: 26.09.2012
Сообщений: 7
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
|
Алгоритм rle
Код:
program Project2; {$APPTYPE CONSOLE} uses SysUtils, Windows; VAR File_In,File_Out:file of byte; mn:integer; exit_:Char; name1,name2:string; {========================================================================} procedure Compress(f1,f2:string); VAR count, b, value : byte; BEGIN Assign(File_in,f1); reset(File_in); Assign(File_out,f2); rewrite(File_out); read(File_in,value); count:=1; while not eof(File_in) do begin read(File_in,b); if (value<>b)or(count>=63)then begin if (count=1)and(value<192) then write(File_out,value) else begin count:=count+192; write(File_out, count, value); count:=1; end; value:=b; end else inc(count); end; count:=count+192; write(File_out, count, value); write(File_out, b); close(File_in); close(File_out); END; {=======================================================================} Procedure DeCompress(f1,f2:string); VAR b,count,i:byte; BEGIN Assign(File_out,f2); rewrite(File_out); Assign(File_in,f1); reset(File_in); count:=0; while not eof(File_in) do begin read(File_in,b); if b>192 then begin count:=b-192; read(File_in,b); for i:=1 to count do write(File_out,b); end else write(File_out,b); end; close(File_out); close(File_in); END; {======================================================================} Procedure Result_1; var size:string; BEGIN reset(File_in); reset(File_out); textcolor(10); str(FileSize(File_in),size); writeln('исходный файл',size); GoToXY(26,9); str(FileSize(File_out),size); GoToXY(26,10); writeln('сжатый файл = ',size); close(File_in); close(File_out) END; {======================================================================} Procedure Result_2; var size:string; BEGIN reset(File_in); reset(File_out); textcolor(10); str(FileSize(File_in),size); GoToXY(26,9) writeln('сжатый файл = ',size); str(FileSize(File_out),size); GoToXY(26,10) writeln('исходный файл = ',size); close(File_in); close(File_out) END; {========================================================================} begin SetconsoleCP(1251); SetconsoleOutPutCP(1251); writeln; write('введите имя входного файла '); readln(Name1); Assign(File_in,Name1); Reset(File_in) ; if IOResult<>0 then begin writeln('файл не найден!'); halt (0); end; write('введите имя выходного файла '); readln(Name2); Assign(File_out,Name2); rewrite(File_out); if Name1<>'' then begin Compress(Name1,Name2); gotoXY(28,7) writeln('файл заархивирован!'); Result_1; Decompress(Name1,Name2); gotoXY(28,7) writeln('файл разархивирован!'); Result_2; end; readln end. |
26.10.2012, 21:12 | |
Helpmaster
Member
Регистрация: 08.03.2016
Сообщений: 0
|
Чтобы не тратить время на поиски, отправлю вам сразу похожие обсуждения Описать алгоритм Разработать алгоритм удаления из стека Помогите изменить алгоритм Алгоритм Алгоритм с возвратом Помогите написать алгоритм и блок-схему |
Ads | |
Member
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
|
Опции темы | |
Опции просмотра | |
|
|