TURBO PASCAL

4.2.10. Тестовая программа

Следующая довольно длинная программа иллюстрирует некоторые приемы работы с подпрограммами модуля F_Mouse. В программе создается экран, показанный на рис.4.1.

Демонстрация возможностей модуля FJIouse

Рис.4.1. Вид экрана для тестовой программы

После запуска программы она ожидает одно из трех возможных событий: нажатие клавиши F1 — в этом случае предлагается возможная форма указателя мыши; F2 — переход из текстового режима в графический и обратно; Esc — завершение работы программы и возврат в ДОС. Замечу, что для сохранения идентичности экранов независимо от текущего режима работы (текстового или графического) в программе используются процедуры модулей F_Text1 и F_GrText. При этом изображения на экране оказываются настолько похожими, что для неискушенного взгляда единственным отличием режимов является лишь форма указателя мыши.

Вы можете выбирать эти продолжения не только с помощью клавиш, но и мышью. Для этого необходимо сместить указатель мыши так, чтобы он попал внутрь соответствующего прямоугольника, и нажать левую кнопку мыши.

При выборе формы указателя в текстовом режиме на экране разворачивается окно, содержащее все символы ПК в диапазоне от 1 до 255. Сместив указатель к нужному символу и нажав левую кнопку мыши, можно выбрать форму указателя. В графическом режиме программа предлагает меню из 4 возможных форм: стандартный указатель, пере—

' Модуль F_Text предназначен для пода.ержки многостраничной работы в текстовом режиме. Поскольку объем этой книги оказался чрезмерно большим, пришлось пожертвовать описанием этого модуля и особенностей работы в текстовом режиме. Текст модуля Вы найдете в прил.7.

крестие, кружок и квадрат. Для выбора формы указателя в графическом режиме используется процедура, получающая управление от драйвера мыши при любом перемещении ее по столу. В этой процедуре определяется текущее положение указателя и высвечивается негативным изображением указатель той или иной формы.

^———————————————————————————+

Программа, демонстрирующая возможности \ ¦ модуля F_Mouse \ +——_——————————————————————+^

Uses CRT,DOS,Graph,F_Mouse,F_GrText,F_Text;

const

tl = ' Демонстрация возможностей модуля F_Mouse ' ;

t2 = ' Состояние мыши: ';

t3: array [1..4] of String [22] =

('Координаты: Х= Y= ','Левая кнопка :', 'Правая кнопка :','Средняя кнопка:');

NItem = 3;

t4: array [1..NItem] of String [24] =

(' Изменить указатель (Fl)',' Сменить режим (F2)', ' Завершить работу (Esc)') ;

type

ItemT = array [1..NItem] of MouseItemType;

const

Items: ItemT =(

(XI: 9; Yl: 4; X2:35; Y2: 6; Butt: LeftButton; Key:59 shi 8), (XI:44; Yl: 4; X2:68; Y2: 6; Butt: LeftButton; Key:60 shi 8), (X1:26; Y1:18; X2:51; Y2:20;utt: LeftButton; Key:27));

Text: Boolean аг True;

var

k,n,b,x,y,bb,xx,yy: Integer;

Font: Pointer;

FontSize: Word;

type

GotoXYType = procedure (X,Y: Byte);

ColorsType = procedure (Text,Back: Byte);

SetWindowType = procedure (XI,Y1,X2,Y2,Border: Byte;

Header: String;lip,Build,Play: Boolean);

ChangeCursorType = procedure;

var

Colors: ColorsType;

GotoXY: GotoXYType;

SetWindow: SetWindowType;

ChangeCursor: ChangeCursorType;

Procedure SetScreen;

/Создает экран в текстовом или графическом режиме} begin

{Создаем основное окно} Colors(Black,LightGray) ;

SetWindow(1,1,80,25,DoubleBorder,tl,True,False,False);

{Создаем элементы выбора} Colors(Black,Green);

for k := 1 to NItem do with Items[k] do begin

SetWindow(XI,Yl,X2,Y2,SingleBorder,'',True,False,False) ;

Write(t4[k]) end;

{Создаем панель статуса} Colors(White,Red) ;

SetWindow(24,9,55,16,DoubleBorder,t2,True,False,False) ;

n := (3O-Length(t2)) div 2;

for k := 1 to 4 do begin

GotoXY(n-3,k+l) ;

Write(t3[k]) end end; {SetScreen} {____——————————————}

Procedure ChangeTextCursor; Far;

{Изменяет курсор в текстовом режиме} const

t = ' Выберите символ для указателя мыши ';

var

k: Byte;

n,x,y: Integer;

begin {Создаем окно выбора} HideMouse;• PutWindow(8,7,73,12,White,Blue,

DoubleBorder,1,t,True,False/False) ;

{Выводим в нем все символы, кроме Bel,BS,LF,CR} for k := 1 to 255 do

if k in [7,8,10,13] then

Write (' ') else

