Кстати, не знаю какая ошибка у тебя вылетает... Сделал пример на основе твоего кода (пришлось кое-что добавить, что бы было красиво), но все работает:
Код:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TCSyn = class;
TMyThread = class;
TForm1 = class(TForm)
btStartThread: TButton;
btReadCount: TButton;
procedure FormCreate(Sender: TObject);
procedure btStartThreadClick(Sender: TObject);
procedure btReadCountClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
FMyThread : TMyThread;
public
{ Public declarations }
end;
TCSyn = class(TComponent)
public
Count : integer;
constructor Create(AOwner:TComponent); override;
destructor Destroy; override;
procedure VaChar;
end;
TMyThread = class(TThread)
private
pser: TCSyn;
FDoWork : Boolean;
protected
procedure Execute; override;
public
constructor Create(CreateSuspended : Boolean); virtual;
destructor Destroy; override;
function GetCount : Integer;
procedure DoWork;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
constructor TCSyn.Create(AOwner:TComponent);
begin
inherited;
Count := 0;
end;
destructor TCSyn.Destroy;
begin
inherited;
end;
procedure TCSyn.VaChar;
begin
Count := Count + 1;
end;
constructor TMyThread.Create(CreateSuspended : Boolean);
begin
inherited Create(CreateSuspended);
FDoWork := False;
pser := TCSyn.Create(Nil);
end;
destructor TMyThread.Destroy;
begin
pser.Free;
end;
procedure TMyThread.Execute;
begin
While Not Terminated Do
Begin
If FDoWork Then
Begin
FDoWork := False;
Synchronize(pser.VaChar);
End;
Sleep(100);
End;
end;
function TMyThread.GetCount : Integer;
begin
Result := pser.Count;
end;
procedure TMyThread.DoWork;
begin
FDoWork := True;
end;
procedure TForm1.btReadCountClick(Sender: TObject);
begin
If Not Assigned(FMyThread)
Then MessageDlg('Thread object is not created. Please click "Start Thread" button first',mtError,[mbOk],0)
Else ShowMessage(Format('Count = %d',[FMyThread.GetCount]));
end;
procedure TForm1.btStartThreadClick(Sender: TObject);
begin
If Not Assigned(FMyThread)
Then FMyThread := TMyThread.Create(False)
Else FMyThread.DoWork;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FMyThread := Nil;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
If Assigned(FMyThread) Then
Begin
FMyThread.Terminate;
FMyThread.WaitFor;
FMyThread.Free;
End;
end;
end.
Да, для реального кода надо будет еще обложиться критическими секциями, что бы не получалось запустить обработку в потоке, если она уже идет. Или вообще лучше сделать очередь заданий, помещать новые задания туда, а поток сам будет от туда их забирать (опять же обложившись критическими секциями). Но в таком простом варианте все работает нормально. Никаких ошибок не вылетает.
ЗЫ. Все делано на 10.2, но думаю, что на других версиях все будет ровно так же.