19.6.1.1. Опрос пикселов. Турбо Паскаль позволяет организовать прямой доступ к каждому пикселу экрана. Делается это функцией
GetPixel( X, Y : Integer )
которая возвращает значение типа Word — номер цвета пиксела с координатами (X,Y). Поскольку обычно номер цвета лежит в диапазоне 0..15 или меньше, значащим является только младший байт.
Приведем пример процедуры копирования изображения с графического экрана на одноцветный принтер (рис. 19.27). Это адаптированная версия процедуры из пакета Turbo Graphix Toolbox 4.0. Ее алгоритм довольно прост: поскольку на принтере можно воспроизвести только два цвета — черный и белый, то каждый пиксел экрана проверяется на совпадение с фоном. Если цвет есть (т.е. его значение не равно фоновому), то на принтер выводится точка, если цвета нет, то точка не выводится. В процедуру CopyToPRN передаются координаты прямоугольной области экрана X1... Y2 и два цвета, принимаемые за фоновые. Один из них — действительно фон, а второй может понадобиться, если в изображении есть область иного цвета, служащая фоном для надписей или чего-либо другого.
USES
CRT, Printer, Graph; { используются эти модули }
PROCEDURE CopyToPRN(X1,Y1,X2,Y2:Integer;Bk1,Bk2 : Word;
Inverse : Boolean; Mode : Byte );
{ Mode : 1 = двойная плотность (д/п) 120 точек/дюйм } { 2 = д/п, высокая скорость 120 точек/дюйм } { 3 = четверная плотность 240 точек/дюйм } { 0, 4, 5 = 80 точек/дюйм }
{ 6 = 90 точек/дюйм }
{ Для EPSON-принтеров не из ряда FX задавать Mode=1 }
{ Inverse : если True, то фон печати будет черным }
VAR
ScanLine : Integer; {текущая выводимая строка печати }
n1, n2 : Byte; {специальные значения для принтера }
Рис. 19.27 {448}
{ Составление байта для вывода графики на печать }
FUNCTION ConstructByte( X,Y : Integer) : Byte;
CONST
Bits : Array[0..7] of Byte = ( 128,64,32,16,8,4,2,1 );
{ десятичные веса 7-го,6-го,..,0-го бита в байте }
VAR
P : Word; { цвет точки (пиксела) }
CByte, Bit : Byte; { байт и номер бита в нем }
YY : Integer; { координата текущей точки }
BEGIN
CByte := 0; { начальное значение байта }
for Bit := 0 to 7 do begin { цикл: 8 точек вдоль оси Y }
YY := Y+Bit; { координата точки по оси Y }
Р := GetPixel(X, YY); { цвет в этой точке }
if (YY<=Y2) and (P<>bk1) and (P<>bk2) { Если цвет видимый, }
then Inc( CByte, Bits[Bit] ); {то запомнить точку }
end; {for}
ConstructByte := Cbyte { 8 битов (точек) построены }
END;
PROCEDURE Doline; { вывод одной строки на печать }
VAR
XPixel : Integer; { текущая координата точки по X }
PrintByte : Byte; { байт, кодирующий 8 пикселов }
BEGIN
if Mode=1 { включение графической печати: }
then Write( Lst, #27'L' )
else Write( Lst, #27'*', Chr(Mode) );
Write(Lst,Chr(n1),Chr(n2)); { посылка длины строки }
for XPixel:=X1 to X2 do begin { цикл по строке растра }
PrintByte := ConstructByte( XPixel, ScanLine );
if Inverse then PrintByte:=not PrintByte; {инверсия }
Write(Lst,Chr(PrintByte)); { печать кодового байта }
end; {for}
Write( Lst, #10 ) { посылка кода перевода строки }
END;
LABEL
Quit; { метка выхода при нажатии Esc }
BEGIN
Mode := Mode mod 7; { настройка режима печати Mode: }
if Mode in [0,5] then Mode := 4;
Write(Lst,#27'3’ #24); { межстрочный интервал 24/256" }
n1 := Lo(Succ(X2-X1)); { Определение количества точек }
n2 := Hi(Succ(X2-X1)); { на одной строке печати }
Рис. 19.27 (продолжение) {449}
ScaneLine := Y1; {стартовая строка растра }
while ScanLine(Y2 do begin {цикл по растру экрана }
if KeyPressed and (ReadKey=#27) {Нажата клавиша Esc? }
then Goto Quit; {если да, то выход… }
DoLine; {печать порции: 8 линий растра }
Inc(ScanLine, 8) {следующая порция линий растра }
end; {while}
Quit: {метка выхода при нажатии Esc }
Write(Lst, #27#2) {восстановление режима печати }
END;
{$I initgraf} {блок инициализации графики }
BEGIN {ПРИМЕР ВЫЗОВА ПРОЦЕДУРЫ}
GrInit; {инициализация графики }
SetFillStyle(HatchFill, Blue); {установка типа заливки }
FillEllipse(300, 100, 100, 50); {заливка области-эллипса }
CopyToPRN(0, 0, GetMaxX, GetMaxY, Black, False, 1);
CloseGraph {закрытие режима графики }
END.
Рис. 19.27 (окончание)
Показанная процедура будет работать во всех графических режимах адаптеров на принтерах, воспринимающих систему команд принтера EPSON.
19.6.1.2. управление пикселями. Оно заключается в возможности назначить цвет любому пикселю экрана. Процедура
PutPixel(x, y : Integer; Color : Word)
зажигает на экране с координатами (X, Y) пиксел цвета Color. На применении этой процедуры построен пример на рис. 19.28.
USES Graph, CRT {понадобится модуль CRT }
{$I initgraf.pas} {процедура инициализации }
CONST
minx = 290; miny = 70; {левый верхний угол области }
maxx = 350; maxy = 130; {правый нижний угол области }
Nx = Succ(maxx-minx); {ширина области в пикселах }
Ny = Succ(maxy-miny); {высота области в пикселах }
Npixels = Nx+Ny; {число пикселов в области } {450}
VAR
countpixels, color : Word; {счетчик точек и их цвет }
x, y : Integer; {координаты текущей точки }
BEGIN
GrInit; {инициализация графики }
color := GetMaxColor; {цвет выводимых точек }
countpixels := 0; {обнуление счетчика точек }
{Повторение до тех пор, пока значение счетчика не равно }
repeat {количеству точек в фигуре: }
x := minx+Random(Nx); {Случайные координаты }
y := miny+Random(Ny); {точки в прямоугольнике. }
if GetPixel(X, Y)=Black then {Если в точке (X, Y) }
begin {ничего нет, то }
PutPixel(x, y, color); {подсветить ее и }
Inc(countpixels) {увеличить счетчик. }
end;
until countpixels=Npixels;
repeat until KeyPressed; {пауза до нажатия клавиши }
{Повторение до тех пор, пока значение счетчика не станет }
repeat {равным нулю: }
x := minx+Random(Nx); {Случайные координаты }
y := miny+Random(Ny); {точки в прямоугольнике. }
if GetPixel(x, y) = color then
begin {Если точка (X, Y) светится, }
PutPixel(x, y, Black); {то «потушить» ее и }
Dec(countpixels) {уменьшить счетчик. }
end;
until countpixels=0;
CloseGraph {закрытие режима графики }
END.