Write(chr(k)) ;

{Формируем пределы перемещения указателя} MouseWindow(MouseGraphCooX(9),MouseGraphCooY(8), MouseGraphCooX(72),MouseGraphCooY(11)) ;

{Цикл до в>тпускания левой кнопки} Repeat

GetMouseState(b,x,у) ;

until b and LeftButton=O;

ShowMouse;

{Цикл до нажатия левой кнопки}

Repeat

GetMouseState(b,x,y);

until b and LeftButtonoO;

HideMouse;

{Определяем выбранный символ}

x := MouseTextCooX(х)-8;

у := MouseTextCooY(у)-7;

х := (у-1)*64+х;

if x>255 then

х := 1; . {Меняем форму курсора}

MouseTextCursor($FFOO,$7FOO+x);

{Восстанавливаем экран}

GetWindow(1) ;

MouseScreen;

ShowMouse

end; {ChangeTeatCursor} {————,—————————————}

{Глобальные определения для обработчика событий от мыши, используемого в режиме выбора графического указателя} const

DX = 40; {Шаг смещения изображений}

NCur =4; {Количество изображений} var

kk, {Ранее выбранное изображение}

хО, {Левая граница изображения}

y0,yl: Integer; {Вертикальные границы}

РР: Pointer; {Изображение указателя}

SizePP: Word; {Его размеры в памяти} Procedure MouseHandler(Mask,Buttons,X,Y,dDX,DY: Integers-Far;

{Отслеживает перемещения мыши и инвертирует изображение,

на которое указывает в данный момент указатель мыши} var

k: Integer; {Текущее изображение} begin

k := (х-ХО) div DX;

if k<l then k := 1;

if k>NCur then k := NCur;

if k=kk then

Exit; {Текущее изображение не изменилось) {Гасим старое и выделяем новое изображение}

PutImage(xO+(2*kk-l) *DX div 2, y0, PP^NormalPut) ;

GetImage(xO+(2*k-l)*DX div 2,y0,x0+(2*k+l)*DX div 2,yl,P?^);

PutImage(xO+(2*k-l)*DX div 2,y0,PP",NotPut) ;

kk := k

end; {MouseHandler} {——————_——_————.———}

Procedure ChangeGraphCursor; Par;

{Изменяет курсор в графическом режиме} const.

t = ' Выберите указатель: ' ;

var

x,y,xl: Integer;

Size,b: Word;

p: Pointer;

Cur: array [1..NCur,0..1,0..15] of Word;

Proc: MouseHandlerType;

{————————}

Procedure PutCur(N: Byte);

{Сканирует изображение в левом верхнем углу экрана и формирует маски указателя} var

х,у: Byte;

b: Word;

begin

for у := 0 to 15 do begin b := 0;

for x := 0 to 15 do

if GetPixel (x,y) OGetBkColor then b := b or ($8000 shr x) ;

Cur[N,l,y] := b;

Cur[N,O,y] := not b end;

ClearViewPort end; {PutCur} {————————}

begin {ChangeGraphCursor}

{Готовим окно 16х16 в левом верхнем углу экрана} Size := ImageSize(О,0,15,15) ;

GetMem(P,Size) ;

GetImage^O/lS,]^,?^) ;

SetViewPort(0,0,15,15,ClipOn) ;

ClearViewPort;

{Готовим маски указателей} HideMouse;

if InitMouse then

ShowMouse; {Получаем стандартное изображение} SetMouseItem(NItem,Items) ;

MouseGotoXY(0,0); {Стандартный указатель} PutCur(1);

HideMouse;

Circle (8,8,4); {Кружок}

PutCur(2) ;

Line(0,8,15,8); {Перекрестие}

Line(8,0,8,15) ;

PutCur(3) ;

Rectangle(0,0,15,15); {Квадратик}

PutPixel(7,7,15) ;

PutCur(4) ;

SetViewPort(O,O,GetMaxX,GetMaxY,ClipOn) ;

{Готовим окно для меню указателей}

