Turbo Pascal для начинающих

         

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

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

( (с) Культин Н. Б., 2000 }
{ Выводит 16-цветную картинку, содержимое bmp-файла }
function Draw(x0,y0: integer; fname: string;
transparent: boolean ):integer; { xO,yO - координаты левого верхнего угла
области вывода; 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; { сдвинутые на четыре разряда четыре
старшие бита прочитанного байта } Ы: 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;


Содержание раздела