Разработка программного приложения по созданию графа

Размещено на http://www.allbest.ru

Введение

Начало теории графов как математической дисциплины было положено Эйлером в его знаменитом рассуждении о Кенигсбергских мостах. Однако эта статья Эйлера 1736 года была единственной в течение почти ста лет. Интерес к проблемам теории графов возродился около середины прошлого столетия и был сосредоточен главным образом в Англии. Имелось много причин для такого оживления изучения графов. Естественные науки оказали свое влияние на это благодаря исследованиям электрических цепей, моделей кристаллов и структур молекул. Развитие формальной логики привело к изучению бинарных отношений в форме графов. Большое число популярных головоломок подавалось формулировкам непосредственно в терминах графов, и это приводило к пониманию, что многие задачи такого рода содержат некоторое математическое ядро, важность которого выходит за рамки конкретного вопроса. Наиболее знаменитая среди этих задач-проблема четырех красок, впервые поставленная перед математиками Де Морганом около 1850 года. Никакая проблема не вызывала столь многочисленных и остроумных работ в области теории графов. Благодаря своей простой формулировке и раздражающей неуловимости она до сих пор остается мощным стимулом исследований различных свойств графов.

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

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

1. Общая часть

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

Первые задачи теории графов были связаны с решением математических развлекательных задач и головоломок (задача о Кенигсбергских мостах, задача о расстановке ферзей на шахматной доске, задачи о перевозках, задача о кругосветном путешествии и другие). Одним из первых результатов в теории графов явился критерий существования обхода всех ребер графа без повторений, полученный Л. Эйлером при решении задачи о Кенигсбергских мостах. Вот пересказ отрывка из письма Эйлера от 13 марта 1736 году: ”Мне была предложена задача об острове, расположенном в городе Кенигсберге и окруженном рекой, через которую перекинуто 7 мостов. Спрашивается, может ли кто-нибудь непрерывно обойти их, проходя только однажды через каждый мост. И тут же мне было сообщено, что никто еще до сих пор не смог это проделать, но никто и не доказал, что это невозможно. Вопрос этот, хотя и банальный, показался мне, однако, достойным внимания тем, что для его решения недостаточны ни геометрия, ни алгебра, ни комбинаторное искусство. После долгих размышлений я нашел лёгкое правило, основанное на вполне убедительном доказательстве, с помощью которого можно во всех задачах такого рода тотчас же определить, может ли быть совершен такой обход через какое угодно число и как угодно расположенных мостов или не может“.

1.1 Обзор элементов языка программирования

Внешний вид среды программирования Delphi отличается от многих других из тех, что можно увидеть в Windows. К примеру, Borland Pascal for Windows 7.0, Borland C++ 4.0, Word for Windows, Program Manager - это все MDI приложения и выглядят по-другому, чем Delphi. MDI (Multiple Document Interface) - определяет особый способ управления нескольких дочерних окон внутри одного большого окна.

Среда Delphi же следует другой спецификации, называемой Single Document Interface (SDI), и состоит из нескольких отдельно расположенных окон. Это было сделано из-за того, что SDI близок к той модели приложений, что используется в Windows 95.

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

1. Дизайнер Форм (Form Designer)

2. Окно Редактора Исходного Текста (Editor Window)

3. Палитра Компонент (Component Palette)

4. Инспектор Объектов (Object Inspector)

5. Справочник (On-line help)

Есть, конечно, и другие важные составляющие Delphi, вроде линейки инструментов, системного меню и многие другие, нужные Вам для точной настройки программы и среды программирования. Программисты на Delphi проводят большинство времени, переключаясь между Дизайнером Форм и Окном Редактора Исходного Текста (которое для краткости называют Редактор). Прежде чем Вы начнете, убедитесь, что можете распознать эти два важных элемента. Дизайнер Форм показан на рис.1, окно Редактора - на рис.2.

Рис. 1. Дизайнер Форм - то место, где Вы создаете визуальный интерфейс программы

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

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

Несмотря на всю важность Дизайнера Форм, местом, где программисты проводят основное время, является Редактор. Логика является движущей силой программы и Редактор - то место, где Вы ее "кодируете".

Палитра Компонент (см. рис. 3) позволяет Вам выбрать нужные объекты для размещения их на Дизайнере Форм. Для использования Палитры Компонент просто первый раз щелкните мышкой на один из объектов, и потом второй раз - на Дизайнере Форм. Выбранный Вами объект появится на проектируемом окне и им можно манипулировать с помощью мыши.

Палитра Компонент использует постраничную группировку объектов.

Внизу Палитры находится набор закладок - Standard, Additional, Dialogs и т. д.

Если Вы щелкнете мышью на одну из закладок, то Вы можете перейти на следующую страницу Палитры Компонент.

Принцип разбиения на страницы широко используется в среде программирования Delphi и его легко можно использовать в своей программе. (На странице Additional есть компоненты для организации страниц с закладками сверху и снизу).

Рис. 3. Палитра Компонент - место, где Вы выбираете объекты, которые будут помещены на вашу форму

Предположим, Вы помещаете компонент TE dit на форму;

Вы можете двигать его с места на место.

