unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Grids, ComCtrls;
type
TForm1 = class(TForm)
GroupBox1: TGroupBox;
Label1: TLabel;
Button1: TButton;
Edit1: TEdit;
Button2: TButton;
GroupBox2: TGroupBox;
StringGrid1: TStringGrid;
Splitter1: TSplitter;
GroupBox3: TGroupBox;
StringGrid2: TStringGrid;
Panel1: TPanel;
Label3: TLabel;
UpDown1: TUpDown;
CheckBox1: TCheckBox;
Label2: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure StringGrid1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure StringGrid1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure StringGrid1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;
var CanSelect: Boolean);
procedure FormCreate(Sender: TObject);
procedure Edit1Change(Sender: TObject);
procedure StringGrid1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
procedure Search(m: integer);
var
Form1: TForm1;
run, painting: boolean;
n, kol_krasok, k, a, b: integer;
col: array of integer;// массив, содержащий цвета вершин
C: array of array of Integer;// матрица смежности
implementation
{$R *.dfm}
procedure Search(m: integer);
var
i, j: integer;
doit: boolean;
begin
if m>n then begin
// найдено решение
Form1.Label3.Caption:='Количество цветов: '+inttostr(kol_krasok);
for i:=1 to n do Form1.StringGrid2.Cells[i, 1]:=IntToStr(col[i]);
run:=false;
end
else begin
for i:=1 to kol_krasok do begin
col[m]:=i;
doit:=true;
if m=1 then Search(m+1) else begin
// если цвета вершин 1,...,m-1 соседних с m-ой не i, то запускаем перебор
for j:=1 to m-1 do if (C[m, j]=1) and (col[j]=i) then doit:=false;
if doit then Search(m+1);
end;
end;
if (kol_krasok<k) and run then begin
kol_krasok:=kol_krasok+1;
col[m]:=kol_krasok;
Search(m+1);
kol_krasok:=kol_krasok-1;
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
q: integer;
begin
Label2.Caption:='Идет анализ...';
Form1.Repaint;
kol_krasok:=1;
k:=n;
run:=true;
for q:=1 to n do col[q]:=0;
Search(1);
Label2.Caption:='Готово!';
end;
procedure TForm1.Button2Click(Sender: TObject);
var
i, j: integer;
begin
//обновляем МАТРИЦУ смежности
SetLength(C, n+1, n+1);
SetLength(col,n+1);
for i:=0 to n do for j:=0 to n do C[i, j]:=0;
for i:=1 to n do for j:=1 to n do if StringGrid1.Cells[i,j]='' then C[i, j]:=0
else C[i, j]:=1;
Button1.Enabled:=true;
end;
procedure TForm1.StringGrid1MouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
if painting then if not(CheckBox1.Checked) then StringGrid1.Cells[a,b]:='1'
else StringGrid1.Cells[a,b]:='';
end;
procedure TForm1.StringGrid1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
painting:=true;
end;
procedure TForm1.StringGrid1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
painting:=false;
end;
procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol,
ARow: Integer; var CanSelect: Boolean);
begin
a:=ACol;
b:=ARow;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
i, j: integer;
begin
Button2.Click;
n:=10;
SetLength(C, n+1, n+1);
SetLength(col,n+1);
for i:=0 to n do for j:=0 to n do C[i, j]:=0;
C[1, 2]:=1;
C[1, 8]:=1;
C[2, 1]:=1;
C[2, 3]:=1;
C[2, 8]:=1;
C[2, 10]:=1;
C[3, 2]:=1;
C[3, 4]:=1;
C[4, 3]:=1;
C[4, 5]:=1;
C[5, 4]:=1;
C[5, 6]:=1;
C[6, 5]:=1;
C[6, 7]:=1;
C[7, 6]:=1;
C[8, 1]:=1;
C[8, 2]:=1;
C[8, 9]:=1;
C[9, 8]:=1;
C[9, 10]:=1;
C[10, 2]:=1;
C[10, 9]:=1;
//обновляем таблицу смежности
for i:=1 to n do for j:=1 to n do if C[i, j]=0 then StringGrid1.Cells[i,j]:=''
else StringGrid1.Cells[i,j]:='1';
end;
procedure TForm1.Edit1Change(Sender: TObject);
var
i: integer;
begin
n:=strtoint(edit1.text);
StringGrid1.RowCount:=n+1;
StringGrid1.ColCount:=n+1;
StringGrid2.ColCount:=n+1;
for i:=1 to n+1 do StringGrid1.Cells[0,i]:=IntToStr(i);
for i:=1 to n+1 do StringGrid1.Cells[i,0]:=IntToStr(i);
StringGrid2.Cells[0,0]:='Вершины';
StringGrid2.Cells[0,1]:='Краски';
StringGrid2.ColWidths[0]:=100;
for i:=1 to n+1 do StringGrid2.Cells[i,0]:=IntToStr(i);
Button1.Enabled:=false;
end;
procedure TForm1.StringGrid1Click(Sender: TObject);
begin
Button1.Enabled:=false;
end;
end.