Мои Конспекты
Главная | Обратная связь

...

Автомобили
Астрономия
Биология
География
Дом и сад
Другие языки
Другое
Информатика
История
Культура
Литература
Логика
Математика
Медицина
Металлургия
Механика
Образование
Охрана труда
Педагогика
Политика
Право
Психология
Религия
Риторика
Социология
Спорт
Строительство
Технология
Туризм
Физика
Философия
Финансы
Химия
Черчение
Экология
Экономика
Электроника

Руководство пользователю





Помощь в ✍️ написании работы
Поможем с курсовой, контрольной, дипломной, рефератом, отчетом по практике, научно-исследовательской и любой другой работой

 

Разрабатываемая программа предназначена для нахождения раскраски заданного неориентированного графа ограниченным числом цветов с использованием алгоритма последовательного перебора.

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

К выходным данным относятся вариант раскраски графа заданным числом цветов, хроматическое число графа, сообщения о невозможности нахождения раскраски.

Максимальное число вершин графа в данной версии программы ограничивается значением 30, число ребер произвольно.

В программе используется следующий алгоритм раскраски графов.

Первая вершина окрашивается в цвет 1; затем список вершин просматривается сверху вниз (по невозрастанию степеней) и в цвет 1 окрашивается всякая вершина, которая не смежна с другой, уже окрашенной в этот цвет. Потом возвращаемся к первой в списке неокрашенной вершине, окрашиваем ее в цвет 2 и снова просматриваем список вершин сверху вниз, окрашивая в цвет 2 любую неокрашенную вершину, которая не соединена ребром с другой, уже окрашенной в цвет 2 вершиной. Аналогично действуем с цветами 3, 4 и т.д., пока не будут окрашены все вершины. Число использованных цветов будет тогда приближенным значением хроматического числа графа.

Управление программой реализуется через меню и клавиши-акселераторы. Ряд функций (добавление / удаление вершины, добавление / удаление ребра) реализуется с помощью мыши.

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

Пункт Редактирование включает действия, обеспечивающие построение графа. Подпункт Добавить вершину позволяет ввести в граф новую вершину с проверкой ограничения на максимальное число вершин. Номер новой вершине присваивается автоматически. Размещение вершин в области построения выполняется в случайных позициях с исключением наложения вершин друг на друга. Добавить вершину можно непосредственно мышью, щелкнув левой кнопкой на пустом месте области построения. Подпункт Удалить вершину служит для удаления выделенной вершины из текущего графа. Выделение вершины выполняется щелчком левой кнопки мыши по ее изображению. Оставшиеся вершины автоматически перенумеровываются. Подпункт Добавить ребро обеспечивает включение в граф нового ребра между двумя выделенными вершинами. Выделение вершин выполняется так же как при удалении вершины. Добавление ребра также можно выполнить путем ввода единичного значения в соответствующую клетку матрицы смежности. Подпункт Удалить ребро предназначен для удаления из графа выделенного ребра. Выделение ребер выполняется щелчком на них левой кнопки мыши. Также ребро можно удалить путем записи нулевого значения в соответствующую клетку матрицы смежности. Выполнение каждого из названных подпунктов приводит к изменению размера или содержимого матрицы смежности. Подпункт Отмена позволяет отменить последнее действие по редактированию графа. Подпункт Восстановление обеспечивает противоположное действие. Отменить и восстановить можно только удаление вершины или ребра.


ПРИЛОЖЕНИЕ: Листинг программы

 

program Coloring;

 

uses

Forms,

uMain in 'uMain.pas' {fmMain},

uInputk in 'uInputk.pas' {fmInputk},

uColoring in 'uColoring.pas',

uFiling in 'uFiling.pas',

uData in 'uData.pas',

uHelp in 'uHelp.pas' {fmHelp};

 

{$R *.res}

 

begin

Application.Initialize;

Application.CreateForm(TfmMain, fmMain);

Application.CreateForm(TfmInputk, fmInputk);

Application.CreateForm(TfmHelp, fmHelp);

Application.Run;

end.

 

 

unit uMain;

 

interface

 

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, Menus, ExtCtrls, StdCtrls, ComCtrls, Grids, Buttons, uData;

 

type

TfmMain = class(TForm)

MainMenu: TMainMenu;

OpenDialog: TOpenDialog;

SaveDialog: TSaveDialog;

iFile: TMenuItem;

iFNew: TMenuItem;

iFOpen: TMenuItem;

iFSave: TMenuItem;

iFSaveAs: TMenuItem;

iFBreak: TMenuItem;

iFExit: TMenuItem;

iEdit: TMenuItem;

iEUndo: TMenuItem;

iERedo: TMenuItem;

iEBreak: TMenuItem;

iEAddV: TMenuItem;

iEDelV: TMenuItem;

iEAddE: TMenuItem;

iEDelE: TMenuItem;

iHelp: TMenuItem;

iHHelp: TMenuItem;

iHAbout: TMenuItem;

stGraph: TStaticText;

StatusBar: TStatusBar;

stMatrix: TStaticText;

sgMatrix: TStringGrid;

btnNew: TBitBtn;

btnColoring: TBitBtn;

btnExit: TBitBtn;

procedure iFOpenClick(Sender: TObject);

procedure iFSaveClick(Sender: TObject);

procedure btnColoringClick(Sender: TObject);

procedure FormActivate(Sender: TObject);

procedure btnNewClick(Sender: TObject);

procedure iFNewClick(Sender: TObject);

procedure iFSaveAsClick(Sender: TObject);

procedure iFExitClick(Sender: TObject);

procedure btnExitClick(Sender: TObject);

procedure iEAddVClick(Sender: TObject);

procedure iEDelVClick(Sender: TObject);

procedure iEAddEClick(Sender: TObject);

procedure iEDelEClick(Sender: TObject);

procedure iEUndoClick(Sender: TObject);

procedure iERedoClick(Sender: TObject);

procedure iHHelpClick(Sender: TObject);

procedure iHAboutClick(Sender: TObject);

procedure FormDeactivate(Sender: TObject);

procedure sgMatrixSelectCell(Sender: TObject; ACol, ARow: Integer;

var CanSelect: Boolean);

procedure FormPaint(Sender: TObject);

procedure FormMouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure FormMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,

Y: Integer);

procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);

private

PaintAreaWidth: Integer; // Размеры области рисования

PaintAreaHeight: Integer;

PaintAreaXMin,PaintAreaYMin: Integer; // Положение области рисования

MouseIsHeld: Boolean;

MouseHeldVNo: Byte;

RepaintOldEdge: Boolean;

DrawnEdge: record src,dst: TPoint end;

// Приведение вида формы к исходному состоянию

procedure InitForm(Repaint: Boolean = True);

// Удаление выбранной вершины

procedure RemoveVertex(

VNo: Cardinal; var VCount: byte; var RemVrx: TVertices);

// Построение матрицы смежности

procedure FillAdMatrix(A: TAdMatrix);

// Перерисовка вершины на форме

procedure RepaintVertex(x,y: Integer; ForceUpdate: Boolean = true );

// Перерисовка ребра на форме

procedure RepaintEdge(x1,y1,x2,y2: Integer);

// Перерисовка всех вершин на форме

procedure RepaintAllVertices;

// Запрос на сохранение графа в файле

function SaveRequest: Boolean;

// Инициализация структуры данных об отмененном действии

procedure InitUndo;

// Заполнение структуры данных для отмены удаления вершины

procedure FillUndoDelVrx(DelVNo: Cardinal);

// Отображение пути к файлу с графом в заголовке

procedure PrintGraphPath;

public

end;

 

var

fmMain: TfmMain;

 

implementation

 

{$R *.dfm}

 

