Форум: "Основная";
Текущий архив: 2005.02.06;
Скачать: [xml.tar.bz2];
Вниз
Проблема при рабете с потоками Найти похожие ветки
← →
4eshka) (2005-01-23 15:11) [0]Вот такая проблема, я вызываю процедуру в отдельном потоке, если ее проходить пошагово(трасировать?) то вроде как нормально работает. Но если просто запустить без отладки, то она совершенно не работает. В чем может быть дело?
function Gg:integer; stdcall;
var
cs:TCriticalSection; // ýòî, åñëè èç ïîòîêà îáðàùàåøüñÿ ê ýëåìåíòàì ãëàâíîé ôîðìû
begin
cs:=TCriticalSection.Create;
try
// òóò âûïîëíÿåøü îáðàáîòêó êàðòèíîê
// ïðè÷åì, ïåðåîäè÷åñêè ïðîâåðÿåøü fStop
// ïðè îáðàùåíèè, íàïðèìåð ê êîìïîíåíòàì ãëàâíîé ôîðìû, âõîäèøü â CriticalSection
if not fStop then
begin
cs.Enter;
// ShowMessage("ss");
FormMain.CheckC;
cs.Leave;
end;
if fStop then exit;
finally
cs.Free;
SendMessage(FormMain.Handle,UM_THSTOP,1,0); // óâåäîìëÿåì ïðèëîæåíèå î çàâåðøåíèè ïîòîêà
result:=0
end
end;
procedure TFormMain.CheckC;
var
Number1,Number2,a:Extended;
R:real;
AngelS:string;
Angel:real;
Coors:TCoors;
Radius:integer;
TempPath:string;
MinIndex:integer;
sX,sY:integer;
cX,cY:integer;
sR,sS:integer;
k,i,j,n,m:integer;
x1,y1,Xab,Yab,X0,Y0:real;
Minus:boolean;
begin
{1. Âû÷èñëÿåì êîîðäèíûòå ìåòîê}
Radius:=20;
// Coors:=FindCircles(1,1,Image1.Height,Image1.Width,Radius,Canvas);
Coors:=FindCircles(1,1,BitMap.Height,BitMap.Width,Radius,BitMap.Canvas);
{-----------------------------}
{Âû÷èñëÿåì óãîë ïîâîðîòà}
if (coors[1,2]<coors[2,2])and (coors[1,1]<coors[2,1]) then Minus:=true
else Minus:=false;
for i:=1 to 4 do
begin
for k:=i to 4 do
begin
if coors[i,1]>coors[k,1] then
begin
j:=coors[i,1];
coors[i,1]:=coors[k,1];
coors[k,1]:=j;
j:=coors[i,2];
coors[i,2]:=coors[k,2];
coors[k,2]:=j;
end;
end;
end;
Number1:=(Coors[3,1]-Coors[1,1]);
Number2:=Image1.Picture.Bitmap.Height;
a:= ArcTan(Number1 / Number2);
R:=(A*100/(Pi/2));
AngelS:=FloatToStr(R)[1]+FloatToStr(R)[2]+FloatToStr(R)[3];
Angel:=StrToFloat(AngelS);
if Minus then Angel:=Angel*(-1)+1.5;
{-----------------------------}
{Îòêðûâàåì çàíîâî íàøå èçîáðàæåíèå äëÿ ïîâîðîòà}
// image1.Picture.LoadFromFile(FileName);
{-----------------------------}
{Ïîâîðà÷èâàåì èçîáðàæåíèå íà Angel ãðàäóñîâ}
Bitmap.Assign(Bitmap2);
RotateBitmap(Bitmap, Angel, clWhite);
{-----------------------------}
{Íàõîäèì êîîðäèíàòû ïîâåðíóòûõ ìåòîê}
Coors:=FindCircles(1,1,Bitmap.Height,Bitmap.Width,Radius,Bitmap.Canvas);
{-----------------------------}
{Ñîåäèíÿåì èõ íà íàøåì èçîáðàæåíèè}
With Bitmap.Canvas do
begin
Pen.Color:=clRed;
Moveto(coors[1,1],coors[1,2]);
lineto(coors[2,1],coors[2,2]);
lineto(coors[4,1],coors[4,2]);
lineto(coors[3,1],coors[3,2]);
lineto(coors[1,1],coors[1,2]);
end;
{-----------------------------}
{Äîáàâëÿåì êîîðäèíàòû â ìåìî}
mCoors.Clear;
for i:=1 to 4 do mCoors.Lines.Add("X:"+inttostr(Coors[i,1])+" Y:"+inttostr(coors[i,2]));
fStop:=true;
{-----------------------------}
{+--Íà÷àëî ïðîâåðêè òåñòà--+}
// MinIndex:=Minimum(coors);
cY:=65;
cX:=60;
for k:=1 to SectionNum do
begin
for i:=1 to Sections[k,3]do
begin
for j:=1 to Sections[k,4]do
begin
Xab:=0;
Yab:=0;
if i=1 then
begin
X1:=7.5;
Xab:=X1+Sections[k,1];
end
else
begin
X1:=15*(i-1)+3*(i-1);
Xab:=X1+7.5+Sections[k,1];
end;
if j=1 then
begin
Y1:=7.5;
Yab:=Y1+Sections[k,2];
end
else
begin
Y1:=15*(j-1)+3*(j-1);
Yab:=Y1+7.5+Sections[k,2];
end;
if CheckEllipse(trunc(Xab),trunc(Yab)) then mData.Lines.Add(IntToStr(trunc(Xab))+" "+" "+IntToStr(trunc(Yab))+" - GOOD" )
else mData.Lines.Add(IntToStr(trunc(Xab))+" "+" "+IntToStr(trunc(Yab))+" - bad" )
end;
end;
{ for sS:=1 to Sections[i,4] do
begin
cY:=cY+11;
for sR:=1 to Sections[i,3] do
begin
{Ïðîâåðêà òåê. êðóãà}
{ cX:=cX+11;
if CheckEllipse(cX,cY) then mData.Lines.Add(IntToStr(sS)+" "+" "+IntToStr(sR));
end;
end;}
end;
end;
← →
MBo © (2005-01-23 15:14) [1]Критическа секция у тебя - локальная, никакого смысла в ней нет.
воспользуйся TThread и Synchronize
← →
Defunct © (2005-01-23 15:41) [2]По поводу критической секции.
Сделай одну секцию для модуля, а локальную выброси:
...
implementation
var
CS: TCriticalSection;
....
initialization
CS := TCriticalSection.Create;
finalization
CS.Free
end.
← →
4eshka) (2005-01-23 15:55) [3]
procedure TFormMain.Button1Click(Sender: TObject);
var Thread:TCheckThread;
begin
Thread :=TCheckThread.CreateIt(0)
end;
unit CheckThread;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, TntExtCtrls, Menus, TntMenus, TntForms, TntDialogs,
StdCtrls, TntStdCtrls, XPMan, ComCtrls, TntComCtrls,SyncObjs;
type
Tcoors=array[1..4,1..2]of integer;
TCheckThread = class(TThread)
private
function CheckEllipse(x,y:integer):boolean;
function FindCircles(FromX,FromY,ToY,ToX,Diameter:integer; Canvas:Tcanvas):Tcoors;
function Minimum(Coors:Tcoors):integer;
procedure RotateBitmap(Bitmap: TBitmap; Angle: Double; BackColor: TColor);
protected
procedure Execute; override; // Main thread execution
published
constructor CreateIt(PriorityLevel: cardinal);
destructor Destroy; override;
end;
implementation
uses
Main;
constructor TCheckThread.CreateIt(PriorityLevel: cardinal);
begin
inherited Create(true); // Create thread suspended
Priority := TThreadPriority(PriorityLevel); // Set Priority Level
FreeOnTerminate := true; // Thread Free Itself when terminated
Synchronize(Execute); // Setup the ProgressBar
Suspended := false; // Continue the thread
end;
destructor TCheckThread.Destroy;
begin
// PostMessage(form1.Handle,wm_ThreadDoneMsg,self.ThreadID,0);
{
This posts a message to the main form, tells us when and which thread
is done executing.
}
inherited destroy;
end;
procedure TCheckThread.Execute; // Main execution for thread
var
Number1,Number2,a:Extended;
R:real;
AngelS:string;
Angel:real;
Coors:TCoors;
Radius:integer;
TempPath:string;
MinIndex:integer;
sX,sY:integer;
cX,cY:integer;
sR,sS:integer;
k,i,j,n,m:integer;
x1,y1,Xab,Yab,X0,Y0:real;
Minus:boolean;
begin
{1. Âû÷èñëÿåì êîîðäèíûòå ìåòîê}
Radius:=20;
Coors:=FindCircles(1,1,FormMain.Image1.Height,FormMain.Image1.Width,Radius,FormMain.Image1.Canvas);
{-----------------------------}
{Âû÷èñëÿåì óãîë ïîâîðîòà}
if (coors[1,2]<coors[2,2])and (coors[1,1]<coors[2,1]) then Minus:=true
else Minus:=false;
for i:=1 to 4 do
begin
for k:=i to 4 do
begin
if coors[i,1]>coors[k,1] then
begin
j:=coors[i,1];
coors[i,1]:=coors[k,1];
coors[k,1]:=j;
j:=coors[i,2];
coors[i,2]:=coors[k,2];
coors[k,2]:=j;
end;
end;
end;
Number1:=(Coors[3,1]-Coors[1,1]);
Number2:=FormMain.Image1.Picture.Bitmap.Height;
a:= ArcTan(Number1 / Number2);
R:=(A*100/(Pi/2));
AngelS:=FloatToStr(R)[1]+FloatToStr(R)[2]+FloatToStr(R)[3];
Angel:=StrToFloat(AngelS);
if Minus then Angel:=Angel*(-1)+1.5;
{-----------------------------}
{Îòêðûâàåì çàíîâî íàøå èçîáðàæåíèå äëÿ ïîâîðîòà}
FormMain.image1.Picture.LoadFromFile(FileName);
{-----------------------------}
{Ïîâîðà÷èâàåì èçîáðàæåíèå íà Angel ãðàäóñîâ}
RotateBitmap(FormMain.image1.Picture.Bitmap, Angel, clWhite);
{-----------------------------}
{Íàõîäèì êîîðäèíàòû ïîâåðíóòûõ ìåòîê}
Coors:=FindCircles(1,1,FormMain.image1.Height,FormMain.image1.Width,Radius,FormMain.image1.Canvas);
{-----------------------------}
{Ñîåäèíÿåì èõ íà íàøåì èçîáðàæåíèè}
With FormMain.image1.Canvas do
begin
Pen.Color:=clRed;
Moveto(coors[1,1],coors[1,2]);
lineto(coors[2,1],coors[2,2]);
lineto(coors[4,1],coors[4,2]);
lineto(coors[3,1],coors[3,2]);
lineto(coors[1,1],coors[1,2]);
end;
{-----------------------------}
{Äîáàâëÿåì êîîðäèíàòû â ìåìî}
FormMain.mCoors.Clear;
for i:=1 to 4 do FormMain.mCoors.Lines.Add("X:"+inttostr(Coors[i,1])+" Y:"+inttostr(coors[i,2]));
{-----------------------------}
{+--Íà÷àëî ïðîâåðêè òåñòà--+}
// MinIndex:=Minimum(coors);
cY:=65;
cX:=60;
for k:=1 to SectionNum do
begin
for i:=1 to Sections[k,3]do
begin
for j:=1 to Sections[k,4]do
begin
Xab:=0;
Yab:=0;
if i=1 then
begin
X1:=7.5;
Xab:=X1+Sections[k,1];
end
else
begin
X1:=15*(i-1)+3*(i-1);
Xab:=X1+7.5+Sections[k,1];
end;
if j=1 then
begin
Y1:=7.5;
Yab:=Y1+Sections[k,2];
end
else
begin
Y1:=15*(j-1)+3*(j-1);
Yab:=Y1+7.5+Sections[k,2];
end;
if CheckEllipse(trunc(Xab),trunc(Yab)) then FormMain.mData.Lines.Add(IntToStr(trunc(Xab))+" "+" "+IntToStr(trunc(Yab))+" - GOOD" )
else FormMain.mData.Lines.Add(IntToStr(trunc(Xab))+" "+" "+IntToStr(trunc(Yab))+" - bad" )
end;
end;
{ for sS:=1 to Sections[i,4] do
begin
cY:=cY+11;
for sR:=1 to Sections[i,3] do
begin
{Ïðîâåðêà òåê. êðóãà}
{ cX:=cX+11;
if CheckEllipse(cX,cY) then mData.Lines.Add(IntToStr(sS)+" "+" "+IntToStr(sR));
end;
end;}
end;
end;
function TCheckThread.CheckEllipse(x,y:integer):boolean;
var i:integer;
begin
Result:=true;
for i:=x-3 to x+3 do
begin
if FormMain.Image1.Canvas.Pixels[i,y]<>clBlack then Result:=false;
end;
for i:=y-3 to y+3 do
begin
if FormMain.Image1.Canvas.Pixels[x,i]<>clBlack then Result:=false;
end;
end;
function TCheckThread.FindCircles(FromX,FromY,ToY,ToX,Diameter:integer; Canvas:Tcanvas):Tcoors;
begin
end;
procedure TCheckThread.RotateBitmap(Bitmap: TBitmap; Angle:integer);
begin
...
end;
function TCheckThread.Minimum(Coors:Tcoors):integer;
var MinIndex,MinIndex2,Min,i:integer;
a:array[1..4]of integer;
begin
....
end;
end.
Делаю так :)
Но программа начинает подвисать(как при выполнении процедуры) как сделать, чтобы программа не подвисала?
← →
4eshka) (2005-01-23 15:55) [4]
procedure TFormMain.Button1Click(Sender: TObject);
var Thread:TCheckThread;
begin
Thread :=TCheckThread.CreateIt(0)
end;
unit CheckThread;
interface
...
type
Tcoors=array[1..4,1..2]of integer;
TCheckThread = class(TThread)
private
function CheckEllipse(x,y:integer):boolean;
function FindCircles(FromX,FromY,ToY,ToX,Diameter:integer; Canvas:Tcanvas):Tcoors;
function Minimum(Coors:Tcoors):integer;
procedure RotateBitmap(Bitmap: TBitmap; Angle: Double; BackColor: TColor);
protected
procedure Execute; override; // Main thread execution
published
constructor CreateIt(PriorityLevel: cardinal);
destructor Destroy; override;
end;
implementation
uses
Main;
constructor TCheckThread.CreateIt(PriorityLevel: cardinal);
begin
inherited Create(true); // Create thread suspended
Priority := TThreadPriority(PriorityLevel); // Set Priority Level
FreeOnTerminate := true; // Thread Free Itself when terminated
Synchronize(Execute); // Setup the ProgressBar
Suspended := false; // Continue the thread
end;
destructor TCheckThread.Destroy;
begin
// PostMessage(form1.Handle,wm_ThreadDoneMsg,self.ThreadID,0);
{
This posts a message to the main form, tells us when and which thread
is done executing.
}
inherited destroy;
end;
procedure TCheckThread.Execute; // Main execution for thread
var
Number1,Number2,a:Extended;
R:real;
AngelS:string;
Angel:real;
Coors:TCoors;
Radius:integer;
TempPath:string;
MinIndex:integer;
sX,sY:integer;
cX,cY:integer;
sR,sS:integer;
k,i,j,n,m:integer;
x1,y1,Xab,Yab,X0,Y0:real;
Minus:boolean;
begin
{1. Âû÷èñëÿåì êîîðäèíûòå ìåòîê}
Radius:=20;
Coors:=FindCircles(1,1,FormMain.Image1.Height,FormMain.Image1.Width,Radius,FormMain.Image1.Canvas);
{-----------------------------}
{Âû÷èñëÿåì óãîë ïîâîðîòà}
if (coors[1,2]<coors[2,2])and (coors[1,1]<coors[2,1]) then Minus:=true
else Minus:=false;
for i:=1 to 4 do
begin
for k:=i to 4 do
begin
if coors[i,1]>coors[k,1] then
begin
j:=coors[i,1];
coors[i,1]:=coors[k,1];
coors[k,1]:=j;
j:=coors[i,2];
coors[i,2]:=coors[k,2];
coors[k,2]:=j;
end;
end;
end;
Number1:=(Coors[3,1]-Coors[1,1]);
Number2:=FormMain.Image1.Picture.Bitmap.Height;
a:= ArcTan(Number1 / Number2);
R:=(A*100/(Pi/2));
AngelS:=FloatToStr(R)[1]+FloatToStr(R)[2]+FloatToStr(R)[3];
Angel:=StrToFloat(AngelS);
if Minus then Angel:=Angel*(-1)+1.5;
{-----------------------------}
{Îòêðûâàåì çàíîâî íàøå èçîáðàæåíèå äëÿ ïîâîðîòà}
FormMain.image1.Picture.LoadFromFile(FileName);
{-----------------------------}
{Ïîâîðà÷èâàåì èçîáðàæåíèå íà Angel ãðàäóñîâ}
RotateBitmap(FormMain.image1.Picture.Bitmap, Angel, clWhite);
{-----------------------------}
{Íàõîäèì êîîðäèíàòû ïîâåðíóòûõ ìåòîê}
Coors:=FindCircles(1,1,FormMain.image1.Height,FormMain.image1.Width,Radius,FormMain.image1.Canvas);
{-----------------------------}
{Ñîåäèíÿåì èõ íà íàøåì èçîáðàæåíèè}
With FormMain.image1.Canvas do
begin
Pen.Color:=clRed;
Moveto(coors[1,1],coors[1,2]);
lineto(coors[2,1],coors[2,2]);
lineto(coors[4,1],coors[4,2]);
lineto(coors[3,1],coors[3,2]);
lineto(coors[1,1],coors[1,2]);
end;
{-----------------------------}
{Äîáàâëÿåì êîîðäèíàòû â ìåìî}
FormMain.mCoors.Clear;
for i:=1 to 4 do FormMain.mCoors.Lines.Add("X:"+inttostr(Coors[i,1])+" Y:"+inttostr(coors[i,2]));
{-----------------------------}
{+--Íà÷àëî ïðîâåðêè òåñòà--+}
// MinIndex:=Minimum(coors);
cY:=65;
cX:=60;
for k:=1 to SectionNum do
begin
for i:=1 to Sections[k,3]do
begin
for j:=1 to Sections[k,4]do
begin
Xab:=0;
Yab:=0;
if i=1 then
begin
X1:=7.5;
Xab:=X1+Sections[k,1];
end
else
begin
X1:=15*(i-1)+3*(i-1);
Xab:=X1+7.5+Sections[k,1];
end;
if j=1 then
begin
Y1:=7.5;
Yab:=Y1+Sections[k,2];
end
else
begin
Y1:=15*(j-1)+3*(j-1);
Yab:=Y1+7.5+Sections[k,2];
end;
if CheckEllipse(trunc(Xab),trunc(Yab)) then FormMain.mData.Lines.Add(IntToStr(trunc(Xab))+" "+" "+IntToStr(trunc(Yab))+" - GOOD" )
else FormMain.mData.Lines.Add(IntToStr(trunc(Xab))+" "+" "+IntToStr(trunc(Yab))+" - bad" )
end;
end;
{ for sS:=1 to Sections[i,4] do
begin
cY:=cY+11;
for sR:=1 to Sections[i,3] do
begin
{Ïðîâåðêà òåê. êðóãà}
{ cX:=cX+11;
if CheckEllipse(cX,cY) then mData.Lines.Add(IntToStr(sS)+" "+" "+IntToStr(sR));
end;
end;}
end;
end;
function TCheckThread.CheckEllipse(x,y:integer):boolean;
var i:integer;
begin
Result:=true;
for i:=x-3 to x+3 do
begin
if FormMain.Image1.Canvas.Pixels[i,y]<>clBlack then Result:=false;
end;
for i:=y-3 to y+3 do
begin
if FormMain.Image1.Canvas.Pixels[x,i]<>clBlack then Result:=false;
end;
end;
function TCheckThread.FindCircles(FromX,FromY,ToY,ToX,Diameter:integer; Canvas:Tcanvas):Tcoors;
begin
end;
procedure TCheckThread.RotateBitmap(Bitmap: TBitmap; Angle:integer);
begin
...
end;
function TCheckThread.Minimum(Coors:Tcoors):integer;
var MinIndex,MinIndex2,Min,i:integer;
a:array[1..4]of integer;
begin
....
end;
end.
Делаю так :)
Но программа начинает подвисать(как при выполнении процедуры) как сделать, чтобы программа не подвисала?
← →
Defunct © (2005-01-23 16:05) [5]> Synchronize(Execute); // Setup the ProgressBar
это есть ошибка, так писать нельзя.
А зависает у вас программа, потому что в теле Execute есть обращения к визуальным компонентам.
Execute выполняется автоматически, ее запускать в конструкторе не следует.
синхронизировать нужно любую другую приватную процедуру, в которой имеют место обращения к визуальным компонентам.
структура примерно такая:constructor TCheckThread.CreateIt(PriorityLevel: cardinal);
begin
inherited Create(true); // Create thread suspended
Priority := TThreadPriority(PriorityLevel); // Set Priority Level
FreeOnTerminate := true; // Thread Free Itself when terminated
Resume
end;procedure TCheckThread.Execute;
begin
// код которые не обращается к визуальным компонентам
// Syncronize( VisualProc );
end;
procedure TCheckThread.VisualProc;
begin
// код с обращением к визуальным компонентам
end;
← →
4eshka) (2005-01-23 16:20) [6]Огромнейшее спасибо
← →
4eshka) (2005-01-23 18:06) [7]Блин :( все равно, получается так, что действия выполняются не правильно, такое ощущение как-будто получается так, что одно действие выполняется быстрее другого
Страницы: 1 вся ветка
Форум: "Основная";
Текущий архив: 2005.02.06;
Скачать: [xml.tar.bz2];
Память: 0.52 MB
Время: 0.037 c