Вы также можете использовать границу, прорисованную вокруг объекта для изменения его размеров.

Большинством других компонент можно манипулировать тем же образом. Однако, невидимые во время выполнения программы компоненты (типа T Menu или T Data Base) не меняют своей формы.

Слева от Дизайнера Форм Вы можете видеть Инспектор Объектов (рис. 4).

Заметьте, что информация в Инспекторе Объектов меняется в зависимости от объекта, выбранного на форме. Важно понять, что каждый компонент является настоящим объектом, и Вы можете менять его вид и поведение с помощью Инспектора Объектов.

Инспектор Объектов состоит из двух страниц, каждую из которых можно использовать для определения поведения данного компонента.

Первая страница - это список свойств, вторая - список событий.

Если нужно изменить что-нибудь, связанное с определенным компонентом, то Вы обычно делаете это в Инспекторе Объектов.

К примеру, Вы можете изменить имя и размер компонента T Label, изменяя свойства Caption, Left, Top, Height, и Width.

Вы можете использовать закладки внизу Инспектора Объектов для переключения между страницами свойств и событий.

Рис. 4. Инспектор Объектов позволяет определять свойства и поведение объектов, помещенных на форму

2. Специальная часть

2.1 Общая постановка задачи

Граф - математически определяется как совокупность двух множеств: множества элементов (вершин графа) и множества соответствий, отношений между этими элементами (множество ребер графа).

Обозначение:

Две вершины, соединенные ребром, называются смежными вершинами графа.

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

2.2 Описание программ комплекса

Interface

USES

Windows, Messages, Sys Utils, Classes, Graphics, Controls, Forms, Dialogs,

ExtCtrls, Std Ctrls, Printers, Clipbrd, Genetic, Menus, Spin;

type Two Di Mint=array of array of integer;

VAR

Point C: integer=cl Blue;

Line C: integer=cl Navy;

Text C: integer=cl Black;

type

TGE Form =class (T Form)

Image: T Image;

Loop Pos B: T Button;

Point Numer: TE dit;

Label 1: T Label;

Label 2: T Label;

Label 3: T Label;

Labe l4: T Label;

Labe l5: T Label;

Bevel 1: T Bevel;

Bevel 2: T Bevel;

Bevel 3: T Bevel;

Label 6: T Label;

Label 7: T Label;

Open Dialog: T Open Dialog;

Save Dialog: T Save Dialog;

Save Image D: T Save Dialog;

Save AJMd: T Save Dialog;

Color Dialog: T Color Dialog;

Menu: T Main Menu;

N1: T Menu Item;

N2: T Menu Item;

N3: T Menu Item;

N4: T Menu Item;

N5: T Menu Item;

N6: T Menu Item;

N7: T Menu Item;

N8: T Menu Item;

N9: T Menu Item;

N10: T Menu Item;

M Grid On: T Menu Item;

M Color On: T Menu Item;

N14: T Menu Item;

N15: T Menu Item;

N16: T Menu Item;

N17: T Menu Item;

Arrow Pos UD: T Spin Button;

Arrow Len: T Spin Button;

Arrow F Back: T Spin Button;

Arrow Wing: T Spin Button;

Radius: T Spin Button;

Show Line Nums: T Menu Item;

procedure Init (Sender: Tobject);

procedure Re Draw;

procedure Image Mouse Up (Sender: Tobject;

Button: T Mouse Button;

Shift: T Shift State;

X, Y: integer);

procedure Try Start Drag (Sender: Tobject;

Button: T Mouse Button;

Shift: T Shift State;

X, Y: integer);

procedure Loop Pos B Click( Sender: Tobject);

procedure Arrow Pos UD Down Click (Sender: Tobject);

procedure Arrow Pos UD Up Click (Sender: Tobject);

procedure Arrow Len UD Down Click (Sender: Tobject);

procedure Arrow Len UD Up Click (Sender: Tobject);

procedure Arrow Wing UD Down Click (Sender: Tobject);

procedure Arrow Wing UD Up Click (Sender: Tobject);

procedure Radius UD Down Click (Sender: Tobject);

procedure Radius UD Up Click (Sender: Tobject);

procedure Feed UD Down Click (Sender: Tobject);

procedure Feed UD Up Click (Sender: Tobject);

procedure Grid On Click (Sender: Tobject);

procedure Save Click (Sender: Tobject);

procedure Load Click (Sender: Tobject);

procedure Save Image Click (Sender: Tobject);

procedure Print (Sender: Tobject);

procedure Save Matrix Click (Sender: Tobject);

procedure Mason Task (FN: string;

Sm: Two Di Mint;

In Sys: array of boolean;

X0, Y0: integer);

procedure Clear B Click (Sender: Tobject);

procedure Copy B Click (Sender: Tobject);

procedure Sel Pnt Color Click (Sender: Tobject);

procedure Sel Line Color Click (Sender: Tobject);

procedure Sel Num Color Click (Sender: Tobject);

procedure Load Inits (Sender: Tobject);

procedure Save Inits (Sender: Tobject;

VAR Action: T Close Action);

procedure N7 Click (Sender: Tobject);

procedure Point Numer Key Press (Sender: Tobject;

VAR Key:Char);