uses Math, uColoring, uInputk, uFiling, uHelp;

 

type

TUndoItem = record

VNo: Byte; // Номер вершины

VPoint: TPoint; // Координаты центра вершины

end;

 

const

VRadius = 10; // Радиус окружности вершины

 

var AdMatrix: TAdMatrix; // Матрица смежности вершин текущего графа

VCount: Byte; // Число вершин текущего графа

VColor: TColoring; // Текущая раскраска вершин

VCenter: array of TPoint; // Массив координат центров вершин

UndoItem: array of TUndoItem; // Информация об отмененной операции

k: Byte; // Требуемое число цветов

GraphChanged: Boolean; // Признак измененного и не сохраненного графа

 

// ------------------------ ОБРАБОТЧИКИ МЕНЮ -----------------------------

 

// Подменю ФАЙЛ

 

// Выбор пункта меню для создания нового графа

procedure TfmMain.iFNewClick(Sender: TObject);

begin

btnNewClick(Sender)

end;

 

// Запрос на сохранение графа в файле

function TfmMain.SaveRequest: Boolean;

begin

result:=False;

if GraphChanged then

begin

if MessageDlg('Текущий граф был изменен. Сохранить?',

mtWarning, [mbYes, mbNo], 0) = mrYes then

begin

StatusBar.SimpleText:='Сохранение графа...';

iFSave.Click;

result:=True;

StatusBar.SimpleText:='Готово';

end;

end;

end;

 

// Нажатие кнопки для создания нового графа

procedure TfmMain.btnNewClick(Sender: TObject);

begin

if VCount > 0 then SaveRequest;

InitForm;

InitUndo;

MainMenu.Items[0].Items[0].Enabled:=False; // Новый

btnNew.Enabled:=False;

btnColoring.Enabled:=False;

GraphChanged:=False;

SaveDialog.FileName:='';

OpenDialog.FileName:='';

MainMenu.Items[0].Items[2].Enabled:=False; // Сохранить

MainMenu.Items[0].Items[3].Enabled:=False; // Сохранить как

MainMenu.Items[1].Items[3].Enabled:=True; // Добавить вершину

MainMenu.Items[1].Items[4].Enabled:=False; // Удалить вершину

end;

 

// Выбор пункта меню для открытия файла

procedure TfmMain.iFOpenClick(Sender: TObject);

var i,j,l: Byte;

Overlap: Boolean;

x,y: Integer;

begin

if VCount > 0 then SaveRequest;

if OpenDialog.Execute then

begin

InitUndo;

if not DoReadFile(OpenDialog.FileName,VCount,AdMatrix) then

MessageDlg('Ошибка при открытии или чтении файла!', mtError, [mbOk], 0)

else

begin

// Очистка и переформат таблицы sgMatrix

sgMatrix.Visible:=True;

for i:=0 to sgMatrix.RowCount - 1 do sgMatrix.Rows[i].Clear;

sgMatrix.RowCount:=VCount+1;

sgMatrix.ColCount:=VCount+1;

sgMatrix.FixedRows:=1;

sgMatrix.FixedCols:=1;

for i:=1 to sgMatrix.RowCount - 1 do sgMatrix.Cells[0,i]:=IntToStr(i);

for j:=1 to sgMatrix.ColCount - 1 do sgMatrix.Cells[j,0]:=IntToStr(j);

// Отображение матрицы смежности на sgMatrix

for i:=1 to VCount do

for j:=1 to VCount do

begin

if AdMatrix[i-1,j-1] > 0 then sgMatrix.Cells[j,i]:='1'

else sgMatrix.Cells[j,i]:='';

end;

// Задание координат центров вершин графа случайным образом

SetLength(VCenter,VCount);

l:=0;

repeat

repeat

Overlap:=False;

x:=round(RandG(PaintAreaWidth div 2, PaintAreaWidth div 6));

y:=round(RandG(PaintAreaHeight div 2, PaintAreaHeight div 6));

// Проверка выхода координат за пределы области построения

if (x < VRadius+PaintAreaXMin) or (y < VRadius+PaintAreaYMin) or

(x > PaintAreaWidth - (VRadius + 5)) or

(y > PaintAreaHeight - (VRadius + 5)) then

begin

Overlap:=True; // За пределами - нужны новые координаты

continue

end;

if l = 0 then continue;

for i:=0 to l - 1 do // Проверка наложения на предыдущие вершины

if (abs(VCenter[i].X - x) <= VRadius + 3) and

(abs(VCenter[i].Y - y) <= VRadius + 3) then

begin

Overlap:=True; // Накладываются - нужны новые координаты

Break

end;

until not Overlap;

VCenter[l].X:=x; // Задание координат

VCenter[l].Y:=y;

inc(l);

until l = VCount;

// Обнуление цветов

SetLength(VColor,VCount);

for i:=0 to VCount - 1 do VColor[i]:=-1;

SaveDialog.FileName:=OpenDialog.FileName;

PrintGraphPath;

MainMenu.Items[0].Items[0].Enabled:=True; // Новый

btnNew.Enabled:=True;

btnColoring.Enabled:=True;

GraphChanged:=False;

MainMenu.Items[0].Items[2].Enabled:=False; // Сохранить

MainMenu.Items[0].Items[3].Enabled:=True; // Сохранить как

MainMenu.Items[1].Items[3].Enabled:=True; // Добавить вершину

MainMenu.Items[1].Items[4].Enabled:=True; // Удалить вершину

self.repaint;

end;

end;

end;

 

// Выбор пункта меню для сохранения файла

procedure TfmMain.iFSaveClick(Sender: TObject);

begin

if (SaveDialog.FileName <> '') or SaveDialog.Execute then

begin

InitUndo;

FillAdMatrix(AdMatrix);

if not DoSaveFile(SaveDialog.FileName,AdMatrix) then

MessageDlg('Ошибка при сохранении файла!', mtError, [mbOk], 0)

else

begin

GraphChanged:=False;

MainMenu.Items[0].Items[2].Enabled:=False; // Сохранить

end;

end;

end;

 

// Выбор пункта меню для сохранения графа в другом файле

procedure TfmMain.iFSaveAsClick(Sender: TObject);

begin

if SaveDialog.Execute then

begin

InitUndo;

FillAdMatrix(AdMatrix);

if not DoSaveFile(SaveDialog.FileName,AdMatrix) then

MessageDlg('Ошибка при сохранении файла!', mtError, [mbOk], 0)

else

begin

PrintGraphPath;

GraphChanged:=False;

MainMenu.Items[0].Items[2].Enabled:=False; // Сохранить

end;

end;

end;

 

// Отображение пути к файлу с графом в заголовке

procedure TfmMain.PrintGraphPath;

var Path: string;

PathWidth,HeaderWidth: Integer;

i: Word;

begin

Path:=''; i:=Length(SaveDialog.FileName);

self.Font:=stGraph.Font;

PathWidth:=self.Canvas.TextWidth(Path);

HeaderWidth:=self.Canvas.TextWidth('Исходный граф +++: ');

while PathWidth < PaintAreaWidth - HeaderWidth do

begin // Отсечение начальных символов полного имени файла

Path:=' ' + Path;

Path[1]:=SaveDialog.FileName[i];

PathWidth:=self.Canvas.TextWidth(Path);

dec(i);

if i = 0 then Break;

end;

if i > 0 then stGraph.Caption:='Исходный граф: ...' + Path

else stGraph.Caption:='Исходный граф: ' + Path;

end;

 

// Выбор пункта меню для выхода из программы

procedure TfmMain.iFExitClick(Sender: TObject);

begin

btnExitClick(Sender)

end;

 

// Нажатие кнопки выхода из программы

