Перейти к содержанию
Fire Monkey от А до Я
  • 0

Поток на клиенте


rust gg

Вопрос

Здравствуйте.

На клиенте происходит прием и отрисовка (OnPaint) на Canvas на основании принятых данных с сервера .

Сервер: отправляет в таймере, в таймере цикл отправки данных.

Клиент принимает в таймере.

Когда данных отправленных сервером не большое количество отрисовка проходит нормально, когда приходит частое количество пакетов,

начинает приложение клиента тормозить.

Думаю капать в сторону потока. 

Вопрос tcpclient вещать в поток или отрисовку?

Попробовал tcpclient засунуть в поток, но ничего не выходит.

type
  TMyThread = class(TThread)
    Progress: string;
    Client : TIdTCPClient;
    procedure SetProgress;
    constructor Create;
  private
  protected
    procedure Execute; override;
  end;
 
  TRec_Data = record
    Flag: array[0..20] of char;
  end;
 
implementation
 
uses ClientForm;
 
constructor TMyThread.Create;
var
  Rec: TRec_Data;
  Buffer: TIdBytes;
begin
  inherited Create(true);
 
  Client := TIdTCPClient.Create(nil);
  Client.Host := '127.0.0.1';
  Client.Port := 6000;
  Client.Connect;
 
  // Передаем данные
  if Client.Connected = True then
  begin
    Rec.Flag := 'addUser';
 
    Buffer := RawToBytes(Rec, SizeOf(Rec));
    Client.IOHandler.Write(Buffer);
  end;
end;
 
procedure TMyThread.Execute;
var
  Rec: TRec_Data;
  Buffer: TIdBytes;
begin
  while (Client.Connected) do
  begin
    Client.IOHandler.ReadBytes(Buffer, SizeOf(Rec));
    BytesToRaw(Buffer, Rec, SizeOf(Rec));
    Progress := Rec.Flag; 
    Synchronize(SetProgress);
  end;
end;
 
procedure TMyThread.SetProgress;
begin
  Form1.Memo1.Lines.Insert(0, Progress);
end;

При таком варианте поток отрабатывает сообщения с сервера, но видит выводит только первый ответ с сервера.

Помогите плиз...

Ссылка на комментарий

Рекомендуемые сообщения

  • 0
2 часа назад, rust gg сказал:

когда приходит частое количество пакетов,

начинает приложение клиента тормозить.

Так не вызывайте отрисовку на каждый принятый пакет.
Пусть принятые данные кладутся в очередь (например - TQueue).
Когда назревает необходимость отрисовки (допустим, по таймеру) - из очереди выгребаются все пакеты и данные рисуются сразу, всем скопом.

По потоку: в соответствии с общими правилами - некорректно создавать объект в одном потоке и начинать его использовать в одном потоке, а основное использование вести в другом. Это я про TIDTCPClient. Перенесите его создание и уничтожение (кстати - а где деструктор?) в Execute вашего потока.

2 часа назад, rust gg сказал:

поток отрабатывает сообщения с сервера, но видит выводит только первый ответ с сервера

На основании чего такой вывод? Я про первую часть - "поток отрабатывает сообщения с сервера"?

Ссылка на комментарий
  • 0

отрисовку я не вызываю на каждый пакет, она происходит в  таймере и  в таймере же происходит принятия пакетов с сервера и тут возникает очередь (это вариант без потока)

"поток отрабатывает сообщения с сервера" - например сервер шлет три сообщения с разными flag, а в мемо попадает три раза одно и тоже, самое первое.

17 минут назад, kami сказал:

Перенесите его создание и уничтожение (кстати - а где деструктор?) в Execute вашего потока.

Перенесу, но от этого ничего не меняется.

Изменено пользователем rust gg
Ссылка на комментарий
  • 0

Накидал вам пример с использование потокобезопасной очереди.

Логика работы такая - поток получает данные и заталкивает их в очередь, в главной форме, в таймере (можно изменить на OnIdle), проверяем очередь на наличие данных, если данные есть, то обрабатываем их.

Обратите внимание на процедуру создания очереди - FQueue:=TThreadedQueue<TRec_Data>.Create(100, 1000, 10); где первый параметр размер очереди (100), второй таймаут заталкивания данных в очередь (1000мс = 1сек), третьй таймаут вытаскивания из очереди (10 мс - маленький,  чтоб таймер у нас не подвисал в ожидании).

