10FA:01C2
10F0:0262
10E0:0362

Замечу, что цифры, используемые в этой записи - шеснадцатеричные, если вы чувствуете себя не очень среди них, то вернитесь к выпуску #2 (http://web-pascal.narod.ru/ras/stunde/s2.htm), где объяснено о том, что это такое. Таким образом формально мы можем иметь доступ к адресам с 00000 - FFFFFh ( буква h в конце числа означает, что это число шеснадцатерично).. Замечу, что при Segment = FFFFh и Offset = FFFFh мы получим Address = 10FFEFh. Однако ввиду ограничения на шину адреса в 20 бит (т.е. размер Address в 20 бит, 20 двоичных цифр) эта комбиинация физически указывает на 0FFEFh - т.е. получается как бы кольцо с небольшим нахлёстом. Кстати наши программы тоже разбиты на сегменты. Различают сегмент кода, сегмент данных и сегмент стека. В сегменте данных хранятся все наши глобальные переменные. В сегменте кода находится код, который исполняет процессор (т.е. все наши процедуры, функции и главная часть программы от begin до end.). И в сегменте стека хранятся локальные переменные и кое-какая служебная информация. Со стеком мы уже сталкивались в предыдущих выпусках. Естесственно, что сегменты кода, данных и стека имеют размер в 64 Kb (сегмент стека может быть и меньше, его размер задаётся опцией Stack size, о которой говорилось в предыдущих выпусках). Например напишем такую программу:

program test;

var
a : array [0 .. 65535] of byte;

begin
end.

вроде бы ничего особенного. Просто большой массив. Однако попробуем запустить .... бац Error 22: Structure too large.(размер структуры слишком большой). Нетрудно понять, что наш массив не влезает в 1 сегмент, который отведён для данных. Точно так же обстоят дела и с кодом и со стеком. Ошибку переполнения стека мы уже разбирали. Получается, что в сумме память, которую использует наша программа равна 64 + 64 + 64 = 192 Кб. ??? Зачем же тогда на компьютеры ставят так много памяти? Так как наши программы работают в Real Mode, нам доступен только 1 Мбайт памяти (на самом деле ещё меньше) - максимальное число из 20 двоичных цифр. Остальные доступны в только защищённом режиме работы процессора. Те 192 Кб, которые мы насчитали называют статическими (т.к. они неизменны). Переменные, созданные в разделе переменных называются статическими переменными. В противоположность им есть динамические переменные - те память под которые выделяется и освобождается программистом. Ниже приведено распределение памяти:

* 00000h - 9FFFFh - Base Memory, 640 Кбайт - стандартная память, доступная программам реального режима. Распределена следующим образом:
o 00000h - 003FFh - Interupt Vectors - векторы прерываний, что это такое я раскажу позже.
o 00400h - 004FFh - BIOS Data Area - область переменных Bios.
o 00500h - 00xxxxh - DOS Area - область DOS
o 00xxxxh - 9FFFFh - User RAM - память, доступная для использования.
* A0000h - FFFFFh - Upper Memory Area (UMA), 384 Кбайта - верхняя память, зарезервированая для системных нужд. Например, в ней размещается память адаптеров.
* 10000h и выше - Extended Memory - дополнительная память, непосредственно доступная только в защищенном режиме процесора.

Что бы не осталось недоговорок: защищённый режим (Protected Mode). Впервые появился на 80286 процессоре. Попытки выполнения недопустимых команд, выхода за рамки отведённого пространства памяти и областей ввода/вывода контролируются системой защиты. В защищённом режиме работает, например Windows (и соответственно программы для него), а в реальном режиме DOS (большинство ДОС программ так же работают в этом режиме).
добавление

Хочу кое что добавить к предыдущим выпускам. Каждый раз создавая новый тип, мы сначала описывали его в разделе type, а потом создавали переменную этого типа в разделе var. Однако, если вам нужно только несколько глобальных (или локальных) переменных этого типа, то можно сделать так:

var

c : file of integer;

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

i : integer;

то @i - это адрес переменной i. Для объявления указателя нам надо создать переменную соответствующего типа. Для начала мы рассмотрим самый простой тип указателей - безтиповые указатели Они могут указывать (т.е. хранить адрес) чего угодно. Хотите адрес переменной - пожалуйста, адрес записи - с легкостью, процедуры - ни каких проблем. Имя у этого типа - Pointer (англ. указатель). Напишем такую программку:

var
i : integer;
p : pointer;

begin
i := 3;
p := @i
end.

а теперь вопрос, что содержится в p (после выполнения программы) ? Ответ адрес переменной i. Если вы посмотрите на указатель p в отладчике, то вы увидите, что он равен Ptr($13C1,$50) (надо довести выполнение программы до полного завершения). Что это такое? Для работы с адресами в паскале есть функция:

function Ptr(Seg, Ofs: Word): Pointer;

она преобразовывает адрес сегмента (Seg) и смещения (Ofs) к указателю. Знак доллара - "$" - перед числом означает, что оно шеснадцатеричное. это специфическое обозначение паскаля. Я при объяснении буду использовать букву h, а в программах мы увидим знак $. Просто это одно и тоже 10h = $10 = 16. Если вы слабо владеете этой системой - обязательно прочитайте выпуск #2 Системы счисления ч1 Шестнадцатеричная Так вот Ptr($13C1,$50) означает, что наш указатель указывает на область памяти с сегментом 13С1h и смещением в этом сегменте 50h. Поменяем местами объявления p и i.

var
p : pointer;
i : integer;

begin
i := 3;
p := @i
end.

Что же тогда произойдёт? Казалось бы ничего такого - просто поменяли местами объявления двух переменных, что от этого может изменится ? Оказывается может! Давайте посмотрим на это дело в отладчике... действительно p теперь равен Ptr($13C1,$54). Почему такое произошло ? Мы перераспределяем память в сегменте данных. Т.е. в первом случае у нас сначала в памяти отводится место под переменную i, а потом идёт указатель. Во втором случае память сначала выделяется под указатель, а только потом под i. Поэтому смещение в обоих случаях разное. Указатель без типа хорошо, ну а с типом лучше! Для использования таких указателей лучше создать новый тип. Перед именем того типа, на который наш указаетль указывает нужно поставить символ каре - "^".

type
pinteger = ^integer;

Теперь мы можем создать указатель на переменную типа integer. И присвоить указателю её адрес.

var
i : integer;
p : pinteger;

begin
i := 3;
p := @i;

Однако наверняка вам хочется знать, что же расположено по адресу на который указывает p ?? Для этого существует приём, который называется "разыменование указателей". Суть его в том, что разыменовав указатель вы можете работать с ним так, как если бы это была переменная того типа, на который он указывает. Чтобы разыменовать указатель, поместите ^ после его имени.

begin
i := 3;
p := @i;
write (p^);

выдаст на экран значение 3. Используя символ ^ мы указываем, что надо использовать указатель не как адрес, а как то что содержится по этому адресу. На что указывает p ? На адрес переменной i. Т.е. изменив i мы изменим значение по адресу p. А изменив p, мы получим в p указатель на неизвестно что. При работе программы используются, не имена переменных, а их адреса. Так как в р у нас адрес i, то изменив значение по этому адресу (по адресу в р) мы изменим значение i. А изменив значение i, мы изменим только значение 2-х байтов по адресу р (и соответственно изменим p^). Например чему будет равно i после такого:

begin
i := 3;
p := @i;
p^ := 123;

Ответ i = 123. Как? Ведь мы i нигде не изменяем ?? Что делает эта строчка p^ := 123; - она помещает по адресу p значение 123. А адрес р равен адресу i.
Для нашего случая условно говоря p^ = i !!! Однако поменяв адрес p на что-то ещё p^ уже будет не равно i !!! Важно вбить себе в голову, что указатель (р) - это только адрес, по которому может распологаться всё, что угодно. А p^ - это значение по этому адресу. На один и тот же адрес может указывать бесконечное число указателей. Например такой код:

var
i : integer;
p1, p2 : pinteger;

begin
i := 3;
p1 := @i;
p2 := p1;
p2^ := 123;
writeLn (i)
end.

Опять тот же вопрос: чему равно i ? Ответ i = 123. Давайте разберёмся построчно и с отладчиком. Кстати в отладчике вместо адреса сегмента данных указывается Dseg (от англ DateSegment - сегмент данных). Это результат такой функции function DSeg: Word; Она возвращает адрес сегмента данных.
Итак:

* i := 3; - смотрим в отладчике: i = 3; p1, p2 = nil. Что это за nil чуть позже и ниже :).
* p1 := @i; - присваиваем р1 адрес i. ( i = 3; p1 = Ptr(DSeg,$52); p2 = nil)
* p2 := p1; - присваиваем р2 значение р1, т.е. присваиваем р2 адрес i (i = 3; p1, p2 = Ptr(DSeg,$52))
* p2^ := 123; - помещаем по адресу p2 значение 123. А что у нас за адрес в р2 ? Адрес i. Значит мы изменяем значение по этому адресу, т.е. значение i (i = 123; p1, p2 = Ptr(DSeg,$52))

Вернёмся к nil. Когда указатель равен nil это означает, что он указывает ни на что. Т.е. не проинициализированный указатель.
Программа

Сегодня мы не будем писать что-то особенное, а просто полазим по некоторым адресам в памяти. Давайте вспомним распределение памяти:

* 00000h - 9FFFFh - Base Memory, 640 Кбайт - стандартная память, доступная программам реального режима.
* A0000h - FFFFFh - Upper Memory Area (UMA), 384 Кбайта - верхняя память, зарезервированая для системных нужд. В ней размещается память адаптеров.
* 10000h и выше - Extended Memory - дополнительная память, непосредственно доступная только в защищенном режиме процесора.

Extended memory нас не интересует, т.к. для нас она не доступна. Обратим наш взгляд на UMA - столько всего интересного... Давайте для начала полазаем по памяти нашего видеоадаптера. В зависимости от его типа она занимает следующие адреса:

* MDA RAM - B000h - B0FFFh
* CGA RAM - B800h - BBFFFh
* EGA ROM - C000h - C3FFFh
* VGA ROM - C000h - C7FFFh
* EGA, VGA RAM - A000h - BFFFFh, в зависимости от режима используют следующие области:
o Графика - A000h - AFFFFh
o Цветной текст - B800h - BFFFFh
o Моно текст - B000h - B7FFFh

Думаю, что у всех сейчас стоит VGA (SVGA тоже сюда относится). Так что разговор пойдёт о нём. Наши программы работают в текстовом режиме (существует ещё и графический, но о нём позже). К тому же в цветном, поэтому видеопамять распологается по этим адресам B800h - BFFFFh . В этом режиме под символ отводится 2 байта (или одно слово: сам символ + аттрибуты (цвет)). Например давайте прочитаем самый первый символ на экране. Мы можем читать только 1 байт, т.к. сначала идёт байт, который отвечает за символ, а потом байт-аттрибут.

type
pbyte = ^byte;

var
video : pbyte;

begin
video := Ptr ($B800, 0);
writeLn (chr(video^))
end.

Если вы не очищали экран и запускали программу из среды BP, то должна вывестись буква B (первый символ на экране).
А теперь вообще чудный фокус: давайте изменим значение этого первого символа на весёлую рожу. Изменим строки:

begin
video := Ptr ($B800, 0);
video^ := 1
end.

Запустим... J ... порадуемся. Сейчас мы использовали метод, называемый прямой доступ к памяти (в нашем случае к видео памяти). Это самый быстрый способ вывода символа на экран.
Так как под символ отводится слово, то мы можем в байте-аттрибуте задать цвет символа, цвет фона и ещё кое что. Биты байта-аттрибута отвечают за следующее:
Фон Текст
7 6 5 4 3 2 1 0
BL R G B I R G B
Буквы RGB представляют собой комбинацию для цвета. R - красная составляющая, B - синяя, G - зелёная. Бит 7 (BL) - отвечает за мигание символа, а бит 3 (I) - интенсивность свечения. Т.е. если мы хотим вывести мигающий символ красным цветом на чёрном фоне, то мы должны составить такую комбинацию 10000100. Давайте изменим код предыдущей программы таким образом:

begin
video := Ptr ($B800, 1);
video^ := $84
end.

Мы изменили смещение на 1 байт, поэтому теперь video^ это не символ, а байт-аттрибут первого символа на экране. Изменив значение по этому адресу мы изменим значение байта-аттрибута первого символа. Если там оставалась весёлая рожица, то она станет красной и начнёт моргать, если там оставалась буква В, то тогда это приключится с ней. Однако помимо экрана (кстати запомните этот адрес B800h - он может встречаться довольно часто), так вот есть ещё куча интересных мест, куда нам следует сунуть свой нос. Например слово по адресу 0:413 - в нем содержится информация BIOS'a о наличной памяти в килобайтах. Оно заполняется во время теста POST. Что бы узнать значение по этому адресу напишем такую "програмку".

type
pword = ^word;

var
p : pword;

begin
p := Ptr (0, $413);
writeLn (p^)
end.

ничего сложного. Однако, если нам понадобится не байт, не два, а сразу много ? Тогда надо создать указатель на массив. Например 8 байт по адресу FFFF:5 - это дата изготовления BIOS'a.

type
tarray = array [0..7] of byte;
p8byte = ^tarray;

var
p : p8byte;
i : integer;

