Показать сообщение отдельно
  #5  
Старый 03.08.2022, 00:11
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 8,015
Версия Delphi: 7, XE3, 10.2
Репутация: 49089
По умолчанию

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