procedure TfmMain.btnExitClick(Sender: TObject);

begin

if VCount > 0 then SaveRequest;

Application.Terminate;

end;

 

// Подменю РЕДАКТИРОВАНИЕ

 

// Выбор пункта меню для добавления вершины

procedure TfmMain.iEAddVClick(Sender: TObject);

var x,y: Integer;

i: Byte;

Overlap,Colored: bool;

begin

if VCount >= MaxVCount then

begin

MessageDlg('Число вершин графа не должно превышать ' +

IntToStr(MaxVCount) + '!', mtWarning, [mbOk], 0);

Exit

end; // Добавление вершины

InitUndo;

inc(VCount);

SetLength(VCenter,VCount);

SetLength(VColor,VCount);

SetLength(AdMatrix,VCount,VCount);

Colored:=ResetColoring(VCount,VColor); // Сброс цветов

sgMatrix.Visible:=True; // Изменение матрицы смежности

sgMatrix.RowCount:=VCount+1;

sgMatrix.Rows[VCount].Clear;

sgMatrix.ColCount:=VCount+1;

sgMatrix.Cols[VCount].Clear;

sgMatrix.FixedCols:=1;

sgMatrix.FixedRows:=1;

sgMatrix.Cells[VCount,0]:=IntToStr(VCount);

sgMatrix.Cells[0,VCount]:=IntToStr(VCount);

repeat // Определение координат новой вершины

Overlap:=False;

x:=round(RandG(PaintAreaWidth div 2, PaintAreaWidth div 6));

y:=round(RandG(PaintAreaHeight div 2, PaintAreaHeight div 6));

// Проверка выхода координат за пределы области построения

if (x < VRadius + PaintAreaXMin) or (y < VRadius + PaintAreaYMin) or

(x > PaintAreaWidth - (VRadius + 5)) or

(y > PaintAreaHeight - (VRadius + 5)) then

begin

Overlap:=True; // За пределами - нужны новые координаты

continue

end;

for i:=0 to VCount-2 do // Проверка наложения вершин

if (abs(VCenter[i].X - x) <= VRadius + 3) and

(abs(VCenter[i].Y - y) <= VRadius + 3) then

begin

Overlap:=True; // Накладываются - нужны новые координаты

Break

end;

until not Overlap;

VCenter[VCount-1].X:=x; // Задание координат

VCenter[VCount-1].Y:=y;

if Colored then RepaintAllVertices // Перерисовка вершин

else RepaintVertex(x,y);

MainMenu.Items[0].Items[0].Enabled:=True; // Новый

btnNew.Enabled:=True;

btnColoring.Enabled:=True;

MainMenu.Items[0].Items[2].Enabled:=True; // Сохранить

MainMenu.Items[1].Items[4].Enabled:=True; // Удалить вершину

GraphChanged:=True; // Граф следует сохранить

end;

 

// Выбор пункта меню для удаления вершины

procedure TfmMain.iEDelVClick(Sender: TObject);

var i,j,VNo: Byte;

x,y: Integer;

RemVrx: TVertices;

begin

fmInputk.Caption:='Выбор вершины для удаления';

fmInputk.StaticText.Caption:='Выберите удаляемую вершину из списка:';

fmInputk.btnSet.Caption:='Удалить';

fmInputk.ComboBox.Items.Clear;

for i:=1 to VCount do

fmInputk.ComboBox.Items.Add(IntToStr(i));

fmInputk.Tag:=VCount;

if fmInputk.ShowModal = mrOk then

begin

VNo:=StrToInt(fmInputk.ComboBox.Text);

x:=VCenter[VNo-1].X; // Удаление вершины

y:=VCenter[VNo-1].Y;

ResetColoring(VCount,VColor); // Сброс цветов

FillUndoDelVrx(VNo); // Сохранение информации для отмены удаления

MainMenu.Items[1].Items[0].Enabled:=True; // Undo

MainMenu.Items[1].Items[1].Enabled:=False; // Redo

RemoveVertex(VNo,VCount,RemVrx);

if RemVrx <> Nil then

for j:=0 to High(RemVrx) do // Перерисовка удаленных ребер

RepaintEdge(x,y,RemVrx[j].X,RemVrx[j].Y);

RepaintVertex(x,y); // Перерисовка удаленной вершины

//if RemVrx <> Nil then

RepaintAllVertices; // Перерисовка вершин после перенумерации

RemVrx:=Nil;

if VCount = 0 then

begin // Все вершины были удалены

MainMenu.Items[0].Items[0].Enabled:=False; // Новый

btnNew.Enabled:=False;

btnColoring.Enabled:=False;

MainMenu.Items[0].Items[2].Enabled:=False; // Сохранить

MainMenu.Items[0].Items[3].Enabled:=False; // Сохранить как

MainMenu.Items[1].Items[4].Enabled:=False; // Удалить вершину

end

else

begin

GraphChanged:=True; // Граф надо сохранить

MainMenu.Items[0].Items[2].Enabled:=True; // Сохранить

end;

end;

end;

 

// Выбор пункта меню для добавления ребра

procedure TfmMain.iEAddEClick(Sender: TObject);

begin

// Резерв

end;

 

// Выбор пункта меню для удаления ребра

procedure TfmMain.iEDelEClick(Sender: TObject);

begin

// Резерв

end;

 

// Выбор пункта меню для отмены последнего действия

procedure TfmMain.iEUndoClick(Sender: TObject);

var i,j: Byte;

begin

MainMenu.Items[1].Items[0].Enabled:=False; // Undo

MainMenu.Items[1].Items[1].Enabled:=True; // Redo

if UndoItem[0].VPoint.X = -1 then

begin // Отмена удаления ребра

sgMatrix.Cells[UndoItem[0].VNo,UndoItem[1].VNo]:='1';

sgMatrix.Cells[UndoItem[1].VNo,UndoItem[0].VNo]:='1';

sgMatrix.Update; // Прорисовка восстановленного ребра

RepaintEdge(VCenter[UndoItem[0].VNo-1].X,VCenter[UndoItem[0].VNo-1].Y,

VCenter[UndoItem[1].VNo-1].X,VCenter[UndoItem[1].VNo-1].Y);

end

else

begin // Отмена удаления вершины вместе со смежными ребрами

inc(VCount);

SetLength(VCenter,VCount); // Восстановление массива координат вершин

if VCount > 1 then

for i:=VCount - 1 downto UndoItem[0].VNo do VCenter[i]:=VCenter[i-1];

VCenter[UndoItem[0].VNo-1]:=UndoItem[0].VPoint;

SetLength(AdMatrix,VCount,VCount); // Изменение матрицы смежности

if VCount > 1 then

begin

for j:=VCount - 1 downto UndoItem[0].VNo do // Вставка столбца

for i:=0 to VCount - 1 do

AdMatrix[i,j]:=AdMatrix[i,j-1];

for i:=0 to VCount - 1 do AdMatrix[i,UndoItem[0].VNo-1]:=0;

for i:=VCount - 1 downto UndoItem[0].VNo do // Вставка строки

for j:=0 to VCount - 1 do

AdMatrix[i,j]:=AdMatrix[i-1,j];

for j:=0 to VCount - 1 do AdMatrix[UndoItem[0].VNo-1,j]:=0;

for i:=1 to High(UndoItem) do

begin // Восстановление связей удаленной вершины

AdMatrix[UndoItem[0].VNo-1,UndoItem[i].VNo-1]:=1;

AdMatrix[UndoItem[i].VNo-1,UndoItem[0].VNo-1]:=1;

end;

end;

sgMatrix.Visible:=True; // Изменение матрицы смежности на форме

sgMatrix.RowCount:=VCount+1;

sgMatrix.ColCount:=VCount+1;

