сnt-1
і відбувається запис змінних сnt та buf[cr] у файл.
Продовження ми можемо побачити на рисунку 2.5
Рисунок 2.5 – Продовження алгоритму функції Compress2
Як бачимо з рисунка 2.5, після запису у файл змінних виконується наступна умова:
сnt<255
Після цього програма перевіряє чи виконується умова чи ні. Якщо ні – то алгоритм повертається до змінної 1<сnt<254.
Якщо умова правильна, тоді задається змінна сnt, яка вже знаходиться на іншому інтервалі від 0 до 254.
Після цього знову повинно виконуватись дві умови:
buf[cr]?buf[cr+1]
cr<n
і якщо ці умови вірні, то алгоритм повертається до змінної сnt.
Якщо ні – то виконується наступна умова:
сnt=0
При правильності даної умови алгоритм повертається до змінної сnt, в іншому випадку відбувається запис змінних nll, сnt, buf[cr- cnt]… buf[i] у файл.
Після цього програма знов переходить до виконання умови:
cnt<255
і переходить до змінної 0<сnt<254, якщо умова правильна. Якщо вона не виконується, то алгоритм повертається аж до умови:
cr?n,
яка знаходиться на рисунку 2.4.
Таким чином працює алгоритм compress2
2.4 Розробка тексту програми
Процес роботи з програмою спочатку вимагає завдання початкового файлу. Для цього вибираються файли з розширенням *.bmp. Це реалізується завдяк наступній процедурі.
procedure TForm1.RB1Click(Sender: TObject);
begin
Задаємо тип маски файлу
fb1.Mask:='*.bmp';
end;
Всі основні операції при виконанні даної програми активізуються з натисканням кнопки Form1.Button1 «Виконати». Їй відповідає процедура procedure TForm1.Button1Click(Sender: TObject). Опишемо цю процедуру.
procedure TForm1.Button1Click(Sender: TObject);
Оголошення змінних
var s:string;
begin
Якщо немає назви, то вихід
if fb1.FileName='' then exit;
Присвоєння змінній s назви файлу
s:=fb1.FileName;
Перейменування розширення з *.bmp на *.сmp
s[length(s)-2]:='c';
Запис назви нового файлу в текстовий рядок на другій формі
form2.Edit3.Text:=s;
Дозвіл на запис в двох текстових рядках
form2.Edit1.Enabled:=true;
form2.Edit2.Enabled:=true;
Показує другу форму
form2.Show;
end;
В результаті виконання цієї процедури появиться нове вікно, за яке відповідає Unit2. Назва кінцевого файлу буде присвоєна змінній s, яка в свою чергу присвоюється текстовому рядку form2.Edit3.
При натисканні кнопки Form2.Button2 «Назад» реалізується процедура TForm2.Button2Click(Sender: TObject).
procedure TForm2.Button2Click(Sender: TObject);
begin
Закриває форму
Close;
end;
Якщо ж ми далі хочемо реалізувати поставлену перед нами задачу, тоді вказуємо в текстових полях form2.Edit1 і form2.Edit1 відповідно ширину і висоту блоку. Наступним нашим кроком є натискання кнопки Form2.Button1 «Конвертувати», яка активує процедуру procedure TForm2.Button1Click(Sender: TObject).
procedure TForm2.Button1Click(Sender: TObject);
оголошення змінних
var i:word;
s:string;
w,h:word;
er:integer;
fs,fd:tfilestream;
f:file;
begin
Присвоєння змінній s ширини блока
s:=edit1.Text;
Перевірка чи вірні символ в текстовому рядку edit1 (0-9)
for i:=1 to length(s) do
if (s[i]<'0') or (s[i]>'9') then
begin
Виведення повідомлення про наявність помилки
application.messagebox('Не вірно введено ширину блока','Помилка');
exit;
end;
Присвоєння змінній s висоти блока
s:=edit2.Text;
Перевірка чи вірні символ в текстовому рядку edit2 (0-9)
for i:=1 to length(s) do
if (s[i]<'0') or (s[i]>'9') then
begin
Виведення повідомлення про наявність помилки
application.messagebox('Не вірно введено висоту блока','Помилка');
exit;
end;
Перевід висоти і ширини з рядкового типу у чисельний
val(s,h,er);
val(edit1.Text,w,er);
try
Створюємо потік для запису в файл
fs:=tfilestream.Create(form1.FB1.FileName,fmopenread);
except
Виведення повідомлення про наявність помилки
application.MessageBox('Не можу відкрити файл з малюнком' ,'Помилка');
exit;
end;
Присвоєння змінній s назви файлу
s:=edit3.Text;
try
Створюємо потік для запису в файл
fd:=tfilestream.Create(s,fmcreate);
except
Виведення повідомлення про наявність помилки
application.MessageBox('Не можу створити вихідний файл' ,'Помилка');
close;
exit;
end;
Якщо виконується функція pack, тоді
if pack(w,h,fs,fd) then
begin
Знищує об’єкти
fs.Free;
fd.Free;
end
else
Якщо ні, то
begin
Знищує об’єкти
fs.Free;
fd.Free;
Зв’язує файл із змінною f
system.AssignFile(f,s);
system.erase(f);
end;
close;
end;
В цій процедурі спочатку перевіряється правильність введених параметрів (ширини і висоти) блоку. Якщо все вірно ,то відкривається початковий файл для читання. Наступним кроком буде процес архівування (функція Pack) і збереження результатів.
Розглянемо функцію TForm2.pack(const w,h:word;const FIn,FOut: Tfilestream).
functioTForm2.pack(const w,h:word;const FIn,FOut:Tfilestream):boolean;
Оголошення змінних
var fileh:TBitmapFileheader;
i,j,z,k:cardinal;
Оголошення списку buf
buf:record
case boolean of
true:(c:cardinal);
false:(wh,wl:word)
end;
t:cardinal;
res:longint;
dhdr:^cmphdr;
sz,rh,rw:cardinal;
ps,pd,p:pointer;
ftmp:tfilestream;
o,oo:cardinal;
f:file;
debug:tfilestream;
begin
try
fin.position:=0;
Заданяя розміру буфера
fin.readbuffer(fileh,sizeof(fileh));
except
Виведення повідомлення про наявність помилки
application.MessageBox('Не вірний формат BMP файла Архівація проводитись не буде','Помилка');
Не виконання функції pack
pack:=false;
exit;
end;
Якщо тип fileh не дорівнює $4D42, тоді
if fileh.bfType<>$4D42 then
begin
Виведення повідомлення про наявність помилки
application.MessageBox('Не вірний формат BMP файла Архівація проводитись не буде','Помилка');
Не виконання функції pack
pack:=false;
exit;
end;
Початок виконання циклу
with fin do
begin
try
position:=28;
Зчитування розміру буфера
ReadBuffer(buf.wh,2);
Якщо buf.wh не дорівнює 8, то
if (buf.wh<>8) then
begin
Виведення повідомлення про наявність помилки
application.MessageBox('BMP файл не 256 - колірний. Архівація проводитись не буде','Помилка');
Не виконання функції pack
pack:=false;
exit;
end;
Зчитування з буфера
readbuffer(buf.c,4);
Перевірка на кількість кольорів
if (buf.c<>BI_BITFIELDS) and (buf.c<>BI_RGB) then
begin
Виведення повідомлення про наявність помилки
application.MessageBox('BMP файл не 256 - колірний. Архівація проводитись не буде','Помилка');
Не виконання функції pack
pack:=false;
exit;
end;
except
Виведення повідомлення про наявність помилки
application.MessageBox('Не вірний формат BMP файла Архівація проводитись не буде','Помилка');
Не виконання функції pack
pack:=false;
exit;
end;
Задання нового розміру sz
sz:=fileh.bfOffBits+24;
getmem(dhdr,sz);
with dhdr^ do
begin
try
Переміщення на позицію 0
Seek(0,sofrombeginning);
Зчитування з буфера
readbuffer(dhdr^.header,fileh.bfOffBits);
ctrl:=cardinal(buffer);
Задання змінної ver
ver:=$0101;
Задання змінної blx
blx:=dhdr^.header.bi.biWidth div w;
Задання змінної bly
bly:=dhdr^.header.bi.biHeight div h;
Задання змінної blw
blw:=w;
Задання змінної bl h
blh:=h;
Задання нового розміру
hsize:=fileh.bfOffBits;
toffs:=sz;
boffs:=sz+blx*bly*4;
except
Виведення повідомлення про наявність помилки
application.MessageBox('Не вірний формат BMP файла Архівація проводитись не буде','Помилка');
pack:=false;
Не виконання функції pack
freemem(dhdr,sz);
Звільнення пам’яті
exit;
end;
Зміна параметрів блоку
rw:=dhdr^.header.bi.biSizeImage div dhdr^.header.bi.biHeight;
rh:=dhdr^.header.bi.biHeight;
dhdr^.header.bi.biWidth:=blx*blw;
dhdr^.header.bi.biHeight:=bly*blh;
Новий розмір блоку dhdr^.header.fh.bfSize:=blx*blw*bly*blh+dhdr^.header.fh.bfOffBits;
end;
try
Задання початкової позиції fout
fout.Position:=0;
Записуємо в буфер
fout.writebuffer(dhdr^,sz);
Звільняємо пам’ять
getmem(ps,dhdr^.blw*dhdr^.blh);
getmem(pd,dhdr^.blw*dhdr^.blh*2);
Створення фйлу Buldozer.tmp
ftmp:=tfilestream.create('Buldozer.tmp',fmcreate);
Задання початкової позиції ftmp
ftmp.Position:=0;
Знаходження параметрів блоку
t:=dhdr^.blh*rw;
k:=dhdr^.blw*dhdr^.blh;
Виконання циклу по кількості блоків
for j:=0 to dhdr^.bly-1 do
begin
Початковий розмір
o:=fileh.bfOffBits+rw*rh-j*t;
Виконання циклу по кількості блоків по x
for i:=0 to dhdr^.blx-1 do
begin
Пре присвоєння зміних
oo:=o;
p:=ps;
Виконання циклу по кількості блоків
for z:=0 to dhdr^.blh-1 do
begin
Знаходження позиції fin
oo:=oo-rw;
fin.Position:=oo;
Зчитування з буфера
fin.readbuffer(p^,dhdr^.blw);
p:=pointer(cardinal(p)+dhdr^.blw);
end;
Створення dbg.dat
debug:=tfilestream.Create('dbg.dat',fmcreate);
Запис в буфер
debug.WriteBuffer(ps^,dhdr^.blh*dhdr^.blw);
Знищення змінної
debug.Free;
Присвоєння res результату виконання функції compress4
res:=compress4(ps,pd,k);
Якщо res >0, тоді
if res>0 then
Записуємо в буфер
ftmp.WriteBuffer(pd^,res)
else
begin
Пере присвоєння змінної res
res:=-longint(dhdr^.blw*dhdr^.blh);
Запис в буфер
ftmp.WriteBuffer(ps^,res);
end;
Запис в