private

{Private declarations}

public

{Public declarations}

end;

2.3 Таблица идентификаторов комплекса

Для написания программы, мы использовали следующие идентификаторы:

Табл. 1

Тип идентификатора	Длина (байт)	Диапазон значений	Операции
integer	2	-32768…...32767	+, -, *, /, mod, div, <=, >=, <>, <, >, =
real	6	-32768Е……32767Е	+, -, *, /, <=, >=, <>, <, >, =
boolean	6	-656…655	+, -, *, /, <=, >=, <>, <, >, =

2.4 Описание наборов данных

В основе иерархии классов, обеспечивающих функционирование наборов данных, в приложениях баз данных, лежит класс T Data Set.

Хотя он почти не содержит методов, реально обеспечивающих работоспособность основных механизмов набора данных, тем не менее, его значение трудно переоценить.

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

При решении наиболее распространенных задач программирования в процессе создания приложений баз данных класс T Data Set не нужен.

Тем не менее, знание основных принципов работы набора данных всегда полезно. Кроме этого, класс T Data Set может использоваться разработчиками в качестве основы для создания собственных компонентов. Поэтому рассмотрим основные механизмы, реализованные в наборе данных.

3. Организация производства

3.1 Комплекс технических средств необходимых для решения задачи

Для полноценной работы нашей программы Delphi необходимо:

Программная часть:

Комплект П/О Sound MAX with SPX от Analog Devices с весом дистрибутива драйверов в 54 Мбайт. Заявлена оптимизация под ММХ и SSE2 SIMD инструкции для процессоров Intel Pentium III и Pentium 4.

Драйвера:

Win 98 SE, Win ME и Win 2K.

Совместимость с игровыми 2D Sound API:

Direct Sound / DirectX 8.0;

Sound Production extensions (SPX);

EAX2.0;

A2D 1.0;

Sensaura Macro FX / Zoom FX;

IA-SIGI2DL2. Характеристики аудиокодека:

полный дуплекс вплоть до 16 бит 48 кГц;

SNR = 94дБА;

THD = 0,01%;

IMD = 90дБ;

- FR = 20 Гц - 20 кГц +/- 0.1 дБ.

MIDI:

wavetable синтезатор 4 Мбайт DLS2, 128 GM-инструментов;

1.2 Мбайт, 260 X Glite-инструментов;

1024 MAX voice программных голоса;

- SPX - Sound Production eXtention - технология аудиорендеринга нового поколения.

3.2 Инструкция пользователю по работе с программой

Задаем параметры программе в виде вершин и ребер.

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

Заключение

В соответствии с заданием была разработана программа, имеющая удобный интерфейс, и предоставляющая возможность создания и редактирования графов и ребер. Задача была реализована в интегрированной среде разработки Borland Delphi 7.0.

граф программный геометрический дискретный

Приложение. Листинг программы

Рис. 5

procedure Go Printing (Xa, Ya, Xb, Yb: integer);

type Loop Position=(P Up, P Right, P Down, P Left);

type Point=record

x,y:integer;

Loop Pos: Loop Position;

grayed: boolean;

end;

VAR

GEForm: T GEForm;

Matrix S:array of array of integer;

Points:array of Point;

ModeIs Line:boolean;

Dragging P:integer;

implementation

VAR

Point Radius:integer=10;

Arrow Length:integer=15;

Arrow Pos2: real=0.85;

Feed Back Shift:integer=3;

Arrow Size:integer=6;

Right:integer=0;

Left:integer=20;

Up:integer=20;

Down:integer=10;

Cell:integer=20;

Time Out:real=0.1/24/60/60;

Wait To: real;

{$R *.DFM}

procedure T GEForm.Clear B Click (Sender: Tobject);

begin

Set Length (Points, 1);

Set Length (Matrix S, 1);

Set Length (Matrix S[0],1);

Matrix S[0,0]:=0;

Points[0].x:=5*cell;

Points[0].y:=5*cell;

Points[0].grayed:=false;

Points[0].LoopPos:=P Down;

re Draw;

end;

procedure Draw Point(X, Y, Num: integer;

Grayed: boolean);

VAR S: string;

C, TC: integer;

begin

if GEForm. M Color On. Checked

then begin C:=Point C;

TC:=Text C;

end

else begin C:=clBlack;

TC:=C;

end;

if grayed then begin C:=clGray;

TC:=C;

end;

GEForm. Image. Canvas. Font. Color:=TC;

GEForm.Image.Canvas.Pen.Color:=C;

GEForm.Image.Canvas.Ellipse(X-PointRadius,Y-PointRadius,X+PointRadius,Y+PointRadius);

S:=IntTostr(Num);

X:=X-GEForm.Image.Canvas.TextWidth(S) div 2;

Y:=Y-GEForm.Image.Canvas.TextHeight(S) div 2;

GEForm.Image.Canvas.Brush.Style:=BSClear;

EForm.Image.Canvas.TextOut(X,Y,S);

GEForm.Image.Canvas.Brush.Style:=BSSolid;

end;

procedure DrawLoop(X,Y,Num:integer;

Pos:LoopPosition;

Grayed:boolean);