sgMatrix.FixedCols:=1;

sgMatrix.FixedRows:=1;

for i:=1 to VCount do sgMatrix.Cells[0,i]:=IntToStr(i);

for j:=1 to VCount do sgMatrix.Cells[j,0]:=IntToStr(j);

for i:=1 to VCount - 1 do

for j:=i+1 to VCount do

if AdMatrix[i-1,j-1] > 0 then

begin

sgMatrix.Cells[i,j]:='1';

sgMatrix.Cells[j,i]:='1';

end

else

begin

sgMatrix.Cells[i,j]:='';

sgMatrix.Cells[j,i]:='';

end;

SetLength(VColor,VCount);

MainMenu.Items[0].Items[0].Enabled:=True; // Новый

btnNew.Enabled:=True;

btnColoring.Enabled:=True;

sgMatrix.Update;

self.Repaint;

end;

end;

 

// Выбор пункта меню для выполнения отмененного действия

procedure TfmMain.iERedoClick(Sender: TObject);

var x,y,j: Integer;

RemVrx: TVertices;

begin

MainMenu.Items[1].Items[0].Enabled:=True; // Undo

MainMenu.Items[1].Items[1].Enabled:=False; // Redo

if UndoItem[0].VPoint.X = -1 then

begin // Повторное удаление ребра

sgMatrix.Cells[UndoItem[0].VNo,UndoItem[1].VNo]:='';

sgMatrix.Cells[UndoItem[1].VNo,UndoItem[0].VNo]:='';

sgMatrix.Update; // Прорисовка удаленного ребра

RepaintEdge(VCenter[UndoItem[0].VNo-1].X,VCenter[UndoItem[0].VNo-1].Y,

VCenter[UndoItem[1].VNo-1].X,VCenter[UndoItem[1].VNo-1].Y);

end

else

begin // Повторное удаление вершины со смежными ребрами

x:=VCenter[UndoItem[0].VNo-1].X;

y:=VCenter[UndoItem[0].VNo-1].Y;

MainMenu.Items[1].Items[0].Enabled:=True; // Undo

MainMenu.Items[1].Items[1].Enabled:=False; // Redo

RemoveVertex(UndoItem[0].VNo,VCount,RemVrx);

if RemVrx <> Nil then

for j:=0 to High(RemVrx) do // Перерисовка удаленных ребер

RepaintEdge(x,y,RemVrx[j].X,RemVrx[j].Y);

RepaintVertex(x,y); // Перерисовка удаленной вершины

if RemVrx <> Nil then

RepaintAllVertices; // Перерисовка вершин после перенумерации

RemVrx:=Nil;

if VCount = 0 then

begin // Все вершины были повторно удалены

MainMenu.Items[0].Items[0].Enabled:=False; // Новый

btnNew.Enabled:=False;

btnColoring.Enabled:=False;

MainMenu.Items[0].Items[2].Enabled:=False; // Сохранить

MainMenu.Items[0].Items[3].Enabled:=False; // Сохранить как

MainMenu.Items[1].Items[3].Enabled:=True; // Добавить вершину

MainMenu.Items[1].Items[4].Enabled:=False; // Удалить вершину

end

else

begin

GraphChanged:=True; // Граф надо сохранить

MainMenu.Items[0].Items[2].Enabled:=True; // Сохранить

end;

end;

end;

 

// Заполнение структуры данных для отмены удаления вершины

procedure TfmMain.FillUndoDelVrx(DelVNo: Cardinal);

var VDeg: Word;

i,p: Byte;

begin

VDeg:=0; // Вычисление локальной степени удаляемой вершины

for i:=1 to VCount do

if sgMatrix.Cells[i,DelVNo] <> '' then inc(VDeg);

SetLength(UndoItem,VDeg+1);

p:=0; // Заполнение структуры для отмены удаления

UndoItem[p].VNo:=DelVNo;

UndoItem[p].VPoint:=VCenter[DelVNo-1];

for i:=1 to VCount do

if sgMatrix.Cells[i,DelVNo] <> '' then

begin

inc(p);

UndoItem[p].VNo:=i; // Сохранение данных о смежной вершине

UndoItem[p].VPoint:=VCenter[i-1];

end;

end;

 

// Подменю СПРАВКА

 

// Вызов помощи

procedure TfmMain.iHHelpClick(Sender: TObject);

begin

fmHelp.Tag:=1;

self.WindowState:=wsMinimized;

fmHelp.ShowModal;

self.WindowState:=wsNormal;

end;

 

// О программе

procedure TfmMain.iHAboutClick(Sender: TObject);

begin

fmHelp.Tag:=2;

self.WindowState:=wsMinimized;

fmHelp.ShowModal;

self.WindowState:=wsNormal;

end;

 

// -------------------- ВЫЧИСЛИТЕЛЬНЫЕ ПРОЦЕДУРЫ ----------------------

 

// Запуск процесса раскраски графа

procedure TfmMain.btnColoringClick(Sender: TObject);

var ColorCount,i: Byte;

begin

StatusBar.SimpleText:='Раскраска...';

FillAdMatrix(AdMatrix);

fmInputk.Caption:='Выбор числа цветов k';

fmInputk.StaticText.Caption:='Выберите нужное число цветов из списка:';

fmInputk.btnSet.Caption:='Задать';

fmInputk.ComboBox.Items.Clear;

for i:=1 to VCount do

fmInputk.ComboBox.Items.Add(IntToStr(i));

fmInputk.Tag:=VCount;

if fmInputk.ShowModal = mrOk then

begin

InitUndo;

k:=StrToInt(fmInputk.ComboBox.Text);

// Минимальная раскраска (определение хроматического числа графа)

ColorCount:=DoMinColoring(AdMatrix,VCount,VColor);

if k < ColorCount then

MessageDlg('Раскраска вершин текущего графа ' + IntToStr(k) +

' цветом(ами) невозможна!' + #13 + 'Необходимо не менее ' +

IntToStr(ColorCount) + ' цветов.', mtWarning, [mbOk], 0)

else // Неминимальная раскраска k цветами

DoNonminColoring(VCount,VColor,ColorCount,k);

RepaintAllVertices; // Перерисовка вершин

end;

StatusBar.SimpleText:='Готово';

end;

 

// Построение матрицы смежности по содержимому sgMatrix

procedure TfmMain.FillAdMatrix(A: TAdMatrix);

var i,j: Byte;

begin

for i:=1 to sgMatrix.RowCount-1 do

for j:=1 to sgMatrix.ColCount-1 do

A[i-1,j-1]:=StrToIntDef(sgMatrix.Cells[j,i],0);

end;

 

// ---------------- ПРОЦЕДУРЫ ОТОБРАЖЕНИЯ И РЕДАКТИРОВАНИЯ -------------------

 

// Перерисовка текущего графа в области построения

procedure TfmMain.FormPaint(Sender: TObject);

var i,j: Byte;

VNo: String[3];

VNoWidth,VNoHeight: Word;

begin

Canvas.Pen.Color:=clBlack;

Canvas.Pen.Width:=1;

// Отображение границ области построения графа

Canvas.Brush.Color:=clBtnFace;

Canvas.Brush.Style:=bsSolid;

Canvas.Rectangle(PaintAreaXMin,PaintAreaYMin,

PaintAreaXMin + PaintAreaWidth,PaintAreaYMin + PaintAreaHeight);

Canvas.Pen.Color:=clBlue;

Canvas.Pen.Width:=1;

if MouseIsHeld and not RepaintOldEdge then

begin

// Прорисовка нового ребра, создаваемого перетаскиванием

Canvas.MoveTo(DrawnEdge.src.X,DrawnEdge.src.Y);

