unit u_test;
{$mode objfpc}

interface

type
	TTest = class
	private
		FData: Integer;
	public
		constructor Create;
		destructor Destroy; override;
		procedure OutputData;
		procedure IncData(Value: Integer);
		procedure RandomData;
		property Data: Integer read FData write FData;
	end;

var
	Test: TTest = nil;

implementation

constructor TTest.Create;
begin
	FData := 0;
end;

destructor TTest.Destroy;
begin
	WriteLn('I''m dying!');
end;

procedure TTest.OutputData;
begin
	WriteLn('Data: ', FData);
end;

procedure TTest.IncData(Value: Integer);
begin
	Inc(FData, Value);
end;

procedure TTest.RandomData;
var
	Temp: Integer;
begin
	Temp := Random(10);
	FData := Temp;
end;

initialization
	Test := TTest.Create;
finalization
	Test.Destroy;
end.

unit u_test;
{$mode objfpc}

interface

type
	TTest = class
	private
		FData: Integer;
		{Объявляем Mutex;}
		function GetData: Integer;
		procedure SetData(Value: Integer);
	public
		constructor Create;
		destructor Destroy; override;
		procedure OutputData;
		procedure IncData(Value: Integer);
		procedure RandomData;
		property Data: Integer read GetData write SetData;
	end;

var
	Test: TTest = nil;

implementation

// private

function TTest.GetData: Integer;
begin
	try
		{Пытаемся захватить Mutex в течении N секунд.}
		if {получилось} then
			Result := FData
		else begin
			Result := 0;
			WriteLn('Error reading.');
		end;
	finally
		{Освобождаем Mutex.}
	end;
end;

procedure TTest.SetData(Value: Integer);
begin
	try
		{Пытаемся захватить Mutex в течении N секунд;}
		if {получилось} then
			FData := Value;
		else
			WriteLn('Error writing.');
	finally
		{Освобождаем Mutex;}
	end;
end;

// public

constructor TTest.Create;
begin
	FData := 0;
	{Создаем Mutex;}
end;

destructor TTest.Destroy;
begin
	WriteLn('I''m dying!');
end;

procedure TTest.OutputData;
begin
	WriteLn('Data: ', Data);
end;

procedure TTest.IncData(Value: Integer);
begin
	Data := Data + Value;
end;

procedure TTest.RandomData;
var
	Temp: Integer;
begin
	Temp := Random(10);
	Data := Temp;
end;

initialization
	Test := TTest.Create;
finalization
	Test.Destroy;
end.

	try
		{Пытаемся захватить Mutex в течении N секунд;}
		if {получилось} then
			FData := Value;
	finally
		{Освобождаем Mutex;}
	end;

	{Пытаемся __установить__ Mutex в течении N секунд;}
	if {получилось} then
		FData := Value;
		{Освобождаем Mutex;}
	end;

unit u_test;
{$mode objfpc}

interface

type
	TTest = class
	private
		FData: Integer;
		CS: TRTLCriticalSection;
		function GetData: Integer;
		procedure SetData(Value: Integer);
	public
		constructor Create;
		destructor Destroy; override;
		procedure OutputData;
		procedure IncData(Value: Integer);
		procedure RandomData;
		property Data: Integer read GetData write SetData;
	end;

var
	Test: TTest = nil;

implementation

// private

function TTest.GetData: Integer;
begin
	try
		EnterCriticalSection(CS);
		Result := FData;
	finally
		LeaveCriticalSection(CS);
	end;
end;

procedure TTest.SetData(Value: Integer);
begin
	try
		EnterCriticalSection(CS);
		FData := Value;
	finally
		LeaveCriticalSection(CS);
	end;
end;

// public

constructor TTest.Create;
begin
	FData := 0;
	InitCriticalSection(CS);
end;

destructor TTest.Destroy;
begin
	DoneCriticalSection(CS);
	WriteLn('I''m dying!');
end;

procedure TTest.OutputData;
begin
	WriteLn('Data: ', Data);
end;

procedure TTest.IncData(Value: Integer);
begin
	Data := Data + Value;
end;

procedure TTest.RandomData;
var
	Temp: Integer;
begin
	Temp := Random(10);
	Data := Temp;
end;

initialization
	Test := TTest.Create;
finalization
	Test.Destroy;
end.

function TD3DWindow.MessageProc(Msg: UINT; WParam: WPARAM; LParam: LPARAM): LResult;
begin
	case Msg of
		WM_DESTROY: begin
			PostQuitMessage(0);
		end;
		WM_SYSCOMMAND: begin
			if (WParam = SC_SCREENSAVE) or (WParam = SC_MONITORPOWER) then
				Result := 0
			else
				Result := DefWindowProc(WinHandle, Msg, WParam, LParam);
		end;
		WM_SYSKEYUP: begin
			if WParam = VK_RETURN then SetFullscreenMode(D3DPP.Windowed) { <- Тут прозреваю небезопасный вызов метода. }
			else if Char(WParam) = '1' then SetMode('800x600x32') { <- И тут. }
			else if Char(WParam) = '2' then SetMode('1024x768x32') { <- И тут. }
			else if Char(WParam) = '3' then SetMode('1280x1024x32'); { <- И тут. }
		end;
		else
			Result := DefWindowProc(WinHandle, Msg, WParam, LParam);
  end;
