ТЕКСТЫ ПРОГРАММ П1
МОДУЛЬ ПОДДЕРЖКИ ТЕКСТОВОГО ВЫВОДА F_TEXT
Этот модуль не описан в книге, т.к. мне показалось, что реализуемая в нем техника мно— гостраничног'--- текстового ввода/вывода не представляет интереса для широкого круга читателей. Тем не менее его полный текст приводится ниже, т.к. некоторые тестовые программы и модули использует его для создания текстовых окон.
^«""~~"==-====; Unit F_Text; {==«=====.,===„} {+~ --———------————------—--—————————-------- --"-./-
I В этот модуль входят подпрограммы поддержки ¦
I многостраничного вывода а текстовом режиме ¦
+——————— ———_—_——____--__————_—_-__+;
INTERFACE {—— ——————.—— _——_-__——_——_——_._————__,
Oses CRT, DOS;
{Следующие константа используются для указания типа рамки при обращении к процедурам BORDER, SETWINDO» и PUTWINDOW.} const
EmptyBorder =0; {Стереть рамку} SingleBorder =1; {Рачка из одинарных линий} DoubleBorder =2; (Рамка из двойных линий}
{Следующий массив определяет символы псевдографики для вычерчивания рамок (альтернативная кодировка)} BorderChar: array [0..2,1..6] of Char = ((#32, #32, #32, #32, *32, #32), (#218, #196, #191, #179, #192, #217), 1*201, #205, #187, #186, #200, #188));
type
PageType = record {Описатель страницы}
case Byte of
0:(Attrib Byte; {Атрибут символов}
CLineUp Byte; {Верхняя строка курсора} CLineDown Byte; {Нижняя строка курсора} CVisible Boolean; (Признак видимого курсора} WBondUp Word; {Левый верхний угол окна} WBondDown Word); {Правый нижний угол} 1:(РадеРаг: array [1..8] of Byte) end;
const
Pages: array [O..7] of PageType -
((PagePar: (7,6,7,1,0,0,79,24)), (PagePar: (7,6,7,1,0,0,79,24)), (PagePar: (7,6,7,1,0,0,79,24)), (PagePar: (7,6,7,1,0,0,79,24)), (PagePar: (7,6,7,1,0,0,79,24)), (PagePar: (7,6,7,1,0,0,79,24)), (PagePar: (7,6,7,1,0,0,79,24)), (PagePar: (7,6,7,1,0,0,79,24)));
{Адрес регистра статуса адаптера CGAf PortCGA = $3DA;
(Начало видеопамяти для CGA/EGA/VGA) BegVideo = $В800;
(Следующие константы зависят от режима работы и типа адаптера. Значения по умолчанию соответствуют CGA/EGA/VGA в режиме С080. Эти значения можно переопределить с помощью процедуры InitText}
const
MaxPage : Byte =3; {Максимальный номер страницы) MaxChar : Byte = 80; (Количество символов в строке} MaxLine : Byte = 25; (Количество строк на экране} PageSize: Word = 4000; {Размер видимой страницы) VSize : Word = 4096; {Полный размер страницы} VMemory : Word = BegVideo; {Адрес видеопамяти} VMW: array [O..15] of Word =
($0000,BegVideo,$1000,BegVideo,$2000,BegVideo, $3000,BegVideo,$4000,BegVideo,$5000,BegVideo, $6000,BegVideo,$7 О О 0,BegVideo) ;
{Массив VMP содержит адреса всех видеостраниц. Значения по умолчанию соответствуют адаптерам CGA/EGA/VGA в режиме С080. Эти значения можно переопределить с помощью процедуры InitText) •wax
VMP: array [O..7] of Pointer absolute VMW;
/
I Подпрограммы управления цветом
}
procedure ChangeAttribute(Page,Xl,Yl,X2,Y2,01dAtt,NewAtt: Byte);
{Меняет атрибут OLDATT на значение NEWATT в прямоугольнике XI...Y2 страницы PAGE}
Procedure Colors(Text,Back: Byte);
{Устанавливает цвет текста TEXT и фона BACK в текущей странице}
Procedure PageColors (Page,Text,Back: Byte);
{Устанавливает цвет текста TEXT и фона BACK в странице PAGE}
Function PackAttribute(Text,Back: Byte): Byte;
{Упаковывает два цвета в байт атрибута}
procedure SetAttribute(Page,XI,Y1,X2,Y2,Attr: Byte);
{Заменяет атрибут всех символов в прямоугольнике XI...Y2 страницы PAGE на значение Attr}
Procedure OnPackAttribute(Attr: Byte; var Text,Back: Byte);
{Распаковывает байт атрибута и возвращает два цвета} {
Подпрограммы управления курсором
> Procedure CursorOff;
{Отключает курсор в активной странице}
Procedure CursorOn;
(Включает курсор в активной странице}
Procedure CursorOnOff (Page: Byte; Vis: Boolean);
{Устанавливает признак видимости курсора: PAGE - номер страницы;
VIS - признак видимости}
procedure GetCursor (Page: Byte; var X, .г. Up, Down: Byte);
{Возвращает координаты курсора: PAGE - номер страницы; X,Y - возвращаемые координаты (отсчет от 1,1); Up, Down - размер курсора в строках развертки)
Function GetCursorVisible(Page: Byte): Boolean;
/Возвращает признак видимости курсора}
Procedure PutCursor(Page,X,Y: Byte);
{Устанавливает требуемое положение курсора. PAGE - номер страницы/ Х,У - координаты курсора (отсчет от 1,1)}
Procedure SetCursorLine(Page,Up,Down: Byte);
{Устанавливает размер курсора/
Подпрограммы управления текстовым выводом \
} Procedure Border (Page,Xl,Yl,X2,Y2,Bord: Byte);
{Обводит рамкой заданную прямоугольную область страницы PAGE: X1..Y2 - координаты окна; BORD - константа 0..2, указывающая тип рамки. Символы рамки выводятся с текущими атрибутами}
Procedure CopyChar (Page: Byte; Cr: Char; Attr: Byte; Count: Word);
{Записывает несколько копий символа, начиная с позиции, на которую указывает курсор: PAGE - номер 0..MaxPage страницы; CR - копируемый символ;
ATTR - его атрибуты; COUNT - количество копий символа. Символ записывается с указанными атрибутами, курсор не меняет своего положения)
Procedure GetChar (Page: Byte; var Cr: Char; var Attr: Byte);
(Читает символ и его атрибуты: PAGE - номер 0..ManPage страницы, откуда нужно прочитать символ; CR - прочитанный символ; ATTR - его атрибуты}
Procedure InitText;
{Переопределяет константы, зависящие от адаптера и режима его работы. Содержимое экрана не меняется}
Procedure MoveFromScreen (var Source, Destin; Count: Word);
{Читает данные из видеопамяти: SOURCE - адрес считываемой видеопамяти;
DESTIN - имя переменной, куда будут прочитаны данные;
COUNT - объем считываемой информации в байтах}
Procedure MoveToScreen (var Source, Destin; Count: Word);
{Записывает данные в видеопамять: SOURCE - переменная, содержащая записываемую информацию; DESTIN - адрес фрагмента видеопамяти; COUNT - объем записываемой информации}
Procedure PageWriteOn;
{Переназначает стандартный канал вывода на процедуру PAGEWRITE, поддерживающую вывод в любую страницу}
Procedure PageWriteOff;
{Восстанавливает стандартный канал вывода}
Procedure PutChar (Page: Byte; Cr: Char);
{Записывает символ на место, указываемое курсором: PAGE - номер 0..MaxPage страницы; CR - записываемый символ; Символ записывается с текущими атрибутами, курсор не меняет своего положения}
Procedure WriteChar (Page: Byte; Cr: Char);
{Выводит символ и сдвигает курсор. Используются текущие атрибуты} г ;(•________________—_*-____^__—.._«—-——--.•.--——•——*
¦Многостраничные варианты подпрограмм модуля CRT\ *_—————---—-——-—---——————————----*;
Procedure CIrEOL;
{Удаляет остаток строки справа от курсора в активной странице}
Procedure CIrScr;
{Очищает текущее окно (страницу)}
Procedure DelLine;
{Удаляет строку в активной странице}
Procedure GotoXY(X,Y: Byte);
{Устанавливает курсор в активной странице}
Procedure InsLine;
{Вставляет пустую строку в активной странице}
Procedure TextBackGround(Color: Byte);
{Устанавливает цвет фона а активной странице}
Procedure TextColor(Color: Byte);
(Устанавливает цвет символов в активной странице}
Function WhereX: Byte;
/'Возвращает- горизонтальную координату курсора в активной странице}
Function WhereY: Byte;
{Возвращает вертикальную координату курсора в активной странице}
Procedure Window(XI,Y1,X2,Y2: Byte);
{Устанавливает окно в активной странице} _'*_________________—--_____-„_-____-_--__------*
I Подпрограммы управления страницами \ *——————————————_-_-.——__——————————^
Function GetActivePage: Byte;
{Возвращает номер активной текстовой страницы}
Procedure GetPage (Page: Byte; var Destin);
{Копирует текстовую страницу в оперативную память: PAGE - номер копируемой страницы; DESTIN - переменная, куда будет копироваться страница}
Procedure SwapPage (Source, Destin: Byte);
{Копирует одну текстовую страницу в другую: SOURCE - номер страницы-источника информации; DESTIN - номер страницы-приемника}
Function PageSaveSize: Word;
{Возвращает размер буфера, необходимый для сохранения текущего состояния видеостраницы}
Procedure PutPage (var Source; Page: Byte);
{Пересылает копию текстовой страницы из оперативной памяти в видеопамять:
SOURCE - имя переменной, хранящей копию страницы;
PAGE - номер страницы-приемника информации}
Procedure RestorePage(Page: Byte; var Buf);
{Восстанавливает текущее состояние страницы PAGE по содержимому буфера BUF}
Procedure SetActivePage(Page: Byte);
{Устанавливает активной, заданную текстовую страницу. PAGE - номер страницы}
Procedure SavePage(Page: Byte; var Buf);
(Сохраняет текущее состояние страницы PAGE в буфере BOF} ^——————————————————————————————»
I Подпрограммы управления окнами I *—————————————.————————————————*;
Procedure ChangeWindAttribute(Page,01dAtt,NewAtt: Byte);
{Заменяет в окне PAGE атрибут OLDATT на значение МЕИАТТ}
Procedure CopyWind(Page,X,Y: Byte; var Buf; LX,LY: Byte);
(Переносит копию окна из памяти на страницу}
Procedure GetWindow (Pac-e: Byte);
(Восстанавливает состояние экрана, бывшее перед обращением к процедуре PUTWINDOff: PAGE - номер страницы, куда была скопирована активная}
Procedure PutWindow(Xl,Yl,X2,Y2,Text,Back,Bord,Page: Byte;
Header: String;Clip,Build,Play: Boolean);
(Сохраняет активную страницу в заданной текстовой странице, создает в активной странице окно с заданными атрибутами, очищает его и обводит рамкой:
XI...Y2 - координаты окна; TEXT - цвет символов; BACK - цвет фона;
BORD - константа, указывающая тип рамки; PAGE - номер 0. .Ma.xPa.ge страницы, куда будет скопирована активная страница; HEADER - заголовок окна;
CLIP - признак границ (TRUE - исключая XI...Y2, FALSE - включая границы XI...Y2); BUILD- признак развертывания окна; PLAY - надо ли сопровождать звуком}
Procedure SaveWind(Page: Byte; var Buf; var LX,LY: Byte);
(Сохраняет копию окна в буфере BUF}
Procedure SetPageWindow (Page,XI,Y1,X2,Y2,Bord: Byte;
Header: String; Clip: Boolean);
(Создает окно в странице PAGE и обводит его рамкой: PAGE - номер страницы;
XI...Y2 - координаты окна; BORD - константа, указывающая тип рамки;
HEADER - заголовок окна; CLIP - признак границ (TRUE - внутри XI...Y2, FALSE - включая границы XI...Y2). Символы рамки выводятся с текущими атрибутами, окно очищается}
Procedure SetWindAttribute(Page,Attr: Byte);
(Устанавливает новый атрибут окна}
Procedure SetWindow (Xl,Yl,X2,Y2,Bord: Byte; Header: String; Clip,Build,Play:
Boolean);
{Создает окно в активной странице и обводит его рамкой: XI...Y2 - координаты окна; BORD - константа, указывающая тип рамки; HEADER - заголовок окна;
CLIP - признак границ (TRUE - внутри XI...Y2, FALSE - включая границы XI...Y2); BUILD- признак развертывания окна; PLAY - надо ли сопровождать звуком. Символы рамки выводятся с текущими атрибутами, окно очищается}
Procedure WindMoveTo(Page,X,Y: Byte; var Buf; ClipW: Boolean);
(Перемещает окно в новое положение: PAGE - номер страницы; X,Y - новые координаты левого верхнего угла; BUF - вид экрана без окна; CLIPW- признак отсечки изображения}
Procedure WindMoveRel(Page: Byte; DX,DY: Integer; var Buf; ClipW: Boolean);
(Смещает окно относительно прежнего положения: PAGE - номер страницы;
DX,DY- приращения координат левого верхнего угла; BUF - вид экрана без окна;
CLIPW- признак отсечки изображения/
Function WindSize(Page: Byte): Word;
(Возвращает размер буфера для сохранения окна}
IMPLEMENTATION ^—————————————————..-————————————-/
var
Reg: registers;
const
ActivePage: Byte =0; (Номер активной страницы} {
Подпрограммы управления цветом
}
Procedure ChangeAttribute(Page,Xl,Yl,X2,Y2,01dAtt,NewAtt: Byte) ;
{Меняет атрибут OLDATT на значение NEHATT в прямоугольнике XI...У2 страницы PAGE} var
Buf: array [1..80,1..2] of Byte;
k,j,Size: Byte;
begin
{Проверяем параметры обращения} if (Page<=MaxPage) and (XI in [1..MaxChar])
and (Yl in [1..MaxLine]) and (X2 in [1..MaxChar]) and (Y2 in [1..MaxLine]) and (X2>Xl) and (Y2>Y1) then begin
Size := (X2-X1+1)*2; {Размер строки видеобуфера} for k := Yl •to Y2 do {цикл по строкам} begin
(Получаем копию видеопамяти} MoveFromScreen(Mem[VMemory:Page*VSi2e+ (pred(k)*MaxChar+Xl-l)*2],Buf,Size) ;
{Меняем атрибут}
for j := 1 to Size div 2 do if Buf[j,2] ° OldAtt then Buf[j,2] := NewAtt;
{Возвращаем в видеопамять} MoveToScreen(Buf,Mem[VMemory:Page*VSize+
(pred(k)*MaxChar+Xl-l)*2],Size) end end
end; (ChangeAttniluce' ;———————————————;
Procedure Colors (Text,Back: Byte);
{Устанавливает цвет текста TEXT и цвет фона BACK для активной страницы} begin
PageColors(ActivePage,Text,Back) end;
^———————————————.^
Procedure PageColors (Page,Text,Back: Byte);
(Устанавливает цвет текста TEXT и цвет фона BACK для страницы PAGE) begin
if Page<=MaxPage then begin
PagesiPage].Attrib := (Text and $8F) or ((Back and ^7) shi 4) or (Back and $80);
if Page=0 then begin
CRT.TextColor(Text);
CRT.TextBackGround(Back) end
end
end {Colors};
;•————————— ——————^
Procedure SetAttribute(Page,X1,Y1,X2,Y2,Attr: Byte);
{Заменяет атрибут всех символов в прямоугольнике XI...Y2 страницы PAGE на значение Attr} var
Buf: array [1..80,1..2] of Byte;
k,j,Size: Byte;
begin
{Проверяем параметры обращения) if (Page<=MaxPage) and (Xl in [1..MaxChar])
and (Yl in [1..MaxLine]) and (X2 in [1..MaxChar]) and (Y2 in [1..MaxLine]) and (X2>X1) and (Y2>Y1) then begin
Size := (X2-X1+1)*2;
for It := Yl to Y2 do begin
MoveFromScreen(Mem[VMemory:Page*VSize+ (pred(k)*MaxChar+Xl-l)*2],Buf,Size) ;
for j := 1 to Size div 2 do Buf[j,2] := Attr;
MoveToScreen(Buf,Mem[VMemory:Page*VSize+
(pred(k)*MaxChar+Xl-l)*2],Size) end end end; {SetAttribute} _—————————————;
Function PackAttribute(Text,Back: Byte): Byte;
{Упаковывает два цвета в байт атрибута} begin
PackAttribute := (Text and $8F) or
((Back and 7) shi 4) or (Back and $80) end; {PackAttnnute} ^—————————————;
Procedure UnPackAttribute(Attr: Byte; var Text,Back: Byte);
{Распаковывает байт атрибута и возвращает два цвета} begin
Text := Attr and $8F;
Back := (Attr shr 4) and 7 end; {UnPackAttribute) /*_—____—_——^__-«—_———_---—-———-——-----—_------_*
1 Подпрограммы управления курсором 1
Procedure CursorOff;
{Отключает курсор в активной странице} begin
with Reg do begin
AH := 1; {Управление курсором} СН := $20 {Убрать курсор} end;
lntr($10,Reg);
Pages[ActivePage].CVisible := False enu {CursorOff};
/———————————————;
Procedure CursorON;
{Включает курсор в активной странице} begin
with Reg,Pages[ActirePage] do begin
AH := 1; {Управление курсором} СН := CLineUp; {Верхняя строка развертки} CL := CLineDown {Нижняя строка} end;
Intr($10,Reg) ;
Pages[ActivePage].CVisible := True end {CursorOn/ ;
^—————————————————_.
Procedure CursorOnOff(Page: Byte; Vis: Boolean);
{Устанавливает признак видимости курсора} begin
if Page<=MaxPage then if Page-ActivePage then case Vis of
True : Cursor-Off;
False: CursorOn end else
Pages[Page].CVisible := Vis end; (CursorOnOff} /————————„——————;
Procedure GetCursor (Page: Byte; var X,Y,Up,Down: Byte);
/'Возвращает координаты и размер курсора:
PAGE - номер страницы;
X, Y - координаты (отсчет от 1,1);
Up, Down - размер курсора} begin
if Page<=MaxPage then with Reg,Pages[Page] do begin
AH := 3; {Получаем положение курсора) ВН := Page; {Номер страницы} Intr($10,Reg) ;
Х := succ(DL); {Преобразуем координаты} Y := succ(DH); {к началу в 1,1} Up := CLineUp; (Верхняя строка развертки} Down := CLineDown (Нижняя строка} end end {GetCursor};
^———————————————;
Function GetCursorVisible (Page: Byte): Boolean;
{Возвращает признак видимости курсора} begin
GetCursorVisible := Pages[Page].CVisible end; (GetCursorVisible} ^———————————————;
Procedure PutCursor(Page,X,Y: Byte);
(Устанавливает требуемое положение курсора. PAGE - номер страницы;
X, Y - координаты курсора (отсчет от 1,1)} begin
{Проверяем параметры обращения} if (Page<=MaxPage)
and (X in [1..MaxChar])
and (Y in [1..MaxLine]) then wxth Reg do begin
AH := 2; {Установить курсор}
DH := pred(Y); {Преобразуем координаты}
DL := pred(X); {к началу в 0,0}
ВН := Page; {Страница} Intr($10,Reg) end end {PutCursor};
^———————————————-;
Procedure SetCursorLine (Pi-.ge,Up, Down: Byte);
{Устанавливает размер курсора} begin
if Page in [O..MaxPage] then with Pages[Page] do begin
CLineUp := Up;
CLineDown := Down;
if Page=ActivePage then
SetActivePage(Page) end
end; {SetCursorLine) /*_--_--•-______-__•-_-•-_•---•----.--———---«----*
] Подпрограммы управления текстовый выводом ¦ *——————————————————————————————*;
var
OldOutput: Text; (Сохраняет стандартный канал вывода} const
ChangeOut: Boolean = False; {Флаг замены канала вывода)
Procedure WriteCharXY(Page,X,Y: Byte; Cr: Char);
(Выводит символ на указанное место. Атрибуты берутся из пассива Attrib. Курсор остается на месте} var
Loc: Word; {Старое положение курсора} begin
Loc := MemW[$0040:$0050+P?ge];
with Reg do begin
AH := 2;
DL := X-1;
DH := У-1;
BH := Page;
Intr($10,Reg); {Переводим курсор} АН := $9;
AL :° ord(Cr) ;
BL := Pages[Page].Attrib;
BH := Page;
CX := 1;
Intr($lO,Reg); (Выводим, символ} АН := 2;
DX := Loc;
BH := Page;
Intr($10,Reg) {Курсор - на старое место} end;
MemW[$0040:$005O+Page] := Loc end; {WriteChavXYf /—————————————————;
Function ZeroFunc(var F: TextRec): Integer; Far;
{Пустая процедура для операций OPEN/CLOSE} begin
ZeroFunc := 0 end; {ZeroFunc} (———...———— ————————;
Procedure Border (Page,Xl,Yl,X2,Y2,Bord: Byte);
{Обводит ранкой заданную прямоугольную область экрана/
var
i : Integer;
begin
{Проверяем параметры обращения) if not ((Page>MaxPage) or (X1<1) or (X2<=X1) or (Y1<1) or (Y2<-Y1) or (X2>MaxChar) or (Y2>MaxLine) or (Bord>2)) then begin
WnteCharXY(Page,Xl,Yl,BorderChar[Bord,l]) ;
for i := 1 to X2-X1-1 do {Верхняя рамка} WriteCharXY(Page,Xl+i,Yl,BorderChar[Bord,2]);
WnteCharXY(Page,X2,yi,BorderChar[Bord,3]) ;
for i := 1 to Y2-Y1-1 do {Боковые стороны} begin
WriteCharXY(Page,Xl,Yl+i,BorderChar[Bord,4]) ;
WriteCharXY(Page,X2,Yl+i,BorderChar[Bord,4]) end;
WnteCharXY(Page,Xl,Y2,BorderChar[Bord,5]);
for i := 1 to x2-xl-l do {Нижняя рамка} WriteCharXY(Page,Xl+i,Y2,BorderChar[Bord,2]) ;
WriteCharXY(Page,X2,Y2,BorderChar[Bord,6]) end end {Border};
{— —.—————-.————————;
Procedure CopyChar(Page:Byte; Cr:Char;Attr:Byte; Count:Word);
{Выводит несколько копий символа} begin
if (Count>0) and (Page<=MaxPage) then with Reg do begin
AH :== 9; (Вывод символа} AL := ord(Cr); {Код символа} BL := Attr; {Атрибут} BH := Page; {Страница} СХ := Count; (Количество копий} Intr($lO,Reg) end end /CopyChar};
^—————————————————J
Procedure GetChar (Page: Byte; var Cr: Char; var Attr; Byte);
{Читает символ, на который указывает курсор, и его атрибуты) begin
if Page<=MaxPage then with Reg do begin
AH := 8; {Читать символ) ' BH := Page; {Страница) Intr($10,Reg) ;
Cr := chr(AL); {Символ} Attr := АН {Его атрибут) end
else {Неверная страница) begin
Cr :» chr(O);
Attr := 0 end end {GetChar);
Procedure InitText;
{Переопределяет константы, зависящие or адаптера и режима его работы. Содержимое экрана не меняется)
var
i : Integer;
begin
{Проверяем параметры обращения) if not ((Page>MaxPage) or (X1<1) or (X2<=X1) or (Y1<1) or (Y2<-Y1) or (X2>MaxChar) or (Y2>MaxLine) or (Bord>2)) then begin
WnteCharXY(Page,Xl,Yl,BorderChar[Bord,l]) ;
for i := 1 to X2-X1-1 do {Верхняя рамка} WriteCharXY(Page,Xl+i,Yl,BorderChar[Bord,2]);
WnteCharXY(Page,X2,yi,BorderChar[Bord,3]) ;
for i := 1 to Y2-Y1-1 do {Боковые стороны} begin
WriteCharXY(Page,Xl,Yl+i,BorderChar[Bord,4]) ;
WriteCharXY(Page,X2,Yl+i,BorderChar[Bord,4]) end;
WnteCharXY(Page,Xl,Y2,BorderChar[Bord,5]);
for i := 1 to x2-xl-l do {Нижняя рамка} WriteCharXY(Page,Xl+i,Y2,BorderChar[Bord,2]) ;
WriteCharXY(Page,X2,Y2,BorderChar[Bord,6]) end end {Border};
{— —.—————-.————————;
Procedure CopyChar(Page:Byte; Cr:Char;Attr:Byte; Count:Word);
{Выводит несколько копий символа} begin
if (Count>0) and (Page<=MaxPage) then with Reg do begin
AH :== 9; (Вывод символа} AL := ord(Cr); {Код символа} BL := Attr; {Атрибут} BH := Page; {Страница} СХ := Count; (Количество копий} Intr($lO,Reg) end end /CopyChar};
^—————————————————J
Procedure GetChar (Page: Byte; var Cr: Char; var Attr; Byte);
{Читает символ, на который указывает курсор, и его атрибуты) begin
if Page<=MaxPage then with Reg do begin
AH := 8; {Читать символ) ' BH := Page; {Страница) Intr($10,Reg) ;
Cr := chr(AL); {Символ} Attr := АН {Его атрибут) end
else {Неверная страница) begin
Cr :» chr(O);
Attr := 0 end end {GetChar);
Procedure InitText;
{Переопределяет константы, зависящие or адаптера и режима его работы. Содержимое экрана не меняется)
test al,l {проверяем наличие обратного хода}
jne @2 (Ждем обратный ход}
lodsw (Получаем видеослово}
sti (Открываем прерывания}
stosw (Пишем видеослово в приемник}
loop 81 {Продолжаем цикл} end
end; {MoveFromScreen} {,-. —————————— ————;
Procedure MoveToScreen (var Source, Destin;Count: Word);
{Записывает данные в видеопамять} begin
if Count>0 then if not CheckSnow then
Move (Source,Destin,Count) else
{Синхронизация переноса для адаптера CGA} asm
Ids si,[Source] {DS:SI = адрес источника} les di,[Destin] {ES:DI = адрес приемник} mov ex,Count {Грузим в CX счетчик} eld (Направление передачи} shr ex, 1 {Переводим байты в слова) mov dx,PortCGA {Получаем в ОХстатус CGA-порта} mov Ы,9 {Готовим a BL маску проверки готовности} {Отсюда начинается цикл записи в видеопамять, который продолжается во время обратного хода луча при горизонтальной развертке. Запись проходит при закрытых прерываниях.} @3: lodsw {Получаем в ВР}
mov Ьр,ах (очередное видеослово} cli /Закрываем прерывания) @4: in al,dx (Получаем статус видеопорта} test al,l {Конец горизонтального хода?} jne @4 {Нет - ждем} mov ax,bp (Переносим в АХ видеослово} stosw (Пишем его в видеопамять) sti (Открываем прерывания} loop @3 {Продолжаем цикл} end end; {MoveToScreen} _•__—————————————;
Function pagewrite(var F: TextRec): Integer; Far;
{Осуществляет вывод строки, подготовленной процедурами HRITE/WRITELN, в активную видеостраницу} var
k: Integer;
begin
with F,Pages[ActivePage] do if (Mode=fm0utput) and (BufPos>0) then begin
for k := 0 to BufPos-1 do with Reg do WriteChar(ActivePage,BufPtr'^ [k]) ;
BufPos := 0 {Обнуляем буфер.вывода} end;
PageWrite :° О end; (PageWrite} /————————————————;
Procedure PageWriteOff;
(Восстанавливает стандартный канал вывода} begin
it ChangeOut then begin
move(OldOutput,Output,SizeOf(Output)); , ChangeOut :° False end end; {PagefirlteOff} ^——————_——_——————;
Procedure PageWriteOn;
(Переназначает стандартный канал выведана процедуру PAGEWRITE, поддерживающую вывод в любую страницу} begin
if ChangeOut then
Exit; (Блокируем повторную установку} ChangeOut := True;
(Сохраняем старый драйвер:} move(Output,OldOutput,SizeOf(Output) ) ;
with TextRec(Output) do
begin (Назначаем новый драйвер:} OpenFunc := @ZeroFunc;
InOutFunc := @PageWrite;
FluahFunc := BPageWrite;
CloseFunc := @ZeroFunc;
end end; {PageWriteOn} _•—————_——_-———————;
procedure PutChar (Page: Byte; Cr: Char);
(Записывает символ на место, указываемое курсором в заданной странице. Курсор не меняет положения. Атрибуты берутся из массива Attrib} begin
if Page<°MaxPage then with Reg do begin
AH := $9;
AL := ord(Cr) ;
BH := Page;
BL := Pages[Page].Attrib;
CX := 1;
Intr($10,Reg) end end (PutChar};
^————————_————————;
Procedure WriteChar (Page: Byte; Cr: Char);
{Выводит символ и сдвигает курсор. Используются атрибуты из массива Attrib} var
X,Y,Xl,Yl,X2,Y2,Size: Byte;
Buf: array [1..80,1..2] of Char;
VW,k: Word;
P: Pointer;
begin
if Page<=MaxPage then with Reg,Pages[Page] do begin
GetCursor(Page,X,Y,Xl,Yl) ;
{Смещение в странице} k := (Pred(Y)*MaxChar+Pred(X))*2;
P := ptr(VMemory,VMW[Page*2]+k) ;
VW := Pages[Page].Attrib shi 8+ord(Cr);
case Cr of (Обрабатываем спецсимволы} #7: begin /Звук/ Sound(900) ;
Delay(150);
NoSound;
Exit end;
#8: if X>Lo(WBondOp)+2 then (Back Space}
dec(X,2)
else if Y>Hi(WBondUp)+2 then begin
X := Lo(WBondDown);
dec(Y) end;
#10: inc(X,80); {LF}
#13: X :» Lo(WBondUp); {CR} else
MoveToScreen(VW,Pл,2);
end;
Inc(X); {Сдвигаема строке) if X-l>Lo(WBondDown) then {Достигнута правая граница окна} begin
X := Lo(WBondOp)+1; (Возвращаем к левой} inc(Y); {границе на новой строке} if Y-l>Hi(WBondDown) then
begin {Достигли нижнюю границу} {Делаем прокрутку с помощью прямого обращениях видеопамяти, т.к. функцич б работает только с активной страницей) dec (Y) ;
XI := Lo(WBondOp);
Yl :° Hi<WBondUp) ;
X2 := Lo(WBondDown);
Y2 := Hi(WBondDown);
Size := 2*(X2-X1+1);
for k :- Yl+1 to Y2 do begin MoveFromScreen(Mem[VMemory:Page*
VSize+(k*MaxChar+Xl)*2],But,Size) ;
MoveToScreen(Buf,Mem[VMemory:Page*
VSize+((k-l)*MaxChar+Xl)*2],Size) end;
for k := 1 to 1+X2-X1 do Buf[k,l] := ' •;
MoveToScreen(Buf,Mem[VMemory:Page*
VSize+(Y2*MaxChar+Xl)*2],Size) end end;
PutCursor(Page,X,Y) end end; {WriteChac} ^————.———————————————————————————*
I Многостраничные варианты подпрограмм модуля CRT I *———————————————————————————————*;
Procedure CIrEOL;
{Удаляет остаток строки справа от курсора в активной странице} var
XI,X2: Byte;
Р: Pointer;
X,Y: Byte;
Buf: array [1..80] of Word;
begin
GetCursor(ActivePage,X,Y,Xl,X2);
with Pages[ActivePage] do begin
P := Ptr(VMemory,VMW[ActivePage*2]+ (Pred(Y)*MaxChar+Pred(X))*2) ;
X2 := PagePar[7]-X+2;
for X := 1 to X2 do
Buf[X] := 32+Attrib shi 8;
MoveToScreen(Buf,P^,X*2) end end; {CIrEOLf f—— _____————__——————;
Procedure CIrScr;
{Очищает текущее окно (страницу)} begin
with Pages[ActivePage],Reg do begin
AH := 6; 1 С помощью прокрутки}
AL := 0; {очищаем все окно}
ВН := Attrib;
CL := Lo(WBondUp) ;
СН := Hi(WBondUp);
DL :» Lo(HBondDown);
DH := Hi(HBondDown) ;
Intr($10,Reg) ;
AH :•= 2; f Устанавливаем курсор}
ВН := ActivePage; /'в левый верхний угол}
DX :° WBondUp;
Intr($10,Reg) end
end; {CIrScr} /—————————————————^
Procedure DelLine;
(Удаляет строку в активной странице) var k,
S, {Длина строки окна} У: Byte; (Номер строки с курсором} С: Word; {Смещение в памяти для левой границы окна} Buf: array [1..80,1..2] of Char; {Буфер строк) P: Pointer;
begin
{Стираем строку прокруткой окна вверх} with Pages[ActivePage] do begin
{Определяем положение в видеопамяти левой верхней границы окна) С := VMW[ActivePage*2]+PagePar[5]*2;
Y := PagePar[6]+Pred(HhereY);
S := (PagePar[7]-PagePar[5]+l)*2;
{Переносим по строкам} for К := 1+1 to PagePar[8] do begin
P := Ptr(VMemory,C+K*MaxChar*2);
MoveFromScreen (P",Q\if, a) •i P := Ptr(VMemory,C+(K-l)*MaxChar*2);
MoveToScreen(Buf,P",s) end;
{Готовим пустую строку} for К := 1 to 80 do begin
Buf[k,l] :" ' ';
Buf[k,2] := chr(Attrib)
end;
{Выводим ее}
Р :- Ptr(VMemory,C+FagePai-[8]*MaxChar*2);
MoveToScreen(Buf,P",s) end
end; (DelLine} /————————————————;
Procedure GotoXY(X,Y: Byte);
{Устанавливает курсор в активной странице! begin
with Pages[ActivePage] do
PutCursor(ActivePage,Lo(WBondUp)+X,Hi(WBondUp)+Y) end; {GotoXYf ^————————————————;
Procedure InsLine;
(Вставляет пустую строку в активной странице} var
k,
S, {Длина строки окна}
Y: Byte; ' (Номер строки с курсором}
С: Word; {Смещение а памяти для левой границы окна)
Buf: array [1..80,1..2] of Char; {Буфер строк!
Р: Pointer;
begin
with Pages[ActivePage] do begin
{Определяем положение в видеопамяти левой верхней границы окна} С := VMW[ActivePage*2]+PagePar[5]*2;
Y := PagePar[6]+Pred(WhereY) ;
S := (PagePar[7]-PagePar[5]+l)*2;
{Переносим по строкам} for К :•= PagePar[8]-l downfco Y do begin
Р := Ptr(VMemory,C+K*MaxChar*2) ;
MoveFromScreen(P'',Buf,s);
P := Ptr(VMemory,C+(K+l)*MaxChar*2);
MoveToScreen(Buf,Р",з) end;
{Готовим пустую строку} for К :° 1 to 80 do begin
Buf[k,l] := ' ';
Buf [It, 2] := chr(Attrib) end;
{Выводим ее} Р :- Ptr(VMeroory,C+Y*MaxChar*2) ;
MoveToScreen(Buf,V,s) end end; {InsLine} ^—.———————————————;
Procedure TextBackGround(Color: Byte);
(Устанавливает цвет фона в активной странице} begin
Pages[ActivePage].Attrib :~
(Pages[ActivePage].Attrib and $8F) or (Color and $7) shi 4);
it ActivePage=0 then
CRT.TextBackGround(Color) •nd; fPageTextBackGround} ^———————————_—.———;
Procedure TextColor(Color: Byte);
(Устанавливает цвет символов s активной странице) begin
Pages[ActivePage].Attrib :=
(Pages[ActivePage].Attrib and $70) or (Color and $8F) ;
if ActivePage=O then
CRT.TextColor(Color) end; {PageTextColor} {-.- ————.—————— ————/
Function WhereX: Byte;
{Возвращает горизонтальную координату курсора в активной странице} var
X,Y,U,D: Byte;
begin
GetCursor(ActivePage,X,Y,U,D) ;
WhereX := X-Lo(Pages[ActivePage].WBondUp) end; {WhereX} ^—.——————————————;
Function WhereY: Byte;
(Возвращает вертикальную координату курсора в активной странице} var
X,Y,U,D: Byte;
begin
GetCursor(ActivePage,X,Y,П,D);
WhereY := Y-Hi(Pages[ActivePage].WBondUp;
end; (WhereY} ^——.————————.————.———;
Procedure Window(XI,Y1,X2,Y2: Byte);
{Устанавливает окно в активной странице} begin
{Проверяем параметры обращения} if (XI in [1..MaxChar]) and (X2 in [1..MaxChar])
and (X2>X1) and (Yl in [1..MaxLine]) and (Y2 in [1..MaxLine]) and (Y2>Y1)
then with Pages[ActivePage] do begin
WBondUp := pred(Xl)+pred(Yl) shi 8;
WBondDown :» pred(X2)+pred(Y2) shi 8;
PutCursor(ActivePage,XI,Yl);
if ActivePage=0 then
CRT.Window(XI,Y1,X2,Y2) end end;
/ ^_—________________----—•._»_•----------»——-----^.А-
I Подпрограммы управления страницами \
ii-----------.--.---------------------------—-----'^
Function GetActivePage: Byte;
(Возвращает номер активной текстовой страницы} begin
GetActivePage := ActivePage end (GetActivePage};
——————————————————/
Procedure GetPage (Page: Byte; var Destin);
^Копирует текстовую страницу в оперативную память} begin
if Раде<-МахРаде then
MoveFromScreen(Mem[VMemory:VSize*page],Destin,MaxChar*MaxLine*2) end (GetPage};
I ——...—.——————————— •
Function PageSaveSize: Word;
{Возвращает размер буфера, необходимый для сохранения текущего состояния видеостраницы} begin
PageSaveSize :« PageSize+SizeOf(PageType) end; {PageSaveSize} /————————————————;
Procedure PutPage (var Source; Page: Byte);
{Пересылает содержимое оперативной памяти в страницу видеопамяти! begin
if Page<=MaxPage then
MoveToScreen(Source,Mem[VMemory:VSize*Page],MaxChar*MaxLine*2) end {PutPage};
;-———————————————;
Procedure RestorePage(Page: Byte; var Buf);
{Восстанавливает текущее состояние страницы PAGE по содержимому буфера BUF} var
В: array [O.-MaxInt] of Byte absolute Buf;
begin
if Page>MaxPage then Exit;
MoveToScreen(B,VMP[Page]",PageSize) ;
Move(B[PageSize],Pages[Page],SizeOf(PageType));
if Page=ActivePage then
SetActivePage(ActivePage) end; {RestorePage} {.....—————————————}
Procedure SavePage(Page: Byte; var Buf);
{Сохраняет текущее состояние страницы PAGE в буфере BUF} var
В: array [O.-MaxInt] of Byte absolute Buf;
begin
if Page>MaxPage then Exit;
MoveFromScreen (VHP [Page] ",B, PageSize);
Move(Pages[Page],В[PageSize],SizeOf(PageType)) end; {SavePage} _•——__———————— ..,-——}
Procedure SetActivePage (Page : Byte);
(Активизирует заданную текстовую страницу} begin
if Page<-MaxPage then with Reg,Pages[Page] do begin
AH := 5; {Установить страницу} AL := Page; {Номер страницы} ActivePage :=' Page; lКорректируем ActivePage} Intr ($10,Reg);
if CVisible then {Включаем/отключаем}
CursorOn {курсор} else
CursorOff;
TextAttr :== Attrib; {Устанавливаем атрибут} WindMin := WBondUp; {Текущее окно} WindMax := WBondDown end;
end {SetActivePage};
/————————————————;
Procedure SwapPage (Source, Destin: Byte);
{ Копирует одну текстовую страницу в другую } var
buf : array [1..2, 1..80] of Byte;
i : integer;
begin
if (Source<=MaxPage) and (Destin<=MaxPage) then for i := 0 to MaxLine-1 do begin
MoveFromScreen (Mem [VMemory :VSi2e*Source+i*Ma.xChar*2] ,buf,MaxChar*2) ;
MoveToScreen(buf,Mem[VMemory:VSize*Destin+i*MaxChar*21,MaxChar*2) end end /SwapPage];
I Подпрограммы управления окнами 1 *———————————————————.——————————*;
Procedure ChangeWindAttribute(Page,01dAtt,NewAtt: Byte);
{Заменяет в окне атрибут OLDATT на значение NEWATTf var
X1,Y1,X2,Y2: Byte;
begin
if Page<=MaxPage then with Pages[Page] do begin
XI :° Lo(WBondUp) ;
Yl := Hi(WBondUp) ;
X2 := Lo(WBondDown)+2;
Y2 := Hi(HBondDown)+2;
ChangeAttribute(Page,XI,Yl,X2,Y2,OldAtt,NewAtt) end
end; {ChangeWindAttribute} ^———————————————/
Procedure CopyWind(Page,X,Y: Byte; var Buf;,LX,LY: Byte);
{Переносит копию окна из яамяги на страницу} var
X2,Y2,k: Byte;
Size: Word;
В: array [O.-MaxInt] of Byte absolute Buf;
begin
if (X in [1..MaxChar]) and (Y in [1..MaxLine]) and (Page<=MaxPage) then with Pages[Page] do begin
X2 := X+LX-1;
if X2>MaxChar then X2 := MaxChar;
Y2 := Y+LY-1;
if Y2>MaxLine then У2 := MaxLine;
Size := (X2-X+1)*2;
for k := У to Y2 do
MoveToScreen(B[(k-Y)*LX*2],Mem[VMemory:Page*VSize+ (pred(k)*MaxChar+X-l)*2],Size) ;
WBondUp := X+Y shi 8;
WBondDown := X2-2+(Y2-2) shi 8;
if Page=ActivePage than
SetActivePage(Page) end
end; (Copy Wind} ^_————_————————_—;
Procedure GetWindow (Page: Byte);
(Восстанавливает состояние экрана, бывшее перед обращением к процедуре PUTWIVDOW} var
X,Y,U,D: Byte;
begin
if (Page<-MaxPage) and (PagaoActivePage) then begin
SwapPage(Page,ActivePage);
Move(Pages[Page],Pages[ActivePage],SiaeOf(PageType));
GetCursor(Page,X,Y,U,D) ;
PutCursor(ActivePage,X,Y);
SetCursorLine(ActivePage,U,D);
SetActivePage(ActivePage) end end {GetSfindow};
^-.___—————————————;
Procedure PutHindow(Xl,Yl,X2,Y2,Text,Back,Bord,Page: Byte;
Header: String; Clip,Build,Play: Boolean);
{Сохраняет текущий экран в текстовой странице PAGE и организует окно с заданными атрибутами и рамкой} var
X,Y,U,D: Byte;
begin
if not ((Page>MaxPage) or (XK1) or (X2<-X1) or (Y1<1) or (Y2<=Y1) or (X2>MaxChar) or (Y2>MaxI»ine) or (Bord>2)> then begin
SwapPage(ActivePage,Page);
Move(Pages[ActivePage],Pages[Page),SizeOf(PageType));
GetCursor(ActivePage,X,Y,U,D);
PutCursor(Page,X,Y) ;
SetCursorLine(Page,U,D);
Colors(Text,Back);
SetWindow(XI,XI,X2,Y2,Bord,Header,Clip,Build,Play) end;
end {PutWindo»);
_-.——————————————;
Procedure SaveWind(Page: Byte; var Buf; var LX,LY: Byte);
{Сохраняет копию окна в буфере BUF} var
X1,Y1,X2,Y2: Byte;
В: array [O-.MaxInt] of pyte absolute Buf;
k: Byte;
begin
if Page<=-MaxPage then with Pages [Page] do begin
XI » Lo(WBondUp) ;
Yl = Hi(WBondUp) ;
X2 = Lo(WBondDown)+2;
Y2 ° Hi(WBondDown)+2;
LX = X2-X1+1;
LY = Y2-Y1+1;
for k :== Yl to Y2 do
MoveFromScreen (Mein[VMemory:Page*VSi2e+
(pred(k)*MaxChar+Xl-l)*2],B[(k-Yl)*LX*2],LX*2) end end; {SaveWind) ^_———————————————;
Procedure SetPageWindow (Page,XI,Y1,X2,Y2,Bord: Byte;
Header: String;Clip: Boolean);
(Создает окно в странице PAGE и обводит его рамкой} var
buf: array [1..80,1..2] of Byte;
X,Y,Size,k: Byte;
begin
i? not ( (Page>MaxPage) or (X1<1) or (X2<-X1) or (УК1) or (Y2<=Y1) or (X2>MaxChar) or (Y2>MaxLine) or (Bord>2)) then begin
(Очищаем прямоугольное окно на экране} Size := Х2-Х1+1;
for Y := 1 to Size do begin
buf[Y,ll := ordC •);
bu?[Y,2] :» Pages[Page].Attrib end;
Size := Size+Size;
for Y := Yl to Y2 do
MoveToScreen(Buf,Mem[VMemory:Page*VSize+ (pred(Y)*MaxChar+pred(Xl))*2],Size) ;
{Обводим его рамкой и выводим заголовок} if BordOEmptyBorder then
Border(Page,XI,Yl,X2,Y2,Bord);
if Length(Header)>0 then begin
if Length(Header)>X2-X1-2 then Header[0] :» chr(X2-Xl-2);
X := Xl+(X2-Xl-Length(Header)) div 2;
for k := 1 to Length(Header) do
WriteCharXY(Page,X+k,Yl,Header W);
end;
{Корректируем границы внутрь прямоугольника XI...Y2, если признак Clip равен Гrue^ if Clip then begin inc(XI) ;
inc (YD ;
dec(X2);
dec(Y2) end;
{Устанавливаем курсор в левую вершину ft запоминаем координаты} dec(XI); (Преобразуем координаты} dec(Yl); {к началу в точке 0,0} dec(X2);
dec(Y2) ;
PutCursor(Page,Xl+l,Yl+l);
Pages[Page 1.WBondUp :-X1+Y1 shi 8;
Pages[Page 1.WBondDown :=X2+Y2 shi 8;
if page=ActivePage then
SetActivePage(Page) end end {SetPageWindow};
^———————————————————————-.Jl
Procedure SetWindAttribute(Page,Attr: Byte);
{Устанавливает новый атрибут окна} var
X1,Y1,X2,Y2: Byte;
begin
if page<-MaxPage then with Pages[Page] do begin
XI :° Lo(WBondUp) ;
XI := Hi(WBondUp) ;
X2 :- Lo(WBondDown)+2;
Y2 :» Hi(WBondDown)+2;
SetAttribute(Page,Xl,Yl,X2,Y2,Attr) end
end; {SetWindAttribute} ^——————————————/
Procedure SetWindow (Xl,Yl,X2,Y2,Bord: Byte;
Header: String; Clip,Build,Play: Boolean);
{Создает окно в активной странице и обводит его рамкой} var
xxl,yyl,xx2, yy2,x,y,dx,dy,k: Byte;
dt: Integer;
const
TonBeg = 400; {Начальный тон I TonEnd •" 800; {Конечный тон} Pause - 5;
N = 10;
begin
if Build and ((x2-xl>-4) or (y2-yl>=4)) then
begin
{Начальное положение левого верхнего угла окна} х := (x2-xl) div 2;
у := (у2-у1) div 2;
(Количество промежуточных окон} dx := ((x2-xl) div 2) div N;
dy := ((y2-yl) div 2) div N;
if dx=0 then inc(dx) ;
if dy-0 then inc(dy);
if x>l then begin
xxl := xl+x-1;
xx2 :" x2-x+l end else begin
xxl :- xl;
xx2 :- x2 end;
if y>l then begin
yyl :- yl+y-1;
yy2 := y2-y+l end else begin
yyl :» yl;
yy2 :- y2 end;
(Изменение тона}
dt := (TonEnd-TonBeg) div N;
for k :» 0 to N-1 do {Цикл построения} begin
if Play then
Sound (TonBeg+dt*k) ; (Включаем э-вук/ SetPageWindow(ActivePage,xxl,yyl,xx2,yy2,Bord,Header,Clip);
(Увеличиваем границы окна} if xxl>xl then dec(xxl,dx) ;
if xx2<x2 then
inc (xx2,dx) ;
if yyl>yl then dec(yyl,dy);
if yy2<y2.then inc(yy2,dy) ;
Delay(Pause) end;
if Play then NoSound;
end;
SetPageWindow(ActivePage,XI,Yl,X2,Y2,Bord,Header,Clip) end; {SetWindow} /—————_———_—____——;
Procedure WindMoveRel(Page: Byte; DX,DY: Integer; var Buf; ClipW: Boolean);
{Смещает окно относительно прежнего положения:
PAGE - номер страницы;
DX,DY- приращения координат левого верхнего угла;
BUF - вид экрана без окна;
CLIPW- признак отсечки изображения} чах
X,Y: Byte;
begin
if Page<=MaxPage then with Pages[Page] do begin
X := Lo(WBondUp) ;
Y := Hi(WBondUp) ;
if X+DX<1 then
X := 1 else if X+DX>MaxChar then
X := MaxChar else
X := X+DX;
if Y+DY<1 then Y := 1
else if Y+DY>MaxLine then
Y := MaxLine else
Y := Y+DY;
WindMoveTo(Page,X,Y,Buf,ClipW) end end; {WIndMovRel} ^_____________________——;
Procedure WindMoveTo(Page,X,Y: Byte; var Buf; ClipW: Boolean);
{Перемещает окно в новое положение:
PAGE - номер страницы,' X,Y - новые координаты левого верхнего угла;
BUF - вид экрана без окна;
CLIPW- признак отсечки изображения} var
X2,Y2,LX,LY: Byte;
Сор: array [1..4OOO] of Byte;
begin
if (X in [1..MaxChar]) and (Y in [1..MaxLine])
and (Page<=MaxPage) then with Pages[Page] do begin {Копируем окно в буфер Сор}
SaveWind(Page,Cop,LX,LY);
{Восстанавливаем вид страницы}
MoveToScreen (Buf, VMP [Page] ^PageSize);
if not ClipW then {Корректируем положение} begin
while X+LX-l>MaxChar do dec (X) ;
while Y+LY-l>MaxLine do
dec(Y) end;
{Переносим окно на новое место}
CopyWind(Page,X,Y,Cop,LX,LY) ;
{Запоминаем новые границы окна} it Page=ActivePage then
SetActivePage(Page) end end; {WindMoveTo} f—— ——-.————————-.————;
Function WindSize(Page: Byte): Word;
{Возвращает размер буфера для сохранения окна} var
X1,Y1,X2,Y2: Byte;
begin
if Page<=MaxPage then with Pages[Page] do begin
XI := Lo(WBondUp) ;
Yl := Hi(WBondUp) ;
X2 := Lo(WBondDown)+2;
У2 :» Hi(WBondDown)+2;
WindSize := (X2-X1+1) * (Х2-П+1) *2 end else
WindSize := 0 end; {WindSize} /===»====»=.==; end. {TextCRT} /==.=====-..«——/
