Поток с использованием семафора

Delphi , Компоненты и Классы , Потоки

Автор: Xavier Pacheco

unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TMainForm = class(TForm)
    Button1: TButton;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
  private
    procedure ThreadsDone(Sender: TObject);
  end;

  TFooThread = class(TThread)
  protected
    procedure Execute; override;
  end;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}

const
  MaxSize = 128;

var
  NextNumber: Integer = 0;
  DoneFlags: Integer = 0;
  GlobalArray: array[1..MaxSize] of Integer;
  hSem: THandle = 0;

function GetNextNumber: Integer;
begin
  Result := NextNumber; // return global var
  Inc(NextNumber); // inc global var
end;

procedure TFooThread.Execute;
var
  i: Integer;
  WaitReturn: DWORD;
begin
  OnTerminate := MainForm.ThreadsDone;
  WaitReturn := WaitForSingleObject(hSem, INFINITE);
  if WaitReturn = WAIT_OBJECT_0 then
  begin
    for i := 1 to MaxSize do
    begin
      GlobalArray[i] := GetNextNumber; // set array element
      Sleep(5); // let thread intertwine
    end;
  end;
  ReleaseSemaphore(hSem, 1, nil);
end;

procedure TMainForm.ThreadsDone(Sender: TObject);
var
  i: Integer;
begin
  Inc(DoneFlags);
  if DoneFlags = 2 then // make sure both threads finished
  begin
    for i := 1 to MaxSize do
      { fill listbox with array contents }
      Listbox1.Items.Add(IntToStr(GlobalArray[i]));
    CloseHandle(hSem);
  end;
end;

procedure TMainForm.Button1Click(Sender: TObject);
begin
  hSem := CreateSemaphore(nil, 1, 1, nil);
  TFooThread.Create(False); // create threads
  TFooThread.Create(False);
end;

end.

Перевод контента на русский язык:

Это проект Delphi, который создает два потока с помощью компонента TThread. Основная форма имеет кнопку и список элементов. Когда кнопка нажата, она создает два потока типа TFooThread. Каждый поток работает параллельно и заполняет массив числами от 1 до MaxSize (128). Массив共享 между потоками.

Семафор (hSem) используется для синхронизации потоков. Перед началом каждой итерации цикла, поток ожидает, пока семафор не будет освобожден. После заполнения массива, поток освобождает семафор, вызывая ReleaseSemaphore.

Когда оба потока закончили работу, процедура ThreadsDone основной формы вызывается. Эта процедура увеличивает счетчик (DoneFlags) и проверяет, достигнуто ли значение 2 (оба потока закончили работу). Если так, она закрывает handle семафора и заполняет список элементов содержимым массива.

Код можно улучшить, добавив более ошибок и обработки. Например, вы можете проверять, не возникло ли ошибка при создании семафора или потоков, и обрабатывать эти ошибки соответствующим образом.

Альтернативное решение с использованием TThreadList вместо общего массива:

unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;

type
  TMainForm = class(TForm)
    Button1: TButton;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
  private
    procedure ThreadsDone(Sender: TObject);
  end;

  TFooThread = class(TThread)
  protected
    procedure Execute; override;
  end;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}

const
  MaxSize = 128;

var
  GlobalList: TThreadList;

procedure TFooThread.Execute;
begin
  OnTerminate := MainForm.ThreadsDone;
  while GlobalList.Count < MaxSize do
  begin
    GlobalList.Add(GetNextNumber);
    Sleep(5);
  end;
end;

procedure TMainForm.ThreadsDone(Sender: TObject);
var
  i: Integer;
begin
  if GlobalList.Count = MaxSize then
  begin
    for i := 0 to GlobalList.Count - 1 do
      ListBox1.Items.Add(IntToStr(GlobalList[i]));
    FreeAndNil(GlobalList);
  end;
end;

procedure TMainForm.Button1Click(Sender: TObject);
begin
  GlobalList := TThreadList.Create;
  TFooThread.Create(False); // create threads
  TFooThread.Create(False);
end;

end.

В этом альтернативном решении используется TThreadList для хранения чисел. Каждый поток добавляет свои числа в список, пока не достигнет MaxSize. Когда оба потока закончили работу, процедура ThreadsDone основной формы вызывается, которая заполняет список элементов содержимым списка и затем освобождает список.

Статья описывает пример использования семафора в многопоточном программировании на языке Delphi для синхронизации доступа к общим ресурсам между потоками.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Потоки ::