Canvas.LineTo(DrawnEdge.dst.X,DrawnEdge.dst.Y);

end;

// Прорисовка ребер графа

Canvas.Pen.Width:=2;

for i:=1 to VCount - 1 do

for j:=i+1 to VCount do

if sgMatrix.Cells[j,i] <> '' then

begin

Canvas.MoveTo(VCenter[i-1].X,VCenter[i-1].Y);

Canvas.LineTo(VCenter[j-1].X,VCenter[j-1].Y);

end;

// Прорисовка вершин графа с учетом назначенных цветов

Canvas.Pen.Color:=clBlack;

Canvas.Pen.Width:=1;

Canvas.Brush.Style:=bsSolid;

for i:=1 to VCount do

begin

Canvas.Ellipse( // Окружность i-й вершины

VCenter[i-1].X - VRadius,VCenter[i-1].Y - VRadius,

VCenter[i-1].X + VRadius,VCenter[i-1].Y + VRadius);

if VColor[i-1] <= 0 then Canvas.Brush.Color:=clWhite

else Canvas.Brush.Color:=RealColors[VColor[i-1]-1];

Canvas.FloodFill( // Закраска окружности

VCenter[i-1].X,VCenter[i-1].Y,Canvas.Pen.Color,fsBorder);

VNo:=IntToStr(i); // Вывод номера вершины

VNoWidth:=Canvas.TextWidth(VNo);

VNoHeight:=Canvas.TextHeight(VNo);

Canvas.TextOut(

VCenter[i-1].X - VNoWidth div 2,VCenter[i-1].Y - VNoHeight div 2,VNo);

end;

end;

 

// Редактирование матрицы смежности вершин графа

procedure TfmMain.sgMatrixSelectCell(

Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean);

var Colored: Boolean;

begin

CanSelect:=True;

if ACol = ARow then Exit;

InitUndo;

if sgMatrix.Cells[ACol,ARow] = '' then

begin // Добавление ребра

sgMatrix.Cells[ACol,ARow]:='1';

sgMatrix.Cells[ARow,ACol]:='1';

end

else

begin // Удаление ребра

sgMatrix.Cells[ACol,ARow]:='';

sgMatrix.Cells[ARow,ACol]:='';

UndoItem[0].VNo:=ARow; // Заполнение структуры для отмены удаления

UndoItem[1].VNo:=ACol;

UndoItem[0].VPoint.X:=-1; // Признак одного удаленного ребра

MainMenu.Items[1].Items[0].Enabled:=True; // Undo

MainMenu.Items[1].Items[1].Enabled:=False; // Redo

end;

RepaintEdge(VCenter[ARow-1].X,VCenter[ARow-1].Y,

VCenter[ACol-1].X,VCenter[ACol-1].Y);

Colored:=ResetColoring(VCount,VColor); // Сброс цветов

if Colored then RepaintAllVertices; // Перерисовка вершин

GraphChanged:=True; // Граф нужно сохранить

MainMenu.Items[0].Items[2].Enabled:=True; // Сохранить

end;

 

// Добавление или удаление вершины графа мышью

procedure TfmMain.FormMouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

var i,j: Byte;

RemVrx: TVertices;

Colored,AddVrx: Boolean;

x0,y0: Integer;

begin

if (Button = mbLeft) and (Shift = []) then

begin

if (X < VRadius + PaintAreaXMin) or (Y < VRadius + PaintAreaYMin) or

(X > PaintAreaWidth - (VRadius + 5)) or

(Y > PaintAreaHeight - (VRadius + 5)) then

begin // За пределами области построения графа

Beep;

MouseIsHeld:=false; // Левая клавиша отпущена

MouseHeldVNo:=0;

Repaint;

Exit

end;

if MouseIsHeld then AddVrx:=False else AddVrx:=True;

i:=1;

while i <= VCount do // Проверка наложения вершин

begin

if (abs(VCenter[i-1].X - X) <= VRadius) and

(abs(VCenter[i-1].Y - Y) <= VRadius) then

begin

Colored:=ResetColoring(VCount,VColor); // Сброс цветов

if MouseHeldVNo = i then

begin // Удаление вершины с номером i

MouseHeldVNo:=0;

MouseIsHeld:=false;

x0:=VCenter[i-1].X;

y0:=VCenter[i-1].Y;

FillUndoDelVrx(i); // Сохранение информации для отмены удаления

MainMenu.Items[1].Items[0].Enabled:=True; // Undo

MainMenu.Items[1].Items[1].Enabled:=False; // Redo

RemoveVertex(i,VCount,RemVrx);

if RemVrx <> Nil then

for j:=0 to High(RemVrx) do // Перерисовка удаленных ребер

RepaintEdge(x,y,RemVrx[j].X,RemVrx[j].Y);

RepaintVertex(x0,y0); // Перерисовка удаленной вершины

//if RemVrx <> Nil then

RepaintAllVertices; // Перерисовка вершин после перенумерации

RemVrx:=Nil;

if VCount = 0 then

begin

MainMenu.Items[0].Items[0].Enabled:=False; // Новый

btnNew.Enabled:=False;

btnColoring.Enabled:=False;

MainMenu.Items[0].Items[2].Enabled:=False; // Сохранить

MainMenu.Items[0].Items[3].Enabled:=False; // Сохранить как

MainMenu.Items[1].Items[4].Enabled:=False; // Удалить вершину

end

else

begin

GraphChanged:=True; // Граф нужно сохранить

MainMenu.Items[0].Items[2].Enabled:=True; // Сохранить

end;

end

else

begin // Добавление ребра между вершинами i и MouseHeldVNo

if sgMatrix.Cells[MouseHeldVNo,i] = '' then

begin

InitUndo;

sgMatrix.Cells[MouseHeldVNo,i]:='1';// Добавление ребра в матрицу

sgMatrix.Cells[i,MouseHeldVNo]:='1';

RepaintEdge(VCenter[i-1].X,VCenter[i-1].Y, // Прорисовка ребра

VCenter[MouseHeldVNo-1].X,VCenter[MouseHeldVNo-1].Y);

if Colored then RepaintAllVertices; // Перерисовка вершин

end;

MouseHeldVNo:=0;

MouseIsHeld:=false;

GraphChanged:=True; // Граф нужно сохранить

MainMenu.Items[0].Items[2].Enabled:=True; // Сохранить

end;

Exit

end;

inc(i);

end;

if VCount >= MaxVCount then

begin

MessageDlg('Число вершин графа не должно превышать ' +

IntToStr(MaxVCount) + '!', mtWarning, [mbOk], 0);

Exit

end;

if not AddVrx then

begin // Удерживалась клавиша мыши - вершину не добавляем

MouseIsHeld:=False;

MouseHeldVNo:=0;

RepaintEdge(DrawnEdge.src.X,DrawnEdge.src.Y, // Прорисовка области

DrawnEdge.dst.X,DrawnEdge.dst.Y);

Exit;

end;

InitUndo;

inc(VCount); // Добавление вершины

SetLength(VCenter,VCount);

SetLength(VColor,VCount);

SetLength(AdMatrix,VCount,VCount);

Colored:=ResetColoring(VCount,VColor); // Сброс цветов

sgMatrix.Visible:=True; // Изменение матрицы смежности

sgMatrix.RowCount:=VCount+1;

sgMatrix.Rows[VCount].Clear;

sgMatrix.ColCount:=VCount+1;

sgMatrix.Cols[VCount].Clear;

sgMatrix.FixedCols:=1;

sgMatrix.FixedRows:=1;

sgMatrix.Cells[VCount,0]:=IntToStr(VCount);

sgMatrix.Cells[0,VCount]:=IntToStr(VCount);

VCenter[VCount-1].X:=X; // Задание координат