end;

TSprite = class(TGraphicObject)
	private
		Texture: TTexture;
		CurrentMode: Integer;
		FramesNum: Integer;
		CurrentFrame: Integer;
		FrameInterval: Double;
		RepeatAnimation: Boolean;
		FrameTime: Double;
		SpriteCenter: TD3DXVECTOR3;
		Scale: TD3DMATRIX;
		Rotate: TD3DMATRIX;
		Translate: TD3DMATRIX;
		Transform: TD3DMATRIX;
		FWidth, FHeight: Integer;
	public
		// Width, Height - размеры спрайта (в тайлах, могут быть дробными).
		// Texture - имя файла с текстурой, которая должна быть наложена на спрайт.
		// AWidth, AHeight - размеры спрайта (размеры одного кадра тектсуры в пикселах).
		constructor Create(const TextureName: AnsiString; AWidth, AHeight: Integer);
		// Деструктор автоматически пытается удалить объект из контейнера Sprites.
		destructor Destroy; override;
		// Установка параметров анимации. Параметры:
		// Mode - номер анимации. Frame - номер текущего кадра. Frames - число кадров.
		// CenterX, CenterY - координаты центра спрайта, относительно которого отсчитываются
		// координаты и происходит поворот.
		// Interval -  время показа кадра в мс, 0, если анимация не нужна.
		// RepeatAni - повторять ли анимацию.
		procedure SetMode(Mode, Frame, Frames, CenterX, CenterY, Interval: Integer; RepeatAni: Boolean);
		// Установить параметры: координаты, угол поворота, масштаб.
		procedure SetParams(X, Y, Z, Angle, ScaleX, ScaleY: Single);
		// Нарисаовать спрайт.
		procedure Draw;
		// Обработчик спрайта. Принимает время, прошедшее с предыдущего вызова в мс.
		procedure Update(Delta: Double); override;
		property Width: Integer read FWidth;
		property Height: Integer read FHeight;
	end;

uses sysutils, classes,
     u_test;

type
  tmythread = class(tthread)
  private
    msg: string;
    num: string;
  protected
    procedure execute; override;
  public
    constructor create(s, n: string);
  end;

constructor tmythread.create(s, n: string);
begin
  msg := s; num := n;
  inherited create(false);
end;

procedure tmythread.execute;
begin
  repeat
    Log.Write(num, msg);
  until terminated;
end;

const n = 50;
var
  thrds: array[1 .. n] of TMyThread;
  i: integer;
begin
  for i := 1 to n do begin
    thrds[i] := TMyThread.Create('message #' + IntToStr(i), IntToStr(i));
  end;
  readln;
  for i := n downto 1 do begin
    thrds[i].Terminate; thrds[i].Destroy;
  end;
end.

unit u_test;
{$mode objfpc}

interface

uses
	windows, sysutils;

type
	TLog = class
	private
		FLogFile: Text;
		FLock: TMultiReadExclusiveWriteSynchronizer;
		procedure WriteString(const Str: string);
	public
		constructor Create(const FileName: string);
		destructor Destroy; override;
		procedure Write(const SenderName, Str: string);
	end;

var
	Log: TLog;

implementation

const
	TimeFormat = 'yyyy-mm-dd hh:mm:ss.zzz';

// TLog -----

// private

procedure TLog.WriteString(const Str: string);
begin
	FLock.BeginWrite;
	try
		{$I-}
		WriteLn(FLogFile, Str);
		Flush(FLogFile);
		{$I+}
		if IOResult <> 0 then begin
			MessageBox(0, 'Can''t write to log file. Program halted.', 'File error', MB_OK);
			Halt(0);
		end;
	finally
		FLock.EndWrite;
	end;
end;

// public

constructor TLog.Create(const FileName: string);
begin
	FLock := TMultiReadExclusiveWriteSynchronizer.Create;
	{$I-}
	Assign(FLogFile, FileName);
	if FileExists(FileName) then Append(FLogFile) else Rewrite(FLogFile);
	{$I+}
	if (IOResult = 0) and (FileName <> '') then begin
		WriteString('');
		WriteString('*** Start session ***');
	end else begin
		MessageBox(0, 'Can''t create or open log file. Program halted.', 'File error', MB_OK);
		Halt(0);
	end;
end;

destructor TLog.Destroy;
begin
	WriteString('*** End session ***');
	Close(FLogFile);
	FLock.Free;
end;

procedure TLog.Write(const SenderName, Str: string);
begin
	WriteString(FormatDateTime(TimeFormat, Now) + ' Note: "' + SenderName + '" - ' + Str);
end;

initialization
	Log := TLog.Create('threads.txt');
finalization
   Log.Destroy;
end.