program APIThreadConflictCritSec;

uses
  Windows,
  SysUtils,
  Dialogs,
  Messages;

const AppName='Конфлікт потоків - критичні секції';

var AMessage  : TMsg;
    hWindow   : HWnd;
    hBtnExit  : HWnd;
    hBtnThreads : HWnd;

    PI        : TProcessInformation;
    hThread1, hThread2, hThread3: THandle;
    ThreadID  : DWORD;

    A         : DWORD = 0;
    Handles   : array[0..2] of DWORD;

    ICriSec   : TRTLCriticalSection;

function ThreadFunc(Ptr: Pointer): LongInt;
var I : integer;
begin
  for I := 1 to 1000000 do begin
    // Якийсь код
    EnterCriticalSection(ICriSec);
    Inc(A);
    LeaveCriticalSection(ICriSec);
    // Якийсь код
  end;
end;

function WindowProc(Window: HWnd; AMessage, WParam, LParam: longint): longint; stdcall; export;
begin
  WindowProc := 0;
  case AMessage of
    WM_DESTROY: begin PostQuitMessage(0); Exit; end;
    WM_COMMAND: if LParam = hBtnExit then begin PostQuitMessage(0); Exit; end
                  else if LParam = hBtnThreads then begin
                    hThread1 := BeginThread(nil, 0, @ThreadFunc, nil, 0, ThreadID);
                    SetThreadPriority(hThread1, THREAD_PRIORITY_IDLE);

                    hThread2 := BeginThread(nil, 0, @ThreadFunc, nil, 0, ThreadID);

                    hThread3 := BeginThread(nil, 0, @ThreadFunc, nil, 0, ThreadID);
                    SetThreadPriority(hThread3, THREAD_PRIORITY_HIGHEST);
                    Handles[0] := hThread1;
                    Handles[1] := hThread2;
                    Handles[2] := hThread3;
                    WaitForMultipleObjects(3, @Handles, true, INFINITE);
                    PostQuitMessage(0);
                  end;
    WM_KEYDOWN: if (wParam = VK_RETURN) or (wParam = VK_ESCAPE) then SendMessage(hBtnExit, BM_CLICK, 0, 0);
  end;
  WindowProc  := DefWindowProc(Window, AMessage, WParam, LParam);
end;

function WinRegister: boolean;
var WindowClass: TWndClass;
begin
  with WindowClass do begin
    Style := CS_HREDRAW or CS_VREDRAW;
    lpfnWndProc := @WindowProc;
    cbClsExtra := 0;
    cbWndExtra := 0;
    hInstance := SysInit.HInstance;
    hIcon := LoadIcon(0, IDI_APPLICATION);
    hCursor :=  LoadCursor(0, IDC_ARROW);
    hbrBackGround := COLOR_WINDOW;
    lpszMenuName := nil;
    lpszClassName := AppName;
  end;
  Result := RegisterClass(WindowClass) <> 0;
end;

function WinCreate: HWnd;
var hWindow : HWnd;
begin
  hWindow := CreateWindow(AppName, Appname, WS_OVERLAPPEDWINDOW,
    200, 100, 300, 200, 0, 0, HInstance, nil);

  if hWindow<>0 then begin
    ShowWindow(hWindow, SW_SHOWNORMAL);
    UpdateWindow(hWindow);
    hBtnExit := CreateWindow('BUTTON', 'Вихід', WS_CHILD or BS_DEFPUSHBUTTON or WS_TABSTOP,
      200, 10, 90, 30, hWindow, 0, HInstance, nil);
    if hBtnExit <> 0 then ShowWindow(hBtnExit, SW_SHOWNORMAL);
    hBtnThreads := CreateWindow('BUTTON', 'Потоки', WS_CHILD or WS_TABSTOP,
      200, 70, 90, 30, hWindow, 0, HInstance, nil);
    if hBtnThreads <> 0 then ShowWindow(hBtnThreads, SW_SHOWNORMAL);
  end;
  Result := hWindow;
end;

begin
  if not WinRegister then begin
    MessageBox(0, 'Клас вікна не зареєстровано', AppName, MB_OK);
    Exit;
  end;
  hWindow := WinCreate;
  if hWindow = 0 then begin
    MessageBox(0, 'Не вийшло створити вікно.', AppName, MB_OK);
    Exit;
  end;

  InitializeCriticalSection(ICriSec);

  while GetMessage(AMessage,0,0,0) do begin
    TranslateMessage(AMessage);
    DispatchMessage(AMessage);
  end;

  ShowMessage('Результат: ' + IntToStr(A));

  CloseHandle(hThread1);
  CloseHandle(hThread2);
  CloseHandle(hThread3);

  CloseHandle(PI.hThread);
  CloseHandle(PI.hProcess);

  DeleteCriticalSection(ICriSec);

  Halt(AMessage.wParam);
end.