VCenter[VCount-1].Y:=Y;

if Colored then RepaintAllVertices // Перерисовка вершин

else RepaintVertex(X,Y);

MainMenu.Items[0].Items[0].Enabled:=True; // Новый

btnNew.Enabled:=True;

btnColoring.Enabled:=True;

GraphChanged:=True; // Граф нужно сохранить

MainMenu.Items[0].Items[2].Enabled:=True; // Сохранить

MainMenu.Items[1].Items[4].Enabled:=True; // Удалить вершину

end;

end;

 

// Захват вершины левой кнопкой мыши

procedure TfmMain.FormMouseDown(Sender: TObject;

Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

var i: Byte;

begin

if (Button = mbLeft) and (Shift = [ssLeft]) then

begin

i:=1;

while i <= VCount do // Проверка нажатия на вершине

begin

if (abs(VCenter[i-1].X - X) <= VRadius) and

(abs(VCenter[i-1].Y - Y) <= VRadius) then

begin

MouseIsHeld:=true;

MouseHeldVNo:=i; // Номер выбранной вершины

Exit

end;

inc(i)

end;

end;

end;

 

// Соединение вершин перетаскиванием

procedure TfmMain.FormMouseMove(

Sender: TObject; Shift: TShiftState; X,Y: Integer);

var Rect: TRect;

begin

if MouseIsHeld then

begin

if (X < PaintAreaXMin) or (Y < PaintAreaYMin) or

(X > PaintAreaWidth) or (Y > PaintAreaHeight) then

// За пределами области построения графа

Exit;

// Очистка области, где ребро было на предыдущем шаге

Rect.Left:=min(DrawnEdge.src.X,DrawnEdge.dst.X)-3;

Rect.Right:=max(DrawnEdge.src.X,DrawnEdge.dst.X)+3;

Rect.Top:=min(DrawnEdge.src.Y,DrawnEdge.dst.Y)-3;

Rect.Bottom:=max(DrawnEdge.src.Y,DrawnEdge.dst.Y)+3;

RepaintOldEdge:=True;

InvalidateRect(Handle,@Rect,true);

Update;

DrawnEdge.src.X:=X; // Прорисовка нового ребра в следующей позиции

DrawnEdge.src.Y:=Y;

DrawnEdge.dst.X:=VCenter[MouseHeldVNo-1].X;

DrawnEdge.dst.Y:=VCenter[MouseHeldVNo-1].Y;

Rect.Left:=min(DrawnEdge.src.X,DrawnEdge.dst.X)-3;

Rect.Right:=max(DrawnEdge.src.X,DrawnEdge.dst.X)+3;

Rect.Top:=min(DrawnEdge.src.Y,DrawnEdge.dst.Y)-3;

Rect.Bottom:=max(DrawnEdge.src.Y,DrawnEdge.dst.Y)+3;

RepaintOldEdge:=False;

InvalidateRect(Handle,@Rect,true);

Update;

end;

end;

 

procedure TfmMain.RemoveVertex( // Удаление выбранной вершины

VNo: Cardinal; var VCount: byte; var RemVrx: TVertices);

var i,j,RemVCount: Byte;

begin

if VCount = 0 then Exit;

FillAdMatrix(AdMatrix); // Перезапись sgMatrix в матрицу смежности

RemVCount:=0; // Формирование массива координат центров

for i:=1 to VCount do // вершин, смежных с удаляемой

if AdMatrix[VNo-1,i-1] > 0 then

begin

inc(RemVCount);

Setlength(RemVrx,RemVCount);

RemVrx[RemVCount-1].X:=VCenter[i-1].X;

RemVrx[RemVCount-1].Y:=VCenter[i-1].Y;

end;

for i:=VNo to VCount - 1 do // Перенумерация матрицы смежности

begin // и сдвиг массива координат центров вершин

VCenter[i-1]:=VCenter[i];

sgMatrix.Cells[i,0]:=IntToStr(i);

sgMatrix.Cells[0,i]:=IntToStr(i);

end;

j:=VNo-1; // Удаление столбца VNo

while j < VCount - 1 do

begin

for i:=0 to VCount - 1 do AdMatrix[i,j]:=AdMatrix[i,j+1];

inc(j)

end;

i:=VNo-1; // Удаление строки VNo

while i < VCount - 1 do

begin

for j:=0 to VCount - 1 do AdMatrix[i,j]:=AdMatrix[i+1,j];

inc(i)

end;

dec(VCount); // Изменение размеров структур данных

SetLength(VCenter,VCount);

SetLength(VColor,VCount);

SetLength(AdMatrix,VCount,VCount);

if VCount = 0 then begin

InitForm; // Все вершины удалены

Exit

end;

sgMatrix.RowCount:=VCount+1; // Вершины еще остались

sgMatrix.ColCount:=VCount+1;

for i:=1 to VCount do // Восстановление измененной матрицы смежности

for j:=1 to VCount do

if AdMatrix[i-1,j-1]>0 then

begin

sgMatrix.Cells[i,j]:='1';

sgMatrix.Cells[j,i]:='1';

end

else

begin

sgMatrix.Cells[i,j]:='';

sgMatrix.Cells[j,i]:='';

end;

end;

 

// Перерисовка вершины на форме

procedure TfmMain.RepaintVertex(x,y: Integer; ForceUpdate: Boolean);

var Rect: TRect;

begin

Rect.Left:=x-VRadius;

Rect.Right:=x+VRadius;

Rect.Top:=y-VRadius;

Rect.Bottom:=y+VRadius;

InvalidateRect(Handle,@Rect,true);

if ForceUpdate then Update;

end;

 

// Перерисовка всех вершин на форме

procedure TfmMain.RepaintAllVertices;

var i: Byte;

begin

if VCount = 0 then Exit;

for i:=0 to VCount - 1 do

RepaintVertex(VCenter[i].X,VCenter[i].Y,false);

Update;

end;

 

// Перерисовка ребра на форме

procedure TfmMain.RepaintEdge(x1,y1,x2,y2: Integer);

var Rect: TRect;

begin

Rect.Left:=min(x1,x2)-2;

Rect.Right:=max(x1,x2)+2;

Rect.Top:=min(y1,y2)-2;

Rect.Bottom:=max(y1,y2)+2;

InvalidateRect(Handle,@Rect,true);

Update;

end;

 

// ------------------------ ИНИЦИАЛИЗАЦИЯ -----------------------------

 

// Приведение вида формы к исходному состоянию

procedure TfmMain.InitForm(Repaint: Boolean);

begin

VCount:=0;

sgMatrix.Visible:=False;

sgMatrix.RowCount:=1;

sgMatrix.ColCount:=1;

stGraph.Caption:='Исходный граф: ';

if Repaint then fmMain.Repaint;

end;

 

// Инициализация глобальных и компонентных данных модуля

procedure TfmMain.FormActivate(Sender: TObject);

begin

InitForm(False);

InitUndo;

Randomize;

PaintAreaXMin:=stGraph.Left;

PaintAreaYMin:=stGraph.Top + stGraph.Height;

PaintAreaWidth:=sgMatrix.Left - PaintAreaXMin;

PaintAreaHeight:=StatusBar.Top - PaintAreaYMin;

MouseIsHeld:=False;

MouseHeldVNo:=0;

RepaintOldEdge:=False;

GraphChanged:=False;

MainMenu.Items[0].Items[0].Enabled:=False; // Новый

MainMenu.Items[0].Items[2].Enabled:=False; // Сохранить

MainMenu.Items[0].Items[3].Enabled:=False; // Сохранить как

MainMenu.Items[1].Items[4].Enabled:=False; // Удалить вершину

btnNew.Enabled:=False;

btnColoring.Enabled:=False;

StatusBar.SimpleText:='Готово';

end;

 

// Завершающие действия

procedure TfmMain.FormDeactivate(Sender: TObject);

begin

AdMatrix:=Nil;

VCenter:=Nil;

VColor:=Nil;

UndoItem:=Nil;

end;

 

// Запрос на закрытие формы

procedure TfmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);