VAR X1,Y1,X2,Y2,W,H:integer;

S:string;

C,TC:integer;

begin

if GEForm.MColorOn.Checked

then begin C:=LineC;

TC:=TextC;

end

else begin C:=clBlack;

TC:=C;

end;

if grayed then begin C:=clGray;

TC:=C;

end;

GEForm.Image.Canvas.Font.Color:=TC;

GEForm.Image.Canvas.Pen.Color:=C;

S:=IntToStr(Num);

W:=GEForm.Image.Canvas.TextWidth(S);

H:=GEForm.Image.Canvas.TextHeight(S);

case Pos of

PUp:begin

X1:=X-W div 2-2;

X2:=X+W div 2+2;

Y2:=Y-PointRadius;

Y1:=Y2-H-4;

end;

PLeft:begin

X2:=X-PointRadius;

X1:=X2-W-4;

Y1:=Y-H div 2-2;

Y2:=Y1+H+4;

end;

PDown:begin

X1:=X-W div 2-2;

X2:=X+W div 2+2;

Y1:=Y+PointRadius;

Y2:=Y1+H+4;

end;

PRight:begin

X1:=X+PointRadius;

X2:=X1+W+4;

Y1:=Y-H div 2-2;

Y2:=Y1+H+4;

end;

else begin

X1:=0;

Y1:=0;

X2:=0;

Y2:=0;

end;

end;

GEForm.Image.Canvas.RoundRect(X1,Y1,X2,Y2,PointRadius,5);

if GEForm.ShowLineNums.Checked then begin

GEForm.Image.Canvas.Brush.Style:=BSClear;

GEForm.Image.Canvas.TextOut(X1+2,Y1+2,S);

GEForm.Image.Canvas.Brush.Style:=BSSolid;

end;

end;

procedure DrawArrow(X1,Y1,X2,Y2,Num:integer;

FeedBack,grayed:boolean);

VAR dx,dy,len,len1:real;

Xa,Ya,Xw,Yw,C,TC:integer;

S:string;

begin

if GEForm.MColorOn.Checked

then begin C:=LineC;

TC:=TextC;

end

else begin C:=clBlack;

TC:=C;

end;

if grayed then begin C:=clGray;

TC:=C;

end;

GEForm.Image.Canvas.Font.Color:=TC;

GEForm.Image.Canvas.Pen.Color:=C;

len:=sqrt(sqr(X1-X2)+sqr(Y1-Y2));

if len=0 then exit;

len1:=len-2*PointRadius;

dx:=(X2-X1)/len;

dy:=(Y2-Y1)/len;

X1:=X1+round(dx*PointRadius);

X2:=X2-round(dx*PointRadius);

Y1:=Y1+round(dy*PointRadius);

Y2:=Y2-round(dy*PointRadius);

if feedback then begin

X1:=X1+round(dy*FeedBackShift);

X2:=X2+round(dy*FeedBackShift);

Y1:=Y1-round(dx*FeedBackShift);

Y2:=Y2-round(dx*FeedBackShift);

end;

GEForm.Image.Canvas.MoveTo(X1,Y1);

GEForm.Image.Canvas.LineTo(X2,Y2);

Xa:=X1+round(dx*ArrowPos2*len1);

Ya:=Y1+round(dy*ArrowPos2*len1);

Xw:=Xa+round(-dx*ArrowLength-dy*ArrowSize/2{len1*Wings});

Yw:=Ya+round(-dy*ArrowLength+dx*ArrowSize/2{len1*Wings});

GEForm.Image.Canvas.MoveTo(Xa,Ya);

GEForm.Image.Canvas.LineTo(Xw,Yw);

Xw:=Xa+round(-dx*ArrowLength+dy*ArrowSize/2{len1*Wings});

Yw:=Ya+round(-dy*ArrowLength-dx*ArrowSize/2{len1*Wings});

GEForm.Image.Canvas.MoveTo(Xa,Ya);

GEForm.Image.Canvas.LineTo(Xw,Yw);

S:=IntTostr(Num);

Xw:=GEForm.Image.Canvas.Textwidth(S);

Yw:=GEForm.Image.Canvas.Textheight(S);

Xa:=X1+round(dx*len1*ArrowPos2)-Xw div 2;

Ya:=Y1+round(dy*len1*ArrowPos2)-Yw div 2;

Xa:=Xa+4*round(dy*2*ArrowSize/5);

Ya:=Ya-4*round(dx*2*ArrowSize/5);

if GEForm.ShowLineNums.Checked then begin

GEForm.Image.Canvas.Brush.Style:=BSClear;

GEForm.Image.Canvas.TextOut(Xa,Ya,S);

GEForm.Image.Canvas.Brush.Style:=BSSolid;

end;

end;

procedure Grid;

VAR Z,Zfin,Q,Qfin:integer;

begin

Z:=Left;

Q:=Up;

Zfin:=GEForm.Image.Width-Right;

Qfin:=GEForm.Image.Height-Down;

Zfin:=Cell*(Zfin div cell);

Qfin:=Cell*(Qfin div cell);

GEForm.Image.Canvas.Pen.Color:=clLtGray;

