Лабораторные занятия
"Разработка векторного графического редактора"
Содержание
Фаза 0 Краткое описание и
возможности редактора.
Фаза 1 Определение свойств
карандаша
Фаза 2 Определение свойств кисти
Фаза 3 Определение типов данных,
необходимых для хранения информации о координатах точек, линий и
многоугольников.
Фаза 4 Определение типов данных,
необходимых для хранения информации о координатах окружностей и эллипсов.
Фаза 5 Определение типов данных,
необходимых для хранения информации о строке в графическом режиме
Фаза 6 Определение типов данных,
необходимых для хранения информации об изображениях
Фаза 7 Абстрактный графический
класс
Фаза 8 Регистрация графических
классов в потоке
Фаза 9 Графическая коллекция
Фаза 10 Обработка событий в
графическом редакторе
Фаза 11 Обьектно-событийная
модель графического редактора
Фаза 12 Разработка основного
приложения, компоновка редактора в единое целое.
Программный проект (Фаза 0).
Краткое описание и возможности редактора:
1.
Графический
редактор позволяет манипулировать простейшими графическими примитивами, как то
– отрезками, окружностями, прямоугольниками, эллипсами, многоугольниками,
заливками различных видов и т.д. Под манипуляциями понимаются интерактивное
создание, удаление, изменение местоположения, размеров и других атрибутов
графических примитивов.
2.
Редактор
позволяет хранить (запись и чтение) на диске полученный набор примитивов в
специализированном формате, а также сохранять в текстовом файле набор вызовов
графических процедур и функций. Таким образом, подготовленный в редакторе
рисунок можно затем использовать в любой программе на Паскале.
3.
Редактор имеет
достаточный для выполнения своих функций набор элементов управления – зависимые
и независимые кнопки, поля для выбора цвета и других атрибутов графических
примитивов, поля ввода и вывода текста, средства скроллинга, меню и т.д.
4.
Основное средство
управления – манипулятор "мышь". Для ввода текстовой информации и
управления с помощью "горячих клавиш" используется клавиатура.
В дальнейшем все требуемые функции графического редактора реализованы не будут. Таким образом недостающие элементы Вы сможете запрограммировать самостоятельно. Ниже приводится примерный вид редактора:
Естественно, что в процессе модификации, улучшения и расширения возможностей редактора его вид может быть изменен.
Для работы нам понадобится несколько процедур и функций, реализующих взаимодействие с мышью, управление вводом строки в графическом режиме, вывод сообщений и т.д. Их создание является не сложной, но объемной и рутинной задачей. Поэтому данные процедуры и функции, сосредоточенные в трех модулях, будут предоставлены в готовом виде (полностью текст модулей находится на сайте http://shadrinsk.zaural.ru/~sda/teaching/programms/gred/index.html и в авторском разделе web-сервера кафедры ТМИ Шадринского государственного педагогического института).
Модуль Mouse.pas:
Используемые функции и процедуры:
function ChkAndReset: Boolean;
Инициализация мыши, возвращает true при нормальном завершении
procedure ShowMouse;
Показывает курсор мыши
procedure HideMouse;
Скрывает курсор мыши
procedure GetMouseState(var X,Y:integer; var Left,Right:boolean);
Получает информацию о состоянии мыши – координаты и статус нажатия клавиш
Модуль Inter.pas:
Используемые функции и процедуры:
procedure NormalizedRect(var r:TRect);
Нормализует переданный прямоугольник. Класс TRect подробно рассмотрен в фазах 3 и 7 программного проекта.
function LineIntersectRect(var oLine,oRect:TRect):boolean;
Возвращает ИСТИНУ, если линия пересекает прямоугольник. Подробнее см. фазу 7 программного проекта.
function Exists(Filename:string):boolean;
Возвращает ИСТИНУ, если файл существует на диске
function InputString(MaxLen:byte; Caption:string;
var inString:string):boolean;
Организует ввод строки в графическом режиме.
MaxLen - максимальное количество отображаемых символов во вводимой строке
Caption - заголовок
InString - первоначальное значение и введенная строка
procedure ShowBar(x1,y1,x2,y2:integer; Color:word; Raised:boolean);
Выводит на экран выпуклый или вдавленный прямоугольник в графическом режиме. Используется обычно для прорисовки кнопок
x1,y1,x2,y2 – координаты прямоугольника
Color – его цвет
Raised – если true, то прямоугольник является выпуклым, иначе- вдавленным
procedure Messagebox(Caption:string);
Выводит в графическом режиме сообщение в центре экрана.
Модуль SimplFont.pas:
Процедуры и функции данного модуля используются в функции InputString и процедуре Messagebox модуля inter.pas.
Темы для предварительного изучения (posobpas2.htm):
2.1.1.1 Характеристики графических режимов
2.1.1.2 Видеоадаптеры EGA и VGA
2.1.1.3 Этапы работы в графическом режиме
2.1.2 Программирование в графическом режиме
2.1.2.1 Инициализация и завершение работы с графикой, видеоадаптер и видеорежимы
Задания для раздела "Инициализация и завершение работы с графикой, видеоадаптер и видеорежимы" (1-4).
Задания для раздела "Анализ ошибок" (5-6).
Задания для раздела "Графический указатель" (7-9).
2.1.2.4 Графические инструменты
Задания для раздела "Свойства
карандаша" (10-14).
Наш графический редактор будет состоять из нескольких модулей. Все, связанное с графическими примитивами, сосредоточим в модуле GrPrim.pas.
Каждый
графический примитив, использующий для рисования карандаш, обладает набором
данных, определяющих свойства карандаша. Определим такой тип:
{ модуль GrPrim.pas }
…
type
prLineStyle=record
linestyle, pattern, thickness,
color: word;
end;
…
Префикс pr в названии типа здесь и в дальнейшем будет означать "параметр".
Темы для предварительного изучения (posobpas2.htm):
Задания для раздела "Свойства кисти" (15-18).
Аналогично свойствам карандаша, определим тип данных, отвечающих за свойства кисти:
{ модуль GrPrim.pas }
…
type
prFillStyle=record
Pattern: word;
UserPattern: FillPatternType;
Color: word;
end;
…
Процедуры, устанавливающие стиль заливки с помощью записи данного типа, должны использовать либо SetFillStyle, либо SetFillPattern в зависимости от значения поля Pattern записи.
Темы для предварительного изучения (posobpas2.htm):
2.1.2.5.1 Точки, линии, многоугольники
Задания для раздела "Точки, линии, многоугольники" (19-23).
Определим типы данных, необходимые для хранения информации о координатах точек, линий и многоугольников.
Для этого воспользуемся, во первых, двумя типами, определенными в модуле Objects:
TPoint=object
X,Y:integer;
end;
TRect=object
A,B:TPoint;
…
end;
Зарезервированное слово object означает, что данный тип является объектным типом, о котором будет подробно рассказано при изучении объектно-ориентированного программирования. На текущий момент нам достаточно знать, что классы TPoint и TRect практически эквивалентны типу запись.
{ модуль GrPrim.pas }
…
type
{точка}
prPoint=TPoint;
{прямоугольник, отрезок}
prRect=TRect;
{многоугольник}
prPoints=array[1..1000] of
prPoint;
pprPoints=^pprPoints;
prPoly=record
number:word;
ppoints:pprpoints;
end;
…
Темы для предварительного изучения (posobpas2.htm):
2.1.2.5.2 Дуги, окружности, эллипсы
Задания для раздела "Дуги, окружности, эллипсы" (24-27).
Определим типы данных, необходимые для хранения информации о координатах окружностей и эллипсов. Типы для дуг определите самостоятельно.
{ модуль GrPrim.pas }
…
type
{ окружность
}
prCircle=record
x,y:integer;
radius:integer;
end;
{ эллипс }
prEllipse=record
x,y:integer;
XRad,YRad:integer;
end;
…
Темы для предварительного изучения (posobpas2.htm):
Задания для раздела "Заполнения" (28-32).
Задания для раздела "Вывод текста" (33-37).
Определим типы данных, необходимые для хранения информации о строке в графическом режиме.
{ модуль GrPrim.pas }
…
type
{ текст }
prTextStyle=record
font,direction,horiz,vert:word;
size:word;
mulx,divx,muly,divy:word;
str:string;
end;
…
Темы для предварительного изучения (posobpas2.htm):
2.1.2.7 Сохранение и выдача изображений
Задания для раздела "Сохранение и выдача изображений" (38-40).
Определим типы данных, необходимые для хранения информации об изображениях.
{ модуль GrPrim.pas }
…
type
{ изображение
}
prPicture=record
Size:word;
pBitmap:Pointer;
end;
…
Теперь, зная процедуры рисования в Турбо-Паскале, можно определить, какие графические примитивы будут использованы в редакторе.
{ константы видов фигур }
…
const
TypePoint=0;
TypeLine=1;
TypeRect=2;
TypeBox=3;
TypePoly=4;
TypePolyFill=5;
TypePicture=6;
TypeText=7;
TypeCircle=8;
TypeCircleArc=9;
TypeCircleFill=10;
TypeEllipse=11;
TypeEllipseFill=12;
TypeCircleEllipse=13;
TypeFill=14;
…
Программный проект (Фаза 7)
Темы для предварительного изучения (posobpas2.htm):
Задания для раздела "Холст" (41-44).
Задания для раздела "Палитры" (45-48).
2.1.2.10 Регистрация нестандартных графических драйверов и шрифтов.
2.1.2.11 Инкапсуляция файлов графических драйверов и шрифтов в исполняемый файл
2.2 Объектно-ориентированное программирование
(ООП)
2.2.2 Реализация ООП средствами
Турбо-Паскаля.
Наиболее эффективным методом организации графических примитивов в редакторе будет объектно-ориентированный подход. Прежде всего требуется создать первоначальный, абстрактный графический класс, в котором будут инкапсулированы основные поля и методы, общие для всех примитивов.
{ модуль GrPrim.pas }
…
type
{ абстрактный графический класс }
pGrObject=^TGrObject;
tgrObject=Object(tObject)
constructor Init; { инициализирует объект }
function
Gettype:integer;virtual;
{ возвращает вид класса (константы определены выше) }
procedure Show;virtual; { показывает объект }
procedure XorShow;virtual;
{ показывает объект с операцией XOR (используется для
интерактивного перемещения и изменения размеров объекта) }
procedure Move(dx,dy:integer);virtual;{перемещает объект на DX,DY}
function
PointIn(x,y:integer):boolean;virtual;
{ возвращает TRUE, если точка с координатами (X,Y)
попала в пределы объекта }
procedure SaveASText(var
f:text);virtual;
{запись в текстовом формате}
constructor load(var s:tstream); {чтение из потока}
procedure store(var s:tstream); {запись в поток}
procedure disable; { запрещает показ примитива из коллекции }
procedure enable; { разрешает показ примитива из коллекции }
private
Disabled:boolean;
end;
…
Большинство из этих методов являются абстрактными, то есть никогда не вызываются для экземпляра класса tgrObject, и перекрываются в классах-потомках. Собственно, никогда не будет создан экземпляр класса tgrObject, хотя указатели на данный класс будут использоваться повсеместно. Класс tgrObject порожден от TObject, определенном в модуле Objects. Класс TObject является базовым для любых классов, которые в дальнейшем будут использовать мощную иерархию классов модуля Objects
Рассмотрим некоторые методы класса.
function TGrObject.Gettype:integer;virtual;
Функция, возвращающая одну из констант определенных в фазе 6. Данная функция обязательно должна быть перекрыта в потомках класса TGrObject. С ее помощью мы будем определять, о переменной какого конкретно класса идет речь. Дело в том, что, как будет показано в следующем параграфе, могут существовать переменные-ссылки одного класса, указывающие на экземпляр класса-потомка от данного класса. Таким образом, мы будем работать в большинстве случаев с переменными типа PGrObject, которые, на самом деле, указывают на реальные графические примитивы – линии, окружности и т.д. В результате такого свойства классов, очень часто нельзя точно определить, на переменную какого класса ссылается тот или иной указатель. Для решения данной проблемы и будет использована функция GetType.
procedure TGrObject.Show;virtual;
Процедура, визуализирующая объект. Обязательно должна перекрываться в потомках. Каждый примитив показывает себя на экране отличным от других примитивов способом.
procedure TGrObject.XorShow;virtual;
Для интерактивного построения примитивов в графическом редакторе, мы будем пользоваться XorShow. С ее помощью можно нарисовать изображение, а вторым вызовом стереть его, полностью восстановив первоначальный фон. Так будет достигнут эффект мультипликации при построении и перемещении примитивов. Процедура XorShow может не перекрываться в примитивах, использующих при своей визуализации только стиль линии и режим вывода на экран. Это касается линий и многоугольников.
procedure TGrObject.Move(dx,dy:integer);virtual;
Перемещает примитив относительно его текущего местоположения на dx, dy. В обязательном порядке перекрывается в потомках.
function
TGrObject.PointIn(x,y:integer):boolean;virtual;
Используется при интерактивном выборе примитива на экране в графическом редакторе. Возвращает Истину, если переданная точка (обычно - координаты мыши), попадает в пределы примитива. Всегда перекрывается в потомках.
procedure TGrObject.SaveASText(var
f:text);virtual;
Сохраняет примитив в текстовом файле в виде вызовов графических процедур и функций. Предполагается, что файл заранее открыт для записи.
constructor TGrObject.load(var s:tstream);
procedure TGrObject.store(var s:tstream);
Чтение и запись примитива в своем собственном формате. Более подробно будет рассмотрено при изучении потоков.
procedure TGrObject.disable;
procedure TGrObject.enable;
Запрещает и разрешает показ примитива из графической коллекции. Понятие коллекции будет рассмотрено позднее, а на текущий момент нам достаточно знать, что коллекция – это объектный тип, в котором могут хранится другие объекты, своего рода аналог динамического массива в ООП. В дальнейшем мы создадим специализированную коллекцию, которая будет хранить в себе и манипулировать набором графических примитивов. Методы disable и enable изменяют значение поля disabled, которое анализируется при показе всех примитивов в коллекции.
Теперь нам известно достаточно, чтобы создать примитивы "Точка" и "Линия", а также реализовать все методы абстрактного графического примитива:
{ модуль GrPrim.pas }
…
{ класс "Точка" }
PGrPoint=^TGrPoint;
TGrPoint=Object(TGRObject)
point: prPoint; {координаты точки}
color: word; {ее цвет}
constructor
init(x,y:integer;c:word);
procedure Show;virtual;
function
Gettype:integer;virtual;
procedure Move(dx,dy:integer);virtual;
function
PointIn(x,y:integer):boolean;virtual;
procedure saveASText(var
f:text);virtual;
constructor load(var
s:tstream);
procedure store(var
s:tstream);
end;
{ абстрактный промежуточный класс, предназначенный для хранения и обработки стиля линий }
TAbstractLS=Object(TGRObject)
Style:prLineStyle; {стиль}
constructor
Init(ls,up,tn,c:word);
procedure SetLS; { установка стиля }
procedure SaveASText(var
f:text);virtual;
constructor load(var
s:tstream);
procedure store(var
s:tstream);
end;
{ класс "Отрезок" ("Линия") }
PGrLine=^TGrLine;
TGrLine=Object(TAbstractLS)
CoordLine:prRect; {координаты отрезка}
constructor
init(x1,y1,x2,y2:integer;ls,up,tn,c:word);
procedure Show;virtual;
function
Gettype:integer;virtual;
procedure
Move(dx,dy:integer);virtual;
function
PointIn(x,y:integer):boolean;virtual;
constructor load(var
s:tstream);
procedure store(var
s:tstream);
procedure saveASText(var
f:text);virtual;
end;
…
implementation
uses inter;
…
{ ------------ TGrObject
------------- }
procedure TGRObject.disable;
begin disabled:=true; end;
procedure TGRObject.enable;
begin disabled:=false; end;
procedure TGRObject.XorShow;
begin SetWriteMode(XorPut);
show; SetWriteMode(NormalPut); end;
constructor TGRObject.Init;
begin Inherited Init; end;
function
TGRObject.GetType:integer;
begin GetType:=-1; end;
procedure TGRObject.show;
begin abstract; end;
procedure
TGRObject.Move(dx,dy:integer);
begin abstract; end;
function
TGRObject.PointIn(x,y:integer):boolean;
begin abstract; end;
procedure
TGRObject.saveAsText(var f:text);
begin abstract; end;
constructor TGRObject.load(var
s:tstream);
begin s.Read(disabled,sizeof(disabled)); end;
procedure TGRObject.store(var
s:tstream);
begin
s.Write(disabled,sizeof(disabled)); end;
{ ------------ TAbstractLS ------------- }
constructor
TAbstractLS.Init(ls,up,tn,c:word);
begin
inherited init;
with style do begin
color:=c; thickness:=tn;
linestyle:=ls; pattern:=up;
end;
end;
procedure TAbstractLS.SetLS;
begin
with Style do begin
SetLineStyle(linestyle,pattern,thickness);
SetColor(color);
end;
end;
procedure
TAbstractLS.saveAsText(var f:text);
begin
with style do begin
writeln (f,
'
SetLineStyle(',LineStyle,',',Pattern,',',Thickness,')',
';','{Установка стиля линий}');
writeln (f,' SetColor(',Color,')',';','{Установка цвета линий}');
end;
end;
constructor
TAbstractLS.load(var s:tstream);
begin
inherited load(s);
s.read(style,sizeof (style));
end;
procedure
TAbstractLS.store(var s:tstream);
begin
inherited store(s);
s.write(style,sizeof (style));
end;
{ ------------ TGrPoint ------------- }
constructor
TGrPoint.Init(x,y:integer;c:word);
begin Inherited Init;
point.x:=x; point.y:=y; color:=c; end;
procedure TGrPoint.Show;
begin with Point do
PutPixel(x,y,color); end;
function
TGrPoint.GetType:integer;
begin GetType:=Typepoint;
end;
procedure TGrPoint.Move(dx,dy:integer);
begin with Point do begin
inc(x,dx);inc(y,dy); end; end;
function
TGrPoint.PointIn(x,y:integer):boolean;
var r:trect;
begin r.assign(x,y,x,y);
r.grow(2,2); pointIn:=r.contains(point); end;
constructor TGrPoint.load(var
s:tstream);
begin
inherited load(s);
s.read(point,sizeof (point)); s.read(color,2);
end;
procedure TGrPoint.store(var
s:tstream);
begin
inherited store(s);
s.write(point,sizeof (point));
s.write(color,sizeof (color));
end;
procedure
TGrPoint.saveAsText(var f:text);
begin
writeln(f,' {Рисуется точка}');
with point do writeln
(f,'
putpixel','(cx+',x,',','cy+',y,',',color,');');
end;
{ ------------ TGrLine -------------
}
constructor
TGrLine.Init(x1,y1,x2,y2:integer;ls,up,tn,c:word);
begin
Inherited Init(ls,up,tn,c);
CoordLine.assign(x1,y1,x2,y2);
end;
procedure TGrLine.Show;
begin SetLS; with CoordLine
do line(a.x,a.y,b.x,b.y); end;
function
TGrLine.GetType:integer;
begin GetType:=Typeline;
end;
procedure
TGrLine.Move(dx,dy:integer);
begin CoordLine.Move(dx,dy);
end;
function
TGrLine.PointIn(x,y:integer):boolean;
var r:prrect;
begin
r.assign(x,y,x,y);
r.grow(2,2);
pointIn:=LineIntersectRect(CoordLine,r);
end;
constructor TGrLine.load(var
s:tstream);
begin
inherited load(s);
s.read(CoordLine, sizeof
(CoordLine));
end;
procedure TGrLine.store(var
s:tstream);
begin
inherited store(s);
s.write(CoordLine,sizeof
(CoordLine));
end;
procedure
TGrLine.saveAsText(var f:text);
begin
writeln(f,' {Рисуется линия}');
inherited saveAsText(f);
with CoordLine do
writeln (f,'
Line(cx+',a.x,',','cy+',a.y,',','cx+',b.x,',','cy+',b.y,')',';');
writeln(f);
end;
…
Рассмотрим подробнее некоторые из методов, при реализации которых могут возникать различные вопросы.
1) Обращает на себя внимание активное использование методов класса prRect, который на самом деле, как видно из фазы 3 программного проекта, является классом TRect,определенным в модуле Objects.
Вот так выглядит его заголовок:
TRect = object
A, B: TPoint;
procedure Assign(XA, YA, XB,
YB: Integer);
procedure Copy(R: TRect);
procedure Move(ADX, ADY:
Integer);
procedure Grow(ADX, ADY:
Integer);
procedure Intersect(R: TRect);
procedure
function Contains(P: TPoint):
Boolean;
function Equals(R: TRect):
Boolean;
function Empty: Boolean;
end;
Как видно из заголовка, класс обладает множеством методов для манипуляции над прямоугольником. Рассмотрим некоторые из них:
procedure TRect.Assign(XA, YA, XB, YB: Integer);
Заполняет поля A и B прямоугольника соответственно значениями XA, YA и XB, YB.
procedure TRect.Move(ADX, ADY: Integer);
Перемещает прямоугольник на ADX, ADY
procedure TRect.Grow(ADX, ADY: Integer);
Увеличивает (уменьшает) прямоугольник на ADX, ADY относительно его центра.
function TRect.Contains(P: TPoint): Boolean;
Возвращает ИСТИНУ, если переданная точка находится внутри прямоугольника.
Многие методы класса TRect подразумевают, что в точке A находится левый верхний угол прямоугольника, а в точке B – правый нижний. При интерактивном создании примитива "прямоугольник" данное правило не выполняется примерно в 75% случаев, в результате чего методы TRect будут работать неверно. Для решения данной проблемы можно произвести "нормализацию" нестандартного прямоугольника процедурой NormalizedRect из модуля inter.pas (см. фазу 0 программного проекта)
2) Конструкторы Init. Обязателен вызов конструктора предка перед установкой полей:
constructor TGrLine.Init(x1,y1,x2,y2:integer;ls,up,tn,c:word);
begin Inherited Init(ls,up,tn,c);
CoordLine.assign(x1,y1,x2,y2); end;
Как видно из примера, вызов конструктора предка инициализирует поле Style, а только затем инициализируется поле CoordLine.
3) Особенности методов PointIn.
Метод PointIn используется для интерактивного выбора графического примитива манипулятором "мышь". Используя подобный "ручной" выбор примитива, очень сложно попасть курсором точно на точку или линию. Поэтому будем считать, что точка выбора является на самом деле небольшим (5*5 точек) прямоугольником:
function TGrPoint.PointIn(x,y:integer):boolean;
var r:trect;
begin r.assign(x,y,x,y);
r.grow(2,2); pointIn:=r.contains(point); end;
function TGrLine.PointIn(x,y:integer):boolean;
var r:prrect;
begin
r.assign(x,y,x,y);
r.grow(2,2);
pointIn:=LineIntersectRect(CoordLine,r);
end;
Функция LineIntersectRect, используемая в методе TGrLine.PointIn, позволяет определить, пересекает ли линия прямоугольник. Функция определена в модуле inter.pas (см. фазу 0 программного проекта) и имеет следующий заголовок:
function LineIntersectRect(var oLine,oRect:TRect):boolean;
где oLine – координаты линии, oRect – координаты прямоугольника.
Тестовые задания для программного
проекта
Задание 1. Создайте программу, в которой инициализируются, показываются и деинициализируются три объекта класса TGrPoint и два объекта класса TGrLine. Координаты и цвет примитивов выбираются случайным образом.
Задание 2. Создайте и отобразите объект класса TGrLine. Случайным образом заполняйте экран точками до тех пор, пока очередная точка не окажется на созданной линии. Нарисуйте окружность радиусом в 5 единиц и центром в последней точке.
Задание 3. Используя модуль Mouse.pas (см. фазу 0 программного проекта) и программную заготовку вида:
uses mouse, graph, …;
var x,y:integer; left,right:boolean;
const Quit:boolean=false;
…
begin
… {инициализация графики}
…
ChkAndReset;
repeat
GetMouseState(x,y,left,right);
… {набор действий}
until Quit;
readln;
CloseGraph;
end.
создать программу с двумя объектами TGrLine, выход из которой производится по щелчку мыши на одной из линий.
Задание 4. Используя объект класса TGrLine для секундной стрелки, организуйте секундомер в центре экрана.
Задание 5*[1]. Определите класс TGrRect (прямоугольник)[2]. Создайте программу для проверки правильности работы всех его методов, в том числе и методов предков (для проверки метода PointIn можете воспользоваться заготовкой из задания 3). Не определяйте методов Load и Store.
Задание 6*. Решите задание 5 для класса TGrCircle (окружность)
Задание 7*. Решите задание 5 для класса TGrEllipse (эллипс)
Задание 8*. Решите задание 5 для класса TGrPoly (ломаная)
Задание 9*. Решите задание 5 для классов TGrBar (закрашенный прямоугольник), TGrFillCircle (закрашенная окружность), TGrFillEllipse (закрашенный эллипс).
Задание 10**[3]. Решите задание 5 для класса TGrFillPoly (закрашенный многоугольник). Особую сложность в реализации представляет собой метод PointIn.
Задание 11**. Решите задание 5 для классов TGrArcCircle (дуга окружности), TGrArcEllipse (дуга эллипса), TGrText (строка), TGrPicture (рисунок), TGrFill (заливка).
Темы для предварительного изучения (posobpas2.htm):
2.2.2.3.1.1
Хранение данных в потоках
Задания для раздела "Хранение данных в потоках"
(60-63)
2.2.2.3.1.2
Хранение объектов в потоках.
В предыдущей фазе программного проекта был описан классы TGrObject, TGrPoint, TAbstractLS и TGrLine, в каждом из которых, в свою очередь, были определены методы Store и Load для хранения полей класса в потоке. Напомним их реализацию, а также произведем регистрацию данных классов.
{ модуль GrPrim.pas }
…
implementation
uses inter;
…
{ ------------ TGrObject
------------- }
…
constructor TGRObject.load(var s:tstream);
begin s.Read(disabled,sizeof(disabled)); end;
procedure TGRObject.store(var
s:tstream);
begin
s.Write(disabled,sizeof(disabled)); end;
…
{ ------------ TAbstractLS -------------
}
…
constructor TAbstractLS.load(var s:tstream);
begin
inherited load(s);
s.read(style,sizeof (style));
end;
procedure
TAbstractLS.store(var s:tstream);
begin
inherited store(s);
s.write(style,sizeof (style));
end;
…
{ ------------ TGrPoint
------------- }
…
constructor TGrPoint.load(var s:tstream);
begin
inherited load(s);
s.read(point,sizeof (point)); s.read(color,2);
end;
procedure TGrPoint.store(var
s:tstream);
begin
inherited store(s);
s.write(point,sizeof (point));
s.write(color,sizeof
(color));
end;
…
{ ------------ TGrLine -------------
}
…
constructor TGrLine.load(var s:tstream);
begin
inherited load(s);
s.read(CoordLine, sizeof (CoordLine));
end;
procedure TGrLine.store(var
s:tstream);
begin
inherited store(s);
s.write(CoordLine,sizeof (CoordLine));
end;
…
{ типированные константы для регистрации классов в системе потокового ввода-вывода }
const
rGrPoint:tstreamrec=
(objtype:2097;
vmtlink:ofs(typeof (TGrPoint)^);
load:@TGrPoint.load;
store:@TGrPoint.store);
rGrLine:tstreamrec=
(objtype:2098;
vmtlink:ofs(typeof (TGrLine)^);
load:@TGrLine.load;
store:@TGrLine.store);
…
begin
{секция инициализации модуля}
{регистрация классов в системе потокового ввода-вывода}
registertype(rGrpoint);
registertype(rGrline);
…
end.
Проанализируем некоторые интересные моменты в регистрации классов.
Во первых, может возникнуть вопрос, почему из четырех классов регистрируется только два, несмотря на то, что методы Load и Store определены в каждом из четырех? Дело в том, что храниться в потоке будут экземпляры классов TGrPoint и TGrLine, а методы Load и Store оставшихся двух классов никогда не будут вызваны напрямую.
Во вторых, обращает на себя внимание формирование значений типированных констант для регистрации классов:
rGrPoint:tstreamrec=
(objtype:2097;
vmtlink:ofs(typeof (TGrPoint)^);
load:@TGrPoint.load;
store:@TGrPoint.store);
Значение поля objtype должно быть уникальным во всей потоковой системе программы. Так как значения от 0 до 999 зарезервированы Турбо-Паскалем для своих нужд, программист в потоковых переменных должен использовать значения >= 1000.
Поле vmtlink представляет собой смещение (offset) области памяти, в
которой находится таблица виртуальных методов для данного класса (сегмент, в
котором находится таблица, известен заранее – это сегмент данных, где хранятся
все глобальные переменные). Рассмотрим способ получения значения поля vmtlink:
ofs(typeof (TGrPoint)^)
Функция ofs возвращает смещение области памяти переменной, которая ей передана в качестве аргумента. Функция typeof возвращает указатель на таблицу VMT переданного ей класса.
Тестовые задания для программного проекта
Задание 12. Определить методы Load и Store для классов примитивов TGrRect, TGrCircle, TGrEllipse, TGrPoly, TGrBar, TGrFillEllipse (см. задания 5-11). Зарегистрировать каждый класс.
Задание 13. Определить методы Load и Store для классов примитивов TGrFillPoly, TGrArcCircle, TGrArcEllipse, TGrText, TGrPicture, TGrFill (см. задания 5-11). Зарегистрировать каждый класс.
Задание 14. Определить массив, состоящий из графических примитивов. Случайным образом заполнить его точками и линиями. Визуализировать содержимое массива. Сохранить в потоке. Очистить массив. Загрузить примитивы из потока в массив. Снова визуализировать массив, предварительно очистив экран.
Задание 15. Выполнить задание 14 для классов примитивов, определенных в задании 12.
Задание 16. Выполнить задание 14 для классов примитивов, определенных в задании 13.
Темы для предварительного изучения (posobpas2.htm):
Для управления набором графических примитивов мы создадим специализированную графическую коллекцию для хранения примитивов, методы которой позволят нам показывать примитивы, сохранять всю коллекцию в текстовом файле и определять примитив, на который указывает курсор мыши.
{ модуль GrPrim.pas }
…
{ класс "Коллекция графических примитивов"}
TGrCollection=object(TCollection)
procedure
SaveASPas(filename,procname:string);
{ сохраняет содержимое коллекции в виде процедуры в подключаемом ($I) к паскалевской программе файле }
procedure Show; { показывает коллекцию }
function
ObjectOnPoint(TP:TPoint):PGrObject;
{ возвращает
последний (ближний в Z-упорядочивании) объект, включающий в себя переданную
точку. Возвращает nil, если такого объекта нет }
end;
…
implementation
uses inter;
…
{ ------------ TGrCollection ------------- }
procedure
tgrCollection.saveaspas(filename,procname:string);
var f:text; i:integer;
begin
assign(f,filename); rewrite (f);
writeln(f,'Procedure '+procName+'(cx,cy:integer)'+';');
writeln(f,'Begin');
for i:=0 to count-1 do
pgrobject(at(i))^.saveastext(f);
writeln(f,'End;'); close(f) ;
end;
procedure tgrCollection.show;
var i:integer;
begin
for i:=0 to count-1 do with pgrobject(at(i))^
do if not disabled then show;
end;
function
tgrCollection.ObjectOnPoint(TP:TPoint):PGrObject;
var i:integer;
begin
ObjectOnPoint:=nil;
for i:=count-1 downto 0 do
if pgrobject(at(i))^.PointIn(tp.x,tp.y)
then begin
ObjectOnPoint:=at(i); exit;
end;
end;
Тестовые задания для программного
проекта
Задание 17. Создать и заполнить произвольным набором примитивов две графических коллекции. Визуализировать по нажатию клавиши поочередно первую, затем вторую коллекции, затем снова первую и т.д. до тех пор, пока не будет нажата клавиша ESC.
Задание 18. Создать и заполнить произвольным набором примитивов графическую коллекцию. Сохранить ее в потоке и паскалевском файле. Уничтожить коллекцию. Загрузить коллекцию из потока и визуализировать ее, предварительно очистив экран.
Задание 19. Создать и заполнить произвольным набором примитивов графическую коллекцию. Используя программную заготовку из задания 3, удалять из коллекции те примитивы, на которых произошел щелчок левой кнопкой мыши. Перерисовывать коллекцию после каждого успешного удаления. Выход из программы по щелчку правой кнопкой.
Задание 20. Создать и заполнить произвольным набором примитивов, состоящем из точек, линий и прямоугольников, три графических коллекции. Последовательно визуализировать все три коллекции. Переместить все точки в первую коллекцию, все линии – во вторую, все прямоугольники – в третью. Снова последовательно визуализировать все три коллекции.
Темы для предварительного изучения (posobpas2.htm):
Задания для раздела "Ресурсы" (73-75)
Задания для раздела "Виды
ошибок" (76-78)
2.3.2 Констатация и локализация ошибок
2.3.3 Использование встроенного отладчика.
2.4 Разработка больших программ.
2.4.1 Общие
принципы разработки программ.
2.4.1.1 Метод
организации «сверху-вниз».
2.4.1.2 Метод организации «снизу-вверх».
2.4.1.3 Достоинства и недостатки обоих методов:
2.4.2 Концепции разработки больших
программных проектов (БПП).
2.4.2.1 Руководство программным проектом и коллектив программистов.
2.4.2.2 Концептуальное единство проекта.
2.4.2.3 Ошибки при реализации проекта.
Задания для раздела "Концепции
разработки больших программных проектов (БПП)." (79-80)
2.4.3 Событийная модель программного
проекта.
2.4.3.1 Понятие события при разработке
больших программных проектов.
2.4.3.2 Реализация механизма получения и обработки событий в однозадачной среде.
2.4.3.3 Реализация механизма получения и обработки событий в многозадачной среде.
2.4.3.4 Пример реализации получения и обработки событий в однозадачной среде.
Создадим модуль Events, в который поместим наиболее общие типы данных, переменные, константы, процедуры и функции, которые будут использованы при реализации программного проекта. Это касается:
1) Всех констант и типов данных, необходимых для хранения событий (TEvent, константы событий, команд и масок) – в интерфейсную секцию.
2) Переменных и констант очереди событий (MaxEvent, CountEvent, ChainEvent) – в секцию реализации.
3) Процедуры добавления события в очередь (PutEvent) – в интерфейсную секцию
4) Процедуры получения события из очереди (GetEvent) – в интерфейсную секцию, и всех глобальных типированных констант для этой процедуры (MouseX, MouseY, MouseLeftDown, MouseRightDown) – в секцию реализации.
Наш графический редактор основан на объектно-ориентированной модели, поэтому в дальнейшем мы создадим специализированный объект, в который будут включены остальные процедуры событийной модели.
Откомпилируйте полученный модуль, убедитесь в отсутствии синтаксических ошибок.
Темы для предварительного изучения (posobpas2.htm):
2.4.4 Объектно-событийная модель программы.
2.4.4.1 Объектная модель программы
2.4.4.2 Объединение объектной и событийной модели программ.
Дополним классами TEventObject и TApp модуль Events и начнем создание
интерактивной среды графического редактора.
Применяя к разрабатываемому графическому редактору объектно-событийную
модель, можно определить классы
Визуальный класс (TView=object(TEventObject)),
Кнопка (TButton=
object(TView)):
Зависимая кнопка (TCheckButton=
object(TButton))
Прямоугольник выбора цвета (TColorBar= object(TView))
Холст (TCanvas=
object(TView)),
Приложение (TApplication=object(TApp)),
со следующими характеристиками
1. Визуальный класс:
Визуальный класс определяет абстрактный метод Show, используемый потомками для визуализации своего содержимого, а также обработку команды cmShow. Визуальный класс рассчитывает, что все подчиненные ему объекты также являются визуальными, поэтому (при обработке cmShow) для каждого из них вызывается метод Show. Визуальный класс имеет координаты в виде прямоугольника, может устанавливать область вывода в эти координаты.
2. Кнопка:
Кнопки используются для передачи команд другим объектам приложения, формируя эти команды из событий мыши и нажатия клавиш. При инициализации экземпляра кнопки ей передаются координаты прямоугольника, строка, обозначающая надпись на кнопке, код клавиши, при нажатии которую происходит срабатывание кнопки, а также команда, которая должна возникать при срабатывании кнопки. Анализируя поступающие к ней события, кнопка в требуемый момент посылает свою команду в очередь событий.
3.
Зависимая кнопка:
Имеет следующие отличия от обычной кнопки:
При нажатии посылает команду в очередь событий, причем остается
нажатой. Кнопки данного типа могут группироваться. В этом случае нажатие на
одну из кнопок группы вызывает отжатие уже нажатой в данной группе. При
инициализации ей дополнительно к стандартным для кнопки параметрам передается
номер группы, в которую она входит.
4.
Прямоугольник выбора цвета
Прямоугольник выбора цвета используется для интерактивного выбора цвета
в графическом редакторе. Представляет собой прямоугольник с набором из 16
цветов, один из которых всегда выбран (отмечен). Нажатие на другой цвет
выбирает его.
5. Холст:
Холст используется для хранения и визуализации коллекции графических объектов, обрабатывает события мыши и команды переключения режимов, направленные от кнопок или другого источника. При инициализации ему передаются координаты рабочего прямоугольника, в котором происходит визуализация коллекции графических объектов. Коллекция графических примитивов хранится отдельным полем внутри холста, не входя в иерархию объектов программы.
6.
Приложение:
Приложение реализует инициализацию и завершение графики (в методах INIT, DOWN), а также подготовку рабочего стола (в методе INIT), которая заключается во вставке туда одного холста, требуемого набора кнопок и прямоугольника для выбора цвета (вставка производится в сам объект Приложение). Дополнительно, приложение дублирует возможности Визуального класса.
Реализацию холста и приложения мы проведем в фазе 12
программного проекта, так как концепция режима,
активно используемая в методах холста, будет подробно рассмотрена только в
следующем параграфе, а в конструкторе приложения кнопкам назначаются команды,
обрабатываемые холстом.
Создадим новый модуль GRED.PAS, где разместим собственно тело редактора, то есть все объекты, определенные в текущей фазе, и все сопутствующие данные, процедуры, функции и т.д.
Unit GRED;
Interface
uses Graph,objects,crt,mouse,grprim,events;
…
{ определим команду, используемую зависимой кнопкой при своем собственном нажатии для "отжатия" уже нажатой кнопки в группе }
const
cmUnCheck=333;
type
PView=^TView;
PButton= ^TButton;
PCheckButton= ^TCheckButton;
PColorBar= ^TColorBar;
{ -- TView -- }
{ Визуально-событийный абстрактный класс }
TView=object(TEventObject)
Rect:TRect; { прямоугольник вывода }
constructor
Init(_Owner:PEventObject; x1,y1,x2,y2:integer);
procedure Show;virtual; { абстрактный метод }
procedure HandleEvent(Var
Event:Tevent);virtual;
{ обрабатывает команду cmShow}
procedure SetView; { устанавливает окно вывода }
procedure SetStandartView;{ устанавливает окно вывода на весь экран}
procedure ResetView; { устанавливает окно вывода, существовавшее до вызова SetView и SetStandartView}
private
oldView:ViewPortType; {поле для хранения "старого" окна вывода}
end;
{ --TButton-- }
{ Класс "Кнопка". При нажатии посылает команду в очередь событий }
TButton= object(TView)
Caption:string[20]; { надпись на
кнопке }
Code:Char; { код клавиши ... }
Ext:boolean; {... и признак расширенного кода, при нажатии на которую срабатывает кнопка }
Command:integer; {команда. которая посылается в очередь событий}
constructor
Init(_Owner:PEventObject; x1,y1,x2,y2:integer;s:string; c:char;
_ext:boolean;cm:integer);
procedure Show;virtual;
procedure HandleEvent(Var
Event:Tevent);virtual;
procedure
ButtonDown;virtual;
{ Вызывается при нажатии на кнопку. В классе TButton анимирует нажатие }
end;
{--TCheckButton--}
{ Класс "Зависимая кнопка". При нажатии посылает команду в очередь событий, причем остается нажатой. Кнопки данного типа могут группироваться. В этом случае нажатие на одну из кнопок группы вызывает отжатие уже нажатой в данной группе. Активно используется для переключения в режимы рисования различных примитивов }
TCheckButton= object(TButton)
Checked:boolean; { признак нажатия-отжатия }
Group:integer; { номер группы }
constructor Init(_Owner:PEventObject; x1,y1,x2,y2:integer;s:string;
c:char; _ext:boolean;cm:integer; _group:integer);
procedure Show;virtual;
procedure ButtonDown;virtual;
{ визуализирует нажатую кнопку и посылает в очередь событий команду cmUnCheck }
procedure HandleEvent(Var Event:Tevent);virtual;
{ обрабатывает команду cmUnCheck }
end;
{--TColorBar--}
{ "Прямоугольник выбора цвета". Используется для интерактивного выбора цвета }
TColorBar= object(TView)
Color:word; { выбранный цвет }
constructor
Init(_Owner:PEventObject; x1,y1,x2,y2:integer);
procedure Show;virtual;
procedure ShowCell(R:TRect;
_Color:word);
{ показывает одну ячейку в переданном прямоугольнике и переданным цветом}
procedure SetBarColor(_Color:word); { рисует маркер на выбранном цвете }
function GetCell(x,y:integer):word;
{ по координатам возвращает номер цвета }
procedure GetCellRect(_Color:word; var R:TRect);
{ по цвету возвращает координаты цветового прямоугольника }
procedure HandleEvent(Var Event:Tevent);virtual;
end;
…
implementation
uses inter;
{
------------ TView ------------- }
procedure TView.Show;
{ абстрактный метод для визуализации объекта,
перекрывается во всех потомках }
begin abstract; end;
procedure
TView.HandleEvent;
var
i:integer;
begin
if (Event.TypeEvent=evCommand)
and (Event.Command=cmShow) then begin
{Обработка команды cmShow}
Show; For
i:=0 to count-1 do PView(at(i))^.Show;
{показ самого объекта, затем – показ всех
подчиненных}
Event.TypeEvent:=0;exit;
end;
inherited HandleEvent(Event);
end;
constructor
TView.Init(_Owner:PEventObject; x1,y1,x2,y2:integer);
begin
inherited
init(_Owner); Rect.assign(x1,y1,x2,y2);
end;
procedure
TView.SetView;
begin
GetViewSettings(oldView); with rect do SetViewPort(a.x,a.y,b.x,b.y,true);
end;
procedure
TView.SetStandartView;
begin
GetViewSettings(oldView); SetViewPort(0,0,GetMaxX,GetMaxY,true);
end;
procedure
TView.ResetView;
begin with
oldView do SetViewPort(x1,y1,x2,y2,true); end;
{ ------------
TButton ------------- }
constructor TButton.Init(_Owner:PEventObject;x1,y1,x2,y2:integer;
s:string;c:char;_ext:boolean;cm:integer);
begin
inherited
init(_owner,x1,y1,x2,y2);
Caption:=s;
Code:=C; Ext:=_ext; Command:=cm;
end;
procedure
TButton.ButtonDown;
begin
with rect
do begin
hidemouse; SetStandartview; setcolor(15); setWriteMode(XorPut);
SetLineStyle(SolidLn,0,1); rectangle(a.x,a.y,b.x,b.y);
delay(100);
rectangle(a.x,a.y,b.x,b.y); setWriteMode(NormalPut);
ReSetview; showmouse;
end;
end;
procedure TButton.Show;
var
dx,dy,x,y:integer;
begin
hidemouse;
SetStandartView;
with rect do
begin
Showbar(a.x,a.y,b.x,b.y,7,true);
if not disabled
then SetColor(0) else setcolor(8);
SetTextstyle(2,0,0); dx:=TextWidth(caption); dy:=TextHeight(caption);
x:=a.x+(b.x-a.x-dx)div 2; y:=a.y+(b.y-a.y-dy)div 2;
OutTextXY(x,y,Caption);
end;
ResetView;
showmouse;
end;
procedure TButton.HandleEvent(Var
Event:Tevent);
var E:TEvent;
begin
if
((event.typeEvent=evKeyBoard)
and(event.code=code)
and(event.ext=ext))
or
((event.typeEvent=evMouseDown)
and
rect.contains(event.xy))
then begin
e.TypeEvent:=evCommand; e.Command:=Command;
PutEvent(e);
Event.TypeEvent:=0;
ButtonDown;
end;
inherited
HandleEvent(Event);
end;
{
------------ TCheckButton ------------- }
constructor TCheckButton.Init(_Owner:PEventObject; x1,y1,x2,y2:integer;
s:string; c:char;_ext:boolean;cm:integer; _group:integer);
begin
inherited
init(_owner,x1,y1,x2,y2,s,c,_ext,cm); checked:=false; group:=_group;
end;
procedure
TCheckButton.ButtonDown;
var E:TEvent;
begin
checked:=true;
show;
e.TypeEvent:=evCommand; e.Command:=cmUnCheck;
e.pinfo:=@self;
PutEvent(e);
end;
procedure
TCheckButton.Show;
var
dx,dy,x,y:integer;
begin
hidemouse;
SetStandartView;
with rect do
begin
showbar(a.x,a.y,b.x,b.y,7,not checked);
if not
disabled then SetColor(0) else setcolor(8);
SetTextstyle(2,0,0); dx:=TextWidth(caption); dy:=TextHeight(caption);
x:=a.x+(b.x-a.x-dx)div 2; y:=a.y+(b.y-a.y-dy)div 2;
OutTextXY(x,y,Caption);
end;
ResetView;
showmouse;
end;
procedure
TCheckButton.HandleEvent(Var Event:Tevent);
begin
if
(event.typeEvent=evCommand)
and(event.Command=cmUnCheck)
and(event.pinfo<>@self)
and(pCheckButton(event.pinfo)^.group=group)
and(checked)
then begin
checked:=false; show;
end;
inherited
HandleEvent(Event);
end;
{
------------ TColorBar ------------- }
constructor
TColorBar.Init(_Owner:PEventObject; x1,y1,x2,y2:integer);
begin
inherited init(_Owner,x1,y1,x2,y2); SetBarColor(15); end;
function
TColorBar.GetCell(x,y:integer):word;
var
dx,dy:integer;
begin
with rect do
begin
x:=x-a.x;
y:=y-a.y; dx:=(b.x-a.x)div 8; dy:=(b.y-a.y)div 2;
GetCell:=(x
div dx)+8*(y div dy);
end;
end;
procedure
TColorBar.GetCellRect(_Color:word; var R:TRect);
var
dx,dy,x,y,i:integer;
begin
with rect do
begin
dx:=(b.x-a.x)div 8; dy:=(b.y-a.y)div 2;
x:=a.x+dx*(_color mod 8); y:=a.y+dy*(_color div 8);
end;
R.assign(x,y,x+dx-1,y+dy-1);
end;
procedure
TColorBar.ShowCell(R:TRect; _color:word);
begin with
r do Showbar(a.x,a.y,b.x,b.y,_color,false); end;
procedure
TColorBar.Show;
var
i:integer;R:TRect;
begin
hidemouse;
SetStandartView;
with rect do for i:=0 to 15 do begin
GetCellRect(i,R); ShowCell(R,i) end;
SetBarColor(Color); ResetView; showmouse;
end;
procedure
TColorBar.SetBarColor(_Color:word);
var R:trect;
oldColor:word;
begin
hidemouse;
SetStandartView;
GetCellRect(Color,R); oldColor:=Color;
Color:=_Color;
ShowCell(R,OldColor); GetCellRect(Color,R);
if Color in
[3,7,10..15] then SetColor(0) else Setcolor(15);
with r do
Circle(a.x+(b.x-a.x)div 2,a.y+(b.y-a.y)div 2,2);
ResetView;
showmouse;
end;
procedure
TColorBar.HandleEvent(Var Event:Tevent);
begin
inherited
HandleEvent(event);
if
(event.typeEvent=evMouseDown) and Rect.contains(event.xy) then begin
SetBarColor(GetCell(event.xy.x,event.xy.y));
event.typeevent:=0;
end;
end;
Рассмотрим некоторые моменты в реализации
методов классов.
1. Стандартный способ
прорисовки любого класса, порожденного от TView состоит в следующих
действиях:
hidemouse;
SetStandartview;
… { прорисовка объекта в
абсолютных координатах }
ResetView; showmouse;
или:
hidemouse; SetView;
… { прорисовка объекта в
относительных координатах }
ResetView;
showmouse;
2. При нажатии на зависимую
кнопку в очередь событий посылается не одно, а два события: одно – в
унаследованным от кнопки методе HandleEvent, второе – в перекрытом методе ButtonDown.
В последнем случае посылается команда cmUnCheck, которую обрабатывают все зависимые кнопки в
группе, кроме пославшей команду.
3. В большом программном
проекте любой класс должен поддерживать универсальность отображения, реакции на
события и т.д. Поэтому вывод текста в TButton и TCheckButton и цветов в TColorBar универсален. И текст и цвета всегда будут
отображаться правильно вне зависимости от размеров объектов.
Темы для предварительного изучения (posobpas2.htm):
2.4.4.3 Режим работы объекта в объектно-событийной модели
Дополним модуль GRED.PAS реализацией холста (TCanvas) и приложения (TApp).
Определим константы режимов холста графического редактора:
Unit GRED;
Interface
…
{РЕЖИМЫ ДЛЯ TCanvas}
modeStandart=0;
modeRis=1; {рисование}
{ПОДРЕЖИМ1}
{подрежим 1 соответствует подготовке и самому процессу рисования}
smodeRisBegin=0; {подготовка рисования}
smodeRis=1; {процесс рисования}
{ПОДРЕЖИМ2}
{подрежим 2 соответствует типу рисуемого примитива}
modeDel=2; {удаление примитива}
{подрежимов нет}
modeMove=3; {перемещение примитива}
{ПОДРЕЖИМ1}
{подрежим 1 соответствует подготовке и самому процессу перемещения}
smodeMoveBegin=0; {подготовка перемещения}
smodeMove=1; {процесс перемещения}
{ Определим команды, которые будут обрабатывать холст. Для простоты все команды, кроме команды выхода, обрабатываются холстом}
{ одиночные команды }
cmRead=2;
cmSave=3;
cmClear=4;
cmShow=5;
cmSaveToPas=9;
{команды переключения в режимы}
cmToLine=10001;
cmToCircle=10002;
cmToRect=10003;
cmToEllipse=10004;
cmToDel=10011;
cmToMove=10012;
type
{--TCanvas--}
{ "Холст". Используется для интерактивного построения и прорисовки набора графических примитивов }
PCanvas= ^TCanvas;
TCanvas= object(TView)
PG:PGrCollection; {
коллекция графических примитивов }
Mode:integer; { текущий режим }
SubMode,SubMode2:integer; { подрежимы }
CurrObj:PGrObject; { текущий рисуемый (перемещаемый и т.д.) примитив }
constructor Init(_Owner:PEventObject;x1,y1,x2,y2:integer);
destructor Done;virtual;
procedure Show;virtual;
procedure Clear; { очищает холст, уничтожая коллекцию примитивов }
procedure HandleDown(xy:tpoint; buttons:byte);
procedure HandleMove(xy:tpoint;
buttons:byte);
procedure HandleUp(xy:tpoint;
buttons:byte);
{ процедуры HandleDown, HandleMove и HandleUp вызываются из HandleEvent при соответствующих событиях мыши }
procedure CancelDynamicMode;
{ отменяет динамический подрежим (smodeRis,smodeMove), если он установлен, переводя его в соответствующий подготовительный подрежим (smodeRisBegin,smodeMoveBegin). Используется обычно перед установкой другого режима или подрежима (например, до завершения рисования линии пришла команда о начале рисования окружности) }
procedure BeginRis(xy:tpoint);
procedure EndRis(xy:tpoint);
procedure MoveRis(xy:tpoint);
{ процедуры BeginRis, EndRis и MoveRis вызываются из HandleDown и HandleMove в начале, завершении и протяжении рисования примитива. Используются в целях установки специфичных для каждого графического примитива параметров }
procedure HandleEvent(Var Event:Tevent);virtual;
{ в дополнении к обработке команд производит перевод координат мыши из абсолютных в относительные }
procedure LoadFromFile;
procedure SaveToFile;
procedure SaveToPas;
{ процедуры чтения и сохранения коллекции примитивов в файле, а также сохранения в паскалевском формате}
private
OldPoint:TPoint;
end;
{--TApplication--}
{ "Приложение" }
TApplication=object(TApp)
constructor Init;
{ создает и располагает на экране набор визуальных объектов }
procedure ShowAll;
{ так как TApplication порожден не от TView, требуется метод ShowAll для показа содержимого приложения }
destructor Done;virtual;
end;
{--Переменные--}
var ColorBar:PColorBar;
{ ссылка на прямоугольник выбор цвета. Используется для доступа к текущему установленному цвету примитивов }
…
implementation
uses inter;
…
{ ------------ TCanvas ------------- }
procedure
TCanvas.CancelDynamicMode;
begin
if (mode=moderis)and(submode=smoderis)
then begin
submode:=smodeRisBegin; pg^.Delete(currobj);
hidemouse;
SetView; show; ReSetView; showmouse;
CurrObj:=nil;
end
else
if
(mode=modeMove)and(submode=smodeMove) then begin
submode:=smodeRisBegin;
hidemouse;
SetView; currObj^.enable; show; ReSetView; showmouse;
CurrObj:=nil;
end;
end;
procedure
TCanvas.BeginRis(xy:tpoint);
begin
case
submode2 of
typeline: CurrObj:=new(pGrline,
init(xy.x,xy.y,xy.x,xy.y,0,1,1,ColorBar^.Color));
typeRect:
CurrObj:=new(pGrRect, init(xy.x,xy.y,xy.x,xy.y,0,1,1,ColorBar^.Color));
typeCircle:
CurrObj:=new(pGrCircle,init(xy.x,xy.y,0,0,1,1,ColorBar^.Color));
typeEllipse:
;
end;
end;
procedure
TCanvas.EndRis(xy:tpoint);
begin
case
submode2 of
typeline,typerect: with pgrline(CurrObj)^.CoordLine do begin
b.x:=xy.x; b.y:=xy.y;
if
submode2=typerect then begin
normalizedRect(pgrRect(CurrObj)^.CoordLine);
end;
end;
typeCircle:
with pgrCircle(CurrObj)^ do begin
with
coordCircle do radius:=round(sqrt(sqr(int(x-xy.x))+sqr(int(xy.y-y))));
end;
typeEllipse: ;
end;
end;
procedure TCanvas.MoveRis(xy:tpoint);
begin
case
submode2 of
typeline,typeRect: with pgrline(CurrObj)^.CoordLine do begin
b.x:=xy.x; b.y:=xy.y;
end;
typeCircle:with pgrCircle(CurrObj)^ do begin
with
coordCircle do radius:=round(sqrt(sqr(int(x-xy.x))+sqr(int(y-xy.y))));
end;
typeEllipse: ;
end;
end;
procedure
TCanvas.HandleDown(xy:tpoint; buttons:byte);
begin
case mode of
modeRis:
begin
case
submode of
smodeRisBegin: begin
BeginRis(xy); pg^.Insert(CurrObj);
hidemouse; SetView; CurrObj^.show; ResetView; showmouse;
submode:=smodeRis;
end;
smodeRis: begin
if
buttons=mbRight then begin
CancelDynamicMode;
exit;
end;
EndRis(xy); submode:=smodeRisBegin;
hidemouse; SetView; show; ReSetView; showmouse;
CurrObj:=nil;
end;
end;
end;
modeDel:begin
CurrObj:=pg^.ObjectOnPoint(XY);
if
CurrObj<>nil then begin pg^.Delete(CurrObj); show; end;
end;
modeMove:begin
case
submode of
smodeMoveBegin: begin
CurrObj:=pg^.ObjectOnPoint(XY);
if
CurrObj<>nil then begin
hidemouse; SetView; submode:=sModeMove; OldPoint:=XY;
CurrObj^.disable; Show; CurrObj^.XorShow; ResetView; showmouse;
end;
end;
smodeMove: begin
if
buttons=mbRight then begin
CancelDynamicMode; exit;
end;
submode:=smodeRisBegin;
hidemouse; SetView; currObj^.enable; show; ReSetView; showmouse;
CurrObj:=nil;
end;
end;
end;
end;
end;
procedure
TCanvas.HandleMove(xy:tpoint; buttons:byte);
var dx,dy:integer;
begin
case mode of
modeRis:
begin
if
submode=smodeRis then begin
hidemouse; SetView; CurrObj^.XorShow;
MoveRis(xy);
CurrObj^.XorShow; ResetView; showmouse;
end;
end;
modeMove:begin
if
submode=smodeMove then begin
hidemouse; SetView; CurrObj^.XorShow;
dx:=xy.x-oldpoint.x; dy:=xy.y-oldpoint.y;
CurrObj^.Move(dx,dy); OldPoint:=xy;
CurrObj^.XorShow; ResetView; showmouse;
end;
end;
end;
end;
procedure
TCanvas.HandleUp(xy:tpoint; buttons:byte);
begin
{ зарезервировано }
end;
constructor
TCanvas.Init(_Owner:PEventObject; x1,y1,x2,y2:integer);
begin
inherited
init(_owner,x1,y1,x2,y2); mode:=modeStandart;
pg:=new(pGrCollection,Init(100,10));
end;
destructor
TCanvas.Done;
begin
dispose(pg,done); inherited done; end;
procedure
TCanvas.Clear;
begin
pg^.freeall; show; end;
procedure
TCanvas.Show;
var
V:ViewPortType;
begin
hidemouse;
setView; setfillstyle(solidfill,0);
with rect do
bar(0,0,b.x-a.x,b.y-a.y);
pg^.show;
ResetView; showmouse;
end;
procedure
TCanvas.HandleEvent(Var Event:Tevent);
var s:string;
begin
inherited
HandleEvent(event);
if
event.typeEvent and evMouse <> 0 then begin
if
Rect.contains(event.xy) then begin
dec(event.xy.x,rect.a.x); dec(event.xy.y,rect.a.y);
with event
do begin
case
event.TypeEvent of
evMouseDown: HandleDown(xy, buttons);{обработка нажатий}
evMouseMove:
HandleMove(xy, buttons);{перемещений}
evMouseUp: HandleUp(xy, buttons); {отжатий}
end;
Event.TypeEvent:=0;
end;
exit;
end;
end;
if
event.TypeEvent=evCommand then begin
case
Event.Command of
cmToLine:begin
CancelDynamicMode;
Mode:=ModeRis;
SubMode:=sModeRisBegin; SubMode2:=typeLine;
end;
cmToRect:begin
CancelDynamicMode;
Mode:=ModeRis;
SubMode:=sModeRisBegin; SubMode2:=typeRect;
end;
cmToCircle:begin
CancelDynamicMode;
Mode:=ModeRis;
SubMode:=sModeRisBegin; SubMode2:=typeCircle;
end;
cmToDel:begin
CancelDynamicMode;
Mode:=ModeDel;
end;
cmToMove:begin
CancelDynamicMode;
Mode:=ModeMove;
end;
cmRead:begin
CancelDynamicMode;
LoadFromFile;
end;
cmSave:begin
CancelDynamicMode;
SaveToFile;
end;
cmSaveToPas:begin
CancelDynamicMode;
SaveToPas;
end;
cmClear:begin
CancelDynamicMode;
Clear;
end
else exit;
end;
end;
end;
procedure
TCanvas.LoadFromFile;
var s:string;
stm:tbufstream;
begin
s:='noname.stm';
if
inputstring(12,'Загрузка файла',s) then begin
if not
exists(s) then begin messagebox('Такого файла нет!'); exit;
end;
dispose(pg,done);
stm.init(s,stopenread,1024); pg:=pgrcollection(stm.Get); stm.done;
show;
end;
end;
procedure
TCanvas.SaveToFile;
var s:string;
stm:tbufstream;
begin
s:='noname.stm';
if
inputstring(12,'Сохранение файла',s) then begin
stm.init(s,stCreate,1024); stm.Put(pg); stm.done;
end;
end;
procedure
TCanvas.SaveToPas;
var s,n:string;
begin
s:='include.inc'; n:='Paint';
if
inputstring(12,'Сохранение в тексте',s) and
inputstring(24,'Введите имя процедуры',n)
then
pg^.saveAsPas(s,n);
end;
{ ------------ TApplication ------------- }
constructor TApplication.Init;
var
obj:pView; dr,dm,gError:Integer; x,y,dx,dy:integer;
begin
inherited
Init; dr := vga; dm := vgaHi; InitGraph(dr,dm,' ');
gError :=
GraphResult;
if gError
<> grOk then begin
Writeln('Graphics error:', GraphErrorMsg(gError)); halt(1);
end;
CHKAndReset;
obj:=new(PCanvas,Init(@Self,20,20,getmaxx-20,400));
x:=20;y:=410;
dx:=65;
dy:=17;
obj:=new(PCheckButton,Init(@Self,x,y,x+dx,y+dy,'Линия',#0,false,cmtoline,0));
inc(x,0);
inc(y,dy+2);
obj:=new(PCheckButton,Init(@Self,x,y,x+dx,y+dy,'Прям.',#0,false,cmtorect,0));
inc(x,dx+2);
inc(y,-dy-2);
obj:=new(PCheckButton,Init(@Self,x,y,x+dx,y+dy,'Окр.',#0,false,cmtocircle,0));
inc(x,0);
inc(y,dy+2);
obj:=new(PCheckButton,
Init(@Self,x,y,x+dx,y+dy,'Эллипс',#0,false,cmtoellipse,0));
obj^.disable;
inc(x,dx+2);
inc(y,-dy-2);
obj:=new(PCheckButton,
Init(@Self,x,y,x+dx,y+dy,'Ломаная',#0,false,cmtocircle,0));
obj^.disable;
inc(x,0);
inc(y,dy+2);
obj:=new(PCheckButton, Init(@Self,x,y,x+dx,y+dy,'З.Прям.',#0,false,cmtoellipse,0));
obj^.disable;
inc(x,dx+2);
inc(y,-dy-2);
obj:=new(PCheckButton,
Init(@Self,x,y,x+dx,y+dy,'З.Окр.',#0,false,cmtocircle,0));
obj^.disable;
inc(x,0);
inc(y,dy+2);
obj:=new(PCheckButton,
Init(@Self,x,y,x+dx,y+dy,'З.Элл.',#0,false,cmtoellipse,0));
obj^.disable;
inc(x,dx+2);
inc(y,-dy-2);
obj:=new(PCheckButton,
Init(@Self,x,y,x+dx,y+dy,'З.Мног.',#0,false,cmtocircle,0));
obj^.disable;
inc(x,0);
inc(y,dy+2);
obj:=new(PCheckButton,
Init(@Self,x,y,x+dx,y+dy,'Заливка',#0,false,cmtoellipse,0));
obj^.disable;
inc(x,dx+10);
inc(y,-dy-2);
obj:=new(PCheckButton,
Init(@Self,x,y,x+dx,y+dy,'Удал.',#66,true,cmToDel,0));
inc(x,0);
inc(y,dy+2);
obj:=new(PCheckButton,
Init(@Self,x,y,x+dx,y+dy,'Перем.',#0,false,cmToMove,0));
x:=20;
y:=455;
dx:=70;
dy:=20;
obj:=new(PButton,Init(@Self,x,y,x+dx,y+dy,'Выход',#0,false,cmQuit));
inc(x,dx+5);
obj:=new(PButton,Init(@Self,x,y,x+dx,y+dy,'Загр.',#61,true,cmread));
inc(x,dx+5);
obj:=new(PButton,Init(@Self,x,y,x+dx,y+dy,'Сохр.',#60
,true,cmsave));
inc(x,dx+5); dx:=100;
obj:=new(PButton,
Init(@Self,x,y,x+dx,y+dy,
'Сохр. в
PAS',#63,true,cmSavetoPas));
x:=364;
obj:=new(PButton,Init(@Self,x,y,x+dx,y+dy,'Очистка',#59,true,cmclear));
ColorBar:=new(pColorBar,init(@Self,500,420,620,460));
ShowAll;
end;
destructor
TApplication.Done;
begin
CloseGraph; inherited Done; end;
procedure
TApplication.ShowAll;
var
e,e1:TEvent;i:integer;
begin
hidemouse;
setfillstyle(solidfill,7); bar(0,0 ,getmaxx,getmaxy);
with e1 do
begin TypeEvent:=evCommand; Command:=cmShow end;
for i:=0 to
Count-1 do begin e:=e1; PView(at(i))^.HandleEvent(e); end;
showmouse;
end;
…
end.
Прокомментируем некоторые методы:
1. Метод ShowAll приложения дублирует
возможности метода Show класса TView.
2. Иерархия объектов приложения
строится внутри констрактора. Любые изменения в интерфейсе желательно
сосредоточить именно там.
3. Для простоты управления
иерархия объектов в графическом редакторе одноуровневая, то есть все объекты
принадлежат объекту "приложение" напрямую.
4. Принцип интерактивного создания примитива состоит в следующем: При
щелчке мыши на холсте в режиме рисования происходит переход в режим
динамического рисования, создается соответствующий примитив, временно
запрещается и вставляется в коллекцию. Указатель на этот примитив дублируется в
специальной переменной, с которой и ведется дальнейшая работа. При перемещении
мыши изменяется одна из групп координат примитива, причем прорисовка ведется
методом XorShow. При повторном нажатии
снова изменяются координаты примитива, он разрешается для показа, обнуляется
временная переменная для хранения указателя на примитив, холст перерисовывается,
происходит переход в режим рисования.
5. Принцип интерактивного перемещения примитива состоит в следующем: при
щелчке мыши в режиме перемещения определяется примитив, на котором произошло
нажатие и если такой существует, то происходит переход в режим динамического
перемещения, примитив временно запрещается, указатель на него копируется в
специальную переменную для дальнейшей работы. При изменении координат курсора
мыши в режиме динамического перемещения, изменяются и координаты примитива
методом TGrObject.Move. Перерисовка примитива
производится методом TGrObject.XorShow. При повторном щелчке
кнопкой мыши происходит переход из режима динамического перемещения в режим
перемещения, а переменная для хранения указателя на примитив обнуляется. Методы
для прорисовки и перемещения примитива являются виртуальными, поэтому
добавление нового вида примитива не требует изменения кода для перемещения
примитивов.
6. Принцип интерактивного удаления примитива состоит в следующем: при щелчке
мыши в режиме удаления определяется примитив, на котором произошло нажатие и
если такой существует, то происходит его удаление из коллекции, после чего
холст перерисовывается.
7. Для интерактивного создания нового вида примитивов следует:
a. Определить команду-событие
для перехода в режим рисования соответствующего примитива (например - cmToPoly)
b. Создать кнопку или другое
средство для возникновения данного события.
c. Реализовать переход в режим
рисования примитива в разделе обработки команд метода TCanvas.HandleEvent.
d. Добавить соответствующие
действия (по аналогии с уже существующими) в методы TCanvas.BeginRis, TCanvas.EndRis, TCanvas.MoveRis. При необходимости добавить
действия в TCanvas.CancelDynamicMode.
Теперь, по завершении работы с модулем gred.pas, следует создать основную
программу, которая будет выглядеть очень просто:
uses Gred;
var A:TApplication;
begin
a.init;
a.run;
a.done;
end.
Графический редактор готов к использованию.
Тестовые задания для программного
проекта
Задание 21.
Определите класс TSpeedButton – кнопка с растровым рисунком вместо текста.
Проверьте его работоспособность.
Задание 22. Определите класс TVSpeedButton – кнопка с векторным рисунком вместо текста. Проверьте его
работоспособность.
Задание 23. Определите класс для
интерактивного выбора стиля линий (по аналогии с TColorBar). Проверьте его
работоспособность.
Задание 24. Определите класс для
интерактивного выбора толщины линий (по аналогии с TColorBar). Проверьте его
работоспособность.
Задание 25. Определите класс для
интерактивного выбора стиля заливки (по аналогии с TColorBar). Проверьте его
работоспособность.
Задание 26. Реализуйте интерактивную
прорисовку классов TGrEllipse, TGrBar, TGrFillEllipse.
Задание 27. Реализуйте интерактивную
прорисовку классов TGrArcCircle, TGrArcEllipse.
Задание 28. Реализуйте интерактивную
прорисовку класса TGrText.
Задание 29. Реализуйте интерактивную
прорисовку класса TGrPicture.
Задание 30. Реализуйте интерактивную
прорисовку классов TGrPoly, TGrFillPoly.
Задание 31.
Реализуйте интерактивную прорисовку класса TGrFill