begin

btnExitClick(Sender);

CanClose:=True;

end;

 

// Инициализация структуры данных об отмененном действии

procedure TfmMain.InitUndo;

begin

SetLength(UndoItem,2);

UndoItem[0].VNo:=0;

UndoItem[1].VNo:=0; // Блокировка пунктов меню

MainMenu.Items[1].Items[0].Enabled:=False; // Undo

MainMenu.Items[1].Items[1].Enabled:=False; // Redo

end;

 

end.

 

 

unit uData;

 

interface

 

uses Types, Graphics;

 

const MaxVCount = 30; // Максимальное число вершин графа

 

type // Глобально используемые типы

TAdMatrix = array of array of Byte; // Матрица смежности графа

TColoring = array of ShortInt; // Вектор цветов вершин

TRealColors = array[0..MaxVCount-1] of TColor; // Системные имена цветов

TVertices = array of TPoint; // Координаты центров вершин

TGraphFile = file of Byte; // Файл графа

 

implementation

 

end.

 

 

unit uFiling;

 

interface

 

uses uData;

 

// Функция сохранения графа в файле по матрице смежности

function DoSaveFile(const FileName: string; const AdMatrix: TAdMatrix): Boolean;

 

// Функция чтения графа из файла в матрицу смежности

function DoReadFile(const FileName: string;

var VCount: Byte; var AdMatrix: TAdMatrix): Boolean;

 

implementation

 

uses Math;

 

var GraphFile: TGraphFile; // Файл для сохранения графа

 

// Функция сохранения графа в файле по матрице смежности

function DoSaveFile(const FileName: string; const AdMatrix: TAdMatrix): Boolean;

var VCount,FileSize: Word;

FileImage: array of Byte;

i,j,Bit,m,u: Byte;

begin

result:=False;

if (FileName='') or (AdMatrix=Nil) then Exit;

AssignFile(GraphFile,FileName);

try // Открытие файла на запись

Rewrite(GraphFile);

except

Exit

end;

VCount:=High(AdMatrix)+1; // Создание массива для образа файла

FileSize:=Ceil(VCount*(VCount-1)/16);

SetLength(FileImage,FileSize+1);

FileImage[0]:=VCount;

Write(GraphFile,FileImage[0]);

m:=1; u:=0; Bit:=0;

for i:=0 to VCount - 2 do

for j:=i+1 to VCount - 1 do

begin // Перезапись матрицы смежности в массив

if Bit > 0 then u:=u shl 1;

inc(Bit);

if AdMatrix[i,j] > 0 then u:=u or $1;

if Bit >= 8 then

begin

Bit:=0;

FileImage[m]:=u;

Write(GraphFile,FileImage[m]);

inc(m);

u:=0;

end;

end;

if Bit > 0 then // Дозапись последнего байта

begin

FileImage[m]:=u;

Write(GraphFile,FileImage[m]);

end;

CloseFile(GraphFile);

FileImage:=Nil;

result:=True;

end;

 

// Функция чтения графа из файла в матрицу смежности

function DoReadFile(const FileName: string;

var VCount: Byte; var AdMatrix: TAdMatrix): Boolean;

var OldVCount,FileSize: Word;

FileImage: array of Byte;

i,j,k,mask,q: Byte;

begin

result:=True;

if FileName='' then Exit;

AssignFile(GraphFile,FileName);

try // Открытие файла на чтение

Reset(GraphFile);

except

result:=False;

Exit

end;

OldVCount:=VCount;

Read(GraphFile,VCount); // Чтение числа вершин графа

if VCount > MaxVCount then begin

VCount:=OldVCount; // Некорректное число вершин

result:=False;

end

else

begin // Считывание матрицы смежности в массив

FileSize:=Ceil(VCount*(VCount-1)/16);

SetLength(FileImage,FileSize);

k:=0;

while not eof(GraphFile) do

begin

Read(GraphFile,FileImage[k]);

inc(k);

end;

if k = 0 then result:=False

else

begin

// Преобразование массива в матрицу смежности графа

SetLength(AdMatrix,VCount,VCount);

i:=0; j:=1;

for k:=0 to FileSize - 1 do

begin // Преобразование k-го элемента массива

if k = FileSize - 1 then

begin

mask:=1; // Расчет числа значащих бит последнего элемента

q:=(VCount*(VCount-1) div 2) mod 8;

mask:=mask shl (q-1);

end

else mask:=$80;

repeat // Распаковка битового образа элемента массива

if mask and FileImage[k] > 0 then

begin

AdMatrix[i,j]:=1;

AdMatrix[j,i]:=1;

end;

inc(j);

if j = VCount then

begin

inc(i);

j:=i+1;

end;

mask:=mask shr 1;

until mask = 0;

end;

end;

FileImage:=Nil;

end;

CloseFile(GraphFile);

end;

 

end.

 

 

unit uColoring;

 

interface

 

uses uData, Graphics;

 

// Раскраска графа в минимальное число цветов

function DoMinColoring(const AdMatrix: TAdMatrix;

VCount: Cardinal; VColor: TColoring): Word;

 

// Раскраска графа в NewColorCount цветов по найденной минимальной раскраске

procedure DoNonminColoring(VCount: Cardinal; VColor: TColoring;

MinColorCount, NewColorCount: Byte);

 

// Обнуление массива цветов вершин графа

function ResetColoring(VCount: Cardinal; VColor: TColoring): boolean;

 

var RealColors: TRealColors; // Фактические цвета раскраски вершин

 

implementation

 

uses uInputk;

 

var VDegree: array of ShortInt; // Массив относительных локальных степеней

VNumber: array of Byte; // Отсортированный массив номеров вершин

Uncolored: set of Byte; // Множество не раскрашенных вершин

 

// Процедура сортировки массива локальных степеней методом вставки

procedure InsertionSort(var A: array of ShortInt;

var V: array of Byte; size: SmallInt);

var i1, i2, i2sav: SmallInt;

tmpA: ShortInt;

tmpV: Byte;

begin

i2 := 1; // номер сортируемого элемента

while i2 < size do // перебор всех элементов до крайнего справа

begin

i1 := i2 - 1; // номер элемента левой части

i2sav := i2; // запоминаем начало неотсортированной части

while i1 >= 0 do // пока не дошли до левой границы

begin

if A[i1] < A[i2] then // нужна перестановка

begin

tmpA := A[i1]; // перестановка

A[i1] := A[i2];

A[i2] := tmpA;

tmpV := V[i1];

V[i1] := V[i2];

V[i2] := tmpV

end else break; // место для элемента нашли

dec(i1); // идем влево

dec(i2);

end;

i2 := i2sav + 1; // на следующий элемент

end;

end;

 

// Раскраска графа в минимальное число цветов

function DoMinColoring(const AdMatrix: TAdMatrix;

VCount: Cardinal; VColor: TColoring): Word;

var i,j: Byte; // Индексы для перебора вершин

CurColor: ShortInt; // Текущий цвет

VCur: Byte; // Номер текущей раскрашиваемой вершины

Colorable: Boolean; // Признак отсутствия вершин, которые

// можно раскрасить в цвет CurColor

label ColFound;

begin

result:=0;

SetLength(VDegree,VCount);

SetLength(VNumber,VCount);

Uncolored:=[]; // Считаем все вершины нераскрашенными

for i:=1 to VCount do

begin

