- •Введение
- •1 Техническое задание
- •1.1 Назначение разработки
- •1.2 Основание для разработки
- •1.3 Требования к программе
- •2 Вариант задания
- •3 Краткие теоретические сведения
- •4 Эскизный проект
- •4.1 Переборный алгоритм раскраски
- •4.2 Последовательный алгоритм раскраски
- •4.3 Разработка структуры программы
- •5 Технический проект
- •5.1 Сценарий диалогас пользователем
- •5.2 Разработка основных форматов данных
- •5.3 Детализация алгоритма раскраски графа
- •5.4 Разработка формата файла для хранения графов
- •6 Рабочий проект
- •6.1 Выбор удобочитаемых идентификаторов
- •6.2 Общая организация проекта
- •6.3 Описание модулей
- •6.3.1 Модуль uMain
- •6.3.2 Модуль uData
- •6.3.3 Модуль uFiling
- •6.3.4 Модуль uColoring
- •6.3.5 Модуль uInputk
- •6.3.6 Модуль uHelp
- •6.4 Отладка и тестирование программного продукта
- •6.5 Руководство пользователю
6.3.6 Модуль uHelp
Модуль обеспечивает отображение справочной информации и окна о программе.
6.3.6.1 Основные переменные, константы и типы модуля
fmHelp: TfmHelp – форма для файла справки;
HelpFileName: string = 'coloring.hlp' – имя файла справки.
6.3.6.2 Компоненты модуля
Компоненты модуля uHelp представлены в таблице 4.
Таблица 4
Компонент |
Свойства, отличные от свойств по умолчанию |
Функции |
fmHelp: TForm |
AutoSize: True, BorderStyle: bsDialog, Caption: Помощь, Color: clBtnFace, ClientHeight: 569, ClientWidth: 537, Color: clBtnFace, Position: poMainFormCenter |
Форма – контейнер |
Panel: TPanel |
BevelOuter: bvLowered |
Панель для создания рельефного прямоугольника в клиентской области формы |
RichEdit: TRichEdit |
Align: alClient, BorderStyle: bsNone, Color: clCream, HideScrollBars: False, ReadOnly: True, ScrollBars: ssVertical |
Окно для отображения содержимого файла справки и информации о программе |
6.3.6.3 Процедуры модуля
Процедура FormActivate – производит настройку внешнего вида и заполнение окна отображения текстом из файла справки или информацию о программе.
Процедура FormDeactivate – восстанавливает стандартный шрифт.
6.4 Отладка и тестирование программного продукта
В ходе отладки и тестирования программы осуществлялся ввод графов с различным числом вершин и ребер, проверялась возможность их раскраски в заданное число цветов, при этом устанавливалось число цветов равное хроматическому числу графа, а также большее или меньшее значение. Выполнялась проверка работы программы при предельном значении числа вершин графа, а также при минимально возможном (0) и максимально возможном (полный граф) числе ребер.
Ниже представлены снимки экрана программы на различных этапах ее работы с разными исходными данными.
Рис. 12
Исходное состояние окна программы
или после нажатия кнопки «Новый граф»
Рис. 13
Окно программы с загруженным из файла графом
Рис. 14
Окно выбора числа цветов при раскраске
Рис. 15
Окно программы с предупреждением
о невозможности раскраски выбранным числом цветов
Рис. 16
Окно программы с полученным вариантом раскраски
Рис. 17
Окно программы после удаления вершины 5
из графа, изображенного на рисунке 16
Рис. 18
Окно программы после добавления вершины и ребра
в граф, изображенный на рисунке 17
Рис. 19
Окно программы с запросом на сохранение изменений в графе
при нажатии одной из кнопок – «Новый граф», «Выход», «Открыть»
Рис. 20
Окно для выбора файла с графом
Рис. 21
Окно программы с предупреждением о превышении числа вершин
6.5 Руководство пользователю
Разрабатываемая программа предназначена для нахождения раскраски заданного неориентированного графа ограниченным числом цветов с использованием алгоритма последовательного перебора.
Входными данными программы являются неориентированный граф, число вершин которого не превышает заданного ограничения, число цветов, которыми необходимо раскрасить данный граф.
К выходным данным относятся вариант раскраски графа заданным числом цветов, хроматическое число графа, сообщения о невозможности нахождения раскраски.
Максимальное число вершин графа в данной версии программы ограничивается значением 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.