while Z<=Zfin do begin

GEForm.Image.Canvas.MoveTo(Z,Q);

GEForm.Image.Canvas.LineTo(Z,Qfin);

inc(Z,Cell);

end;

while Q<=Qfin do begin

GEForm.Image.Canvas.MoveTo(Left,Q);

GEForm.Image.Canvas.LineTo(Zfin,Q);

inc(Q,Cell);

end;

GEForm.Image.Canvas.Pen.Color:=clBlack;

end;

procedure LinesNum;

VAR i,j,m:integer;

begin

m:=1;

for i:=0 To Length(Points)-1 do

for j:=0 To Length(Points)-1 do

if MatrixS[i,j]>0 then begin MatrixS[i,j]:=m;

inc(m);

end;

end;

procedure TGEForm.ReDraw;

VAR i,j:integer;

begin

Image.Canvas.Brush.Color:=clWhite;

Image.Canvas.FillRect(Rect(0,0,Image.Width,Image.Height));

if MGridOn.Checked then Grid;

for i:=0 To Length(Points)-1 do

DrawPoint(Points[i].x,Points[i].y,i+1,Points[i].Grayed);

if Length(Points)>1 then

for i:=0 To Length(Points)-1 do

for j:=0 To Length(Points)-1 do

If MatrixS[i,j]<>0 then

ifi<>jthen

DrawArrow(Points[i].x,Points[i].y,Points[j].x,Points[j].y,MatrixS[i,j],Matrix

S[j,i]<>0,Points[i].grayed or Points[j].grayed)

else

DrawLoop(Points[i].x,Points[i].y,MatrixS[j,i],Points[i].LoopPos,Points[i].gr

ayed);

end;

procedure TGEForm.Init(Sender:Tobject);

begin

AppName:='Graf Editor';

AppVersion:='v2.2';

Caption:=AppName+' '+AppVersion;

ModeIsLine:=false;

DraggingP:=-1;

ReDraw;

ClearBClick(Sender);

WaitTo:=Time;

end;

function PointNum(x,y:integer):integer;

VAR PN,i:integer;

begin

PN:=-1;

X:=((X+cell div 2) div cell)*cell;

Y:=((Y+cell div 2) div cell)*cell;

for i:=0 To Length(Points)-1 do

if (Points[i].x=x) and (Points[i].y=y) then PN:=i;

PointNum:=PN;

end;

procedure DeletePoint(p:integer);

VAR i,j:integer;

begin

if Length(Points)=1 then exit;

For i:=0 To Length(Points)-1 do

if i>p then Points[i-1]:=Points[i];

//-----------------------------------

For i:=0 To Length(Points)-2 do

For j:=0 To Length(Points)-2 do

begin

if (i>=p) and (j>=p) then MatrixS[j,i]:=MatrixS[j+1,i+1];

if (i<p) and (j>=p) then MatrixS[j,i]:=MatrixS[j+1,i];

if (i>=p) and (j<p) then MatrixS[j,i]:=MatrixS[j,i+1];

end;

//-------------------------------------

SetLength(Points,Length(Points)-1);

SetLength(MatrixS,Length(Points));

for i:=0 To Length(Points)-2 do

SetLength(MatrixS[i],Length(Points));

LinesNum;

end;

procedure AddPoint(X,Y:integer);

VAR i,j:integer;

begin

X:=((X+cell div 2) div cell)*cell;

Y:=((Y+cell div 2) div cell)*cell;

i:=PointNum(x,y);

if i<>-1 then begin

DeletePoint(i);

GEForm.reDraw;

exit;

end;

i:=Length(Points);

inc(i);

SetLength(Points,i);

Points[i-1].x:=x;

Points[i-1].y:=y;

Points[i-1].LoopPos:=PDown;

Points[i-1].grayed:=false;

SetLength(MatrixS,i);

for j:=0 To i-1 do

SetLength(MatrixS[j],i);

for j:=0 To i-1 do begin

MatrixS[i-1,j]:=0;

MatrixS[j,i-1]:=0;

end;

GEForm.ReDraw;

end;

procedure LoopMove(N:integer);

begin

If Points[N].LoopPos=PLeft then Points[N].LoopPos:=PUp else inc(Points[N].LoopPos);

GEForm.ReDraw;

end;

procedure TGEForm.LoopPosBClick(Sender:Tobject);

VAR PN:integer;

begin

PN:=StrToIntDef(PointNumer.Text,0)-1;

if (PN<>-1) and (PN<Length(Points)) then LoopMove(PN);

end;

procedure TGEForm.ArrowPosUDDownClick(Sender:Tobject);

begin

if ArrowPos2>0.15 then ArrowPos2:=ArrowPos2-0.05;

ReDraw;

end;

procedure TGEForm.ArrowPosUDUpClick(Sender:Tobject);

begin

if ArrowPos2<0.95 then ArrowPos2:=ArrowPos2+0.05;

ReDraw;

end;

procedure TGEForm.ArrowLenUDDownClick(Sender:Tobject);

begin

if ArrowLength>5 then dec(ArrowLength,1);

ReDraw;

end;

procedure TGEForm.ArrowLenUDUpClick(Sender:Tobject);

