شبه کد این برنامه رو آقای جم پور(ارائه کننده مقاله) برای بنده ارسال کرده که متاسفانه دچار مشکل شده بود ولی کد برنامه به شرح زیر است.
Program Coloring_Graph;
uses Crt,Graph;
Type rec= Record
x: integer;
y: integer;
end;
var
Matrix : Array [1..10,1..10] of Byte;
Deadline : Array [1..10,1..10] of Byte;
Colors : Array [1..10] of Byte;
Last: Array [1..10] of Byte;
Locat:Array [1..10] of Rec;
i,j,n : integer;
{************************************************* ******************}
Procedure Drawing;
var
Gd, Gm,clr: Integer;
begin
Gd := Detect;
InitGraph(Gd, Gm, '');
if GraphResult <> grOk then
Halt(1);
setfillstyle(1,8);
bar(350,30,570,160);
setcolor(7);
Rectangle(350,30,570,160);
line(350,55,570,55);
setcolor(15);
Locat[1].x:=50; Locat[1].y:=100;
Locat[2].x:=100; Locat[2].y:=50;
Locat[3].x:=150; Locat[3].y:=50;
Locat[4].x:=200; Locat[4].y:=100;
Locat[5].x:=200; Locat[5].y:=150;
Locat[6].x:=150; Locat[6].y:=200;
Locat[7].x:=100; Locat[7].y:=200;
Locat[8].x:=50; Locat[8].y:=150;
setcolor(14);
for i:=1 to n-1 do
for j:=i+1 to n do
begin
if Matrix[i,j]<> 0 then
Line(locat[i].x,locat[i].y,locat[j].x,locat[j].y);
end;
for i:=1 to n do
begin
if (colors[i]>=3)
then clr:=colors[i]+1 else clr:=colors[i];
setcolor(15);
SetFillStyle(1,clr);
fillEllipse(locat[i].x,locat[i].y,10,10);
end;
setcolor(15);
for i:=1 to n do
OutTextXY(locat[i].x-2,locat[i].y-3,char(64+i));
Readkey;
CloseGraph;
end;
{************************************************* *******************}
Procedure Select_color( p,index:byte);
var i,j:integer;
begin
for i:=1 to n do
begin
for j:=1 to n do
if deadline[j,p]=i then break;
if j=n then
begin
Colors[p]:=i;
deadline[index,p]:= Colors[p];
last[p]:=last[p] + 1;
break;
end;
end;
end;
{
************************************************** ***************
* s t a r t p r o g r a m *
************************************************** ***************
}
Begin
clrscr;
write('please set size of matrix [ n<8 !] : ');
readln(n);
if n>8 then halt;
for i:=1 to n do
last[i]:=1;
for i:=1 to n-1 do
for j:=i+1 to n do
begin
write('[',i,',',j,'] : ');
read(Matrix[i,j]);
Matrix[j,i]:=Matrix[i,j];
end;
for i:=1 to n do
for j:=1 to n do
begin
gotoxy(10+2*i,j+5);
Write(Matrix[i,j]);
end;
for i:=1 to n do
begin
Select_color(i,last[i]);
for j:=1 to n do
if Matrix[i,j]<>0 then
begin
Deadline[last[j],j]:=Colors[i] ;
last[j]:=last[j] + 1 ;
end;
end;
for i:=1 to n do
begin
gotoxy(10+3*i,20);
Write(Colors[i]);
end;
Readkey;
Drawing;
End.
پاسخ با نقل قول
نوشته شده توسط raha_hakhamanesh
