1. Do you speak English? Use the English version of the site! Link
    Скрыть объявление
Скрыть объявление
Здравствуй гость! После регистрации на ресурсе, ты сможешь скачивать материалы с форума и участвовать в его жизни! Для регистрации откройте соответствующую форму или нажмите на эту ссылку.

Многопотоковая обработка delphi

Тема в разделе "Статьи", создана пользователем AnGel, 09.10.2015.

  1. AnGel

    AnGel Администратор
    Команда форума

    Дек 05 2016 в 00:51
    Регистрация:
    27.08.2015
    Сообщения:
    1.782
    Симпатии:
    1.299
    Пример: выполнить имитатор гонок (в просторечии эта задача известна как «тараканьи бега» ) при помощи создания нескольких потоков. Каждый поток обслуживает свою «беговую дорожку». На исполнение все потоки запускаются одновременно, после чего потоки произвольным образом приостанавливаются и запускаются вновь функциями SuspendThread() и ResumeThread().

    На исполнение каждому потоку выделяется квант времени (например, 500 мс или 1 с). За этот период поток производит выполнение задачи, например, увеличивает позицию гонщика на некоторую величину. После истечения кванта времени поток приостанавливается на производный период времени, определяемый при помощи генератора случайных чисел.
    После завершения гонки производиться выдача результатов(очередность завершения).
    Завершение потока после завершения исполнения можно произвести при помощи функций ExitThread() и TerminateThread().

    a3d4f533293c246d313ad216c542865f.png

    Использование класса TThread, включенного в поставку interise Delphi или C++ Builder, допускается в ознакомительных целях.


    Сделал вот так, на счет 100% правильности конечно говорить не приходиться, но думаю, что правильно. Кто ни чего не делает то не ошибается))

    Код:
    unit unitMain;
    
    interface
    
    uses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, StdCtrls, ComCtrls;
    
    const
      PROGRESS_POS = WM_USER+1;//установка значения
      EXITTHREAD_MESSAGE=WM_USER+2;//выход из потока
    type
      TfrmMain = class(TForm)
        ProgressBar1: TProgressBar;
        ProgressBar2: TProgressBar;
        ProgressBar3: TProgressBar;
        ProgressBar4: TProgressBar;
        ProgressBar5: TProgressBar;
        btnStart: TButton;
        btnStop: TButton;
        btnClear: TButton;
        btnExit: TButton;
        Memo1: TMemo;
        Label1: TLabel;
        procedure btnStartClick(Sender: TObject);
        procedure btnStopClick(Sender: TObject);
        procedure btnClearClick(Sender: TObject);
        procedure FormClose(Sender: TObject; var Action: TCloseAction);
        procedure FormCreate(Sender: TObject);
        procedure btnExitClick(Sender: TObject);
      private
        { Private declarations }
        procedure SetProgressPos(var Msg: TMessage); message PROGRESS_POS;
        procedure MSExitThread(var Msg: TMessage); message EXITTHREAD_MESSAGE;
      public
        { Public declarations }
      end;
    
      //процедура выполняемая в отдельном потоке
      procedure procedurePotoc1(aValue:PInteger);stdcall;
    const
      countThread=5;//кол-во потоков
    
    var
      frmMain: TfrmMain;
      thread:array[1..countThread] of THandle;//массив для хранения
      threadID:array[1..countThread] of DWORD;
      bStop,vse:Boolean;
      Poriadok:TStringList;
    implementation
    
    {$R *.dfm}
    //процедура выполняемая в отдельном потоке
    procedure procedurePotoc1(aValue:PInteger);stdcall;
    var
      i:Integer;
    begin
      for I := 0 to 100 do
      begin
        Randomize;
        Sleep(Random(100)+50);
        SendMessage(frmMain.Handle,PROGRESS_POS, aValue^, i);
      end;
      SendMessage(frmMain.Handle,EXITTHREAD_MESSAGE, aValue^, 0);
    end;
    
    procedure TfrmMain.btnClearClick(Sender: TObject);
    var
      i:Integer;
    begin
      for i := 1 to countThread do
      begin
        if thread[i]>0 then //проверка того, что он вообще запускался))
          if TerminateThread(thread[i],0) then
            thread[i]:=0;
      end;
      ProgressBar1.Position:=0;
      ProgressBar2.Position:=0;
      ProgressBar3.Position:=0;
      ProgressBar4.Position:=0;
      ProgressBar5.Position:=0;
      Poriadok.Clear;
      Memo1.Lines.Clear;
    end;
    
    procedure TfrmMain.btnExitClick(Sender: TObject);
    begin
      frmMain.Close;
    end;
    
    procedure TfrmMain.btnStartClick(Sender: TObject);
    var
      i:Integer;
      n:Integer;
    begin
      for i := 1 to countThread do
      begin
        if thread[i]=0 then
        begin
          thread[i]:=CreateThread(nil,0, @procedurePotoc1, @thread[i], 0, threadID[i]);
        end;
        if (thread[i] = 0) then
          ShowMessage('Поток не создан '+IntToStr(i));
      end;
      Poriadok.Clear;
    end;
    
    procedure TfrmMain.btnStopClick(Sender: TObject);
    var
      i:Integer;
    begin
      for i := 1 to countThread do
      begin
        if bStop then
        begin
          ResumeThread(thread[i]);
        end
        else
        begin
          SuspendThread(thread[i]);
        end;
      end;
      if bStop then
        bStop:=False
      else
        bStop:=True;
    end;
    
    procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
    begin
      btnClearClick(Self);
      Poriadok.Free;
    end;
    
    
    procedure TfrmMain.FormCreate(Sender: TObject);
    begin
      Poriadok:=TStringList.Create;
    end;
    
    procedure TfrmMain.MSExitThread(var Msg: TMessage);
    var
      i:Integer;
      temp:cardinal;
    begin
      temp:=0;
      for I := 1 to countThread do
      begin
        if thread[i]=Msg.WParam then
        begin
          thread[i]:=0;
          Poriadok.Add('"Таракан" №'+IntToStr(i));
        end;
        temp:=temp+thread[i];
        if temp=0 then//все потоки завершились или нет
          vse:=True
        else
          vse:=False;
      end;
      if vse then//все потоки завершились или нет
        Memo1.Lines:=Poriadok;
    end;
    
    procedure TfrmMain.SetProgressPos(var Msg: TMessage);
    var
      i:Integer;
      n:Integer;
      hN:THandle;
    begin
      for i:= 1 to countThread  do
      begin
        if thread[i]=Msg.WParam then
          TProgressBar(Self.FindComponent('ProgressBar'+IntToStr(i))).Position:=Msg.LParam;
      end;
    end;
    end.
    
    Синхронизацию с VCL реализовал путем обмена сообщениями.

    Скачать: Ссылки могут видеть только зарегистрированные пользователи. Зарегистрируйтесь или авторизуйтесь для просмотра ссылок!