PutImage (0, 0, P-'^NormalPut) ;

FreeMem(P,Size) ;

х0 := GraphCooX(9) ;

у0 := GraphCooY(7) ;

xl := GraphCooX(36) ;

yl := GraphCooY(lO) ;

Size := ImageSize(xO,yO,xl,yl);

GetMem(P,Size) ;

Getlmage(xO,yO,xl,yl,P") ;

Colors(White,Blue) ;

SetWindow(9,7,35,9,DoubleBorder,t,True,False,False);

{Выводим изображения указателей}

yl := yO+16;

for kk := 1 to NCur do for у := 0 to 15 do begin

xl := xO+kk*DX;

b := Cur[kk,1,y];

for x := 0 to 15 do

if b and ($8000 shr x)<>0 then

PutPixel(xl+x,yl+y,White) end;

{Уста на влив а ем пределы перемещения указателя}

yO := yO+16;

yl := у1+16;

MouseWindow(xO,yO,xl+DX,yl) ;

{Выделяем первое изображение}

SizePP := ImageSize(xO+DX div 2,yO,xO+3*DX div 2,yl);

GetMem(PP,SizePP) ;

Getlmage (xO+DX div 2,yO,xO+3*DX div 2,yl,PP-^);

PutImage (xO+DX div 2, yO, PP^NotPut) ;

kk := 1;

{Устанавливаем свой обработчик событий}

SetMouseHandler(l,MouseHandler) ;

{Цикл до нажатия левой кнопки}

repeat

GetMouseState(k,x,у)

until k and LeftButtonoO;

{Удаляем обработчик событий}

ClearMouseHandler;

FreeMem(PP,SizePP) ;

{Формируем новый указатель}

kk := (х-х0) div DX;

if kk>NCur then kk := NCur;

if kk<l then kk := 1;

MouseGraphCursor(Cur[kk,0,0],0,0) ;

{Восстанавливаем экран}

Putlmage(x0,yO-16,P^/NormalPut) ;

FreeMem(P,Size);

MouseWindow(0,0,GetMaxX,GetMaxY) ;

F_GrText.Window(25,10,54,15) ;

Colors(White,Red) ;

ShowMouse

end; {ChangeGraphCursor} ^—.————————..——————;

Procedure SetTextScreen;

{Создает текстовый экран} begin

if not Text then

begin {Был графический режим} FreeMem(Font,FontSize); {Удаляем шрифт} GraphWriteOff; (Восстанавливаем ввод/вывод} CloseGraph; {Переходим к текстовому режиму} Text := True end;

{Указываем нужные для текстового режима процедуры) GotoXY := F_Text.GotoXY;

Colors := F_Text.Colors;

SetWindow := F_Text.SetWindow;

ChangeCursor := ChangeTextCursor;

{Ус та на влив а ем стандартный коэффициент пересчета} TextRatioY :=• 8;

{Создаем текстовый экран.}

SetScreen

end; {SetTextScreen} ^_—— ——.—.———.__—._——__;

Procedure SetGraphScreen;

{Создает графический экран} var

d,r: Integer;

h: Byte;

Name: String;

F: File;

begin

if Text then {Инициируем графику} begin

d := Detect;

InitGraph(d,r,'') ;

if GraphResultOgrOk then

Exit;

{Выбираем шрифт в зависимости от разрешения экрана} case GetMaxY of

349: h := 14; {EGA 8х14}

479: h := 19; {VGA 8х19} else

h := 8 {Прочие 8х8} end;

{Загружаем шрифт из файла BxH.fnt} Str (h,Name) ;

Name := '8x'+Name+'.fnt';

Assign(F,Name) ;

{$!-} Reset(F,1),•

{$!+} if IOResult<>0 then Exit;

FontSize := FileSize(F);

GetMem(Font,FontSize) ;

BlockReadtFyFont",FontSize,r) ;

Close(F) ;

if rOFontSize then begin

FreeMem(Font,FontSize) ;

Exit end;

{Регистрируем шрифт и переназначаем ввод/вывод} SetFont(Font,8,h) ;

GraphWriteOn;

Text := False end;

{Указываем нужные для графического режима процедуры]-GotoXY := F_GrText.GotoXY;

Colors := F_GrText.Colors;

SetWindow := F_GrText.SetWindow;

ChangeCursor := ChangeGraphCursor;

{Задаем коэффициент пересчета вертикального положения указателя мыши в текстовый размер: он равен высоте шрифта} TextRatioY := h;

{Создаем графический экран}

SetScreen end; {SetGraphScreen}

{—————————}

begin {Основная программа} CursorOff; {Удаляем курсор} SetTextScreen; {Формируем текстовый экран} {Инициируем мышь. Эту процедуру всегда следует осуществлять

после установки или смены режима работы дисплея} if not InitMouse then . Halt;

ShowMouse;

{Указываем элементы выбора) SetMouseItem(NItem,Items);

{Основной цикл работы продолжается до выбора элемента "Завершить работу" или нажатия Esc} {Запоминаем начальное состояние мыши} GetMouseState(b, x,у) ;

While (True) do {"Бесконечный" цикл} begin

{Проверяем выбор элементов} if KeyOrMousePressed then case ReadKeyOrMouse of {Есть выбор}

#27: Halt; {Esc}

#0: case ReadKeyOrMouse of

#59: ChangeCursor; {Fl-Изменить курсор}

#60: begin {F2-Сменить режим}

HideMouse; {Убираем мышь перед сменой режима} if Text then

SetGraphScreen {Был текстовый режим} else

SetTextScreen; {Был графический режим} if InitMouse then {Инициируем мышь

после смены режима!} ShowMouse;

SetMouseItem(NItem,Items) {Заново указываем элементы выбора, т.к. они сбрасываются при инициации мыши} end;

end {case} end; {case}