begin

inc(ArrowLength,1);

ReDraw;

end;

procedure TGEForm.ArrowWingUDDownClick(Sender:Tobject);

begin

if ArrowSize>5 then dec(ArrowSize,1);

ReDraw;

end;

procedure TGEForm.ArrowWingUDUpClick(Sender:Tobject);

begin

inc(ArrowSize,1);

ReDraw;

end;

procedure TGEForm.ImageMouseUp(Sender:Tobject;

Button:TMouseButton;

Shift:TShiftState;

X, Y:integer);

VAR DrTo:integer;

begin

if Time<WaitTo then exit;

DrTo:=PointNum(X,Y);

if Button=mbMiddle then

if DrTo=-1 then ModeIsLine:=not ModeIsLine

else LoopMove(DrTo);

if (Button=mbRight) and (DrTo<>-1) then DeletePoint(DrTo);

if (Button=mbLeft) and (DraggingP=-1)

and (DrTo=-1) then AddPoint(x,y);

if (Button=mbLeft) and (DraggingP>=0) then

if (DrTo=-1) then begin

X:=((X+cell div 2) div cell)*cell;

Y:=((Y+cell div 2) div cell)*cell;

Points[DraggingP].x:=x;

Points[DraggingP].y:=y;

end else begin

if MatrixS[DraggingP,DrTo]=0 then

MatrixS[DraggingP,DrTo]:=1 else MatrixS[DraggingP,DrTo]:=0;

if DraggingP=DrTo then PointNumer.Text:=IntTostr(DrTo+1);

LinesNum;

end;

ReDraw;

DraggingP:=-1;

end;

procedure TGEForm.TryStartDrag(Sender:Tobject;

Button:TMouseButton;

Shift:TShiftState;

X, Y:integer);

begin

if Time<WaitTo then exit;

if (Button=mbLeft) then begin

DraggingP:=PointNum(X,Y);

end;

end;

LinesNum;

end;

procedure AddPoint(X,Y:integer);

VAR i,j:integer;

begin

X:=((X+cell div 2) div cell)*cell;

Y:=((Y+cell div 2) div cell)*cell;

i:=PointNum(x,y);

if i<>-1 then begin

DeletePoint(i);

GEForm.reDraw;

exit;

end;

i:=Length(Points);

inc(i);

SetLength(Points,i);

Points[i-1].x:=x;

Points[i-1].y:=y;

Points[i-1].LoopPos:=PDown;

Points[i-1].grayed:=false;

SetLength(MatrixS,i);

for j:=0 To i-1 do

SetLength(MatrixS[j],i);

for j:=0 To i-1 do begin

MatrixS[i-1,j]:=0;

MatrixS[j,i-1]:=0;

end;

GEForm.ReDraw;

end;

procedure LoopMove(N:integer);

begin

If Points[N].LoopPos=PLeft then Points[N].LoopPos:=PUp else inc(Points[N].LoopPos);

GEForm.ReDraw;

end;

procedure TGEForm.ImageMouseUp(Sender:Tobject;

Button:TMouseButton;

Shift:TShiftState;

X, Y:integer);

VAR DrTo:integer;

begin

if Time<WaitTo then exit;

DrTo:=PointNum(X,Y);

if Button=mbMiddle then

if DrTo=-1 then ModeIsLine:=not ModeIsLine

else LoopMove(DrTo);

if (Button=mbRight) and (DrTo<>-1) then DeletePoint(DrTo);

if (Button=mbLeft) and (DraggingP=-1)

and (DrTo=-1) then AddPoint(x,y);

if (Button=mbLeft) and (DraggingP>=0) then

if (DrTo=-1) then begin

X:=((X+cell div 2) div cell)*cell;

Y:=((Y+cell div 2) div cell)*cell;

Points[DraggingP].x:=x;

Points[DraggingP].y:=y;

end else begin

if MatrixS[DraggingP,DrTo]=0 then

MatrixS[DraggingP,DrTo]:=1 else MatrixS[DraggingP,DrTo]:=0;

if DraggingP=DrTo then PointNumer.Text:=IntTostr(DrTo+1);

LinesNum;

end;

ReDraw;

DraggingP:=-1;

end;

procedure TGEForm.TryStartDrag(Sender:Tobject;

Button:TMouseButton;

Shift:TShiftState;

X, Y:integer);

begin

if Time<WaitTo then exit;

if (Button=mbLeft) then begin

DraggingP:=PointNum(X,Y);

end;

end;

procedure TGEForm.LoopPosBClick(Sender:Tobject);

VAR PN:integer;

begin

PN:=StrToIntDef(PointNumer.Text,0)-1;

if (PN<>-1) and (PN<Length(Points)) then LoopMove(PN);

end;

procedure TGEForm.ArrowPosUDDownClick(Sender:Tobject);

begin

if ArrowPos2>0.15 then ArrowPos2:=ArrowPos2-0.05;

ReDraw;

end;

procedure TGEForm.ArrowPosUDUpClick(Sender:Tobject);

begin

if ArrowPos2<0.95 then ArrowPos2:=ArrowPos2+0.05;

ReDraw;

end;

