Problem z dostępem do komponentu t image z poziomu wątku

0

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 :(

0
  1. nie to żeby ten kod był lekko nieczytelny
  2. nie to, że nawet nie napsałeś o którą linijkę chodzi kompilatorowi
  3. po canvasie możesz rysować bez synchronize bo canvas jest threadsafe
0

problem polega na tym, że kompilator nie wskazuje gdzie się sypie :( przepraszam za lekko nieczytelny kod, ale zmienia się około 100 razy na sec :( nie wiedziałem, że Timage jest threadsafe - czyli nie posypie się, jak 2 wątki naraz zaczną na nim rysować ?? ps nie wiem dlaczego nie pozwala mi korzystać z mojego nicka :/

0

nie TImage ale Canvas, czyli poczym byś nie rysował (w sensie po canvasie jakiego komponentu byś nie rysował) to jest to threadsafe.

Co do nieczytelności to nic nie stoi na przeszkodzie zainstalować sobie formater kodu ale lepiej nabyć nawyk czytelnego pisania.

A jak dalej nie wiesz co jest nie tak to spakuj projekt i daj gdzieś na rapida to zerknę co tam może być

BTW którą masz wersję Delphi?

0

2006 :) a co do kodu to fakt promotor mnie non toper krytykuje za brak ładu i składu :) nadal tego nie rozwiązałem :/ o ile się nie mylę (wykonuje aplikację krokowo f7) to krzaczy się albo przy inicjalizacji formy (nie wiem why) albo przy application.run :( BTW pozdro dla dąbrowianina ;P

0

sen przynosi odpowiedź na wiele pytań .. rozwiązałem problem :) mam jeszcze 1 problem ale to na oddzielny temat :)

1 użytkowników online, w tym zalogowanych: 0, gości: 1, botów: 0