begin
p := Ptr ($FFFF, 5);
for i := 0 to 7 do
write (chr(p^[i]))
end.

При загрузке компьютера в момент, когда определяется количество памяти (тест POST), нажмите на клавишу Pause - и посмотрите в левый нижний угол экрана - там обычно эта дата и печатается. Однако кроме того, что мы указали на массив из 8 байт, мы могли указать на 1 байт, и в цикле менять смещение. Память вообщем отдалённо напоминает простой массив. Можно посвятить целую рассылку, перечисляя адреса памяти, по которым можно полазить и узнать что-нибудь полезное, однако на сегодня хватит. К тому же подобную информацию легко найти.

procedure New(var P: Pointer)

Вызвав эту процедуру, передав ей в качестве параметра имя указателя (можно так же имя типизированного указателя, т.к. pointer вмещает его в себя). Так вот, вызвав эту процедуру, вы соответственно отведёте кусок памяти нужного размера (т.е. размера той переменной, на которую указывает указатель p). После вызова процедуры получаем следующее: p - адрес, p^ - переменная, того типа на который указывает p. Например:

var
pInt : ^integer;
i : integer;

begin
i := 1;
New (pInt);
pInt^ := i;

Вызвав New (pInt); мы выделяем два байта (именно столько занимает переменная типа integer). Теперь у нас как бы появляется новая целочисленная переменная pInt^. Освободить, выделенную в ходе работы программы память можно процедурой:

procedure Dispose(var P: Pointer);

Завершим предыдущий пример таким образом:

i := pInt^ * 2;
Dispose (pInt)
end.

теперь посмотрим на это дело в отладчике. Добавим только ещё пару строк. Теперь наша программа будет выглядеть так:

type
pinteger = ^integer
var
pInt, pInt1 : pinteger ;
i : integer;
begin
i := 1;
New (pInt);
pInt^ := i;
i := pInt^ * 2;
Dispose (pInt);
New (pInt1);
pInt^ := i;
Dispose (pInt1)
end.

Давайте добавим просмотр значений указателей pInt и pInt1 и значений по этим адресам (вместо имени переменной надо ввести pInt^ и pInt1^ соответственно). Входим в пошаговое исполнение, видим как pInt присваивается адрес (New (pInt)), потом по этому адресу меняется значение (pInt^ := i;), потом происходит вызов Dispose (pInt).... вроде бы ничего не поменялось... ладно смотрим дальше...После New (pInt1) pInt1 ссылается на тот же адрес, что и pInt !!! Поэтому pInt^ := i; изменит значение pInt1^ !!! Почему так происходит ? Памятью заведует операционная система, именно она по нашему запросу решает дать или не дать. Когда мы вызываем New (pInt) ОС выделяет 2 байта и возвращает нам адрес этих байт. Вызывая же Dispose (pInt); мы "говорим" ОС, что эти 2 байта нам больше не нужны и она считает их свободными. Когда мы в следующий раз просим 2 байта (New (pInt1)), то она опять выделяет нам те же самые байты, поэтому происходит такая фишка, что pInt и pint1 указывают на один и тот же адрес! Поэтому, что бы не возникло логической ошибки (такую ошибку будет трудно поймать), можно после освобождения памяти присваивать неиспользуемым указателям значение nil и так же перед вызовом Dispose заполнить эту память 0. Так же есть возможность использовать New, как функцию. В таком случае она возвращает указатель типа, имя которого является единственным параметром такой функции. Т.е. в предыдущем примере мы могли написать следующее:

pInt := New (pinteger);

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

procedure GetMem(var P: Pointer; Size: Word);

Как видите эта процедура отличается от New вторым параметром. Size - это точное число выделяемых байт. Т.е. под указатель на integer Size = 2, на byte Size = 1 и так далее. Естесственно, что для определения размера структур можно использовать функцию sizeof. Для тех, кто забыл я повторюсь:

function SizeOf(X): Integer;

возвращает размер аргумента Х в байтах. Соответственно вторая процедура

procedure FreeMem(var P: Pointer; Size: Word);

Параметр Size теперь определяет число байт, которые надо освободить. Параметр Size у GetMem / FreeMem должен совпадать, иначе в памяти останутся байты, которые не используются, но и не считаются свободными. Т.е. происходит простое захламленее памяти. Или же если вы освободите больше байт, чем "заказали", то тогда вы можете освободить память другой переменной! Кажется зачем такие трудности, когда используя New/Dispose можно не заботится об размере выделяемой памяти ? Однако давайте рассмотрим такой пример: считать из файла 1000 строк и сохранить их в массиве:

program read;

type
pstring = ^string;

var
buffer : string;
data : array [1 .. 1000] of pstring;
f : text;
i : integer;

begin
assign (f, 'C:\autoexec.bat');
reset (f);

for i := 1 to 1000 do
begin
readLn (f, buffer);
getMem (data[i], length (buffer));
data[i]^ := buffer
end;
.....

Итак мы создаём массив указателей data. Каждый элемент такого массива - указатель на строку. Потом мы в цикле читаем из файла строки, при этом заносим строку во временную переменную buffer.
Теперь обратите внимание, как мы выделяем память getMem (data[i], length (buffer)); В качестве размера выделяемой памяти мы используем длинну считанной строки. Используя New, мы бы всегда выделяли бы 256 байт (размер string), однако если размер считанной строки меньше чем 256 байт, зачем нам тратить лишнюю память ? А теперь маленький вопрос как вы видите в конце программы я поставил троеточие. Так вот вопрос: как в данном случае правильно освободить память ? Ответы как всегда шлите на мыло, внизу. Ещё один момент, может быть он и очевиден, но всё же: для выделения/освобождения память надо использовать только парные функции. Т.е. вы не можете вызвать с New - FreeMem, а с GetMem нельзя использовать Dispose.

Итак сегодня мы займёмся рассмотрением классического примера: связанный список. Для начала самый простой вариант - односвязный. Что же такое связаный список ? Давайте представим, что у нас есть запись.... для простоты введём только одно поле

tlist = record
data : integer;
end;

И пускай нам нужно создать массив из N таких записей, причём N задаётся пользователем и может изменяться во время работы программы, как в сторону увеличения, так и в сторону уменьшения. Конечно можно создать массив таким образом:

list : array [1 .. N] of tlist;

где N будет максимально возможное число для того, что бы массив поместился в сегменте данных. Однако это не есть гуд. Гораздо проще такая задача решается с использованием указателей. Чем мы сейчас и займёмся. Идея связанного списка проста как бит: в каждом элементе содержится указатель на следующий. Т.е. запись выглядит так:

type
plist = ^tlist;
tlist = record
data : integer;
next : plist
end;

Давайте рассмотрим организацию такого списка. Проще всего это дело нарисовать, к сожалению к рассылке нельзя приаттачить картинку, поэтому я нарисую её тут с использованием текстовых символов (не судите за убогость):

+------+ |---->+------+ |---->+------+
| data | | | data | | | data |
+------+ | +------+ | +------+
| next | | | next | | | next |
| ----------- | ----------- | -------------> nil
+------+ +------+ +------+

итак как мы видим в указателе next находится адрес следующего элемента в памяти. Последний же указатель указывает в никуда (т.е. в nil). Поэтому для организации списка нам потребуются 2 указателя на tlist. Один из них будет постоянно хранить адрес начала (т.е. первого элемента) списка, второй будет "суетится" по списку, т.е. бегать по нему из начала в конец. Можно было бы ввести ещё и указатель на последний элемент (т.е. 3-й указатель на tlist) , но в нём нет надобности, т.к. узнать кончился ли список мы можем, сравнив next с nil. Т.е. у нас будет 2 глобальных переменных:

var
list, start : plist;

Start - будет указывать на начало списка, а list будет нашей рабочей лошадкой. Как видите наш список занимает в памяти всего 8 байт (под один указатель отводится 4). Для начала напишем процедуру, которая добавляет элемент в список. Замечу, что добавляем мы всегда в конец списка! Параметр d - это то, что нам нужно добавить. list у нас указывает на последний элемент списка.

procedure Add (d : integer);
var
l : plist;
begin
New (l); { выделяем память под структуру }

l^.data := d; { инициализируем данные }
l^.next := nil; { т.к. добавляем в конец, то указатель на следующий равен nil }

{ если start не равен nil, значит список не пуст}
if start <> nil then
begin
list := start;

{ "перематываем" список, что бы list стал последним элементом }
while list^.next <> nil do
list := list^.next;

list^.next := l { устанавливаем указатель на следующий элемент, а это у нас l }
end
else
start := l; { если список был пуст, тогда делаем l первым элементом }
list := l { теперь меняем текущий элемент, присваивая ему значение l }
end;

Обратите внимание, что мы не освобождаем память, которую занимает l. Почему мы так делаем ? Опять "нарисую" картинку:

+------+ |---->...->+------+ +------+
| data | | ... | data | | data |
+------+ | ... +------+ +------+
| next | | ... | next | | next |
| ----------- ... | -------->nil | -------------> nil
+------+ ... +------+ +------+
^ ^ ^
| - это start | - это list | - это l

Выполняя присваивание list^.next := l мы переходим к такому виду:

+------+ |---->...->+------+ |---->+------+
| data | | ... | data | | | data |
+------+ | ... +------+ | +------+
| next | | ... | next | | | next |
| ----------- ... | ------------ | -------------> nil
+------+ ... +------+ +------+
^ ^ ^
| - это start | - это list | - это l

и после list := l мы получаем такую картину:

+------+ |---->...->+------+ |---->+------+
| data | | ... | data | | | data |
+------+ | ... +------+ | +------+
| next | | ... | next | | | next |
| ----------- ... | ------------ | -------------> nil
+------+ ... +------+ +------+
^ ^
| - это start | - это list и l

Если же мы добавляем первай элемнт, то в начале start = nil. В конце и list и start и l будут указывать на одно и тоже. Если же освободить память, которую занимает l, то последний (или первый) элемент списка отрежется и мы ничего не добавим. Теперь напишем процедуру, которая выводит результаты нашей деятельности, т.е. список на экран:

procedure Display;
begin
if start = nil then
begin
writeLn ('Список пуст.');
exit
end;

list := start;