procedure TGEForm.ArrowLenUDDownClick(Sender:Tobject);

begin

if ArrowLength>5 then dec(ArrowLength,1);

ReDraw;

end;

procedure TGEForm.ArrowLenUDUpClick(Sender:Tobject);

begin

inc(ArrowLength,1);

ReDraw;

end;

procedure TGEForm.ArrowWingUDDownClick(Sender:Tobject);

begin

if ArrowSize>5 then dec(ArrowSize,1);

ReDraw;

end;

procedure TGEForm.ArrowWingUDUpClick(Sender:Tobject);

begin

inc(ArrowSize,1);

ReDraw;

end;

for i:=0 To k-1 do

for j:=0 To k-1 do

if MatrixS[i,j]=0 then S:=S+'0'else S:=S+'1';

Writeln(F,S);

for i:=0 To k-1 do begin

S:=IntToStr(Points[i].x);

S:=S+':'+IntToStr(Points[i].y)+',';

case Points[i].LoopPos of

PUp:S:=S+'U';

PDown:S:=S+'D';

PLeft:S:=S+'L';

PRight:S:=S+'R';

end;

Writeln(F,S);

end;

writeln(F,IntTostr(PointRadius));

writeln(F,IntTostr(ArrowLength));

writeln(F,floatTostr(ArrowPos2));

writeln(F,IntTostr(FeedBackShift));

writeln(F,IntTostr(ArrowSize));

CloseFile(F);

except

on EInOutError do MessageDlg('Ошибка записи',mterror,[mbOk],0);

end;

WaitTo:=Time+TimeOut;

end;

procedure DoLoad(FN:string);

VAR F:TextFile;

S,S1:string;

i,j,k,l,m:integer;

begin

If Not Fileexists(FN) then exit;

AssignFile(F,FN);

try

ReSet(F);

Readln(F,S);

k:=Pos(':',S);

S1:=Copy(S,1,k-1);

l:=StrToInt(S1);

SetLength(Points,l);

SetLength(MatrixS,l);

for i:=0 To l-1 do SetLength(MatrixS[i],l);

k:=k+1;

m:=1;

for i:=0 To l-1 do

for j:=0 To l-1 do begin

if S[k]='0'then MatrixS[i,j]:=0 else

begin MatrixS[i,j]:=m;

inc(m);

end;

inc(k);

end;

for i:=0 To Length(Points)-1 do begin

ReadLn(F,S);

l:=Pos(':',S);

S1:=Copy(S,1,l-1);

Delete(S,1,l);

Points[i].x:=StrToInt(S1);

l:=Pos(',',S);

S1:=Copy(S,1,l-1);

Delete(S,1,l);

Points[i].y:=StrToInt(S1);

if S='U'then Points[i].LoopPos:=PUp;

if S='D'then Points[i].LoopPos:=PDown;

if S='L'then Points[i].LoopPos:=PLeft;

if S='R'then Points[i].LoopPos:=PRight;

Points[i].grayed:=false;

end;

readln(F,S);

PointRadius:=StrToInt(S);

readln(F,S);

ArrowLength:=StrToInt(S);

readln(F,S);

ArrowPos2:=StrToFloat(S);

readln(F,S);

FeedBackShift:=StrToInt(S);

readln(F,S);

ArrowSize:=StrToInt(S);

CloseFile(F);

except

on EInOutError do MessageDlg('Ошибка чтения',mterror,[mbOk],0);

end;

GEForm.ReDraw;

end;

procedure TGEForm.LoadClick(Sender:Tobject);

begin

if OpenDialog.execute then DoLoad(OpenDialog.FileName);

WaitTo:=Time+TimeOut;

end;

procedure TGEForm.SaveImageClick(Sender:Tobject);

VAR G:boolean;

begin

if not SaveImageD.execute then exit;

G:=MGridOn.Checked;

if G=true then begin MGridOn.Checked:=false;

ReDraw;

end;

Image.Picture.SaveToFile(SaveImageD.FileName);

if G=true then begin MGridOn.Checked:=G;

ReDraw;

end;

WaitTo:=Time+TimeOut;

end;

procedure GoPrinting(Xa,Ya,Xb,Yb:integer);

VAR X,Y,X1,X2,Y1,Y2,i,Scale,Sc:integer;

Part,G:boolean;

begin

if Length(Points)<=1 then exit;

G:=GEForm.MGridOn.Checked;

if G=true then begin GEForm.MGridOn.Checked:=false;

GEForm.ReDraw;

end;

Part:=Printer.Printing;

if not Part then begin

Printer.Orientation:=poLandscape;

Printer.BeginDoc;

end;

X1:=Points[0].x;

X2:=X1;

Y1:=Points[0].y;

Y2:=Y1;

For i:=1 To Length(Points)-1 do begin

if Points[i].x>X2 then X2:=Points[i].x;

if Points[i].x<X1 then X1:=Points[i].x;

if Points[i].y>y2 then y2:=Points[i].y;

if Points[i].y<y1 then y1:=Points[i].y;

end;

X1:=X1-3*PointRadius;

X2:=X2+3*PointRadius;

Y1:=Y1-4*PointRadius;

