Модуль CRT.

Язык программирования Паскаль
Лекция 8
Модуль CRT.
Графический адаптер, например, EGA, VGA или SVGA, может работать в нескольких
режимах; режим определяет величину экрана - 80 или 40 символов в строке (только в текстовом
режиме), разрешающую способность экрана (только в графическом режиме) и тип дисплея
(цветной или черно-белый).
Рабочий режим экрана определяется, когда программа вызывает одну из функций
определения режима (textmode - текстовые режимы, initgraph или setgraph-mode - графические
режимы). Ниже - только текстовые режимы.
В любом текстовом режиме экран компьютера разделен на ячейки (80 или 40 столбцов в
ширину и 25, 43 или 50 строк по высоте). Каждая ячейка состоит из атрибута и символа.
Символ представляет собой ASCII-символ, имеющий графическое отображение, а атрибут
задаст, каким образом данный символ будет выведен на экран (его цвет, яркость и гл.).
Каждая ячейка имеет координаты -позицию. В текстовом режиме позиция верхнего левого
угла экрана определяется координатами (1,1), где х- координата растет слева -направо, а у координата растет сверху -вниз.
Как Turbo Pascal, так в Turbo C++ предоставляет полный набор подпрограмм для
манипулирования текстовым экраном, для вывода текста непосредственно на экран и управления
атрибутами ячеек.
Окно представляет собой прямоугольную область, определенную на экране PC, когда
он находится в текстовом режиме. Когда программа выполняет вывод на экран, то область
вывода будет в таком случае ограничена активным окном. Опальная часть экрана (вне окна)
недоступна и остается без изменений.
По умолчанию размер окна равен всему экрану. Программа; может изменить данное
умолчание полноэкранного текстового окна на окно, меньшее по размерам, чем полный экран
при помощи функции window. Эта функция задает позицию окна в экранных координатах.
За исключением функции определения текстовых окон, все остальные функций даются в
локальных координатах активного текстового окна, а не в абсолютных экранных координатах.
При этом верхний левый угол установленного текстового окна будет являться началом координат
(1,1).
При работе в стандартном текстовом режиме 80x25 экран представляет собой 2000 слов
(4000 байт) памяти с адресом В800:0000 (в шестнадцатеричной системе счисления). Пересылка
данных, в эту область памяти - означает вывод на экран. Повторная пересылка по одному и тому
же адресу, естественно, сотрет то, что там было раньше. Физически это выглядит как появление
символов на экране или изменения цветов ранее выведенных символов. Поэтому, при
реализации таких функций, как распахивание окна или изменение размеров окна, необходимо
перед изменением окна сохранить весь экран (или часть его) в памяти.
На экран можно представить как одномерный массив байт, слов или двумерный массив
записей (в зависимости от потребностей), настроенный (отображенный) на физический
адрес В800:0000 с помощью Конструкции absolute. Все указанные ниже описания эквивалентны.
type TPoinl = record
S: byte; { символ }
A: byte; { атрибут - цвета }
end;
var Screen_1: array[1.. 4000] of Byte absolute B800:0000;
var Screen_1: array[1.. 3999] of Byte absolute B800:0000;
var Screen_2: array[1 ..2000] of Word absolute B800:0000;
var Screen_3:array [1..25, 1..80] of TPoint absolute B800:0000;
Пересчет позиции (х,у) в смещение (в байтах)выполняется по формуле:
offset = 2*(80*(у-1)+(х-1).
Эта же конструкция позволит, в случае необходимости, написать собственные функции
вывода на экран взамен излишне универсальной и слишком и медленной стандартной процедуры
Write. Кроме того, она обладает тем недостатком, что при выводе в последнюю (правая нижняя )
позицию окна, выполняется скроллинг всего окна, что часто нежелательно.
Другим способом прямого доступа к памяти дисплея является использование
1
Язык программирования Паскаль
Лекция 8
предопределенною массива Mem, например:
offset = 2*(80*(у-1)+(х-1);
Mem [b800: offset] :='a';
{ символ )
Mem[b800: offset+ 1]:= 0; {атрибут}
Модуль CRT1 .
Модуль Crt реализует ряд программ, которые позволяют управлять возможностями экрана,
такими как управление режимами экрана, расширенные коды клавиатуры, цвета, окна и звук.
Одна из основных особенностей Crt - достижение высокой скорости к гибкости операций
вывода на экран. Программы, которые не используют модуль Crt посылают выходные данные на
экран через DOS, что гораздо медленнее. С использованием модуля Crt данные посылаются прямо
в BIOS, или, для более быстрых операций, прямо в видеопамять.
Модуль Crt содержит подпрограммы управления текстовым выводом на экран дисплея,
звуковым генератором и чтения клавиатуры.
В режиме текстового вывода используются следующие координаты экрана: левый верхний
угол экрана имеет координаты 1,1; горизонтальная координата возрастает слева направо,
вертикальная - сверху вниз. Если на экране определено окно, все координаты определяются
относительно границ окна. Исключением являются координаты процедуры Window установки
границ окна, которые всегда задаются относительно границ экрана.
Для чтения клавиатуры используются две функции - KeyPressed и ReadKey. Функция
KeyPressed определяет факт нажатия на любую клавишу и не приостанавливает дальнейшее
исполнение программы. Функция KeyPressed читает расширенный код нажатой клавиши. Если к
моменту обращения к функции не была нажата ни одна клавиша, программа приостанавливает
свою работу, ожидая действий пользователя.
Управление звуковым генератором строится по схеме Sound - Delay - NoSound. Процедура
Sound включает звуковой генератор и заставляет его непрерывно генерировать звук нужного тона.
Процедура Delay приостанавливает работу программы на заданное число миллисекунд реального
времени. Процедура NoSound отключает звуковой генератор.
Константы режима работы
const
BW40 = 0;
BW80 = 2;
Mono = 7;
СО40 = 1;
СО80 = 3;
Font 8x8 = 256;
С40 = C040;
С80 = C080;
{Черно-белый , 40 символов, 25 строк}
{Черно- белый, 80*25}
{Монохромный, 80*25}
{Цветной, 40*25}
{Цветной, 80*25}
{Для EGA\VGA режим 43 или 50 строк}
{Для совместимости с версией 3.0}
{ Для совместимости с версией 3.0}
Константы цветов
const
Black = 0;
Blue = 1;
Green = 2;
Cyan = .3 ;
Red = 4;
Magenta
Brown = 6;
= 5;
{Черный}
(Синий}
{Зеленый}
{Голубой}
{Красный}
(Фиолетовый)
(Коричневый)
Аббревиатура CRT соответствует русскоязычной аббревиатуре ЭЛТ - электронная лучевая трубка. На
профессиональном жаргоне CRT означает устройство визуализации информации (дисплей) даже в том случае, когда вместо ЭЛТ
используются иные физические устройства - плазменные панели, жидкокристаллические экраны и т.п.
1
2
Язык программирования Паскаль
Лекция 8
(Светло-серый)
(Темно-серый)
(Ярко-синий)
(Ярко-зеленый}
(Ярко-голубой)
(Розовый)
{Малиновый}
(Желтый)
(Белый)
(Мерцание символа)
LightGray
= 7;
DarkGray
= 8;
LightBlue
« 9;
LightGreen
= 10;
LightCyan
= 11;
LightRed
=12;
LightMagenta = 13;
Yellow = 14;
White = 15;
Blink = 128;
Переменные
var
CheckBreak
CheckEof
CheckSnow
DirectVideo
Boolean
Boolean
Boolean
Boolean
LastMode
TextAttr
WindMin
Word;
Byte;
Word;
WindMax
Word;
{Разрешает/запрещает контроль Ctrl-Break}
{Разрешает/запрещает контроль Ctrl-Z}
{Разрешает/запрещает контроль "снега"}
{Разрешает/запрещает прямой доступ к
видеопамяти}
{Хранит последний текстовый режим}
{Хранит текущий байт атрибутов}
{Координаты левого верхнего угла текущего
окна}
{Координаты правого нижнего угла}
Процедуры и функции
Функции
Function KeyPressed:
Boolean Возвращает True, если на клавиатуре была нажата
клавиша, и False в противном случае. Не задерживает исполнение программы.
Function ReadKey:
char Читает символ с клавиатуры без эхоповтора на экране.
Приостанавливает исполнение программы до нажатия на любую клавишу, кроме Shift, Ctrl, Alt,
CapsLock, NumLock, ScrollLock.
Function WhereX:
Byte Возвращает горизонтальную координату текущей позиции
курсора относительно текущего окна.
Function WhereY: Byte Возвращает вертикальную координату текущей позиции курсора
относительно текущего окна.
Процедуры
Procedure AssignCrt (var F: Text) Связывает с файловой переменной устройство
CON (клавиатуру для ввода и экран для вывода).
Procedure ClrEol Удаляет все символы от текущей позиции курсора до конца строки без
перемещения курсора.
Procedure ClrScr Очищает экран (окно) и помещает курсор в верхний левый угол.
Procedure Delay (D: Word) Приостанавливает работу программы на указанное число D
миллисекунд.
Procedure
DelLine Удаляет строку, на которой находится курсор, и перемещает все
строки ниже этой строки на строку вверх. Нижняя строка очищается.
Procedure GotoXY (X, Y: Byte) Перемещает курсор в нужное место экрана (окна).
Procedure Highvideo Устанавливает высокую яркость символов.
Procedure InsLine Вставляет пустую строку в позицию курсора.
Procedure LowVideo Устанавливает низкую яркость символов.
3
Язык программирования Паскаль
Лекция 8
Procedure NormVideo Устанавливает нормальную яркость символов.
Procedure NoSound Выключает звуковой генератор.
Procedure Sound (F: Word) Включает звуковой генератор. F - частота звука (Гц).
Procedure TextBackqround (Color: Byte) Устанавливает цвет фона.
Procedure TextColor (Color: Byte) Устанавливает цвет символов.
Procedure TextMode (Mode: Word) Устанавливает нужный текстовый режим.
Procedure Window (XI, Yl, X2, Y2 : Byte) Определяет текстовое окно на экране. XI, Y1
- координаты левого верхнего угла, Х2, Y2 - правого нижнего угла.
Во многих случаях стандартные для Паскаля возможности ввода/вывода данных с
помощью процедур Ready ReadLn, Write, WriteLn оказываются явно недостаточными для
разработки удобных в использовании диалоговых программ. Например, процедуры Read/ReadLn
вводят с клавиатуры только типизированные данные, причем с обязательным эхо-повтором
набираемых символов на экране. С их помощью нельзя определить факт нажатия какой-либо
специальной клавиши (функциональной клавиши, клавиши управления курсором и т.п.).
Процедуры Write/WriteLn выводят сообщения, начиная с того места на экране, где в данный
момент находится курсор, причем по мере вывода курсор автоматически сдвигается на экране, а
если очередной символ выводится в самом нижнем правом углу экрана, осуществляется
«прокрутка» экрана: его содержимое сдвигается вверх на одну строку. Все это сильно затрудняет
создание и обновление различного рода окон, меню и других атрибутов современных диалоговых
программ.
Разработчики Турбо Паскаля предусмотрели несколько подпрограмм, существенно
увеличивающих возможности текстового ввода/вывода. Эти подпрограммы сосредоточены в
библиотеке (модуле) CRT, входящей в комплект поставки Турбо Паскаля модуль включены также
процедуры Sound, NoSound и Delay, которые позволяют программировать звуковой генератор ПК.
Дополнительные возможности управления клавиатурой реализуются двумя функциями:
KeyPressed и Read Key.
Функция KeyPressed. Возвращает значение типа Boolean, указывающее состояние буфера
клавиатуры: False означает, что буфер пуст, a True - что в буфере есть хотя бы один символ, еще
не прочитанный программой.
В MS-DOS реализуется так называемый асинхронный буферизованный ввод с клавиатуры.
По мере нажатия на клавиши соответствующие коды помещаются в особый буфер, откуда они
могут быть затем прочитаны программой. Стандартная длина буфера рассчитана на хранение до
16 кодов символов. Если программа достаточно долго не обращается к клавиатуре, а пользователь
нажимает клавиши, буфер может оказаться переполненным. В этот момент раздается звуковой
сигнал и «лишние» коды теряются. Чтение из буфера обеспечивается процедурами Read/ReadLn и
функцией ReadKey. Замечу, что обращение к функции KeyPressed не задерживает исполнения
программы: функция немедленно анализирует буфер и возвращает то или иное значение, не дожидаясь нажатия клавиши.
Функция ReadKey. Возвращает значение типа Char. При обращении к этой функции
анализируется буфер клавиатуры: если в нем есть хотя бы один не прочитанный символ, код этого
символа берется из буфера и возвращается в качестве значения функции, в противном случае
функция будет ожидать нажатия на любую клавишу. Ввод символа с помощью этой функции не
сопровождается эхо-повтором и содержимое экрана не меняется.
Пусть, например, в какой-то точке программы необходимо игнорировать все на нажатые
клавиши, коды которых еще не прочитаны из буфера, т.е. необходимо очистить буфер. Этого
можно достичь следующим способом:
Uses CRT; var
С: Char;
begin
while KeyPressed do С := ReadKey;
end.
а
При использовании процедуры ReadKey необходимо учесть, что в клавиатурный буфер
помещаются так называемые расширенные коды нажатых клавиш. Если нажимается любая
4
Язык программирования Паскаль
Лекция 8
алфавитно-цифровая клавиша, расширенный код совпадает с ASC кодом соответствующего
символа. Например, если нажимается клавиша с латинсь буквой «а» (в нижнем регистре),
функция ReadKey возвращает значение chr ( 9 7 ) . а если «А» (в верхнем регистре) - значение chr
( 6 5 ) . При нажатии функциональных клавиш F1...F10, клавиш управления курсором, клавиш
Ins, Home, Del, End, PgUp, PgDn в буфер помещается двухбайтная последовательность:
сначала символ #0, затем расширенный код клавиши. Таким образом, значение #0, возвращаемое
функп ей ReadKey, используется исключительно для того, чтобы указать программе на ген рацию
расширенного кода. Получив это значение, программа должна еще раз обратиться к функции,
чтобы прочитать расширенный код клавиши2.
Следующая простая программа позволит Вам определить расширенный код любой
клавиши. Для завершения работы программы нажмите клавишу Esc.
Uses CRT;
var
С: Char;
begin
repeat
С:= ReadKey;
if C<>#0 then
WriteLn(ord(C))
else WriteLn('0',ord(ReadKey):8)
until C=#27 {21 - расширенный код клавиши Esc}
end.
Если Вы воспользуетесь этой программой, то обнаружите, что нажатие на некоторые
клавиши игнорируется функцией ReadKey. Это прежде всего так называемые сдвиговые клавиши Shift, Ctrl, Alt. Сдвиговые клавиши в MS-DOS обычно используются для переключения регистров
клавиатуры и нажимаются в сочетании с другими клавишами. Именно таким способом, например,
различается ввод прописных и строчных букв. Кроме того, функция игнорирует переключающие
клавиши Caps Lock, Num Lock, Scroll Lock, а также «лишние» функциональные клавиши FU и F12
клавиатуры IBM AT, не имеющие аналога на клавиатуре ранних моделей IBM PC/XT (в этих машинах использовалась 84-клавишная клавиатура, в то время как на IBM AT - 101-клавишная).
Библиотека Turbo Vision способна удовлетворить самым высоким требованиям следует
обращаться к ней при программировании сложных текстовых изображений (меню, окон и т.п.).
Тем не менее, вполне возможно, что некоторые захотят использовать значительно более простые,
но достаточно эффективные средства модуля CRT.
Текстовые возможности CGA стали стандартом де-факто и поддерживаются во всех
последующих разработках IBM - адаптерах EGA, MCGA, VGA и SVGA. Возможности модуля CRT
рассматриваются применительно к адаптерам этого типа.
Процедура TextMode. Используется для задания одного из возможных текстовых режимов
работы адаптера. Заголовок процедуры:
Procedure TextMode(Mode: Word);
Здесь Mode - код текстового режима. В качестве значения этого выражения могут
использоваться следующие константы, определенные в модуле CRT.
const
BW40 = 0; {Черно-белый режим 40x25}
Со4 0 = 1; {Цветной режим 40x25}
BW80
= 2;
{Черно-белый режим 80x25}
Со8 0 = 3; {Цветной режим 80x25}
Mono = 7; {Используется с MDA}
Font8x8 = 256;
{Используется для загружаемого шрифта в режиме 80x43 или 80x50 с
2
Т.е. код сканирования клавиши. Этот код определяется порядком, в соответствии с которым микропроцессор клавиатуры Intel
8042 периодически опрашивает (сканирует) состояние клавиш.
5
Язык программирования Паскаль
Лекция 8
адаптерами EGA или VGA}
Код режима, установленного с помощью вызова процедуры TextMode, запоминается в
глобальной переменной LastMode модуля CRT и может использоваться для восстановления
начального состояния экрана.
Следующая программа иллюстрирует использование этой процедуры в различных режимах.
Замечу, что при вызове TextMode сбрасываются все ранее сделанные установки цвета и окон, экран
очищается и курсор переводится в его левый верхний угол.
Uses CRT;
Procedure Print (S: String);
{Выводит сообщение S и ждет инициативы пользователя}
begin
WriteLn(S); {Выводим сообщение}
WriteLn('Нажмите клавишу Enter...');
ReadLn
{Ждем нажатия клавиши Enter}
end; {Print}
var
LM: Word; {Начальный режим экрана}
begin
LM := LastMode; {Запоминаем начальный режим работы дисплея}
TextMode (Co4 0) ;
Print('Режим 40x25');
TextMode (Co80) ;
Print('Режим 80x25');
TextMode(Co40+Font8x8);
Print('Режим Co40+Font8x8');
TextMode(Co80+Font8x8);
Print('Режим Co80+Font8x8'); {Восстанавливаем исходный режим работы:}
TextMode(LM)
end.
Процедура TextColor. Определяет цвет выводимых символов. Заголовок процедуры:
Procedure TextColor(Color: Byte);
Процедура TextBackground. Определяет цвет фона. Заголовок:
Procedure TextBackground(Color: Byte);
Единственным параметром обращения к этим процедурам должно быть выражена типа Byte,
задающее код нужного цвета. Этот код удобно определять с помощью cm дующих мнемонических
констант, объявленных в модуле CRT.
Следующая программа иллюстрирует цветовые возможности Турбо Паскаля.
Uses CRT;
const
Col: array [1..15] of String [16] =
('темно-синий','темно-зеленый','бирюзовый','красный',
'фиолетовый','коричневый','светло-серый','темно-серый',
'синий', 'зеленый', 'светло-бирюзовый', 'розовый' ,
'малиновый','желтый','белый');
var
k: Byte;
begin
for к := 1 to 15 do
begin
{Выводим 15 сообщений различными цветами}
TextColor(к); WriteLn('Цвет ', к, ' - ',Col[k])
end;
TextColor(White+Blink); {Белые мигающие символы}
WriteLn ( 'Мерцание символов ' ) ;
6
Язык программирования Паскаль
Лекция 8
{Восстанавливаем стандартный цвет}
TextColor(LightGray);
WriteLn
end.
Обратите внимание на последний оператор WriteLn: если его убрать, режим мерцания символов
сохранится после завершения программы, несмотря на то, что перед ним стоит оператор
TextColor(LightGray).
Дело в том, что все цветовые определения предварительно заносятся в специальную переменную
TextAttr модуля CRT и используются для настройки адаптера только при обращении к процедурам
Write/WriteLn.
Процедура ClrScr.
Очищает экран или окно (см. ниже процедуру Window). После обращения к ней экран (окно)
заполняется цветом фона и курсор устанавливается в его левый верхний угол.
Процедура Window. Определяет текстовое окно - область экрана, которая в дальнейшем
будет рассматриваться процедурами вывода как весь экран. Сразу после вызова процедуры курсор
помещается в левый верхний угол окна, а само окно очищается (заполняется цветом фона). По мере
вывода курсор, как обычно, смещается вправо и при достижении правой границы окна переходит
на новую строку, а если он к этому .сету находился на последней строке, содержимое окна
сдвигается вверх на одну строку, т.е. осуществляется «прокрутка» окна. Заголовок процедуры:
Procedure Window( X I , Y 1 , X 2 , Y 2 : Byte);
Здесь X1...Y2 - координаты левого верхнего (XI,Y1) и правого нижнего (X2,Y2) углов окна.
Они задаются в координатах экрана, причем левый верхний угол экрана имеет координаты (1,1),
горизонтальная координата увеличивается слева направо, а вертикальная - сверху вниз.
В следующем примере иллюстрируется вывод достаточно длинного сообщения в двух
разных окнах.
Uses CRT;
var
k: integer;
begin
{Создаем левое окно -желтые символы на синем фоне:}
TextBackground(Blue);
Window(5,2,35,17);
TextColor(Yellow);
for k := 1 to 100 do
Write (' Нажмите клавишу Enter.. . ') ;
ReadLn;
{Ждем нажатия Enter}
ClrScr; {Очищаем окно}
(Создаем правое окно - белые символы на красном фоне:}
TextBackground(Red);
TextColor(White);
Window (4 0,2,70,17) ;
for k := 1 to 100 do
Write ( ' Нажмите клавишу Enter.. . ');
ReadLn;
TextMode(CO80)
{Сбрасываем все установки}
end.
Обращение к процедуре Window игнорируется, если какая-либо из координат выходит за
границы экрана или если нарушается одно из условий: Х2>Х1 и Y2>Y1. Каждое новое обращение
к Window отменяет предыдущее определение окна. Грницы текущего окна запоминаются в двух
глобальных переменных модуля CRT: перемен WindMin типа Word хранит XI и Y1 (XI - в младшем
байте), а переменная того же и WindMax - Х2 и Y2 (Х2 - в младшем байте). При желании Вы можете
изменять их нужным образом без обращения к Window. Например, вместо оператора
Window(4 0,2,70,17) ; можно было бы использовать два оператора
WindMin := 39+(1shl8 ) ; WindMax := 69+(16 shl8);
7
Язык программирования Паскаль
Лекция 8
(в отличие от обращения к Window координаты, хранящиеся в переменных WindM: WindMax,
соответствуют началу отсчета 0,0).
Процедура GotoXY. Переводит курсор в нужное место экрана или текущего окна.
Заголовок процедуры:Procedure GotoXY(X,Y: Byte);
Здесь X, Y - новые координаты курсора. Координаты задаются относительно гран: экрана
(окна), т.е оператор GotoXY(1,1);означает указание перевести курсор в левый верхний угол
экрана (или окна, если к этому моменту на экране определено окно). Обращение к процедуре
игнорируется, если новые координаты выходят за границы экрана (окна).
Пример 1. Создать окно в рамке с тенью на фоне, заполненном псевдографическим
символом #176 желтого цвета, с текстом из файла. Выполнять перемещение окна вверх, вниз,
вправо или влево с сохранением фона по клавишам управления курсором.
program prg_name;
uses UCanvas,FileView,crt,dos,UMinMax;
var
curr,old:TextModeCanvas;
wnd:ShortFileViewer;
key:char;
S: PathStr;
procedure MyFillBG (var canvas:TextModeCanvas);
var row, col:byte;
begin
canvas.SetDrawMode(CharAndAttr);
for row:=1 to nMaxRow do
for col:=1 to nMaxCol do
with canvas do
begin
Put(row,col,
{min_4(row,col,nMaxRow-row+1,nMaxCol-col+1)+ord('0')}
byte(' ')
, {254}
(
{1}{(row+col)*(row-col+nMaxCol)div 25}
{2}{(col+row)
*
(col-row+nMaxRow)*(row)*(-rowcol+nMaxCol+nMaxRow) *8}
{3}{(col+row) + max_4(col,row,nMaxCol-col+1,nMaxRow-row+1)div 3}
(
(
((col+row)* 1) xor ((col-row+nMaxRow+1) *1))*2div 3+$10
+ min_4(col*2,row,nMaxCol*2-col*2+1*2,nMaxRow-row+1)div 4
)*2
)
and not Blink
);
{ $0F{random(256)};
end;
end;
procedure TheirFillBG (var canvas:TextModeCanvas);
var row, col:byte;
begin
8
Язык программирования Паскаль
Лекция 8
canvas.SetDrawMode(CharAndAttr);
for row:=1 to nMaxRow do
for col:=1 to nMaxCol do
with canvas do
begin
Put(row,col,176,$0E);
end;
end;
const CurrMode : (Scrolling,Resizing) = Scrolling;
var strHint,strMode:string;
const
strScrollHint : string =
'Use arrow keys to scroll. Press Ctrl+F5 to move or resize, ESC exits';
strScrollMode : string ='mode: SCROLLING';
strResizeHint : string =
'Use NUMERIC KEYPAD to move, SHIFT allows to resize instead, ENTER - continue...';
strResizeMode : string ='mode: RESIZING';
begin
S := FSearch(ParamStr(1),GetEnv('PATH'));
if S = '' then
begin
WriteLn(ParamStr(1),' not found');
Writeln ('Pls, specify a valid file in the command line.');
TextAttr:=$87;
WriteLn('Press any key to exit...');
TextAttr:=$07;
ReadKey;
Halt(1);
end;
strHint:=strScrollHint;
strMode:=strScrollMode;
wnd.init(7,6,68,13,ParamStr(1));
curr.init;
old.init;
old.CopyFromScreen;
{wnd.MayGoOut;}
repeat
curr.CopyFrom(old);
{TheirFillBG(curr);}
{MyFillBG(curr);}
curr.SetDrawMode(CharAndAttr);
curr.SetUsedAttr($43);
curr.SetUsedChar(byte(' '));
curr.FillSpaces(true);
curr.SetStrAlign(Center);
curr.PutString(strHint,1,1,nMaxCol);
9
Язык программирования Паскаль
{
Лекция 8
curr.SetStrAlign(Center);
curr.PutString(strHint,nMaxRow div 2+1,1,nMaxCol);}
{curr.SetStrAlign(Right);}
curr.PutString(strMode,nMaxRow,1,nMaxCol);
wnd.ShowOn(curr);
curr.CopyToScreen;
key:=readkey;
if (CurrMode=Scrolling)
then
begin
if (key=#0) then
case (readkey) of
#98: begin CurrMode:=Resizing;
strHint:=strResizeHint;
strMode := strResizeMode; end;
#75{Lt}: wnd.ScrollBy(-1,0);
#77{Rt}: wnd.ScrollBy(+1,0);
#72{Up}: wnd.ScrollBy(0,-1);
#80{Dn}: wnd.ScrollBy(0,+1);
#71{Home}: wnd.ScrollHome;
#79{End }: wnd.ScrollEnd;
#73{PgUp}: wnd.ScrollBy(+1,-1);
#81{PgDn}: wnd.ScrollBy(+1,+1);
end;
end
else
begin
if (key=#0) then
case (readkey) of
#98: begin CurrMode:=Scrolling;
strHint:=strScrollHint;
strMode := strScrollMode; end;
#75{Lt}: wnd.MoveBy(-1,0);
#77{Rt}: wnd.MoveBy(+1,0);
#72{Up}: wnd.MoveBy(0,-1);
#80{Dn}: wnd.MoveBy(0,+1);
#71{Home}: wnd.MoveBy(-1,-1);
#73{PgUp}: wnd.MoveBy(+1,-1);
#79{End }: wnd.MoveBy(-1,+1);
#81{PgDn}: wnd.MoveBy(+1,+1);
end
else
case key of
#52{Lt}: wnd.GrowBy(-1,0);
#54{Rt}: wnd.GrowBy(+1,0);
10
Язык программирования Паскаль
Лекция 8
#56{Up}: wnd.GrowBy(0,-1);
#50{Dn}: wnd.GrowBy(0,+1);
#55{Home}: wnd.GrowBy(-1,-1);
#57{PgUp}: wnd.GrowBy(+1,-1);
#49{End }: wnd.GrowBy(-1,+1);
#51{PgDn}: wnd.GrowBy(+1,+1);
#13: begin CurrMode:=Scrolling;
strHint:=strScrollHint;
strMode := strScrollMode; end;
end
end
until key=#27;
old.CopyToScreen;
end.
unit FileView;
interface
{ Public symbols }
uses UCanvas,uMinMax; { Uses clause }
type ShortFileViewer = object
public
constructor Init(x,y,width,height:integer;const strFileName:string);
procedure ShowOn (const canvas:TextModeCanvas);
procedure MoveBy(dx,dy:integer);
procedure MoveTo(x,y:integer);
procedure GrowBy(dw,dh:integer);
procedure GrowTo(x,y:integer);
procedure ScrollBy(dx,dy:integer);
procedure ScrollTo(x,y:integer);
{
procedure ScrollHome;
procedure ScrollEnd;
procedure Maximize;
procedure Restore;}
procedure StayOnScreen;
procedure MayGoOut;
function InvalidPosition:boolean;
private
bWholeOnScreen_:boolean;
x_,y_,w_,h_,
scrollx_,scrolly_,
nLines_,nLineLen_:integer;
txt_:text;
11
Язык программирования Паскаль
Лекция 8
strName_:string;
end;
implementation { Private symbols }
constructor ShortFileViewer.Init(x,y,width,height:integer;const strFileName:string);
var str:string;
begin
x_:=x; y_:=y; w_:=width; h_:=height;
strName_:=strFileName;
assign(txt_,strName_);
{MayGoOut;}
StayOnScreen;
reset(txt_);
nLines_:=0;
nLineLen_:=0;
while not(eof(txt_)) do
begin
inc(nLines_);
readln(txt_,str); {'' if EOF}
if(length(str)>nLineLen_) then nLineLen_:=length(str);
end;
close(txt_);
ScrollHome;
end;
procedure ShortFileViewer.ShowOn (const canvas:TextModeCanvas);
var i,len:integer;
str:string;
const
atrBorder:byte=$2f;
atrCaption:byte=$72;
atrCorner:byte=$2f;
atrText :byte=$1e;
atrShade :byte=$08;
cornerH:integer=7;
cornerW:integer=34;
begin
with canvas do
begin
{//the major: THE SHADE}
{//horizontal}
for i:=1 to w_ do
PutAttr(y_+h_,x_+i+1,atrShade);
{//vertical}
for i:=1 to h_ do
begin
PutAttr(y_+i,x_+w_,atrShade);
PutAttr(y_+i,x_+w_+1, atrShade);{GetAttr(y_+i,x_+w_+1) and}
end;
12
Язык программирования Паскаль
Лекция 8
{//the corners shade:}
SetDrawMode(CharAndAttr);
for i:=1 to min_2(cornerH,h_) do
begin
PutAttr(y_+i,x_+w_+2, atrShade);{GetAttr(y_+i,x_+w_+1) and}
PutAttr(y_+h_-i+1,x_+w_+2,atrShade);
end;
for i:=1 to min_2(cornerW,w_) do
begin
PutAttr(y_+h_+1,x_+i+1,atrShade);
PutAttr(y_+h_+1,x_+w_-i+2,atrShade);
PutAttr(y_,x_+w_-i+2,atrShade);
end;
PutAttr(y_,x_+w_+2,atrShade);
PutAttr(y_+h_+1,x_+1,atrShade);
PutAttr(y_+h_+1,x_+w_+2,atrShade);
{//the border:}
SetDrawMode(CharAndAttr);
SetUsedAttr(atrBorder);
DrawRectUpperDoubleWidth(y_,x_,h_,w_);
{//the corners:}
for i:=1 to min_2(cornerH,h_) do
begin
Put(y_+i-1,x_-1,byte('+'),atrCorner);
Put(y_+i-1,x_,byte('+'),atrCorner);
Put(y_+h_-i,x_-1,byte('+'),atrCorner);
Put(y_+h_-i,x_,byte('+'),atrCorner);
Put(y_+i-1,x_+w_,byte('+'),atrCorner);
Put(y_+i-1,x_+w_-1,byte('+'),atrCorner);
Put(y_+h_-i,x_+w_,byte('+'),atrCorner);
Put(y_+h_-i,x_+w_-1,byte('+'),atrCorner);
end;
for i:=1 to min_2(cornerW,w_) do
begin
Put(y_-1,x_+i-1,byte('T'),atrCorner);
Put(y_,x_+i-1,byte('¦'),atrCorner);
Put(y_-1,x_+w_-i,byte('T'),atrCorner);
Put(y_,x_+w_-i,byte('¦'),atrCorner);
Put(y_+h_,x_+i-1,byte('+'),atrCorner);
Put(y_+h_-1,x_+i-1,byte('T'),atrCorner);
Put(y_+h_,x_+w_-i,byte('+'),atrCorner);
Put(y_+h_-1,x_+w_-i,byte('T'),atrCorner);
end;
Put(y_-1,x_-1,byte('-'),atrCorner);
Put(y_-1,x_+w_,byte('¬'),atrCorner);
Put(y_+h_,x_-1,byte('L'),atrCorner);
Put(y_+h_,x_+w_,byte('-'),atrCorner);
13
Язык программирования Паскаль
Лекция 8
Put(y_,x_,byte('+'),atrCorner);
Put(y_,x_+w_-1,byte('+'),atrCorner);
Put(y_,x_-1,byte('¦'),atrCorner);
Put(y_,x_+w_,byte('¦'),atrCorner);
Put(y_+h_-1,x_,byte('+'),atrCorner);
Put(y_+h_-1,x_+w_-1,byte('+'),atrCorner);
{//the caption:}
SetDrawMode(CharAndAttr);
FillSpaces(true);
SetStrAlign(Center);
{SetUsedAttr(atrBorder);
PutString('¦ ' +strName_+' ¦',y_,x_,w_);
{181,185} {198,204}
SetUsedAttr(atrCaption);
PutString(' '+strName_+' ',y_,x_,w_);
{//and here comes the text}
SetDrawMode(CharAndAttr);
SetUsedAttr(atrText);
SetStrAlign(Left);
FillSpaces(true);
reset(txt_);
for i:=1 to scrolly_-1 do
readln(txt_,str); {let's skip some lines}
for i:=1 to h_-2 do
begin
readln(txt_,str); {'' if EOF}
str:=copy(str,scrollx_,length(str)-scrollx_+1);
PutString(str,y_+i,x_+1,w_-2);
end;
close(txt_);
end;
end;
procedure ShortFileViewer.MoveBy(dx,dy:integer);
begin
inc(x_,dx);
if (InvalidPosition) then dec(x_,dx);
inc(y_,dy);
if (InvalidPosition) then dec(y_,dy);
end;
procedure ShortFileViewer.MoveTo(x,y:integer);
begin
MoveBy(x-x_,y-y_);
end;
procedure ShortFileViewer.GrowBy(dw,dh:integer);
begin
inc(w_,dw);
if (InvalidPosition) then dec(w_,dw);
14
Язык программирования Паскаль
Лекция 8
inc(h_,dh);
if (InvalidPosition) then dec(h_,dh);
end;
procedure ShortFileViewer.GrowTo(x,y:integer);
begin
GrowBy(x-x_,y-y_);
end;
procedure ShortFileViewer.ScrollBy(dx,dy:integer);
begin
ScrollTo(scrollx_+dx,scrolly_+dy);
end;
procedure ShortFileViewer.ScrollTo(x,y:integer);
begin
if ((x>=1)and (nLineLen_>=w_+x-3)) then
scrollx_:=x;
if ((y>=1) and (nLines_>=h_+y-4)) then
scrolly_:=y;
end;
procedure ShortFileViewer.ScrollHome;
begin
scrollx_:=1;
scrolly_:=1;
end;
procedure ShortFileViewer.ScrollEnd;
begin
scrolly_:=nLines_-h_+4;
end;
procedure ShortFileViewer.StayOnScreen;
begin
bWholeOnScreen_:=true;
end;
procedure ShortFileViewer.MayGoOut;
begin
bWholeOnScreen_:=false;
end;
function ShortFileViewer.InvalidPosition:boolean;
begin
InvalidPosition:=false;
if (bWholeOnScreen_) then
begin
if ((x_<2)or(x_+w_>nMaxCol))
or ((y_<3)or(y_+h_+1>nMaxRow))
or ((w_<min_2(4+length(strName_),20)-2)or(h_<2))
then InvalidPosition:=true;
end
else
begin
if ((x_+w_-1<1)or(x_>nMaxCol))
or ((y_+h_-1<1)or(y_>nMaxRow))
or ((w_<min_2(4+length(strName_),20))or(h_<2))
then InvalidPosition:=true;
end;
15
Язык программирования Паскаль
Лекция 8
end;
end.
unit UCanvas;
interface
const
nMaxRow = 25;
nMaxCol = 80;
type TMCanvas_DrawMode = (CharOnly,AttrOnly,CharAndAttr);
TMCanvas_StrAlign = (Left,Center,Right);
CoordType = shortint;
type TextModeCanvas = object
public
constructor Init;
destructor Done;
procedure Put(row,col:CoordType;ch,at:byte);
procedure PutChar(row,col:CoordType;ch:byte);
procedure PutAttr(row,col:CoordType;at:byte);
function GetChar(row,col:CoordType):byte;
function GetAttr(row,col:CoordType):byte;
procedure PutString (const str:string;atRow,atCol,width:CoordType);
procedure DrawRectSingleWidth(atRow,atCol,h,w:CoordType);
procedure DrawRectUpperDoubleWidth(atRow,atCol,h,w:CoordType);
procedure CopyFrom(const canvas:TextModeCanvas);
procedure CopyFromScreen;
procedure CopyToScreen;
procedure SetDrawMode (mode : TMCanvas_DrawMode);
procedure SetStrAlign (align : TMCanvas_StrAlign);
procedure SetUsedAttr (at : byte);
procedure SetUsedChar (ch : byte);
procedure FillSpaces (b:boolean);
private
mode_ : TMCanvas_DrawMode;
align_ : TMCanvas_StrAlign;
bFillSpaces_:boolean;
usedChar_, usedAttr_ : byte;
16
Язык программирования Паскаль
Лекция 8
buf_ :
array [1..nMaxRow,1..nMaxCol]
of
record
char_,attr_: byte;
end;
function InvalidIndex(row,col:shortint):boolean;
procedure PutCharImpl(row,col:shortint;ch:byte);
procedure PutAttrImpl(row,col:shortint;at:byte);
end;
implementation
uses UMinMax;
const ScreenSeg = $B800;
function offset (row,col:byte):word;
begin
offset:= 2 * (nMaxCol*(row-1) + (col-1));
end;
{///////////////////////////////////////////////////////////////////////////}
{//constructor and destructor}
constructor TextModeCanvas.Init;
begin
SetDrawMode(CharAndAttr);
SetStrAlign(Left);
usedChar_:=176;
usedAttr_:=$07;
bFillSpaces_:=true;
end;
destructor TextModeCanvas.Done;
begin
end;
{///////////////////////////////////////////////////////////////////////////}
{//options}
procedure TextModeCanvas.SetDrawMode (mode : TMCanvas_DrawMode);
begin
mode_ := mode
end;
procedure TextModeCanvas.SetStrAlign (align : TMCanvas_StrAlign);
begin
align_ := align;
end;
17
Язык программирования Паскаль
Лекция 8
procedure TextModeCanvas.SetUsedAttr (at : byte);
begin
usedAttr_:=at;
end;
procedure TextModeCanvas.SetUsedChar (ch : byte);
begin
usedChar_:=ch;
end;
procedure TextModeCanvas.FillSpaces (b:boolean);
begin
bFillSpaces_:=b;
end;
{///////////////////////////////////////////////////////////////////////////}
{//validator}
function TextModeCanvas.InvalidIndex(row,col:CoordType):boolean;
begin
{IsValidIndex:=(row>=1) and(col>=1) and (row<=nMaxRow) and(col<=nMaxCol);}
InvalidIndex:=
( row<1
)
or ( col<1
)
or ( row>nMaxRow )
or ( col>nMaxCol )
;
end;
{///////////////////////////////////////////////////////////////////////////}
{//drawing functions}
procedure TextModeCanvas.Put(row,col:CoordType;ch,at:byte);
begin
if(InvalidIndex(row,col)) then exit;
PutCharImpl(row,col,ch);
PutAttrImpl(row,col,at)
end;
procedure TextModeCanvas.PutChar(row,col:CoordType;ch:byte);
begin
if(InvalidIndex(row,col)) then exit;
PutCharImpl(row,col,ch);
end;
procedure TextModeCanvas.PutAttr(row,col:CoordType;at:byte);
begin
if(InvalidIndex(row,col)) then exit;
PutAttrImpl(row,col,at)
end;
function TextModeCanvas.GetChar(row,col:CoordType):byte;
begin
GetChar:=buf_[row,col].char_;
end;
function TextModeCanvas.GetAttr(row,col:CoordType):byte;
begin
GetAttr:=buf_[row,col].attr_;
end;
{///////////////////////////////////////////////////////////////////////////}
18
Язык программирования Паскаль
Лекция 8
{//drawing rects}
procedure TextModeCanvas.DrawRectSingleWidth(atRow,atCol,h,w:CoordType);
var row, col:CoordType;
begin
for row:=1 to h-2 do
begin
Put(atRow+row,atCol,byte('¦'),usedAttr_);
Put(atRow+row,atCol+w-1,byte('¦'),usedAttr_);
end;
for col:=1 to w-2 do
begin
Put(atRow,atCol+col,byte('-'),usedAttr_);
Put(atRow+h-1,atCol+col,byte('-'),usedAttr_);
end;
Put(atRow,atCol,byte('-'),usedAttr_);
Put(atRow+h-1,atCol,byte('L'),usedAttr_);
Put(atRow,atCol+w-1,byte('¬'),usedAttr_);
Put(atRow+h-1,atCol+w-1,byte('-'),usedAttr_);
end;
procedure TextModeCanvas.DrawRectUpperDoubleWidth(atRow,atCol,h,w:CoordType);
var row, col:CoordType;
begin
for row:=1 to h-2 do
begin
Put(atRow+row,atCol,byte('¦'),usedAttr_);
Put(atRow+row,atCol+w-1,byte('¦'),usedAttr_);
end;
for col:=1 to w-2 do
begin
Put(atRow,atCol+col,byte('='),usedAttr_);
Put(atRow+h-1,atCol+col,byte('-'),usedAttr_);
end;
Put(atRow,atCol,byte('-'),usedAttr_);
Put(atRow+h-1,atCol,byte('L'),usedAttr_);
Put(atRow,atCol+w-1,byte('¬'),usedAttr_);
Put(atRow+h-1,atCol+w-1,byte('-'),usedAttr_);
end;
{///////////////////////////////////////////////////////////////////////////}
{//drawing strings}
procedure TextModeCanvas.PutString(const str:string;atRow,atCol,width:CoordType);
var i,indent:CoordType;
begin
case align_ of
Left: indent:=0;
Center: indent:=(width-length(str)) div 2;
Right : indent:=(width-length(str));
end;
for i:=1 to width do
if ((i<=indent) or
(i>indent+length(str)))
then
if (bFillSpaces_)
19
Язык программирования Паскаль
Лекция 8
then Put(atRow,atCol+i-1,usedChar_,usedAttr_)
else continue
else Put(atRow,atCol+i-1,byte(str[i-indent]),usedAttr_);
end;
{///////////////////////////////////////////////////////////////////////////}
{//basic drawings}
procedure TextModeCanvas.PutCharImpl(row,col:CoordType;ch:byte);
begin
if (mode_ = CharOnly)or(mode_ = CharAndAttr) then
buf_[row,col].char_:=ch;
end;
procedure TextModeCanvas.PutAttrImpl(row,col:CoordType;at:byte);
begin
if ((mode_ = AttrOnly)or(mode_ = CharAndAttr)) then
buf_[row,col].attr_:=at;
end;
{///////////////////////////////////////////////////////////////////////////}
{//huge array processors}
procedure TextModeCanvas.CopyToScreen;
var row, col:CoordType;
begin
for row:=1 to nMaxRow do
for col:=1 to nMaxCol do
begin
mem[ScreenSeg:offset(row,col)] := buf_[row,col].char_;
mem[ScreenSeg:offset(row,col)+1] := buf_[row,col].attr_;
end;
end;
procedure TextModeCanvas.CopyFromScreen;
var row, col:CoordType;
begin
for row:=1 to nMaxRow do
for col:=1 to nMaxCol do
begin
buf_[row,col].char_:=mem[ScreenSeg:offset(row,col)];
buf_[row,col].attr_:=mem[ScreenSeg:offset(row,col)+1];
end;
end;
procedure TextModeCanvas.CopyFrom(const canvas:TextModeCanvas);
var row, col:CoordType;
begin
for row:=1 to nMaxRow do
for col:=1 to nMaxCol do
begin
buf_[row,col].char_:=canvas.buf_[row,col].char_;
buf_[row,col].attr_:=canvas.buf_[row,col].attr_;
end;
end;
20
Язык программирования Паскаль
Лекция 8
END.
unit UMinMax;
interface
function max_2(a,b:byte):byte;
function max_3(a,b,c:byte):byte;
function max_4(a,b,c,d:byte):byte;
function min_2(a,b:byte):byte;
function min_3(a,b,c:byte):byte;
function min_4(a,b,c,d:byte):byte;
implementation
{///////////////////////////////////////////////////////////////////////////}
{//max implementation}
function max_2(a,b:byte):byte;
begin
if (a>b) then max_2:=a
else max_2:=b;
end;
function max_3(a,b,c:byte):byte;
begin
max_3:=max_2(max_2(a,b),c);
end;
function max_4(a,b,c,d:byte):byte;
begin
max_4:=max_2(max_3(a,b,c),d);
end;
{///////////////////////////////////////////////////////////////////////////}
{//min implementation}
function min_2(a,b:byte):byte;
begin
if (a<b) then min_2:=a
else min_2:=b;
end;
function min_3(a,b,c:byte):byte;
begin
min_3:=min_2(min_2(a,b),c);
end;
function min_4(a,b,c,d:byte):byte;
begin
min_4:=min_2(min_3(a,b,c),d);
end;
end.
21