Иллюстрированный самоучитель по Turbo Pascal для начинающих

Вывод иллюстраций

В языке Turbo Pascal нет стандартной процедуры, которая обеспечивала бы вывод на экран картинки, находящейся в файле. Программист сам может разработать такую процедуру. Однако эта задача является довольно сложной. Поэтому ниже приведен текст разработанной автором функции Draw, которая выводит на экран 16-цветную картинку, созданную в среде Windows, например, при помощи графического редактора Paint.

((с) Культин Н. Б., 2000 }
{ Выводит 16-цветную картинку, содержимое bmp-файла }
function Draw(x0,y0: integer; fname: string;
transparent: boolean):integer; { x0,y0 – координаты левого верхнего угла
области вывода; fname – имя файла картинки; transparent = True – не выводить точки,
цвет которых совпадает с цветом левой нижней точки картинки. Значения функции:
успех – высота картинки в пикселах; -1 – не найден файл; -2 – картинка не является 16-цветной.
label
bye;
const
{ таблица преобразования кодировки цвета из Windows в DOS }
color: array[0..15] of byte = (0.4.2.6.1.5.3.7.8.12.10, 14.9.13.11.15);
type
{ Прочитав из bmp-файла эту запись, можно получить информацию
о находящейся в этом файле картинке: размере и кол-ве цветов. } bmpinfo = record
{ файл должен начинаться буквами ВМ }
(размер файла, байт }
{ резерв, не используется }
(смещение данных относительно
начала файла } { не используется } { ширина картинки } { высота картинки }
{ кол-во планов, должно содержать 1 } { кол-во битов на пиксел (1, 4, 8 или 24 }
hl,h2:
Size:
Reserved:
Offset:
b:
Width: Height: Plans: bpp:
char; longint; longint; longint;
longint;
longint;
longint;
word;
word;
end;
f: file of bmpinfo; bmpf: file of byte; res: integer;
{ для получения информации о картинке }
{ для чтения картинки }
{ код ошибки открытия файла }
info: bmpinfo;
х,у:integer; { координаты пиксела }
b: byte; { байт, прочитанный из файла }
bh: byte; { сдвинутые на четыре разряда четыре
старшие бита прочитанного байта } b1: byte; { четыре младшие бита прочитанного байта }
nb: integer; { кол-во байт (кратное четырем)
соответствующее строке } np: integer; { кол-во выведенных пикселов строки }
tpcolor: byte; { "прозрачный" цвет. Закрашенные этим цветом точки картинки на экран
не выводятся
i,j: integer;
begin
assign(f,fname);
{$1-}
reset(f);
{$1+}
res: = IOResult;
if res < > 0 then
begin
Draw: = – 1; { не найден файл картинки }
goto bye; end;
read(f,info); { читаем информацию о картинке } close(f); { и закрываем файл }
if info.bpp < > 4 then begin
Draw: = – 2; { картинка не 16-цветная }
goto bye; end;
x: = xO;
у: = yO+infо.height;
nb: = (info.width div 8)*4;
if (info.width mod 8) < > 0 then nb: = nb+4;
assign(bmpf,fname);
reset (bmpf);
seek(bmpf,info.offset);
if transparent then begin
read (bmpf, b);
tpcolor: = b shr 4;
seek(bmpf,info.offset); end
else tpcolor: = 17; { в качестве прозрачного зададим
несуществующий цвет }
for i: = l to info.height do begin
np: = 0; {кол-во выведенных пикселов }
246 Turbo Pascal в задачах и примерах
for j: = l to nb do { вывод строки }
begin
¦ II { if not EOF(bmpf) then }
read (bmpf, b);
1 if np < info.width then
begin
1 bh: = b shr 4;
if bh < > tpcolor
then putpixel(x,y,color[bh]);
inc(x);
inc(np);
end;
if np < info.width then
begin
bl: = b and 15;
II if bl < > tpcolor
then putpixel (x, y, color [Ы]);
inc(x);
inc(np);
end;
end;
x: = xO;
dec(y);
end;
close(bmpf);
Draw: = info.height;
bye:
end;
Если Вы заметили ошибку, выделите, пожалуйста, необходимый текст и нажмите CTRL + Enter, чтобы сообщить об этом редактору.