| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Проблема при рабете с потоками

4eshka) ©   (2005-01-23 15:11:00) 

Вот такая проблема, я вызываю процедуру в отдельном потоке, если ее проходить пошагово(трасировать?) то вроде как нормально работает. Но если просто запустить без отладки, то она совершенно не работает. В чем может быть дело?
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]

---

4eshka)   (2005-01-23 18:06:00) [1]

Блин :( все равно, получается так, что действия выполняются не правильно, такое ощущение как-будто получается так, что одно действие выполняется быстрее другого

---

4eshka)   (2005-01-23 16:20:00) [2]

Огромнейшее спасибо

---

Defunct   (2005-01-23 16:05:00) [3]

> 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 15:55:00) [4]


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]

---

4eshka)   (2005-01-23 15:55:00) [5]


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]

---

Defunct   (2005-01-23 15:41:00) [6]

По поводу критической секции.

Сделай одну секцию для модуля, а локальную выброси:

...
implementation

var
  CS: TCriticalSection;

....

initialization
  CS := TCriticalSection.Create;

finalization
  CS.Free

end.

---

MBo   (2005-01-23 15:14:00) [7]

Критическа секция у тебя - локальная, никакого смысла в ней нет.
воспользуйся TThread и Synchronize

---

Наверх