unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, XPStyleActnCtrls, ActnList, ActnMan, ExtCtrls;
type
TForm1 = class(TForm)
Label1: TLabel;
Edit1: TEdit;
Edit2: TEdit;
Button1: TButton;
Label2: TLabel;
Edit3: TEdit;
Button2: TButton;
Label3: TLabel;
Edit4: TEdit;
Edit5: TEdit;
Label4: TLabel;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Button6: TButton;
Image1: TImage;
public
procedure przypisz(cos:TImage);
procedure Button6Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
public
{ Public declarations }
end;
rec=record
trasa:string;
długość:double;
end;
wątek=class(tthread)
trasa:string;
długość:double;
koniec,k:integer;
tabela1:array[1..10]of integer;
tabela2:array[1..10,1..2]of integer;
procedure wczytaj;
procedure szukaj;
procedure konczaca;
procedure rysuj;
procedure Execute; override;
constructor Create(kol:integer);
end;
var
Form1: TForm1;
tabelapkt:array[1..10,1..2]of integer;
start,koniec,licznik,licznikwolnego,ile,powt,min:integer;
tablicawyników:array of rec;
w1,w2:wątek;
Image2: TImage;
save:textfile;
procedure narysuj(tab:array of integer;kolor:integer);
implementation
{$R *.dfm}
procedure wątek.wczytaj;
var
I:integer;
begin
for I := 1 to 10 do
begin
tabela2[I,1]:=tabelapkt[I,1];
tabela2[I,2]:=tabelapkt[I,2];
end;
end;
constructor wątek.Create(kol:integer);
begin
inherited Create(true);
k:=kol;
synchronize(wczytaj);
koniec:=0;
end;
procedure wątek.konczaca;
begin
tablicawyników[ile].trasa:=trasa;
tablicawyników[ile].długość:=długość;
ile:=ile+1;
end;
procedure wątek.szukaj;
var a,b,pom1,pom,j,I,cos:integer;
begin
for I := 1 to 1000 do
tabela1[i]:=i;
Randomize;
for I := 1 to 10 do
begin
pom:=random(10)+1;
pom1:=random(10)+1;
if pom<>pom1 then
begin
cos:=tabela1[pom];
tabela1[pom]:=tabela1[pom1];
tabela1[pom1]:=cos;
end;
end;
begin
for i := 2 to 10 do
if tabela1[i]=start then
begin
cos:=tabela1[1];
tabela1[1]:=tabela1[i];
tabela1[i]:=cos;
end;
end;
begin
for j := 1 to 9 do
if tabela1[j]=koniec then
begin
cos:=tabela1[10];
tabela1[10]:=tabela1[j];
tabela1[j]:=cos;
end;
end;
for I := 1 to 9 do
begin
długość:=długość+sqrt(abs(tabela2[tabela1[I],1]-tabela2[tabela1[I+1],1])+abs(tabela2[tabela1[I],2]-tabela2[tabela1[I+1],2]));
trasa:=trasa+' '+inttostr(tabela1[i]);
end;
trasa:=trasa+' '+inttostr(tabela1[10]);
end;
procedure wątek.rysuj;
begin
narysuj(tabela1,k);
end;
procedure wątek.Execute;
begin
szukaj;
synchronize(konczaca);
synchronize(rysuj);
koniec:=1;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if licznikwolnego>0 then
begin
tabelapkt[licznikwolnego,1]:=strtoint(edit1.text);
tabelapkt[licznikwolnego,2]:=strtoint(edit2.text);
licznikwolnego:=licznikwolnego-1;
label1.Caption:='Ilość pkt:'+inttostr(licznikwolnego);
end else
showmessage('za dużo pkt');
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
licznik:=strtoint(edit3.Text);
setlength(tablicawyników,2*licznik);
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
start:=strtoint(edit4.Text);
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
koniec:=strtoint(edit5.Text);
end;
procedure TForm1.Button5Click(Sender: TObject);
var sprawdzenie:double;
begin
for powt := 0 to licznik do
begin
w1:=wątek.Create(0);
w2:=wątek.Create(1);
w1.resume;
w2.Resume;
while (w1.koniec<>1) or (w2.koniec<>1) do
application.processmessages;
w1.Free;
w2.Free;
end;
sprawdzenie:=tablicawyników[0].długość;
for powt := 1 to (licznik*2)-1 do
if tablicawyników[powt].długość<sprawdzenie then
begin
min:=powt ;
sprawdzenie:=tablicawyników[powt].długość
end
end;
procedure TForm1.Button6Click(Sender: TObject);
var i:integer;
begin
assignfile(save,'plik.txt');
try
begin
rewrite(save);
writeln(save,'==================minimalna wartość==================');
writeln(save,tablicawyników[min].trasa+' '+floattostr(tablicawyników[min].długość)+' '+inttostr(min));
writeln(save,'======================================================');
for i := 0 to licznik*2 do
writeln(save,tablicawyników[i].trasa+' : '+floattostr(tablicawyników[i].długość)+' '+inttostr(i));
end
finally
showmessage('bug');
closefile(save);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
licznikwolnego:=10;
label1.Caption:='Ilość pkt:'+inttostr(licznikwolnego);
ile:=0;
end;
procedure narysuj(tab: array of Integer;kolor:integer);
var licznik:integer;
begin
if kolor=0 then
image2.Canvas.Pen.Color:=clgreen
else
image2.Canvas.Pen.Color:=clblack;
image2.Canvas.Pen.Width:=2;
for licznik := 1 to 9 do
begin
image2.Canvas.MoveTo(tabelapkt[tab[licznik]][1],tabelapkt[tab[licznik]][2]);
image2.Canvas.LineTo(tabelapkt[tab[licznik+1]][1],tabelapkt[tab[licznik+1]][2]);
sleep(10);
end;
end;
procedure tform1.przypisz(cos:timage);
begin
image1:=cos;
end;
end.
tyle posiada, jednak podczas kompilowania występuje błąd 'invalid property value'; piszę to do pracy dyplomowej i 1 raz się spotkałem z problemami z dostępem do zasobów :/ wątek działa w porządku, raportowanie też :/ tylko zchrzanione jest to rysowanie. Aha najważniejsze- program rozwiązuje problem komiwojażera - łączy 10 pkt i szuka metodą losową najszybsze połączenie pomiędzy nimi. deklaruje się miejsce startu i końca oraz ilość wywołań wątku(x2 bo lecą współbierznie). każdy wątek musi synchronicznie rysować na canvie imaga (lub innego vcl- dowolnie wybrałem imaga bo promotor zasugerował) jak łączy help bo ja już wymiękam :(