Прикладная программа для нахождения раскраски неориентированного графа ограниченным числом цветов
Разработка граф-схемы алгоритма раскраски на языке Object Pascal. Формат файла для хранения графов. Выбор удобочитаемых идентификаторов. Переменные, константы, типы, компоненты, процедуры и функции модулей uMain, uInputk, uFiling, uColoring, uHelp.
| Рубрика | Программирование, компьютеры и кибернетика |
| Вид | курсовая работа |
| Язык | русский |
| Дата добавления | 22.11.2013 |
| Размер файла | 1,3 M |
Отправить свою хорошую работу в базу знаний просто. Используйте форму, расположенную ниже
Студенты, аспиранты, молодые ученые, использующие базу знаний в своей учебе и работе, будут вам очень благодарны.
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('Выполнила слушатель гр.___________________');
RichEdit.Lines.Append('Руководитель работы: _____________________');
end;
end;
procedure TfmHelp.FormDeactivate(Sender: TObject);
begin
RichEdit.Font.Size:=8;
RichEdit.Font.Color:=clBlack;
end;
end.
Размещено на Allbest.ru
Подобные документы
Этапы нахождения хроматического числа произвольного графа. Анализ примеров раскраски графа. Характеристика трудоемкости алгоритма раскраски вершин графа Мейниеля. Особенности графов, удовлетворяющих структуру графов Мейниеля, основные классы графов.
курсовая работа [1,1 M], добавлен 26.06.2012Математические графы, области их применения. Способы раскраски вершин и ребер графов, задачи на их применение. Разработка алгоритма, работающего на основе операций с матрицей смежности. Описание логической структуры программы. Пример зарисовки графа.
курсовая работа [145,5 K], добавлен 27.01.2013Элементы языка Object Pascal: идентификаторы, константы, переменные, выражения. Структура проекта Delphi. Операторы и метки. Типы данных языка OPascal. Статические и динамические массивы. Записи с вариантными полями. Совместимость и преобразование типов.
курс лекций [385,4 K], добавлен 18.02.2012Основные понятия и определения теории графов: теоремы и способы задания графа, сильная связность графов. Построение блок-схем алгоритма, тестирование разработанного программного обеспечения, подбор тестовых данных, анализ и исправление ошибок программы.
курсовая работа [525,6 K], добавлен 14.07.2012История и термины теории графов. Описание алгоритма Дейкстры. Математическое решение проблемы определения кратчайшего расстояния от одной из вершин графа до всех остальных. Разработка программы на объектно-ориентированном языке программирования Delphi 7.
контрольная работа [646,9 K], добавлен 19.01.2016Способы построения остовного дерева (алгоритма поиска в глубину и поиска в ширину). Вид неориентированного графа. Понятие и алгоритмы нахождения минимальных остовных деревьев. Последовательность построения дерева графов по алгоритмам Крускала и Прима.
презентация [22,8 K], добавлен 16.09.2013Работа с файлами на языке Pascal. Типы файлов: типизированные, текстовые, нетипизированные. Сущность процедуры и функции. Использование процедуры Read и Write для операций чтения и записи в типизированном файле. Листинг программы и экранные формы.
лабораторная работа [38,4 K], добавлен 13.02.2009Написание игры "Lines" на языке Object Pascal в среде Delphi. Алгоритм работы программы. Описание метода генерации поля. Используемые константы и переменные. Форма приложения после старта игрового процесса. Основные элементы формы и обработки событий.
курсовая работа [225,0 K], добавлен 12.04.2012Характеристика вычислительной системы и инструментов разработки. Программирование на языке Pascal в среде Turbo Pascal и на языке Object Pascal в среде Delphi. Использование процедур, функций, массивов, бинарного поиска. Создание базы данных в виде файла.
отчет по практике [2,1 M], добавлен 02.05.2014Элементы и переменные, используемые для составления записи в Паскале. Основные числовые типы языка Turbo Pascal. Составление блок-схемы приложения, программирование по ней программы для вычисления функции. Последовательность выполнения алгоритма.
лабораторная работа [256,9 K], добавлен 10.11.2015
