Недавно добавленные исходники

•  DeLiKaTeS Tetris (Тетрис)  4 826

•  TDictionary Custom Sort  6 821

•  Fast Watermark Sources  6 600

•  3D Designer  9 562

•  Sik Screen Capture  6 941

•  Patch Maker  7 389

•  Айболит (remote control)  7 335

•  ListBox Drag & Drop  6 193

•  Доска для игры Реверси  98 180

•  Графические эффекты  7 506

•  Рисование по маске  6 792

•  Перетаскивание изображений  5 647

•  Canvas Drawing  6 026

•  Рисование Луны  5 818

•  Поворот изображения  5 268

•  Рисование стержней  3 861

•  Paint on Shape  3 017

•  Генератор кроссвордов  3 973

•  Головоломка Paletto  3 150

•  Теорема Монжа об окружностях  3 986

•  Пазл Numbrix  2 633

•  Заборы и коммивояжеры  3 444

•  Игра HIP  2 360

•  Игра Go (Го)  2 278

•  Симулятор лифта  2 676

•  Программа укладки плитки  2 236

•  Генератор лабиринта  2 791

•  Проверка числового ввода  2 396

•  HEX View  2 732

•  Физический маятник  2 424

 
скрыть

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



Автор: 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;
  hMutex: THandle = 0;

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

procedure TFooThread.Execute;
var
  i: Integer;
begin
  FreeOnTerminate := True;
  OnTerminate := MainForm.ThreadsDone;
  if WaitForSingleObject(hMutex, INFINITE) = 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;
  ReleaseMutex(hMutex);
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(hMutex);
  end;
end;

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

end.




Похожие по теме исходники

Потоки NTFS

Потоки Multi Thread