Створена програма є простою в застосуванні.

1. Натиснувши на пункт меню програми «Файл>Открыть ВМР-файл…» користувачу буде запропоновано ввести ім'я файлу, що потрібно відкрити.

2. Для того, щоб вивести обране зображення на екран потрібно натиснути на пункт меню «Работа с изображением> Отобразить ВМР-файл…».

3. Натиснувши на пункт меню програми «Файл>Сохранить ВМР-файл…» користувачу буде запропоновано ввести ім'я файлу, що потрібно зберегти на диск. Даним пунктом меню можливо скористатися, якщо попередньо було відкрито ВМР-файл.

4. Для перегляду довідки про програму потрібно натиснути на «Помощь> О Программе…».

5. Для виходу із програми потрібно натиснути «Файл>Выход».

А.4. Функціональні клавіші

{ Программа просмотра и записи BMP-файлов }

{$I-} { Отключаем контроль ошибок ввода/вывода }

program BMP_Viewer;

uses

crt, graph, My_Unit;

type

rgb = record

r, g, b: byte;

end;

const

g = 9.81;

palette: array[0..7] of rgb = (

(r:0; g:0; b:0), { 0 }

(r:0; g:0; b:1), { 1 }

(r:0; g:1; b:0), { 2 }

(r:0; g:1; b:1), { 3 }

(r:1; g:0; b:0), { 4 }

(r:1; g:0; b:1), { 5 }

(r:1; g:1; b:0), { 6 }

(r:1; g:1; b:1) ); { 7 }

var

bmpfile, savefile: string;

filled: boolean;

Procedure FileNameWin (x, y, w, h : byte);

Begin

TextColor (15);

GotoXY (6,1);

{ Вспомогательный текст }

TextColor (14);

Write ('Введите путь к загружаемому BMP-файлу:');

TextColor (15);

Rama (x, y, w, h);

window (lo(WindMin)+x+1, hi(WindMin)+y,

lo(WindMin)+x+w-2, hi(WindMin)+y+h-1); { Созда_м окно для ввода }

TextBackGround (7);

ClrScr;

TextColor (0)

End; { *** FileNameWin *** }

{ Ввод пути к файлу }

procedure InputFileName;

var

s: string;

begin

RamaWindow ('Загрузка BMP-файла',16, 10, 47, 4);

FileNameWin (10, 3, 30, 1);

repeat

ClrScr;

Readln(s);

if s<>'' then

bmpfile:= s;

until s <> '';

filled:= true;

end; { *** InputFileName *** }

Procedure SaveFileNameWin (x, y, w, h : byte);

Begin

TextColor (15);

GotoXY (6,1);

{ Вспомогательный текст }

TextColor (14);

Write ('Введите путь к сохраняемому BMP-файлу:');

TextColor (15);

Rama (x, y, w, h);

window (lo(WindMin)+x+1, hi(WindMin)+y,

lo(WindMin)+x+w-2, hi(WindMin)+y+h-1); { Созда_м окно для ввода }

TextBackGround (7);

ClrScr;

TextColor (0)

End; { *** FileNameWin *** }

{ Ввод пути к сохраняемому файлу }

procedure InputSaveFileName;

var

s: string;

begin

RamaWindow ('Сохранение BMP-файла',16, 10, 47, 4);

SaveFileNameWin (10, 3, 30, 1);

repeat

ClrScr;

Readln(s);

if s<>'' then

savefile:= s;

until s <> '';

end; { *** InputFileName *** }

{ Процедура просмотра BMP-файлов }

function ViewBMP(bmpfile: string): byte;

var

i, j, k, n, x0, y0, xs, ys, asp: word;

dep, rc, gc, bc, curdif, mindif: double;

c: char;

page: boolean;

bmp: file of byte;

wid, hgt, w2, h2: word;

shift, fp: longint;

wh, wl, hh, hl, r, g, b, col, dumb: byte;

begin

assign(bmp, bmpfile); { Открываем bmp-файла }

reset(bmp);

if IOResult <> 0 then { Проверяем есть ли такой файл }

begin

FileError(bmpfile);

exit;

end;

GraphInit; { Включаем графический режим }

x0:= getmaxX div 2; { Узнаем координаты центра экрана }

y0:= getmaxY div 2;

seek(bmp, 18); { Переходим к полям в файле с описанием ширины }

read(bmp, wl);

read(bmp, wh);