Y2:=Y2+4*PointRadius;

if X1<0 then X1:=0;

if Y1<0 then Y1:=0;

if X2>GEForm.Image.Width then X2:=GEForm.Image.Width;

if Y2>GEForm.Image.Height then Y2:=GEForm.Image.Height;

if Xb+Xa+Ya+Yb=0 then begin

Xa:=0;

Ya:=0;

Xb:=Printer.PageWidth-1;

Yb:=Printer.PageHeight-1;

end;

Scale:=(Xb-Xa) div ((X2-X1));

Sc:=(Yb-Ya) div ((Y2-Y1));

if Sc<Scale then Scale:=Sc;

if (Xb+Xa+Ya+Yb=0) and (Scale>10) then Scale:=5;

if Scale<1 then Scale:=1;

Xa:=Xa+((Xb-Xa)-(X2-X1)*Scale) div 2;

Ya:=Ya+((Yb-Ya)-(Y2-Y1)*Scale) div 2;

For X:=X1 To X2 do

For Y:=Y1 To Y2 do begin

Printer.Canvas.Brush.Color:=GEForm.Image.Canvas.Pixels[x,y];

Printer.Canvas.FillRect(Rect(Xa+(X-X1)*Scale,Ya+(Y-Y1)*Scale,Xa+(X+1-X1)*Scale+1,Ya+(Y+1-Y1)*Scale+1));

end;

if G=true then begin GEForm.MGridOn.Checked:=G;

GEForm.ReDraw;

end;

if not Part then Printer.EndDoc;

end;

procedure TGEForm.Print(Sender:Tobject);

begin

if Printer.Printers.Count=0 then exit;

GoPrinting(0,0,0,0);

end;

procedure TGEForm.SaveMatrixClick(Sender:Tobject);

VAR S:string;

F:TextFile;

i,j,k:integer;

begin

k:=Length(Points);

if k<1 then exit;

if not SaveAJMd.execute then exit;

AssignFile(F,SaveAJMd.FileName);

try

Rewrite(F);

For i:=0 To k-1 do begin

S:=IntToStr(MatrixS[i,0]);

For j:=1 To k-1 do

S:=S+','+IntToStr(MatrixS[i,j]);

Writeln(F,S);

end;

closeFile(F);

except

on EInOutError do MessageDlg('Ошибка записи',mterror,[mbOk],0);

end;

WaitTo:=Time+TimeOut;

end;

procedure TGEForm.MasonTask(FN:string;

Sm:TwoDiMint;

InSys:array of boolean;

X0,Y0:integer);

VAR i,j,l:integer;

begin

Show;

MGridOn.Checked:=false;

MColorOn.Checked:=false;

ShowLineNums.Checked:=true;

DoLoad(FN);

l:=Length(Sm);

if Length(Points)<>l then exit;

SetLength(MatrixS,l);

for i:=0 To l-1 do SetLength(MatrixS[i],l);

for i:=0 To l-1 do

for j:=0 To l-1 do

MatrixS[i,j]:=Sm[i,j];

for i:=0 To l-1 do

Points[i].grayed:=not InSys[i];

GEForm.reDraw;

GoPrinting(X0,Y0,Printer.PageWidth div 2-10,Printer.PageHeight div 2-10);

Close;

end;

procedure TGEForm.CopyBClick(Sender:Tobject);

begin

Clipboard.Assign(Image.Picture);

end;

procedure TGEForm.SelPntColorClick(Sender:Tobject);

begin

ColorDialog.Color:=PointC;

if not ColorDialog.Execute then exit;

PointC:=ColorDialog.color;

ReDraw;

end;

procedure TGEForm.SelLineColorClick(Sender:Tobject);

begin

ColorDialog.Color:=LineC;

if not ColorDialog.Execute then exit;

LineC:=ColorDialog.color;

ReDraw;

end;

procedure TGEForm.SelNumColorClick(Sender:Tobject);

begin

ColorDialog.Color:=TextC;

if not ColorDialog.Execute then exit;

TextC:=ColorDialog.color;

ReDraw;

end;

procedure TGEForm.LoadInits(Sender:Tobject);

VAR F:File of integer;

S:string;

begin

S:=ProgFiles+'ini';

if not Fileexists(S) then exit;

assignFile(F,S);

try

ReSet(F);

Read(F,PointC,LineC,TextC);

closeFile(F);

finally

end;

end;

procedure TGEForm.SaveInits(Sender:Tobject;

VAR Action:TCloseAction);

VAR F:File of integer;

S:string;

begin

S:=ProgFiles+'ini';

assignFile(F,S);

try

Rewrite(F);

Write(F,PointC,LineC,TextC);

closeFile(F);

except

on EInOutError do MessageDlg('Ошибка записи',mterror,[mbOk],0);

end;

end;

procedure TGEForm.N7Click(Sender:Tobject);

begin

close;

end;

procedure TGEForm.PointNumerKeyPress(Sender:Tobject;

VAR Key:Char);

VAR Ok:boolean;

begin

Ok:=(Key>='0') and (Key<='9');

ok:=ok or (Key=#8);

if not Ok then Key:=#0;

end;

end.

Размещено на Allbest.ru