Вот код проекта целиком

unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
  System.Generics.Collections,
  IdTCPClient, IdGlobal, FMX.Controls.Presentation, FMX.ScrollBox, FMX.Memo;

type
  TRec_Data = record
    Flag: array[0..20] of char;
  end;

  TMyThread = class(TThread)
  private
    Progress: string;
    Client : TIdTCPClient;
    FQueue : TThreadedQueue<TRec_Data>;
  protected
    procedure Execute; override;
  public
    constructor Create(const AQueue : TThreadedQueue<TRec_Data>);
    destructor Destroy; override;
  end;

  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    FQueue : TThreadedQueue<TRec_Data>;
    FMyThread : TMyThread;
    Timer : TTimer;
    procedure OnTimer(Sender: TObject);
  public
    Memo1: TMemo;
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

procedure TForm1.FormCreate(Sender: TObject);
begin
  FQueue:=TThreadedQueue<TRec_Data>.Create(100, 1000, 10);

  Timer:=TTimer.Create(Self);
  Timer.Interval:=100;
  Timer.OnTimer:=OnTimer;
  Timer.Enabled:=True;

  FMyThread:=TMyThread.Create(FQueue);
  FMyThread.Start;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  if Assigned(FMyThread) then
  begin
    FMyThread.Terminate;
    FMyThread.WaitFor;
    FMyThread.Free
  end;
  if Assigned(Timer) then
    Timer.Free;
  if Assigned(FQueue) then
    FQueue.Free;
end;

procedure TForm1.OnTimer(Sender: TObject);
Var ARec : TRec_Data;
begin
//  while FQueue.PopItem(ARec) = TWaitResult.wrSignaled do или
  if FQueue.PopItem(ARec) = TWaitResult.wrSignaled then
    Form1.Memo1.Lines.Insert(0, ARec.Flag);
end;

constructor TMyThread.Create(const AQueue : TThreadedQueue<TRec_Data>);
var
  Rec: TRec_Data;
  Buffer: TIdBytes;
begin
  inherited Create(true);

  FQueue:=AQueue;

  Client := TIdTCPClient.Create(nil);
  Client.Host := '127.0.0.1';
  Client.Port := 6000;
  Client.Connect;

  // Передаем данные
  if Client.Connected = True then
  begin
    Rec.Flag := 'addUser';

    Buffer := RawToBytes(Rec, SizeOf(Rec));
    Client.IOHandler.Write(Buffer);
  end;
end;

destructor TMyThread.Destroy;
begin
  if Assigned(Client) then
    Client.Free;
  inherited;
end;

procedure TMyThread.Execute;
var
  Rec: TRec_Data;
  Buffer: TIdBytes;
begin
  while Not Terminated do
  begin
    if Client.Connected then
    begin
      Client.IOHandler.ReadBytes(Buffer, SizeOf(Rec));
      BytesToRaw(Buffer, Rec, SizeOf(Rec));
      Progress := Rec.Flag;
//      Synchronize(SetProgress);
      FQueue.PushItem(Rec);
    end
    else
      Client.Connect;
    TThread.Sleep(10);
  end;
end;


end.

Так же обратите внимание, я переписал ваш метод Execute на правильный. В вашей реализации, поток завершался при потере соединения.

Ссылка на комментарий

Присоединяйтесь к обсуждению

Вы можете написать сейчас и зарегистрироваться позже. Если у вас есть аккаунт, авторизуйтесь, чтобы опубликовать от имени своего аккаунта.

Гость
Ответить на вопрос...

×   Вставлено с форматированием.   Вставить как обычный текст

  Разрешено использовать не более 75 эмодзи.

×   Ваша ссылка была автоматически встроена.   Отображать как обычную ссылку

×   Ваш предыдущий контент был восстановлен.   Очистить редактор

×   Вы не можете вставлять изображения напрямую. Загружайте или вставляйте изображения по ссылке.

  • Последние посетители   0 пользователей онлайн

    • Ни одного зарегистрированного пользователя не просматривает данную страницу
×
×
  • Создать...