wid:= wh*256 + wl;

seek(bmp, 22); { Переходим к полям в файле с описанием высоты }

read(bmp, hl);

read(bmp, hh);

hgt:= hh*256 + hl;

h2:= hgt; w2:= wid; asp:= 1; { Определяем высоту и ширину картинки на экране }

while (h2 > 480)or(w2 > 640) do

begin

h2:= h2 div 2; w2:= w2 div 2; asp:= asp*2;

end;

xs:= x0 - w2 div 2; { опредляем координаты верхнего левого угла на экране }

ys:= y0 - h2 div 2;

seek(bmp, 54); { Переходим к описанию пикселей картинки }

for i:= h2 downto 1 do { В bmp-файле строки записываются в обратном порядке }

begin

for k:= 1 to wid*(asp-1)*3 do { Пропускаем строки, которые не будем выводить }

read(bmp, dumb);

for j:= 1 to w2 do

begin

for k:= 1 to (asp-1)*3 do

read(bmp, dumb);

read(bmp, b);

read(bmp, g);

read(bmp, r);

rc:= r;

gc:= g;

bc:= b;

dep:= sqrt(rc*rc + gc*gc + bc*bc); { Определение глубины цвета }

if dep > 0 then

begin

rc:= rc / dep;

gc:= gc / dep;

bc:= bc / dep;

mindif:= 1000;

col:= 0;

for k:= 0 to 7 do { Определение цвета из 16 возможных }

begin

curdif:= abs(rc - palette[k].r) +

abs(gc - palette[k].g) +

abs(bc - palette[k].b);

if curdif < mindif then { Определяем наименьшое расхождение от цвета в палитре }

begin

mindif:= curdif;

col:= k;

end;

end;

if dep > 220 then { Если яркость высокая, выбираем яркий цвет }

col:= col + 8;

end

else

col:= 0;

putpixel(xs + j, ys + i, col); { Отображаем пиксель на экране }

end;

end;

close(bmp); { Закрываем файл }

repeat { Ожидание нажатия клавиши }

c:= readKey;

case c of

#27: ViewBMP:= 0;

#13: ViewBMP:= 1;

else c:=#0;

end;

until c <> #0;

CloseGraph; { Выключаем графический режим }

end; { *** ViewBMP *** }

{ Процедура сохранения BMP-файла}

function SaveBMP(savefile: string): byte;

var

bmp1, bmp2: file of byte;

bt: byte;

begin

Write('Подождите, пожалуйста!');

assign(bmp1, bmpfile);

reset(bmp1);

if IOResult <> 0 then

begin

FileError(bmpfile);

filled:= false;

exit;

end;

assign(bmp2, savefile);

rewrite(bmp2);

while not eof(bmp1) do

begin

read(bmp1, bt);

write(bmp2, bt);

end;

close(bmp1);

close(bmp2);

end; { *** SaveBMP *** }

{ Информационное диалоговое окно о программе }

procedure ProgramInfo;

var

c: char;

begin

TextColor(15);

RamaWindow ('О программе...', 18, 8, 44, 9);

GotoXY(1,2);

Writeln (' Данная программа предназначена для');

writeln (' просмотра и записи BMP-файлов.');

Writeln (' Для начала вам нужно загрузить ');

writeln (' BMP-файл, а затем отобразить его на ');

writeln (' экране.'); Writeln; Writeln;

TextColor(4); Write('':1, 'Esc ');

TextColor(15); Write('- Выход');

TextColor(10);

Write('':18, 'Enter ');

TextColor(15); Write('- Далее');

TextColor (15);

Repeat

c:=upcase(readkey);