while list <> nil do
begin
write (#32, list^.data);
list := list^.next
end
end;

Итак тут мы устанавливам указтель list на начало списка (list := start), а потом "прокручиваем" его, пока он не равен nil (т.е. пока он существует). Обратите внимание, что мы переходим к следующему элементу таким образом: list := list^.next После выполнения программы было бы неплохо (я сказал даже очень замечательно) освободить память, которую занимает список. Это кстати может понадобится и в процессе выполнения самой программы. Процедура осовобождения очень похожа на процедуру вывода - мы так же последовательно перебираем список, только вместо вывода на экран мы освобождаем память.

procedure Clean;
var
l : plist;
begin
if start = nil then
exit; { список пуст, удалять нечего }

list := start; { переходим на начала списка }

while list <> nil do
begin
l := list; { теперь l - это текущий элемент }
list := list^.next; { list переходит на следующий }
Dispose (l) { освобождаем память }
end;
start := nil { обнуляем указатель начала }
end;

Естественно, что нам может понадобится найти чего-то в списке. Для этого предназаначена следующая процедура. Мы ищем элемент с data = d. Указатель на него останется в list после завершения работы процедуры, если же элемент не найден, то list = nil. Сама она не представляет из себя что-то сверх выдающееся. Тот же перебор от начала до конца (или же до той поры пока не найдём).

procedure Search (d : integer);
var
flag : boolean;
begin
list := start;
flag := false;

while (list <> nil) and (not flag) do
begin
if d = list^.data then
flag := true
else
list := list^.next
end
end;

Ну и напоследок напишем процедуру для удаления произвольного элемента из списка. Тут сразу же возникает 3 случая: удаляется первый, удалется последний и удаляется средний (т.е. не первый и не последний) элемент. Для начала рассмотрим третий случай. Список в данный момент представляет из себя что-то такое:

...->+------+ |---->+------+ |---->+------+
| data | | | data | | | data |
+------+ | +------+ | +------+
| next | | | next | | | next |
| ----------- | ------------ | ------------...
+------+ +------+ +------+
prev cur nxt

Я назвал условными именами элементы: cur - элемент, который удаляем; prev - элемент, который идёт перед удаляемым; nxt - элемент, идущий за удаляемым. Что бы удалить cur мы должны сделать следующие действия: prev.next = nxt (т.е. предыдущий должен указать на последующий за удаляемым):

...->+------+ +------+ |--|---->+------+
| data | | data | | | | data |
+------+ +------+ | | +------+
| next | | next | | | | next |
| -----------| | ---------+--- | ------------...
+------+ | +------+ | +------+
prev | cur | nxt
| |
|--------------|

Таким образом мы исключили из списка элемент cur, теперь просто освободим память и список преобразуется в такой:

...->+------+ |------>+------+
| data | | | data |
+------+ | +------+
| next | | | next |
| -----------| | | ------------...
+------+ | | +------+
prev | | nxt
| |
|------|

Случай удаления последнего элемента, является частным от удаления среднего, если предположить, что nxt = nil. А случай для удаления первого, если prev = nil. Процедура, которая выполняет всё описанное выше написана ниже При этом обратите внимание, что в момент входа в процедуру list указывает на элемент, который предшествует удаляемому (т.е. условно list = prev)

procedure Delete;
var
l : plist;
begin
if start = nil then
exit; { список пуст - удалять нечего }

l := list^.next; { теперь l указыват на удаляемый элемент l = cur}

if list <> nil then
begin{ если удаляется не первый элемент }
list^.next := l^.next; { prev.next = nxt (или же prev.next = cur.next) }
Dispose (l){ Освобождаем память }
end
else
begin { удаляем первый элемент }
list := start^.next;
Dispose (start); { освобождаем память }
start := list { устанавляваем новое начало списка }
end
end;

Теперь у нас есть довольно мощный арсенал для работы со списком. Мы можем заполнить список с помощью Add, очистить его Clean, найти нужный элемент Search и удалить его .... или нет удалить его сразу мы не можем. Ведь после выполнения Search list указывает на найденный элемент, а для выполнения Delete нам в list нужен указатель на предыдущий. Надо бы написать ещё процедуру, которая бы находила элемент предшествующий данному. Это и будет домашним заданием. Написать процедуру findPrior, которая ищет элемент списка, предшествующий list.... после её выполнения именно list и должен указывать на этот элемент (что бы потом проще было вызывать Delete). Так же было бы не плохо (а вернее очень хорошо) написать процедуру для добавления элемента в начало списка. Ниже я привёл пример работы со связанным списком. Это просто все процедуры описанные выше + маленькая менюшка. Естественно не хватает процедуры findPrior. Поэтому не пытайтесь что-то удалять пока не напишите её. colspan

uses CRT;

type
plist = ^tlist;
tlist = record
data : integer;
next : plist
end;

var
list, start : plist;
i : integer;

procedure Add (d : integer);
var
l : plist;
begin
New (l);
l^.data := d;
l^.next := nil;

if start <> nil then
begin
list := start;

while list^.next <> nil do
list := list^.next;
list^.next := l
end
else
start := l;
list := l
end;

procedure Display;
begin
if start = nil then
begin
writeLn ('‹Ёбв Їгбв');
exit
end;

list := start;

while list <> nil do
begin
write (#32, list^.data);
list := list^.next
end
end;

procedure Clean;
var
l : plist;
begin
if start = nil then
exit;

list := start;

while list <> nil do
begin
l := list;
list := list^.next;
Dispose (l)
end;
start := nil
end;

procedure Delete;
var
l : plist;
begin
if start = nil then
exit;

l := list^.next;

if list <> nil then
begin
list^.next := l^.next;
Dispose (l)
end
else
begin
list := start^.next;
Dispose (start);
start := list
end
end;

procedure Search (d : integer);
var
flag : boolean;
begin
list := start;
flag := false;

while (list <> nil) and (not flag) do
begin
if d = list^.data then
flag := true
else
list := list^.next
end
end;

procedure findPrior;
begin
**** ERROR ****
end;

begin
while true do
begin
ClrScr;
writeLn ('Џа®Ја ¬¬ ¤«п а Ў®вл б® бўп§ ­­л¬ бЇЁбЄ®¬');
writeLn ('1 - ¤®Ў ўЁвм н«Ґ¬Ґ­в');
writeLn ('2 - ­ ©вЁ Ё г¤ «Ёвм н«Ґ¬Ґ­в');
writeLn ('3 - ®зЁбвЁвм бЇЁб®Є');
writeLn ('4 - ўлўҐбвЁ бЇЁб®Є');
writeLn ('5 - ўл室');
writeLn ('>>>>>');
Display;
gotoxy (7, 7);
readLn (i);
gotoxy (1, 9);

case i of
1 : begin
write ('‚ўҐ¤ЁвҐ зЁб«®: ');
readLn (i);
Add (i)
end;
2 : begin
write ('‚ўҐ¤ЁвҐ зЁб«®: ');
readLn (i);
Search (i);
if list = nil then
begin
writeLn ('ЌҐ ­ ©¤Ґ­®');
readLn;
continue
end;
findPrior;
Delete;
end;
3 : Clean;
4 : begin
ClrScr;
Display;
readLn;
end;
5 : begin
Clean;
break
end
end
end
end.

+------+<---| |---->+------+<---| |---->+------+
| data | | | | data | | | | data |
+------+ | | +------+ | | +------+
| next | | | | next | | | | next |
| ---------+--- | ---------+--- | -------------> nil
+------+ | +------+ | +------+
| prev | | | prev | | | prev |
nil<--------- | |------------- | |------------- |
+------+ +------+ +------+

Соответственно наша структура преобразуется к следующей:

type
plist = ^tlist;
tlist = record
data : integer;
next, prev : plist;
end;

Работа с двусвязным списком не на много сложнее работы с односвязным. А в некоторых местах даже легче. Кроме двусвязных списков я бы хотел обратить внимание на ещё одну деталь. Давайте создадим указатель на указатель звучит не очень, но всё таки. Для нашего примера тип указателя на указатель на tlist опишется так:

p2list = ^plist;

Что же это такое указатель на указатель ? Давайте вспомним что такое указатель. Указатель - это адрес. Значит указатель на указатель - это адрес указателя. Т.е. это адрес той ячейки памяти, где содержится адрес ячейки памяти, где содержится tlist. Помните: "...синица, которая ворует пшеницу, которая в чёрном чулане хранится, в доме который построил Джек." Мы можем создать и указатель на указатель на указатель и так далее. Но сегодня мы не будем так изощрятся и кроме двусвязных списков научимся использовать указатели на указатель. Для начала откажемся от глобальных переменных. Давайте представим, что мы будем писать функции и процедуры для кого другого, т.е. у нас не будет глобальных переменных - всё, что нам нужно мы будем получать из параметров. Начнём с добавления нового элемента в конец списка. Это очень просто

procedure AddToEnd (list : p2list; d : integer);
var
prior : plist;
begin
prior := nil;

{ перематываем список до конца }
while list^ <> nil do
begin
prior := list^;
list := @list^^.next
end;

{ добавляем новый элемент }

New (list^);

with list^^ do
begin
data := d;
next := nil;
prev := prior
end
end;

Итак наша процедура получает 2 параметра: указатель на указатель на tlist и число, которое добавим в конец списка. Давайте обратимся к самой "страшной" строчке и попробуем разобраться: list := @list^^.next. Итак list указывает на plist, т.е. если разыменовать(получить значение по его адресу) указатель, то list^ - это указатель на tlist. Тогда, что бы обратиться к какому либо полю мы должны провести операцию разыменования ещё раз, т.е. list^^ - это уже структура tlist и мы можем спокойно обращаться с её полями. Теперь давайте разберём зачем мы здесь использовали @. Опять обратимся к определению указателя: указтель - это адрес. Значит в list у нас должен содержаться адрес указателя на tlist. Такой указтель у нас есть - list^^.next - указывает на tlist. Значит мы должны присвоить list адрес list^^.next, что мы благополучно и делаем. В остальном эта процедура ничем замечательным не обладает. Итак элемент добавлен, после работы его надо удалить.

procedure DelFromEnd (list : p2list);
var
old : plist;
begin
if list^ = nil then
exit; { список пуст, удалять нечего }

{ перемотка в конец }
while list^^.next <> nil do
list := @list^^.next;

{ list^ указывает на последний элемент }
old := list^;

{ удаляем этот элемент логически ....}
list^ := nil;
{ ... и физически - освобождаем память }
Dispose (old)
end;

Так же необходимо написать процедуру для очиски списка. Это можно сделать 2 способами.

1. Преобразовать DelFromEnd в функцию, возвращающую значение false, если список пуст, тогда что бы его очистить можно создать пустой цикл, пока функцию не вернёт false
2. Воспользоваться специальной процедурой, текст которой приведён ниже.

procedure Clear (list : p2list);
var
old : plist;
begin
if list^ = nil then
exit;

{ перемотка в начало }
while list^^.prev <> nil do
list^ := list^^.prev;

{ перемотка в конец с уничтожением текущего элемента }
while list^ <> nil do
begin
old := list^;
list^ := list^^.next;
Dispose (old)
end
end;

Естественно, что нам может понадобится функция для поиска элемента. Поиск осуществляется тем же перебором от начала до конца, если поиск успешен, то функция вернёт значение true, а list будет указывать на найденный элемент. В противном случае функция вернёт false.

function FindData (list : p2list; data : integer): boolean;
var
l : plist;
begin
if list^ = nil then
begin
FindData := false;
exit
end;

while list^^.prev <> nil do
list^ := list^^.prev;

l := list^;

while l <> nil do
begin
if l^.data = data then
begin
FindData := true;
list^ := l;
exit
end;
l := l^.next
end;

FindData := false
end;

Внимательный читатель должен был бы уже призадуматься, а почему это мы передаём параметры обычным способом и ожидаем, что в конце что-то изменится ? (Если этот вопрос вас не гложет или вы понимаете почему произойдёт изменение переходите сразу дальше). Ведь после выполнения такого кода a и b остануться равными 0 !

procedure bla (c,d : integer);
begin
c := 2;
d := 3
end;

var
a, b : integer;
begin
a := 0;
b := 0;
bla (a, b)
end.

Однако, то что истинно для простых переменных не всегда правда для указателей. Давайте немного изменим код:

type
pint = ^integer;

procedure bla (c,d : pint);
begin
c^ := 2;
d^ := 3
end;

var
a, b : integer;
begin
a := 0;
b := 0;
bla (@a, @b)
end.

В результате a и b изменятся ! Давайте разберём почему. Мы передаём в bla указатели (читай адреса) c и d. Потом меняем значения по этим адресам (c^ := 2). При вызове в bla передадутся адреса a и b - bla (@a, @b). Когда процедура изменит значения по этим адресам, то изменятся значения a и b. Всё это конечно хорошо, но зачем тогда мы передаём в процедуры для работы со списком указатель на указатель, а не просто указатель! Тут всё дело в организации списка. Для односвязного списка мы использовали 2 указателя: начала и рабочий. Для двусвязного списка необходимость в указателе на начало отпадает, поэтому у нас будет один единственный указатель. С ним надо быть осторожнее! Не дай бог обратить его где-нибудь в nil! Односвязный список мы могли бы востановить по указателю начала. Поэтому например в функции поиска для перемотки используется дополнительная переменная. Однако я отвлёкся. Главная часть нашей программы будет выглядеть так:

var
list : plist; { это и есть наш список }
begin
.....
AddTolistEnd (@list, d);
.....

Т.е. что бы изменить list, а значит и наш список нам надо в процедуры передавать указатель на plist, т.е. указатель на указатель на tlist. Но вернёмся к нашим баранам. Продолжим пополнять арсенал процедур и функций для работы со списком. Теперь, когда мы можем найти элемент в списке, то нужно с ним что-то делать. Например удалить или вставить новый после него. Начнём со вставки. Что бы вставить элемент нам надо соответствующим образом изменить указатели next у предшествующего и prev у следующего. Т.е. если вначале у нас был такой список:

...---->+------+<---| |---->+------+
| data | | | | data |
+------+ | | +------+
| next | | | | next |
| ---------+--- | ------------->....
+------+ | +------+
| prev | | | prev |
...<--------- | |------------- |
+------+ +------+

тогда, изменив указтели мы получаем такую картинку:

...---->+------+ +------+
| data | | data |
+------+ +------+
| next | | next |
| ------| | ------------->...
+------+ | +------+
| prev | | | prev |
...<--------- | | |---------- |
+------+ | | +------+
^ | \ / ^
| |->+------+ |
| | data | |
| +------+ |
| | next | |
| | ----------|
| +------+
| | prev |
|----------- |
+------+

Текст процедуры, которая описывает это приведён ниже:

procedure Add (list : p2list; d : integer);
var
l : plist;
begin
if list^ = nil then
begin
AddToEnd (list, d);
exit
end;

New (l);
l^.data := d;
l^.prev := list^;
l^.next := list^^.next;
list^^.next := l
end;

Обратите внимание на "маленькую хитрость" к котороя я прибегнул: если добавляем первый элемент, то тогда вызываем AddToEnd. Попытайтесь понять почему мы так сделали. Процедуру удаления я оставляю на ваше собственное рассмотрение. Так же без комментариев останутся процедуры для добавления/удаления элемента в/из начала. Если у вас возникнут вопросы - пишите.

procedure AddToBegin (list : p2list; d : integer);
var
l : plist;
begin
if list^ = nil then
begin
AddToEnd (list, d);
exit
end;

while list^^.prev <> nil do
list := @list^^.prev;

New (l);

l^.data := d;
l^.prev := nil;
l^.next := list^;
list^^.prev := l
end;

procedure DelFromBegin (list : p2list);
var
old : plist;
begin
if list^ = nil then
exit;

while list^^.prev <> nil do
list^ := list^^.prev;

old := list^;
list^ := list^^.next;
list^^.prev := nil;

Dispose (old)
end;

Вот так слово за слово мы и подошли к процедуре вывода списка на экран. Тут я хочу остановится подробнее. Вспомним примерную структуру нашей будующей программы для работы со списком:

var
list : plist; { это и есть наш список }
begin
.....
AddTolistEnd (@list, d);
.....

В отличии от односвязного списка теперь у нас только один указатель - list. Он у нас и бегает по списку. При этом бегает в прямом смысле слова. Если вы где-то присвоите ему по ошибке nil, то список будет потерян. Давайте рассмотрим пример работы списка. Итак в начале список пуст, но тут мы добавляем первый элемент (* я буду показывать на что сейчас указывает list):

*123

добавим элемент в начало:

321 *123

добавим элемент в конец:

321 *123 456

теперь добавим после текущего:

321 *123 0 456

. Теперь найдём элемент 456:

321 123 0 *456

Как вы видите list путешествует по списку (хотя особо не расходится и было бы неплохо добавить в процедуру вывода на экран именно указывать где сейчас list с помощью такой же звёздочки, что мы сейчас благополучно и сделаем:

procedure Display (list : plist);
var
p : plist;
begin
if list = nil then
writeLn ('Список пуст')
else
begin
p := list;

while p^.prev <> nil do
p := p^.prev;

while p <> nil do
begin
if p = list then
write ('*');
write (p^.data, #32);
p := p^.next
end
end
end;

именно для указания текущего положения мы и вводим дополнительную переменную p с помощь которой осуществляем перемотку. И когда p = list значит это текущий элемент и поэтому мы выводим звёздочку. Ну и наконец я привожу текст программы, работающей с двусвзяным списком. Как и в прошлый раз процедуры, которые я дал вам на домашнее рассмотрение не приведены.

uses CRT;

type
plist = ^tlist;
tlist = record
data : integer;
next, prev : plist;
end;
p2list = ^plist;

procedure Display (list : plist);
var
p : plist;
begin
if list = nil then
writeLn ('‘ЇЁб®Є Їгбв')
else
begin
p := list;

while p^.prev <> nil do
p := p^.prev;

while p <> nil do
begin
if p = list then
write ('*');
write (p^.data, #32);
p := p^.next
end
end
end;

procedure AddToEnd (list : p2list; d : integer);
var
prior : plist;
begin
prior := nil;

while list^ <> nil do
begin
prior := list^;
list := @list^^.next
end;

New (list^);

with list^^ do
begin
data := d;
next := nil;
prev := prior
end
end;

procedure Add (list : p2list; d : integer);
var
l : plist;
begin
if list^ = nil then
begin
AddToEnd (list, d);
exit
end;

New (l);
l^.data := d;
l^.prev := list^;
l^.next := list^^.next;
(list^)^.next := l
end;

procedure AddToBegin (list : p2list; d : integer);
var
l : plist;
begin
if list^ = nil then
begin
AddToEnd (list, d);
exit
end;
while list^^.prev <> nil do
list := @list^^.prev;
New (l);
l^.data := d;
l^.prev := nil;
l^.next := list^;
list^^.prev := l
end;

procedure DelFromEnd (list : p2list);
var
old : plist;
begin
if list^ = nil then
exit;
while list^^.next <> nil do
list := @ list^^.next;

old := list^;

list^ := nil;
Dispose (old)
end;

procedure DelFromBegin (list : p2list);
var
old : plist;
begin
if list^ = nil then
exit;
while list^^.prev <> nil do
list^ := list^^.prev;
old := list^;
list^ := list^^.next;
list^^.prev := nil;
Dispose (old)
end;

procedure Delete (list : p2list);
begin
writeLn ('Please make it yourself. Have fun ')
end;

function FindData (list : p2list; data : integer): boolean;
var
l : plist;
begin
if list^ = nil then
begin
FindData := false;
exit
end;
while list^^.prev <> nil do
list^ := list^^.prev;
l := list^;
while l <> nil do
begin
if l^.data = data then
begin
FindData := true;
list^ := l;
exit
end;
l := l^.next
end;
FindData := false
end;

procedure Clear (list : p2list);
var
old : plist;
begin
if list^ = nil then
exit;
while list^^.prev <> nil do
list^ := list^^.prev;
while list^ <> nil do
begin
old := list^;
list^ := list^^.next;
Dispose (old)
end
end;

var
list : plist;
i : integer;
begin
while true do
begin
ClrScr;
writeLn ('ЏаЁ¬Ґа а Ў®вл ¤ўгбўп§­®Ј® бЇЁбЄ ');
writeLn ('1 - ¤®Ў ўЁвм н«Ґ¬Ґ­в ў ­ з «®');
writeLn ('2 - ¤®Ў ўЁвм н«Ґ¬Ґ­в ў Є®­Ґж');
writeLn ('3 - ¤®Ў ўЁвм н«Ґ¬Ґ­в ў ⥪гйго Ї®§ЁжЁо');
writeLn ('4 - ­ ©вЁ н«Ґ¬Ґ­в');
writeLn ('5 - г¤ «Ёвм ЇҐаўл©');
writeln ('6 - г¤ «Ёвм Ї®б«Ґ¤­Ё© ');
writeLn ('7 - г¤ «Ёвм ⥪гйЁ©');
writeLn ('8 - ®зЁбвЁвм бЇЁб®Є');
writeLn ('9 - ўл室');
writeLn ('>>>>');
writeln(#10, 'CЇЁб®Є:');
Display (list);
gotoxy (5, 11);
readLn (i);
case i of
1: begin
write ('‚ўҐ¤ЁвҐ зЁб«®: ');
readLn (i);
AddToBegin (@list, i);
end;
2: begin
write ('‚ўҐ¤ЁвҐ зЁб«®: ');
readLn (i);
AddToEnd (@list, i);
end;
3: begin
write ('‚ўҐ¤ЁвҐ зЁб«®: ');
readLn (i);
Add (@list, i);
end;
4: begin
write ('‚ўҐ¤ЁвҐ зЁб«®: ');
readLn (i);
if not FindData (@list, i) then
begin
writeLn ('ќ«Ґ¬Ґ­в ­Ґ ­ ©¤Ґ­');
readLn
end
end;
5: DelFromBegin (@list);
6: DelFromEnd (@list);
7: Delete (@list);
8: Clear (@list);
9: break;
end
end;
Clear (@list);
end.

* сам Mem - каждый компонент такого массива типа byte.
* MemW - каждый компонент типа word.
* MemL - каждый компонент типа longint.

Теперь рассмотрим примеры. Условно обозначим Seg - сегмент, Ofs - смещение в сегменте, b, w, l - переменные соответственно типов byte, word и longint.

* b := Mem [Seg:Ofs]; - в b байт с указанного адреса.
* w := MemW[Seg:Ofs]; - в w 2 байта с адреса
* l := MemL[Seg:Ofs]; - в l 4 байта

это мы читали из памяти. Для записи же в память надо присвоить элементу массива нужное число:

* Mem[Seg:Ofs] := b; - запишет 1 байт по адресу
* MemW[Seg:Ofs] := w; - запишет 2 байта по адресу
* MemL[Seg:Ofs] := l; - запишет 4 байта по адресу

Еще одна тонкость. Число ABCDEF12h будет записано в памяти в следующем виде: 12EFCDABh, т.е. наоборот. Вот и всё Теперь я рассмотрю несколько примеров для закрепления материала. Например помните, как мы с помощью указателя изменяли первый символ на экране? Давайте провернём тот же фокус с использованием Mem.

begin
Mem[$B800:0] := 1;
Mem[$B800:1] := $84
end.

-рисует вместо первого символа красную мигающую рожицу на чёрном фоне. Если вы забыли, как устроена видеопамять в текстовом режиме или не читали об этом, то вам лучше вернуться к выпуску #16 Путешествие по памяти. Продолжим и сделаем тоже самое, но с использованием MemW:

begin
MemW[$B800:0] := $8401
end.

вот тут обратите внимание на тут тонкость о которой я говорил - запись идёт в обратном порядке.
Если бы мы написали MemW[$B800:0] := $0184 - т.е. сначала символ, а потом аттрибут. То мы бы увидели синюю букву Д, а не красную рожицу. Давайте теперь изменим 4 байта в видеопамяти, т.е. 2 первых символа на экране с помощью MemL:

begin
MemL[$B800:0] := $24028401
end.

Опять таки обратите внимание на обратный порядок записи - сначала идёт байт-аттрибут 2-го символа, потом второй символ, потом байт-аттрибут 1-ог символа и наконец сам 1-й символ. Теперь давайте считывать из памяти. Напомня, что слово по адресу 0:413 содержит информацию BIOS'a о наличной памяти в килобайтах. Давайте распечатаем это число.

begin
writeLn (MemW[0:$413])
end.

в общем и целом тут нет ничего сложного. Поэтому думаю, что эту тему можно считать закрытой.
colspanЗадание

В прошлый раз я не дал объяснения как найти предыдущий элемент в списке с одной связью (list на входе указывает на текущий элемент списка, start на его начало). Ниже приводится текст процедуры с комментариями.

procedure findPrior;
var
l : plist;
begin
if (start = list) or (list = nil)then
exit; { предыдущего нет }

l := list; { сохраняем текущий в переменной l }
list := start;

{ перематываем список с начала }
while list <> nil do
begin
if list^.next = l then
exit; { нашли элемент, next которого указывает на текущий элемент, на выход }
list := list^.next
end
end;

если мы не смогли найти предыдущий элемент (например в случае если list принял ошибочное значение и вылез куда-то за границу списка), то при выходе list = nil. В случае удачного выполнения в list и окажется предыдущий элемент.

uses Graph;

var
grDriver: Integer;
grMode: Integer;
Errcode: Integer;
begin

grDriver := Detect;
InitGraph(grDriver, grMode,'');
Errcode := GraphResult;

if Errcode <> grOk then
begin
Writeln('Graphics error:');
Writeln(GraphErrorMsg(Errcode));
Writeln('Program aborted...');
Halt(1)
end

..... do something ...
Readln;
CloseGraph
end.

ну что неплохое начало Эта программа "ничего" не делает. Просто переходт в графический режим, ждёт нажатия клавиши и выходит назад в текстовый. Теперь давайте разберём, что же мы тут использовали:

procedure InitGraph(var GraphDriver:Integer; var GraphMode: Integer; PathToDriver: string);

процедра инициализации графики. Т.е. по просту говоря для перехода в графический режим. GraphDriver - графический драйвер, которым мы хотим пользоваться. Мы задаём этому параметру значение Detect - авто определение(т.е. программа сама определит наилучший режим). Для современной техники это 640x480x16
GraphMode определяет графический режим, т.к. у нас стоит автоопределение он определится сам (это и будет режим 640х480 16 цветов).
PathToDriver - путь к файлу драйвера. Если путь не задаётся, как это сделали мы, то драйвер ищётся в текущем каталоге программы. Если использовать автоопределение, то нам нужен файл egavga.bgi из папки bp\bgi. На всякий случай, вдруг кто не знает скажу кое-что об обозначениях что значит 640х480х16 - то точная характеристика графического режима: (число точек по горизонтали)х(число точек по вертикали)х(количество цветов). Т.е. 640 точек по горизонтали, 480 по вертикали и 16 цветов. В интернете сейчас можно найти версии файлов *.bgi для работы в более лучших режимах. Однако я всё же буду рассказывать про стандартную поставку, т.к. углубляться в графику мы пока особо не будем. Всему своё время. Следующая функция возвращает нам резльтат предыдущей функции или процедуры, если возникла ошибка:

function GraphResult: Integer;

Если возникла ошибка (например при инициализации графики программа не нашла файл с драйвером), то возвращаемое значение не равно grOk. Расшифровку ошибки можно получить вызвав:

function GraphErrorMsg(Errorcode: Integer): string;

возвращает строку, содержащую содержание ошибки, заданной переменной Errorcode. Не помню писал ли я про halt, так что если повторюсь, то ничего:

procedure Halt ( Exitcode: Word );

останавливает выполнеие программы и передаёт управление операционной системе. Если параметр Exitcode = 1 значит это завершение программы с ошибкой. Ну и последняя процедура:

procedure CloseGraph;

переходит назад в текстовый режим. Обратите внимание на вызов ReadLn перед вызовом CloseGraph. Зачем мы это делаем? Если опустить этот вызов, то после выполнения программы сразу произойдёт выход в текстовый режим и соответственно экран очистится. Что бы посмотреть результаты выполнения программы мы вынужденны ожидать нажатия клавиши. Если вы думаете, что это сложно, то вы ошибаетесь, что бы создать простое пустое окошко в программе для Windows надо написать раза в три-четыре больше Этот код будем считать каркасом наших будующих графических программ. Теперь самое время поговорить о координатах. Всё дело в том, что в компьютерах координатные оси направленны по другому. Для примера: мы пользуемся декартовой системой координат ( © by Рене Декарт :), центром которой является точка (0,0) опять же извиняюсь за убогость, но картинку не приаттачить:

^ y
|
|
|
--------+------->
| x
|
|

В компьютерах же используется несколько другая система

+----------------------->
| x
|
|
|
|
|
|
V y

Как видите в ней отсутствуют отрицательные числа и ось ординат (y) направленна вниз. Вызвано это следующей причиной. Разрешение экрана определяют в пикселях. Пиксель (сокращение от Picture Element - элемент картинки) - это минимальная логическая точка (или если хотите единица) экрана. Т.е. разрешению экрана 800х600 означает, что по оси Х у нас максимально 800 пикселей, а по оси Y - 600. Один пиксель может состоять из множества физических точек (т.е. точек подсветкой которых можно управлять аппаратно). Так вот левому верхнему углу экрана соответствеут пиксель с координатами (0,0), а правому нижнему в зависимости от разрешения. Если оно 800х600 тогда (799, 599). Пиксель - это всегда целое положительное число. У вас не может быть 1/3 пикселя или пиксель с координатой (-5, -5). Так как мы не можем посветить на экране 1/3 пикселя и мы не можем высветить пиксель (-5, -5) т.к. это выпадает за границу экрана. Кстати количесто цветов на экране определяется количеством бит видеопамяти, отводимой под 1 пиксель. Так если под один пиксель отводится 1 байт (8 бит) тогда это режим с 256 цветами (напомню, что столько может быть различных комбинаций бит в байте). Теперь рассмотрим самую важную процедуру в графике - подсветка пикселя:

procedure PutPixel(X, Y: Integer; color: Word);

соответственно х, у - координаты. Color - цвет. Кстати о цветах. Для первых 16 цветов введены специальные константы. Ниже приводится таблица соответствия цветов и номеров (для текстовой версии к сожалению графа пример останется незаполненной, т.к. нет такой возможности):
Номер цвета Название константы Русское название (для текстовой версии) Примерчик
0 BLACK чёрный
1 BLUE синий
2 GREEN зелёный
3 CYAN голубой
4 RED красный
5 MAGENTA фиолетовый
6 BROWN коричневый
7 liGHTGRAY светло серый
8 DARKGRAY тёмно серый
9 liGHTBLUE светло синий
10 liGHTGREEN светло зелёный
11 liGHTCYAN светло голубой
12 liGHtrED розовый
13 liGHTMAGENTA светло фиолетовый
14 YELLOW жёлтый
15 WHITE белый

поэтому putpixel (10, 10, 15) и putpixel (10, 10, WHITE) произведёт одинаковый эффект. Таким образом мы можем рисовать любые фигуры, используя посветку точек на экране. Однако в BGI есть специальные процедуры для рисования графических примитивов - линий, окружностей, прямоугольников, вывода текста, работы с изображениями и многим другим. К сожалению в формат выпусков не влезет описать все возможности BGI, да многое и не понадобится. Поэтому проведу обзор самых нужных функций и процедур.

function GetPixel(X,Y: Integer): Word;
возвращает цвет точки с координатами х,у
procedure line(x1, y1, x2, y2: Integer);
рисует линию от точки (x1,y1) к точке (x2, y2). Цвет линии устанавливается с помощью следующей процедуры:
procedure SetColor(Color: Word);
устанавливает текущий цвет для рисования графических объектов. По умолчанию цвет белый.
procedure SetBkColor(ColorNum: Word);
устанавливает цвет фона, по умолчанию цвет фона чёрный. Цвет фона - это цвет экрана на котром мы рисуем. Что-то типа цвета рабочего стола в Windows
procedure Circle(X,Y: Integer; Radius: Word);
рисует окружность с центром в точке (x,y) и радиусом Radius. Цвет окружности задаётся с помощью SetColor.
procedure Ellipse(X, Y: Integer; StAngle, EndAngle: Word; XRadius, YRadius: Word);
рисует элипс с центром в точке (x,y), полу-осями xradius, yradius, от угла stangle до угла endangle. Угол считается против часовой стрелки (т.е. 00 - 3 часа, 900 - 12 часов). Цвет задаётся с помощью SetColor.
procedure Bar(x1, y1, x2, y2: Integer);
рисует закрашенный прямоугольник. левый верхний угол (х1,у1) - правый нижний (х2, у2). Стиль кисти и цвет закраски определяется следующей процедурой:
procedure SetFillStyle(Pattern: Word; Color: Word);
устанавливает текущий стиль кисти (pattern) и её цвет (color). Цвет, который задаётся setcolor и setfillstyle не совпадают и применяются к разным графическим объектам. Первый к графическим примитивам, второй к закрашенным объектам. Существует несколько предопределённых стилей, которые приведены в нижеследующей таблице:
Констнанта Численное значение Описание
EMPTY_FILL 0 Закрашивает цветом фона
(несмотря на цвет, который вы указали в setfillstyle)
SoliD_FILL 1 Равномерная закраска
liNE_FILL 2 Закрашивает ---
LTSLASH_FILL 3 Закрашивает ///
SLASH_FILL 4 Закрашивает ///, толстые линии
BKSLASH_FILL 5 Закрашивает \\\, толстые линии
LTBKSLASH_FILL 6 Закрашивает \\\
HATCH_FILL 7 В "клеточку"
XHATCH_FILL 8 В клеточку под углом
INTERLEAVE_FILL 9 Чередование
WIDE_DOT_FILL 10 Широко расположенные точки
CLOSE_DOT_FILL 11 Близко расположенные точки
USER_FILL 12 Стиль определять вам!
что бы лучше понять напишите программу, которая бы в цикле выводила прямоугольники и меняла стиль, тогда вы поймёте что к чему.
procedure FillEllipse(X, Y: Integer; XRadius, YRadius: Word)
рисует закращенный элипс с центром (х,у) и полу-осями xradius, yradius. Стиль и цвет определяются Setfillstyle
procedure ClearDevice;
очищает экран (заполняет его цветом фона).
procedure OutTextXY(X,Y: Integer; TextString: string);
выводит строку textstring, начиная с точки (х,у). В графическом режиме для вывода нужно обязательно использовать эту процедуру.
procedure GetImage(x1, y1, x2, y2: Integer; var BitMap);
копирует картинку в память. Картинка определяется координатами (x1, y1) - левый верхний угол; (x2, y2) - правый нижний угол. BitMap - это область куда мы должны копировать картинку. Размер области памяти складывается из количества необходимого под картинку + 6 байт. Два первых слова этих байт хранят ширину и высоту картинки, третье слово зарезервировано и зачем оно нужно это охраняемая тайна компании Borland
procedure PutImage(X, Y: Integer; var BitMap; BitBlt: Word);
соответственно обратная процедура. Рисует изображение из BitMap на экран, начиная с координат (х,у). BitBlt - определяет способ вывода картинки. Ниже даны его возможные значения:
Константа Численное значение Смысл
NormalPut 0 Копирует изображение на экран (цвет каждого пикселя сохраняется)
XORPut 1 Результат получается как XOR, применённый к точке на экране и точке изображения
OrPut 2 как OR, применённый к точке на экране и точке изображения
AndPut 3 как AND, применённый к точке на экране и точке изображения
NotPut 4 Цвет каждого пикселя инвертируется (заменяется на противоположный)
function ImageSize(x1, y1, x2, y2: Integer): Word;
эта функция используется, что бы вычислить размер памяти BitMap в процедуре GetImage, т.е. размер необходимый под сохранение области + 3 слова.
function GetMaxX: Integer; / function GetMaxY Integer;
возвращает максимальное значение Х / Y координаты.
procedure FloodFill(X, Y: Integer; Border: Word);
закрашивает область, которая содержит точку (x,y) и ограничена кривой с цветом Border. Стиль и цвет определяются Setfillstyle

это далеко не полный список процедур и фунций из библиотеки BGI. Что бы понять как они работают лучше всего, что бы вы попробовали вызвать их поочереди и посмотреть что будет. Кстати хороший пример работы этих и других функций и процедур находится в программе BP\EXAMPLES\DOS\BGI\bgidemo.pas. Сейчас я как раз разберу пример от туда. Это пример с НЛО запустите и посмотрите, так как надо объяснять пользуясь картинкой. Если НЛО летает медленно, тогда в самом конце измените задержку (например на delay (1000) - в 10 раз быстрее) так как на моём P4 за НЛО не уследить этот параметр в примере равен кстати 70

program demo;

uses Crt, Graph;

const
r = 20;
StartX = 100;
StartY = 50;

var
grDriver, grMode, Errcode : integer;
MaxX, MaxY : word;
Saucer : pointer;
X, Y : integer;
ulx, uly : word;
lrx, lry : word;
Size : word;
I : word;

procedure MoveSaucer(var X, Y : integer; Width, Height : integer);
var
Step : integer;
begin
Step := Random(2*r);

if Odd(Step) then
Step := -Step;

X := X + Step;
Step := Random®;

if Odd(Step) then
Step := -Step;

Y := Y + Step;

if X > MaxX then
X := MaxX
else
if (X < 0) then
X := 0;
if Y > MaxY then
Y := 1
else
if Y < 0 then
Y := 0
end;

begin
grDriver := Detect;
InitGraph(grDriver, grMode,'');
Errcode := GraphResult;
if Errcode <> grOk then
begin
writeLn ('Graphics error:', GraphErrorMsg(Errcode));
halt (1)
end;

ClearDevice;

MaxX := getmaxx;
MaxY := getmaxy;

{ рисуем НЛО }
Ellipse(StartX, StartY, 0, 360, r, (r div 3)+2);
Ellipse(StartX, StartY-4, 190, 357, r, r div 3);
line(StartX+7, StartY-6, StartX+10, StartY-12);
Circle(StartX+10, StartY-12, 2);
line(StartX-7, StartY-6, StartX-10, StartY-12);
Circle(StartX-10, StartY-12, 2);
SetFillStyle(SolidFill, WHITE);
FloodFill(StartX+1, StartY+4, GetColor);

{ вычисляем границы прямоугольника в который вмещается НЛО }
ulx := StartX-(r+1);
uly := StartY-14;
lrx := StartX+(r+1);
lry := StartY+(r div 3)+3;

Size := ImageSize(ulx, uly, lrx, lry);
GetMem(Saucer, Size);
GetImage(ulx, uly, lrx, lry, Saucer^);
PutImage(ulx, uly, Saucer^, XORput);

{ рисуем звёздное небо }
for I := 1 to 1000 do
PutPixel(Random(MaxX), Random(MaxY), random (WHITE));

X := MaxX div 2;
Y := MaxY div 2;

repeat
PutImage(X, Y, Saucer^, XORput);
Delay (10000);
PutImage(X, Y, Saucer^, XORput);
MoveSaucer(X, Y, lrx - ulx + 1, lry - uly + 1);
until Keypressed;

FreeMem(Saucer, size);

ReadLn;
closegraph
end.

Сначала одна неизвестная до этого момента функция

function Odd(X: Longint): Boolean;

проверяет является ли число нечётным. и возвращает true в случае успеха. Так вот думаю вы ужу понаблюдали за НЛО, теперь разберём как это происходит. Процедура MoveSaucer не осуществляет ничего сверх естественного и просто изменяет координаты НЛО, которые хранятся в глобальных переменных Х,Y. На ней подробно останавливаться думаю не стоит. Так же я не буду комментировать процесс рисования объекта, так как это просто последовательный вызов графических функций безо всяких алгоритмов. Я бы хотел обратить ваше внимание на следующие строки:

Size := ImageSize(ulx, uly, lrx, lry); - вычисляем память, которая нам нужна для хранения картинки НЛО
GetMem(Saucer, Size); - выделяем эту память
GetImage(ulx, uly, lrx, lry, Saucer^); - захватываем изображение НЛО в буффер Saucer.
PutImage(ulx, uly, Saucer^, XORput); - стираем НЛО

тут придётся вспомнить логические операции (как неужели вы их забыли !!!). Если забыли, тогда вернитесь к выпуску "#0E А сила - она, брат, в правде". Так вот что будет, когда мы число xor'им само с собой (a xor a) ??? Правильно 0. То же самое происходит и когда мы вызываем PutImage(ulx, uly, Saucer^, XORput). Ведь в Saucer у нас находится изображение НЛО, когда же мы накладываем изображение само на себя используя операцию xor, то получается 0, т.е. изображение цвет всех точек которого равен 0. А так как цвет фона у нас чёрный (0) то получается эффект стирания, а не перерисовки. Продолжим:

repeat
PutImage(X, Y, Saucer^, XORput); - рисуем НЛО
Delay (10000); - пауза
PutImage(X, Y, Saucer^, XORput); - стираем
MoveSaucer(X, Y, lrx - ulx + 1, lry - uly + 1); - двигаем НЛО
until Keypressed;

вроде бы ничего сложного, но задумайтесь на минутку почему остаются звёзды ? Давайте поставим задержку (delay) совсем большой и присмотримся к НЛО .... через него просвечивают звёзды! (что бы лучше это рассмотреть увеличте количество звёзд ). Всё из-за того что способ применённый здесь не является правильным. Хотя согласитесь рассмотреть эти маленькие точки тяжело и искажения не очень заметны. Теперь рассмотрим внимательнее исходник. Когда мы рисуем НЛО мы опять применяем операцию xor - поэтому если под НЛО находится звёздочка, то она просвечивает, причём с искажением цвета. Однако когда мы стираем НЛО мы вновь применяем xor и НЛО стирается, а звездочке возвращается свой "первозданный" цвет. Давайте обратимся к цифрам. Пускай у нас будет звезда жёлтого (14) цвета.

14 = 1110b
1111b xor 1110b = 0001b - синий цвет. это в момент рисования.
0001b xor 1111b = 1110b - жёлтый. в момент стирания. Как говорят математики ЧТД.

Данную анимацию можно применять для взаимно обратных цветов, т.е. по цветам с одинаковым отступом от концов палитры (палитра - набор цветов, каждому цвету соответствует номер в палитре, помните таблицу констант?). Такими цветами и являются: чёрный-белый (0 -15), синий-жёлтый (1-14) и т.д. Про правильную анимацию я раскажу как нибудь в другой раз.

asm
текст на языке ассемблер
end

Например напишем простую программку выводящую на экрана строку Hello world!:

program test;

label
Next, Msg;

begin
asm
jmp Next
Msg: db 'Hello world!$'
Next:
push ds
push cs
pop ds
mov ah, 9
mov dx, offset Msg
int 21h
pop ds
end
end.

Вот такая вот программка. Теперь давайте разберём что к чему и зачем. Думаю все догадались, что ассемблерный код вставится непосредственно в сегмент кода. А что это значит? Это значит, что процессор попытается исполнить все инструкции, даже те которые мы ему не давали. Строка db 'Hello world!$' запишет в ехе файл строку Hello world!$ (можете убедится в этом сами, открыв его в текстовом редакторе). А помните как процессор выполнил сочетание буквы Н и пробела? Правильно надо не дать ему выполнить инструкции, которые имеют коды 'Hello world!$'. Поэтому надо обойти эту строку. Поэтому мы используем команду jmp Next. Синтаксис её таков:

jmp МЕТКА

переходит на метку. Аналог уже знакомого нам goto. Думаю что с этой командой всё понятно jmp Next - переходит к строчке, помеченной Next. Дальше мы ставим метку Msg. Это нам понадобится, что бы как-то пометить строку db 'Hello world!$', что бы к ней вернуться. Следубщие строки пока пропускаем и переходим сразу к mov ah, 9. Тут мы сделаем долгую остановку. Вы уже привыкли пользоваться переменными, создавать их столько сколько нужно и давать им любые имена. Однако сюрприз. При программировании на ассемблере для навороченных вычислений разрешается использовать только несколько переменных с фиксированными именами собственными и имеющих фиксированный размер. Эти переменные называются регистрами. Например процессор 8086 имеет 14 регистров (посмотреть на них можно выбрав Debug -> Register). На все них мы не будем останавливаться подробно. Сейчас я раскажу о регистрах общего назначения. К ним относятся регистры с именами AX, CX, DX, BX. Каждый регистр имеет размер в 1 слово (2 байта). Обычно в этот момент рисуют вот такую схемку:
AX BX CX DX
AH AL BH BL CH CL DH DL
О чем она нам говорит? О том, что каждый дву байтовый регист состоит из 2-х однобайтовых (логично не правдо ли :). Левый байт называют старшей частью, а правый младшей. Соответственно и буква после имени H (High - старший) и L (Low - младший). Поэтому команда mov ah, 9 делает что-то со старшей частью ax, а mov dx, offset Msg с регистром dx. Очевидно, что присвоить значение регистру можно 2-мя способами:

1. присвоить сразу значение: AX = 32D2h
2. присвоить значения старшей и младшей части отдельно: AH = 32h, AL=D2h

Точно также значение старшей (младшей) части можно присвоить двумя способами:

1. присвоить непосредственно: AH = 32h
2. или через AX = 3200h

Кстати так как язык ассемблера представляет собой команды процессора, то команды равно ( = ) нет. Для присвоения регистру какого либо значения надо пользоваться командой mov (от англ. move - движение, хотя в данном контексте переводится, как загружать). Т.е. когда мы пишем mov ah, 9 - мы загружаем в AH 9. По русски это так AH = 9. Пропустим пока mov dx, offset Msg и перейдём сразу к строчке int 21h. Команда int - имеет такой синтаксис:

int [номер]

при вызове этой команды происходит прерывание (от англ. Interruption - прерывание). Что такое прерывание? Прерывание - это своего рода подпрограмма, которая находится постоянно в памяти и может вызываться в любое время из любой программы. Т.е. выполнение нашей программы прерывается и осуществляется переход на обработку прерывания. Прервание хотя и записывается одной командой на самом деле состоит из нескольких. После обработки (выполнения) прерывания программа продолжит работу. Если вы не поняли привожу замечательный пример из рассылки "Низкоуровневое программирование для дZенствующих":

Для тех, кто не понял. Представьте себе, что вы сидите за компом и выполняете какую-либо работу. И вдруг ловите себя на мысли, что вам СРОЧНО НУЖНО сходить в туалет (терпеть вы больше уже не можете). Вот это СРОЧНО НУЖНО и есть сигнал-прерывание, по которому вы начинаете выполнять определенную СТАНДАРТНУЮ последовательность инструкций (программу обработки прерывания), как-то: встать, пойти туда-то, включить свет ... вернуться, сесть за комп и ПРОДОЛЖИТЬ РАБОТУ с того же самого места, на котором вы остановились перед выполнением программы "поход в туалет". В данном случае наш мозг выполняет роль процессора, наши внутренние органы сигнализируют мозгу о потребности в обслуживании, а само обслуживание проводится "программой-навыком", заложенным в процессе нашего развития и (хм!) воспитания.

В нашей программе мы вызываем int 21h - прерывание 21h (читается двадцать первое прерывание). Это прерывание DOS. Каждое прерывание имеет несколько функции. Т.е. совершает различные действия в зависимости от номера функции. Номер функции должен быть помещён перед вызовом прерывания в ah (что мы и делаем mov ah, 9). Функция 9 прерывания 21h - это вывод строки на экран. Так же в зависимости от нужд прерывание может получать дополнительные параметры через другие регистры. Вполне логично, что для функции вывода строки на экран нам надо передать эту строку в прерывание. Этим и занимается mov dx, offset Msg. Так как dx может содержать всего 2 байта (а строка наверно будет длинее :), поэтому в dx должен быть адресс строки. Так вот offset Msg - это смещение до метки Msg (помните мы ей пометили Hello world). Однако нужно вспомнить, что в адресе помимо смещения есть ещё и сегмент. Откуда он берётся? Для этого существуют специальные сегментные регистры. Их имена - CS DS SS ES. Эти регистры уже не делятся на младшую и старшую часть, так они несут адрес сегмента. При этом подразумеваются следующее их назначение:

* Регистр CS служит для хранения сегмента кода программы (code Segment - сегмент кода);
* Регистр DS - для хранения сегмента данных (Data Segment - сегмент данных);
* Регистр SS - для хранения сегмента стека (Stack Segment - сегмент стека);
* Регистр ES - дополнительный сегментный регистр, который может хранить любой другой сегмент (например, сегмент видеобуфера).

Сразу скажу, что загрузка напрямую в сегментный регистр запрещена! Делать это можно например так:

mov ax, 0B800h
mov es, ax

Так вот, возвращаясь к 9 функции 21h прерывания - по умолчанию предпологается, что строка у нас находится в сегменте данных. Т.е. адресс строки на входе выглядит так - DS:DX. Однако наша то строка находится в сегменте кода. Т.е. нам надо присвоить DS значение CS. Делаем мы это через стек. Стек - область памяти, используемая программой для временного хранения данных. Работа со стеком заключается в простом правиле - первый пришёл, последний ушёл Для работы со стеком нам понадобятся всего 2 команды: push и pop. Синтаксис у них такой:

PUSH приемник
POP приемник

PUSH - записывает в стек, POP - извлекает из стека. Соответственно:

push AX - ПОМЕЩАЕТ В СТЕК значение регистра AX
pop AX - ИЗВЛЕКАЕТ ИЗ СТЕКА значение регистра AX

Вернёмся к нашей программе:

push ds
push cs
pop ds
........
pop ds

Итак первым push'eм мы сохраняем в стеке значение регистра ds (который сейчас указывает на сегмент данных). Вторым push'eм - значение cs (который указывает на сегмент кода). Что же мы извлекаем первым pop'ом? Давайте вспомним правило - первый пришёл, последний ушёл или же если сказать нооборот последний пришёл - первый ушёл. Значит первым pop'ом мы извлечём из стека значение cs. Т.е. после pop ds регистр DS = CS (что нам и было нужно). Второй pop нам нужен, что бы во первых вернуть стек в его первоначальное состояние (т.е. состояние до выполнения нашего кода). Во вторых что бы востановить значение DS. Здесь нам были не нужны никакие переменные, а если они будут, то программа будет лезть в сегмент данных (т.е. в DS), а он у нас указывает на код.... вообщем получится полная лабуда. Несмотря на кажащуюся простоту (всё так просто не правда ли со стеком надо обращаться аккратно.Ведь помимо нас со стеком работают и другие фукции программы. Например вы никода не задумывались как после выполнения процедуры программа знает куда ей вернуться? Оказывается адресс возврата предварительно записывается в стек и после выполнения процедуры извлекается от туда, и осуществлляется переход на него. А если внутри процедуры мы положили в стек число 3 и забыли его извлечь? Программа то не разберётся и решит, что это адрес возврата и перейдёт на него... что произойдёт дальше я боюсь предсказывать. По этотму не забывайте извлекать из стека, то что в него занесли. И что бы укрепить пройденное рассмотрим несколько примеров. Допустим, мы помещаем в стек следующие регистры: AX, BX, CX:

push ax
push bx
push cx

Восстанавливать со стека нужно в обратном порядке:

pop cx
pop bx
pop ax

Если вы поменяете местами регистры при восстановлении, то ничего страшного не произойдет, только содержать они будут другие числа. Например:

mov ax,1234h
mov bx,5678h
push ax
push bx
pop ax
pop bx

В итоге AX будет равен 5678h, а BX - 1234h. И тепрь ещё раз в кратце прокоментирую каждую строчку программы:

jmp Next - переходим на метку Next
Msg: db 'Hello world!$' - наша строка, содержащаяся в сегменте кода!
Next:
push ds - сохраняем в стеке адрес сегмента данных
push cs - сохраняем в стеке адрес сегмента кода
pop ds - извлекаем его из стека и записываем в ds, т.е. DS = CS
mov ah, 9 - записываем в ah - номер функции, AH = 9
mov dx, offset Msg - в dx смещение до строки
int 21h - вызываем 21h прерывание
pop ds - восстанавливаем ds в первоначальное значение

Чуть не забыл Вы обратили внимание на строку: Hello world!$. Зачем тут $ ? Просто 9-ая функция 21h прерывания считает $ признаком конца строки. Т.е. она будет выводить на экран символы начиная с адреса DS:DX пока не встретит $. Например уберите его из строки и вы увидите как редко $ встречается в памяти Итак теперь вы знаете 8 регистров. Назову ещё несколько:

* Регистр командного указателя IP
Он содержит смещение на команду, которая должна быть выполнена. Обычно этот регистр в программе не применяется.
* Индексные указатели SI и DI
Регистры SI (Source Index register - индекс источника) и DI (Destination Index register - индекс приемника) применяются для расширенной адресации и для использования в операциях сложения, вычитания и в некоторых строковых. Например адрес видеобуффера занесём в es, а смещение в di... ну и изменим первый символ:

mov ax,0B800h
mov es,ax - записываем в es адресс начала видеобуффера
mov di,0 - в di смещение относительно начала

mov ah,31 - байт аттрибут
mov al,1 - код символа
mov es:[di],ax

Придётся опять вспомнить организацию видеопамяти. Квадратные скобки ( [ ] ) в команде mov es:[di],ax указывают на то, что надо загрузить число не в регистр, а по адресу, который содержится в этом регистре (в данном случае - это 0B800:0000).
* Регистры-указатели SP и BP
о них я раскажу позже.
* Флаговый регистр (или регист флажков).
Очередной сюрприз - этот регист не имеет имени. Так как нас интересует не сам регист, а состояние некоторых его бит, которые имеют свои имена. Если посмотреть окно Registers, то они занимают 2 нижние строчки. О них я тоже раскажу в следующий раз.

cmp bx, 00

Как же узнать какой флаг установился, а какой нет? Для этого есть команды для перехода на метку, если флаг установлен. Всех их писать я не буду. Но например, если в предыдущем примере BX = 0, тогда сравнение вызовет установку флага ZF (Zero Flag - флаг нуля). Команда jz вызывает переход на метку, если установлен ZF. Для нашего примера:

cmp bx, 00
jz Label1
....это будет выполняться, если bx не равно 0
.....
Label1:
... здесь если bx равно 0

Во встроенном ассемблере могут использоваться три предопределённых имени:

* @code - текущий сегмент кода
* @Data - текущий сегмент данных
* @Result - ссылка, куда надо занести результат выполняемой функции

Остановимся подробнее на @Result. Например напишем функцию, возвращающую наименьшее из 2-х чисел.

function Min (x,y : integer): integer;
begin
asm
mov ax, x
cmp ax, y
jl @less
mov ax, y
@less:
mov @Result, ax
end
end;

Обратим взгляд на неизвестную нам команду jl - переход если меньше. Т.е. в нашем случае если AX меньше Y, то совершается переход на метку @less. Кстати откуда такое странное название (начинается с @)? Это так называемые локальные метки - метки в которые можно передать управление только внутри ассемблерной вставки. Т.е. вы не можете прыгнуть на неё с помощью goto. С другой стороны нам не надо объявлять такую метку в разделе label, так что начинайте свои метки с символа @. Этот символ говорит компилятору, о том что метка локальная. Так вот значит, если AX меньше Y (т.е. если X меньше Y), тогда мы переходим на метку @less. И записываем в @Result значение АХ (а там у нас Х). Если же Y меньше Х, тогда переход на метку не состоится и мы сначала занесём в АХ Y, а потом значение АХ в @Result. Вот таким образом компилятор преобразовывает наши высоко уровневые конструкции if-else к машинным cmp. Естесственно в силу превосходства человека над машиной, наш код меньше, чем генерируемый компилятором. Однако давайте обратим свой взор на использование функций процедур, написанных на ассемблере. Во перых объявление таких подпрограмм должно идти с директивой assembler. Во вторых исполняемая чать вместо привычного begin - end обрамляется asm - end. Т.е. шаблон выглядит так:

procedure NAME; assembler;
asm
.... текст на ассемблере
end

При этом ассемблерные функции должны возвращать свои значения следующим образом:

* если возвращаемый тип занимает 1 байт (тип Byte, Char) - в регистре AL
* 2 байта (Integer, word) - в AX
* 4 байта (pointer, longint) - в регистре DX (старшее слово) и AX (младшее слово)
* типа Real - в регистрах DX, BX, AX (DX - старшее слово и AX - младшее слово)
* других вещественных чисел - в регистре ST (0) сопроцессора (об этом ниже)
* строкового типа - в области памяти на которую ссылается @Result

Как видите в ассемблерных функциях разрешено использовать @Result только, если возвращаемое значение строкового типа. Так как наша функция Min не содержит "паскалевских" строк перепишем её в виде ассемблерной подпрограммы:

function Min (x,y : integer): integer;assembler;
asm
mov ax, x
cmp ax, y
jl @less
mov ax, y
@less:
end;

так как мы возвращаем значение типа integer, то нам надо запихать это значение в АХ (что мы и делаем). Обратите внимание, что наш код сократился ещё на одну строку. Нам не надо записывать возвращаемоео значение в @Result. Метка @less теперь у нас соответствует выходу из подпрограммы. Следующие строки будут целиком понятны только для людей знакомых с ассемблером более чем поверхностно. Однако и вам полезно это знать. Итак на входе и выходе в ассемблерную подпрограмму генерируется следующий код (он добавляется в ехе файл):

colspanВход в процедуру:
push bp - сохраняем значение bp
mov bp, sp - bp теперь содержит текущую границу стека
sub sp, local - резервируем часть стека для локальных данных, local - длинна в байтах всех объявленных в подпрограмме переменных

colspanВыход из процедуры:
mov sp, bp - восстанавливаем границу стека
pop bp - восстанавливаем bp
ret param - удаляем из стека все параметры и выходим из подпрограммы, param - длинна всех параметров

Если входные и выходные параметры отсутствуют, то создаётся код содержащий единственную инструкцию ret. Как я уже когда-то писал все параметры передаются в подпрограммы черз стек. Так же все локальные переменные хранятся в стеке. Поэтому при входе в процедуру создается локальный стек: в bp помещается текущая граница стека, а сама эта граница сдвигается на суммарную длинну всех локальных переменных что бы работа со стеком не разрушила локальные переменные. Например:

procedure some; assembler;
var
x : integer;
y : byte;
asm
mov X, ax - скомпилируется в mov [bp - 2], ax
mov al, Y - скомпилируется в mov al, [bp - 3]
end;

Как я написал выше, результат функции других вещественных чисел возвращается в регистре ST (0) сопроцессора. Что же такое сопроцессор? Как следует из названия это "дополнительный" процессор. Сопроцессор - это процессор для работы с числами с плавающей запятой. Вообще-то полное название - арифметический сопроцессор. Этот сопроцессор имеет свою систему команд разработанную специально для ускорения математических расчётов. Раньше не все компьютеры были оснащены сопроцессором. Сейчас он неизменно присутствует на всех машинах. Поэтому компилятор Турбо Паскаля содержит 2 режима компиляции с поддержкой сопроцессора : Options->Compiler раздел Numeric processing. Галочка у 8087/80287 - при компиляции будут использованы команды сопроцессора. Галочка у Emulation - будет использован режим эмуляции. Т.е. при компиляции будет эмулироваться сопроцессор. Помимо арифметического сопроцессора существует куча сопроцессоров. Самый яркий пример - графический, для ускорения работы с графикой (он содержит в себе функции для рисования графических примитивов).
Кул-][ацкерам

Хотите почувствовать себя героем фильма Матрица и иже с ними? Нет ничего проще! Правда во времена создания BP никто о существовании Матрицы не подозревал, но такую возможность предоставили. Итак возьмём простенькую програмульку из прошлого выпуска:

begin
asm
jmp @next
@msg: db 'Hello world!$'
@next:
push ds
push cs
pop ds
mov ah, 9
mov dx, offset @msg
int 21h
pop ds
end
end.

сохраняем, делаем ехе файл и выходим из Паскаля. теперь запускаем bp\bin\td.exe - это Turbo Debugger. Отладчик фирмы Borland. Выбираете File->Change Dir В появившемся окне вводите путь к программе (без имени!). Помните, что путь должен быть короче 8 символов (имеется ввиду длинна имени каждой папки). Если сразу затрудняетесь, то введите только имя диска, на котором находится ехе файл. Дальше File->Open и выбираем нужный нам ехе файл (видите именно ехе, а не pas). На все появшиеся сообщения (если такие будут) ответьте Ок. Окно у вас должно представлять собой нечто такое:

+-[_]-CPU 80486-------------------------------------------------------1----[]-+
| cs:0000>9A0000925D call 5D92:0000  ax 0000 |c=0|
| cs:0005 55 push bp | bx 0000 |z=0|
| cs:0006 89E5 mov bp,sp | cx 0000 |s=0|
| cs:0008 31C0 xor ax,ax | dx 0000 |o=0|
| cs:000A 9ACD02925D call 5D92:02CD | si 0000 |p=0|
| cs:000F EB0D jmp 001E | di 0000 |a=0|
| cs:0011 48 dec ax | bp 0000 |i=1|
| cs:0012 656C insb gs: | sp 4000 |d=0|
| cs:0014 6C insb | ds 5D7E | |
| cs:0015 6F outsw | es 5D7E | |
| cs:0016 20776F and [bx+6F],dh | ss 5E16 | |
| cs:0019 726C jb 0087 | cs 5D8E | |
| cs:001B 642124 and fs:[si],sp | ip 0000 | |
| cs:001E 1E push ds | | |
| cs:001F 0E push cs  | |
|___________________________________________________________+----------------|
| ds:0000 CD 20 00 A0 00 9A F0 FE = а ЪЁ_ | ss:4002 0000 |
| ds:0008 1D F0 E4 01 56 24 AE 01 Ёф
V$о
| ss:4000>0000 |
| ds:0010 56 24 80 02 B1 1E 1F 10 V$А_ | ss:3FFE 0000 |
| ds:0018 01 01 01 00 02 FF FF FF


___ | ss:3FFC 0000 |
| ds:0020 FF FF FF FF FF FF FF FF ________ | ss:3FFA 0000 |
+------------------------------------------------------------------------------+

Нечто похожее показывают во всех фильмах о компьютерах. Итак что мы имеем. Сейчас я вам проведу обзорную экскурсию. Большую часть окна (вверху слева) занимает наша программа. Как, а где begin, где end? Я этого не писал ! - такие мысли наверняка уже посетили вас. Скажу сразу. Это машинный код нашей программы переделанный в "понятные" нам команды ассемблера. Вот в это и преобразовывает наши прекрасные программы компилятор. Чуть правее вы видите уже знакомые нам имена регистров. Ну и в самую правую часть окна выведен регист флажков по битам (выведены сответственно имена битов и их состояние). Под кодом программы распологается дамп сегмента данных. Процитирую в очередной раз Serrgio

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

Так что поднимайте ваш жизненный тонус и отправимся изучать подробнее этот дамп. Итак слева как можно догадаться адресс (вернее только смещение, т.к. сегмент задаётся DS). В центре идут hex числа, справа их расшифровка в коды символов. Так например первый байт по адресу DS:0000 имеет значение5 CDh, а символ с номером CD это = (равно). Следующий за ним байт со значением 20h - это пробел и т.д. Последнюю часть окна мы пока трогать не будем. Теперь давайте посмотрим как вставился наш ассемблерный код ... ищем в коде программы jmp @next.... как вы не нашли ? Правильно. Ведь при компиляции имена меток заменяются адресами. Так что мы пойдём другим путём. Итак давим до боли знакомую клавишу F8 (нам надо именно Step Over, так что именно F8 иначе можете оказаться где-то в месте далёком от нашего кода Обратите внимание: зажглись регистры - только, те которые измениись. Это запустилась наша программа. Итак мы дошли до места

cs:001E 1E push ds

похоже на то, что мы писали ? но ведь текст начинался с jmp @next, где же он? Давайте рассмотрим текущую строчку: вначале идёт смещение текущей команды относительно сегмента кода (посмотрите кстати на регистр ip). Дальше идёт цифра означающая код команды в hex виде. Т.е. для команды push ds это 1E. Ну и дальше идёт соответственно команда ассемблера. Итак нам надо искать jmp, который ссылается на строчку с адресом 001E - ведь именно её мы пометили меткой @next. Такой jmp находится по адресу cs:000F - jmp 001E - это и есть наш jmp @next Теперь смотрите на строку mov dx, offset @msg- эта строка скомпилировалась в mov dx, 0011 - 'эта адрес строки в сегменте кода, на который у нас ссылается ds. Выберете View -> Dump и посмотрите на дамп - там и правда будет строка Hello World! Теперь обратим взгляд на код нашей програмки именно с адреса 0011 - там находятся команды, которые мы перепрыгнули - а ведь, это то, во что скомпилировался наш Hello World!. А именно в это:

dec ax
insb gs:
insb
outsw
and [bx+6F],dh
jb 0087
and fs:[si],sp

UNIT имя;
INTERFACE
интерфейсная часть
IMPLEMENTATION
исполняемая часть
BEGIN
часть инициализации
END.

Начнём по порядку. ИМЯ - задаёт имя модуля (это то, которое мы потом будем объявлять в USES). Для того что бы избежать лишних проблем следует называть модуль и файл с его кодом одним именем. Т.е. если мы хотим назвать модуль так:

unit myunit;

то текст его должен распологаться в файле с именем myunit.pas. Интерфейсная часть несёт в себе описание типов, переменных, констант, подпрограмм, которые можно будет использовать (вызывать) из головной программы. При описании подпрограмм нужно написать просто их заголовок. Например начнём писать простенький модуль для работы с комплексными числами. (для тех кто в танке - комплексные числа - это числа вида a + b*i, где i число, такое что i2 = -1, a и b - вещественные числа... вообщем литературу на эту тему найти легко, было бы желание). Для этого опишем запись с полями re и im (это a и b) и заголовок процедуры для сложения 2-х комплексных чисел.

unit Cmplx;
interface
type
complex = record
re, im : real;
end;

procedure AddComplex (x, y : complex; var z : complex);

Итак теперь в основной программе, подключив наш модуль, мы можем объявить переменные типа complex и вызывать процедуру AddComplex. Следует так же отметить (ведь наши программы пока для ДОСа), что все переменные объявленные в интерфейсной части модуля и все переменные основной программы помещаются в единный сегмент данных и следовательно не могут превышать 64 Кб. Переходим к исполняемой части. В ней должно содержаться описание подпрограмм, объявленных в интерфейсной части. Так же можно помещать локальные для модуля объекты (т.е. к ним нельзя обратиться из головной программы) - типы, константы, подпрограммы, переменные. Продолжим наш модуль:

unit Cmplx;
interface
type
complex = record
re, im : real;
end;

procedure AddComplex (x, y : complex; var z : complex);
implementation

procedure AddComplex;
begin
z.re := x.re + y.re;
z.im := x.im + y.im
end;

Обратите внимание на объявление процедуры AddComplex в исполняемой части модуля. Очередная халява - можно опускать список параметров (и тип результата для функции), так как они уже описаны в интерфейсной части. При этом халява не обязательная - вы вполне можете написать полный заголовок. Переходим к последней части - части инициализации. Она может быть, а может и не быть. Если она есть - тогда обрамляется begin-end. Если её нет, тогда просто пишется end. (с точкой!!). В части инициализации помещается код, который выполняется до передачи управления главной программы. Например здесь программист может присвоить переменным модуля какие-то стартовые значения. В нашем модуле нет никаких тайных махинации и поэтому мы можем опустить инициализацию и вот он - наш первый законченный модуль:

unit Cmplx;
interface
type
complex = record
re, im : real;
end;

procedure AddComplex (x, y : complex; var z : complex);
implementation

procedure AddComplex;
begin
z.re := x.re + y.re;
z.im := x.im + y.im
end;
end.

Ещё один важный момент - если нечего инициализировать, то тогда лучше вообще не писать часть инициализации (т.е. слово begin) т.к. получится так называемый пустой оператор. Что может в некоторых случаях привести к проблемам. Давайте напишем модуль с инициализацией и скрытой переменной:

unit some;

interface

procedure iplus;

implementation

uses CRT;

var
i : integer;

procedure iplus;
begin
i := i + 1;
writeLn ('I = ', i)
end;

begin
randomize;
i := random (256);
writeLn ('Start I = ', i)
end.

i - это переменная, доступная только внутри модуля! Тепрь напишем головную программу, использующую этот самый модуль:

program test;

uses some;

begin
writeLn ('Yo-ho-ho!');
iplus;
iplus;
iplus
end.

Запускаем и что мы видим?

Start I = 16
Yo-ho-ho!
I = 17
I = 18
I = 19

О чём нам говорит эта картинка? Правильно: о том, что часть инициализации модуля выполнится раньше чем головная программа. Вот вообщем то и всё.
Программа

В начале я хотел "отписаться" стандартным в этом случае модулем для работы с комплексными числами. Но, подумал я, неужели мы зря учили ассемблер, нет. Давайте лучше напишем модуль для работы с мышой. Думаю у вас уже неоднократно возникало желание подключить грызуна к своим программам. Сегодня мы это и сделаем. Работа с ушастым реализуется через 33h прерывание. Программа осуществляет это прерывание, передавая в регистрах необходимые параметры, и в них же получает возвращаемые значения от драйвера мыши. Наш модуль не будет поддерживать все возможности мыши, а только самые основные. Итак текст модуля:

unit mouse;

interface

const
MB_LEFT = 1;
MB_RIGHT = 2;
MB_MIDDLE = 4;

type
tPoint = record
x, y : integer
end;
tMouseState = record
loc:tPoint;
but:integer
end;

function ResetMouse:integer;
procedure ShowMouse;
procedure HideMouse;
procedure GetMouseState (var s:tMouseState);
procedure MoveMouseCursor (p :tPoint);
procedure SetMouseVert (max, min : integer);
procedure SetMouseHorz (max, min : integer);

implementation

function ResetMouse:integer;assembler;
asm
xor ax, ax
int 33h
end;

procedure ShowMouse;assembler;
asm
mov ax, 1
int 33h
end;

procedure HideMouse;assembler;
asm
mov ax, 2
int 33h
end;

procedure GetMouseState;assembler;
asm
mov ax, 3
int 33h
push es
push di
les di, dword ptr s
mov es:[di], cx
mov es:[di+2], dx
mov es:[di+4], bx
pop di
pop es
end;

procedure MoveMouseCursor;assembler;
asm
mov ax, 4
mov cx, p.x
mov dx, p.y
int 33h
end;

procedure SetMouseVert;assembler;
asm
mov ax, 8
mov cx, min
mov dx, max
int 33h
end;

procedure SetMouseHorz; assembler;
asm
mov ax, 7
mov cx, min
mov dx, max
int 33h
end;

end.

Итак наш модуль поддерживает всего 7 из 31 возможных функций мыши. Если хотите ознакомится, то в новостях сайта дана ссылка на соответствующий документ. Я не буду рассматривать, как написаны эти процедуры и функция, т.к. это простые вызовы прерываний. Если вы немнго разбираетесь в ассемблере, то вам всё понятно. Если есть вопросы - тогда пишите. Я же рассмотрю этот модуль со стороны языка Паскаль. Мы имеем общедоступными 3 константы - они определяют кнопки мыши. 2 типа:

* tPoint - описывает точку на экране
* tMouseState - описывает состояние мыши. loc - координаты, but - состояние кнопок (имено те 3 константы).

И наконец 6 подпрограмм:

* function ResetMouse:integer;
Инициализирует мышь, если таковой не имеется вернётся нулевое значение.
* procedure ShowMouse;
Показывает курсор мыши на экране. При этом курсор следует за перемещениями мыши.
* procedure HideMouse;
Прячет курсор. Полезно когда надо что-то нарисовать под курсором, последовательность действий при этом: спрятали курсор, нарисовали, показали курсор.
* procedure GetMouseState (var s:tMouseState);
Читает и возвращает состояние мыши в виде записи tMouseState
* procedure MoveMouseCursor (p :tPoint);
Передвигает курсор мыши в точку p
* procedure SetMouseVert (max, min : integer);
Устанавливает минимальную/максимальную вертикальную границу передвижения мыши
* procedure SetMouseHorz (max, min : integer);
Устанавливает минимальную/максимальную горизонтальную границу передвижения мыши

Никаких скрытых подпрограмм или переменных у нас нет. Секция инициализации так же опущена, за ненадобностью. Теперь напишем головную программу для работы с мышью. Я написал такой примерчик:

program mousetest;

uses graph, mouse, crt;

var
Gd, Gm: Integer;
flag : boolean;
ms : tMouseState;

begin
Gd := Detect;
flag := false;

InitGraph(Gd, Gm, '');

if GraphResult <> grOk then
Halt(1);

Randomize;
ShowMouse;

while not flag do
begin
GetMouseState (ms);

if ms.but = MB_RIGHT then
flag := true
else if ms.but = MB_LEFT then
PutPixel (ms.loc.x - 1, ms.loc.y - 1, Random (WHITE))
end;

CloseGraph
end.

Итак мы в цикле опрашиваем мышь, если нажата правая кнопка (ms.but = MB_RIGHT), тогда выходим из программы. Если нажата левая кнопка, тогда ставим точку случайного цвета на экране. Вот и всё!.

set of БАЗОВЫЙ_ТИП

Например:

Days : set of 1..31;
Digit : set of '0'..'9';
Leters : set of Char;

Для задания множества надо использовать специальный конструктор: значения множества перечисляются через запятую (или диапозон через две точки), в квадратных скобках. Например:

Days := [8, 9, 13, 20 .. 25];
Digit := ['1', '3', '2', '9', '0'];
Leters := [ ]; - пустое множество

Рассмотрим ещё один пример, что бы понять что такое эквивалентность и включение:

type
num = set of 0 ..9;
digit = set of '0' .. '9';
var
s1, s2, s3 : digit;
s4, s5, s6 : num;
begin
s1 := ['1', '2', '3'];
s2 := ['2', '1', '3'];
s3 := ['1', '3'];
s4 := [0..3];
s5 := [4 .. 6];
s6 := [3, 5 .. 9];

Множества s1 и s2 эквивалентны. Множество s3 включается в s2 и в s1 соответственно. Над множествами определны следующие операции:

*
пересечение множеств - результат содержит общие для обеих множеств элементы. s4 * s6 cодержит [3], а s4 *s5 пустое множество
+
объединение множест - результат содержит элементы первого множества, дополненные недостоющими элементами второго множества. s4 + s5 содержит [0,1,2,3,4,5, 6]
-
разность множеств - результат содержит элементы из первого множества, которые не принадлежат второму. например s6 - s5 содержит [3,7,8,9]
=
эквивалентность - результат true, если множества эквивалентны и false в другом случае
<>
не эквивалентность - true если множества не эквивалентны
>=, <=

* вхождение (проверка на подмножество) <= - true если первое множество включено во второе
* >= - true, если второе множество включено в первое

in
проверка на принадлежность. Синтаксис: ЗНАЧЕНИЕ in МНОЖЕСТВО
возвращает true, если ЗНАЧЕНИЕ принадлежит множеству, например 3 in s6 - true; 2*2 in s1 - flase

Так же для множеств определены 2 процедуры:

* procedure Include(var S: set of T;I:T);
Включает новый элемент I в множество S
* procedure Exclude(var S: set of T;I:T);
Исключает элемент I из множества S

Несмотря на возможность использовать для этих операций +/- использование процедур более предпочтительней, т.к. они отличаются более высокой скоростью выполнения. Ну вот и всё, а вы боялись!
© дантист, после вырывания зуба Теперь пришло время рассмотреть несколько примерчиков.

program test;

var
S : set of char;
c : char;

begin

s := [];

repeat
read ©;
include (s, c);
until c = '.';

for c := '0' to '9' do
if c in s then
writeLn ©
end.

Итак что же делает эта программа? Для начала пользователь вводит в цикле символы, пока не нажал точку. При этом мы заполняем множество S этими символами. После этого выводим на экран те символы, которые оказались цифрами. Для этого нам надо проверить вхождение цифр в это множество. Что мы благополучно и делаем. Ещё один пример использования множеств - стандартный запрос Y / N - раньше надо было писать 2 условия if (key = 'Y') or (key = 'y') теперь же всё гораздо проще - if key in ['Y', 'y'], так же можно добавть проверку, не нажал ли пользователь букву У вместо Y key in ['Y', 'y', 'У', 'у'] или же добавить ещё проверку на букву Д ....
Программа

Сегодня мы напишем програмку, позволяющую нам находить простые числа среди натуральных. В основу её будет заложен метод, названный решето Эратосфена. Суть этого метода очень проста - из множества чисел ( в начале оно является множеством [2 .. N]) берётся первое число (назовём его next) - оно является простым, потом из множества чисел удаляются само next и все кратные ему числа, т.е. next*2, next*3 и т.д. И так повторяем до тех пор, пока не исключим из исходного множества все элементы. Сам текст программы приведён ниже:

program pnum;

const
N = 255;

type
SetOfNumber = set of 1 .. N;

var
n1, next, i : word;
BeginSet, PrimerSet : SetOfNumber;

begin
BeginSet := [2 .. N]; { начальное множество }
PrimerSet := [1]; { это множество простых чисел, в нём первое простое число 1}
next := 2; {следующее простое }

while BeginSet <> [] do
begin
n1 := next;

{ исключаем все числа кратные next }
while n1 <= N do
begin
Exclude (BeginSet, n1);
n1 := n1 + next
end;

{ включаем next в множество }
Include (PrimerSet, next);

{получаем в next следующее простое, которое есть первое в BeginSet}
repeat
next := next + 1
until (next in BeginSet) or (next > N)
end;

for i := 1 to N do
if i in PrimerSet then
write (i:8)
end.

Эту программу нельзя использовать для произвольного набора чисел, т.к. в множестве не может быть больше 256 элементов. Кстати в нашем множестве SetOfNumber 255 элементов, двайте ка добавим ещё один SetOfNumber = set of 1 .. 256 - компилируем и получаем жизнерадостное сообщение об ошибке, под номером 23 - Set base type out of range - тип множества выходит за границы. Эта ошибка происходит из-за того. что можно использовать целочисленный тип с минимальной границей 0 и максимальной 255 или любой перечисляемый тип, но не более чем с 256 элементами.

имя : тип = значение

Например,

name : string = 'Вася Пупкин';
x : real = 0.123;
days : 1..31 = 1;

Ну это было просто. Гораздо интереснее использовать чего-нить более сложное. Например константы-массивы. Для задания значения необходимо написать их в круглых скобках () через запятую:

someconst : array [1..5] of byte = (0, 1, 2, 3, 4);

Для масивов типа char есть очередная халява. Два следующих объявления идеентичны:

a1 : array [0..9] of char = ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9');
a2 : array [0..9] of char = '0123456789';

Но иногда может понадобится создать константу -запись. Что ж не проблемма. Для значений полей используется список из последовательности вида имя поля, двоеточие и константа. Например:

point = record
x, y : real;
end;
const
p1 : point = (x : 0; y : 12);

Поля должны указываться в той последовательности, в какой они перечислены в определении типа. Если в записи есть поле файлового типа, то такая запись не может быть константой. Константы множества задаются с помощью конструктора множества:

type
day = set of 1 .. 31;
const
someday : day = [1..5, 8, 10];

Вот вообщем и всё про константы. Так же сегодня по просьбе одного из чиателей я раскажу об запуске внешних программ. Иногда просто необходимо перед (или даже во время) исполнения вашей запустить другую. Например ну лениво вам писать текстовый редактор, а надо что б в программе можно было отредактировать файл - пожалуйста запускайте любой внешний! Для этого надо использовать процедуру exec из модуля Dos.

procedure Exec(Path, Cmdline: string);

Процедура получает две строки: Path - путь и имя файла с программой и Cmdline - командная строка. Однако не всё так просто, как хотелось бы. Использование этй процедуры имеет некоторые особенности. Во первых вызывающая программа остаётся в памяти, поэтому она не должна съесть всю доступную память. Объём памяти для программы можно установить здеся Options -> Memory Sizes. По умолчанию вся доступная память отводится вашей программе, поэтому внешней программе будет некуда грузиться Так же размеры памяти можно установить с помощью директивы $M, которая имеет следующий формат:

{$M stack, low, hight}

где stack - размер стека, low - нижняя граница динамической памяти, hight - верхняя граница. Все размеры указываются в байтах. Особенности исполнения программ на Паскале так же требует изменения некоторых стандартных векторов прерываний. К ним относятся:

00h 02h 18h 23h 24h 34h 35h 36h 37h 38h 39h 3Ah 3Bh 3Ch 3Dh 3Eh 3Fh 75h

Начальные значения хранятся в переменных SaveIntXX (где XX - номер прерывания в Hex виде). Поэтому перед вызовом внешней программы и после него рекомендуется вызывать процедуру SwapVectors, которая обменивает содержимое векторов прерываний и перечисленных перменных. Вот и все. Теперь рассмотрим пример

{$M 1024, 0, 0}
uses Dos;

begin
writeLn ('переходим в режим командной строки');
writeLn (' для выхода в программу введите exit');
SwapVectors;
Exec (GetEnv ('COMSPEC'), '');
SwapVectors;
writeLn ('наша программа завершена')
end.

Я не стал придумывать ничего свехъестественного и запустил командный процессор command.com. Для получения имени файла я использовал функцию GetEnv

function GetEnv(EnvVar: string): string;

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

uses Dos;

var I: Integer;
begin
for I := 1 to EnvCount do
Writeln(EnvStr(I));
end.

Посмотрите что выведет на экран эта программа. И увидите, что у значение параметра COMSPEC - это путь к файлу command.com. В этой програмке я использовал соответственно функции

function EnvCount: Integer;

возвращает число переменных ДОС. И функцией

function EnvStr(Index: Integer): string;

Которая возвращает строку типа Name = Value, где Name - имя переменной, Value - значение. Так вот вызов Exec (GetEnv ('COMSPEC'), '') - означает, что мы вызвали command.com без параметров, а значит просто появится командная строка с которой можно будет работать. Например так:

переходим в режим командной строки
для выхода в программу введите exit

Microsoft® Windows 98
©Copyright Microsoft Corp 1981-1999.

D:\>E:

E:\>cd bp

E:\BP>bla-bla
Имя команды или файла указано неправильно

E:\BP>exit
наша программа завершена

Вот в очередной раз и всё.