include(Uncolored,i);

VColor[i-1]:=-1;

end;

CurColor:=1; // Начинаем с первого цвета

repeat // Цикл раскраски

for i:=1 to VCount do // Расчет относительных локальных степеней

begin

VNumber[i-1]:=i;

if VColor[i-1] < 0 then

begin

VDegree[i-1]:=0;

for j:=1 to VCount do

if VColor[j-1] < 0 then

VDegree[i-1]:=VDegree[i-1] + AdMatrix[i-1,j-1];

end

else VDegree[i-1]:=-1;

end;

// Сортировка относительных локальных степеней по неубыванию

InsertionSort(VDegree,VNumber,VCount);

Colorable:=True; // Поиск и раскраска очередной вершины

VCur:=1;

while VCur <= VCount do

begin

if VDegree[VCur-1] < 0 then break;

i:=1;

while i <= VCount do

begin

if VColor[i-1] = CurColor then

if AdMatrix[i-1,VNumber[VCur-1]-1] > 0 then

begin

inc(VCur);

break;

end;

inc(i);

end;

if i > VCount then goto ColFound;

end;

Colorable:=False; // Вершин для раскраски цветом CurColor больше нет

ColFound:

if Colorable then

begin // Пометка найденной вершины цветом CurColor

VColor[VNumber[VCur-1]-1]:=CurColor;

exclude(Uncolored,VNumber[VCur-1]);

result:=CurColor;

end

// В текущий цвет вершины раскрасить нельзя, берем следующий

else inc(CurColor);

until Uncolored=[];

VDegree:=Nil;

VNumber:=Nil

end;

 

// Раскраска графа в NewColorCount цветов по найденной минимальной раскраске

procedure DoNonminColoring(VCount: Cardinal; VColor: TColoring;

MinColorCount, NewColorCount: Byte);

var i,j: Byte;

begin

if MinColorCount >= NewColorCount then Exit;

for i:=1 to VCount - 1 do

for j:=i+1 to VCount do

if VColor[j-1] = VColor[i-1] then

begin

inc(MinColorCount);

VColor[j-1]:=MinColorCount;

if MinColorCount >= NewColorCount then Exit;

end;

end;

 

// Обнуление массива цветов вершин графа

function ResetColoring(VCount: Cardinal; VColor: TColoring): boolean;

var i: Byte;

begin

result:=false;

if VCount = 0 then Exit;

for i:=0 to VCount - 1 do

if VColor[i] > 0 then

begin

result:=true;

VColor[i]:=-1;

end;

end;

 

begin

// Установка цветов для раскраски вершин графа на форме

RealColors[0]:=clYellow;

RealColors[1]:=clAqua;

RealColors[2]:=clMaroon;

RealColors[3]:=clRed;

RealColors[4]:=clSkyBlue;

RealColors[5]:=clGreen;

RealColors[6]:=clPurple;

RealColors[7]:=clTeal;

RealColors[8]:=clSilver;

RealColors[9]:=clOlive;

RealColors[10]:=clNavy;

RealColors[11]:=clltGray;

RealColors[12]:=clLime;

RealColors[13]:=clFuchsia;

RealColors[14]:=clMedGray;

RealColors[15]:=clMoneyGreen;

RealColors[16]:=clBlue;

RealColors[17]:=clCream;

RealColors[18]:=clWhite;

//...

end.

 

 

unit uInputk;

 

interface

 

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, Buttons;

 

type

TfmInputk = class(TForm)

ComboBox: TComboBox;

StaticText: TStaticText;

btnSet: TBitBtn;

btnCancel: TBitBtn;

procedure btnSetClick(Sender: TObject);

procedure btnCancelClick(Sender: TObject);

procedure ComboBoxChange(Sender: TObject);

procedure FormActivate(Sender: TObject);

private

public

end;

 

var

fmInputk: TfmInputk;

 

implementation

 

{$R *.dfm}

 

procedure TfmInputk.btnSetClick(Sender: TObject); // Установить значение

begin

if ComboBox.Text = '' then ModalResult:=mrNone

else ModalResult:=mrOk;

end;

 

procedure TfmInputk.btnCancelClick(Sender: TObject); // Игнорировать ввод

begin

ModalResult:=mrCancel;

end;

 

procedure TfmInputk.ComboBoxChange(Sender: TObject); // Проверка по числу

// вершин

var i: Integer;

begin

i:=StrToIntDef(ComboBox.Text,0);

if (i < 1) or (i > ComboBox.Tag) then

ComboBox.Text:='';

end;

 

procedure TfmInputk.FormActivate(Sender: TObject); // Обнуление поля ввода

begin

ComboBox.Text:='';

end;

 

end.

 

 

unit uHelp;

 

interface

 

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, ExtCtrls, StdCtrls, ComCtrls;

 

type

TfmHelp = class(TForm)

Panel: TPanel;

RichEdit: TRichEdit;

procedure FormActivate(Sender: TObject);

procedure FormDeactivate(Sender: TObject);

private

public

end;

 

var

fmHelp: TfmHelp;

 

implementation

 

{$R *.dfm}

 

const HelpFileName: string = 'coloring.hlp'; // Имя файла справки

 

procedure TfmHelp.FormActivate(Sender: TObject);

begin

if Tag = 1 then // Окно используется в режиме помощи

try

self.Caption:='Помощь';

RichEdit.Font.Size:=9;

RichEdit.Font.Color:=clBlack;

Panel.Height:=round(Panel.Width * 1.3);

self.Position:=poMainFormCenter;

RichEdit.ScrollBars:=ssVertical;

RichEdit.Lines.LoadFromFile(HelpFileName);

except

MessageDlg('Ошибка при открытии или чтении файла справки!', mtError,

[mbOk], 0);

Exit

end

else

begin // Окно используется в режиме "о программе"

self.Caption:='О программе';

Panel.Height:=Panel.Width div 5;

self.Position:=poMainFormCenter;

RichEdit.Lines.Clear;

RichEdit.ScrollBars:=ssNone;

RichEdit.Font.Size:=10;

RichEdit.Font.Color:=clBlue;

RichEdit.Lines.Append('Курсовая работа по дисциплине Программирование на

языке высокого уровня.');

RichEdit.Lines.Append('');

RichEdit.Lines.Append('Тема работы: Прикладная программа. Раскраска

графа.');

RichEdit.Lines.Append('');

RichEdit.Lines.Append('Выполнила слушатель гр.ПО-71в Зотова М.В.');

RichEdit.Lines.Append('Руководитель работы: к.т.н., доцент Белова Т.М.');

end;

end;

 

procedure TfmHelp.FormDeactivate(Sender: TObject);

begin

RichEdit.Font.Size:=8;

RichEdit.Font.Color:=clBlack;

end;

 

end.

 


БИБЛИОГРАФИЧЕСКИЙ СПИСОК

 

 

1. Кристофидес Н. Теория графов. Алгоритмический подход. – М.: Издательство «Мир», 1978. – 432 с.

2. Фаронов В.В. Delphi. Программирование на языке высокого уровня: Учебник для вузов – СПб.: Питер, 2007. – 640 с.: ил.

3. Белова Т.М., Старков Ф.А. Программирование в Delphi: Учебное пособие – Курск. гос.-техн. ун-т. Курск, 2002. – 134 с.

4. Интернет-Университет Информационных Технологий – http://www.INTUIT.ru: Лекции курса Программирование на языке Pascal.

Доверь свою работу ✍️ кандидату наук!
Поможем с курсовой, контрольной, дипломной, рефератом, отчетом по практике, научно-исследовательской и любой другой работой



Поиск по сайту:







©2015-2020 mykonspekts.ru Все права принадлежат авторам размещенных материалов.