Прикладная программа. Раскраска графа

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; граф схема раскраска pascal

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

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.

...