Until (c=#27)or(c=#13);

If c=#27 then halt;

c:=#0;

end; { *** ProgramInfo *** }

{ Окно с предупреждением о bmp-файле }

procedure BMPAlert;

var

c: char;

begin

TextColor(15);

RamaWindowAlert ('Внимание', 18, 8, 44, 7);

GotoXY(13,3);

Writeln ('BMP-файл не загружен!');

GotoXY(1,7);

TextColor(13); Write('':1, 'Esc ');

TextColor(15); Write('- Выход');

TextColor(10);

Write('':18, 'Enter ');

TextColor(15); Write('- Далее');

TextColor (15);

Repeat

c:=upcase(readkey);

Until (c=#27)or(c=#13);

If c=#27 then halt;

c:=#0;

end; { *** BMPAlert *** }

{ Процедура "Header" отображает начальную заставку программы }

procedure Header;

var

c: char;

m_i, m_j, i_max, j_max: byte;

quit: boolean;

{ Вывод меню }

procedure DialogMenu;

{ Выбор цвета пункта меню }

procedure SetColor_i(i: byte);

begin

if m_i = i then

begin

TextColor(15);

TextBackGround(0)

end

else

begin

TextColor(0);

TextBackGround(7)

end;

end;

{ Выбор цвета пункта подменю }

procedure SetColor_j(j: byte);

begin

if m_j = j then

begin

TextColor(0);

TextBackGround(3);

end

else

begin

TextColor(15);

TextBackGround(0);

end;

end;

{ Вывод подменю }

procedure SubDialog;

begin

TextColor(15);

TextBackGround(0);

if m_i = 1 then { Подменю файла }

begin

J_max:= 3;

Rama (3, 3, 32, 3);

window (3, 3, 34, 5);

clrscr;

SetColor_j(1); GotoXY(1,1); Write(' Открыть BMP-файл... ');

SetColor_j(2); GotoXY(1,2); Write(' Сохранить BMP-файл... ');

SetColor_j(3); GotoXY(1,3); Write(' Выход ');

end

else if m_i = 2 then { Подменю работы с графом }

begin

J_max:= 1;

Rama (14, 3, 32, 1);

window (14, 3, 45, 3);

clrscr;

SetColor_j(1); GotoXY(1,1); Write(' Отобразить BMP-файл... ');

end

else if m_i = 3 then { Подменю помощи }

begin

J_max:= 1;

Rama (42, 3, 32, 1);

window (42, 3, 73, 3);

clrscr;

SetColor_j(1); GotoXY(1,1); Write(' О программе... ');

end;

end;

begin

SetColor_i(1); GotoXY(2,1); Write('ФАЙЛ');

SetColor_i(2); GotoXY(13,1); Write('РАБОТА С ИЗОБРАЖЕНИЕМ');

SetColor_i(3); GotoXY(41,1); Write('ПОМОЩЬ');

SubDialog;

end;

{ *** Обработка выбранного пункта меню *** }

procedure ProcessItem;

begin

case m_i of

1: case m_j of

1: InputFileName;

2: if filled then

begin

InputSaveFileName;

SaveBMP(savefile);

end

else

BmpAlert;

3: quit:= true;

end;

2: case m_j of

1: if filled then

ViewBMP(bmpfile)

else

BmpAlert;

end;

3: case m_j of

1: ProgramInfo;

end;

end;

end;

begin

m_i:= 1; m_j:= 1;

i_max:= 3; j_max:= 1;

quit:= false;

repeat

window(1,1,80,25);

TextBackGround(7);

TextColor(1);

ClrScr;

GotoXY(30,10); Writeln('Курсовая работа на тему:');

TextColor(4); GotoXY(21,12); Writeln('"Программа записи и просмотра BMP-файлов"');

TextColor(0); GotoXY(4,23);

Write('Перемещайтесь по меню с помощью клавиш <ВЛЕВО>, <ВПРАВО>, <ВВЕРХ> и <ВНИЗ>');

TextColor(1); GotoXY(4,24);

Write('Выбор пункта меню - <ENTER>, ');

TextColor(4); Write('выход из программы - <ESCAPE>');

DialogMenu; { Вывод меню }

c:=upcase(readkey);

if c = #27 then quit:= true; { Выход из программы }

if c = #13 then ProcessItem; { Обработка выбора меню }

if c = #0 then c:= readkey; { Перемещение по меню }

case ord(c) of

72: if m_j <= 1 then m_j:= j_max { up }

else dec(m_j);

80: if m_j >= j_max then m_j:= 1 { down }

else inc(m_j);

75: begin

if m_i <= 1 then m_i:= i_max { left }

else dec(m_i);

m_j:= 1;

end;

77: begin

if m_i >= i_max then m_i:= 1 { right }

else inc(m_i);

m_j:= 1;

end;

end;

until quit;

if quit then

halt;

end; { *** Header *** }

begin

filled:= false;

repeat

Header; { Заставка }

InputFileName; { Ввод длины маятника }

if ViewBMP(bmpfile) = 1 then

begin

InputSaveFileName;

SaveBMP(savefile);

end;

until false;

end.

Размещено на Allbest