Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Архив1 / docx31 / Отчет (3).docx
Скачиваний:
96
Добавлен:
01.08.2013
Размер:
606.3 Кб
Скачать

Implementation

procedure ThreadWorking(Self:TFilosof); stdcall;

begin

while Self.FWorkThread do

begin

Self.FState:=2;

WaitForSingleObject(Self.FVilka,INFINITE); Self.DoVilkaCapture; Self.FState:=4;

WaitForSingleObject(Self.FNoj,INFINITE); Self.DoNojCapture;

if not Self.FWorkThread then Break;

Self.FState:=1;

Sleep(Self.FTimeToEat*1000);

ReleaseSemaphore(Self.FNoj,1,nil); Self.DoNojPut;

ReleaseSemaphore(Self.FVilka,1,nil); Self.DoVilkaPut;

if not Self.FWorkThread then Break;

Self.FState:=0;

Sleep(self.FTimeToThink*1000+1);

end;

Self.FState:=3;

end;

{ TFilosof }

constructor TFilosof.Create(AVilka, ANoj: THandle);

begin

inherited Create;

self.FVilka:=AVilka;

self.FNoj:=ANoj;

FState:=0;

FTimeToThink:=5;

FTimeToEat:=10;

end;

destructor TFilosof.Destroy;

begin

inherited;

end;

procedure TFilosof.DoNojCapture;

begin

if Assigned(FOnNojCapture) then FOnNojCapture(Self);

end;

procedure TFilosof.DoNojPut;

begin

if Assigned(FOnNojPut) then FOnNojPut(Self);

end;

procedure TFilosof.DoVilkaCapture;

begin

if Assigned(FOnVilkaCapture) then FOnVilkaCapture(Self);

end;

procedure TFilosof.DoVilkaPut;

begin

if Assigned(FOnVilkaPut) then FOnVilkaPut(Self);

end;

procedure TFilosof.SetTimeToEat(const Value: Cardinal);

begin

if Value>3600 then raise Exception.Create('Слишком много придется ждать!');

FTimeToEat := Value;

end;

procedure TFilosof.SetTimeToThink(const Value: Cardinal);

begin

if Value>3600 then raise Exception.Create('Слишком много придется ждать!');

FTimeToThink := Value;

end;

procedure TFilosof.Start;

var lpThreadId:Cardinal;

begin

FWorkThread:=true;

FThread:=CreateThread(nil,0,@ThreadWorking,Self,0,lpThreadId);

end;

procedure TFilosof.Stop;

begin

FWorkThread:=false;

end;

end.

//--------------------------------------------------------------------------------------

UnitUnit1

Interface

uses

Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,

Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,Filosof, Vcl.ExtCtrls,

JvExExtCtrls, JvImage, Vcl.Imaging.jpeg, Vcl.Imaging.GIFImg;

type

TMain = class(TForm)

JvImage1: TJvImage;

JvImage2: TJvImage;

JvImage3: TJvImage;

JvImage4: TJvImage;

JvImage5: TJvImage;

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

Label4: TLabel;

Label5: TLabel;

Timer1: TTimer;

Label6: TLabel;

Label7: TLabel;

Image1: TImage;

Image2: TImage;

procedure FormShow(Sender: TObject);

procedure Timer1Timer(Sender: TObject);

private

procedure FilosofVilkaCapture(Sender: TObject);

procedure FilosofNojCapture(Sender: TObject);

procedure FilosofVilkaPut(Sender: TObject);

procedure FilosofNojPut(Sender: TObject);

public

{ Public declarations }

end;

TPointF = record

x,y:Integer;

end;

const

nmax = 100;

nFil = 5;

var

Main: TMain;

VilkaHandle,NojHandle:THandle;

Filosofs:array[1..nmax] of TFilosof;

Images:array[1..nmax] of TImage;

ImgOfState:array[1..nmax] of TImage;

TimeGolodovka:Array[1..nmax] of Cardinal;

PrevStateOfFilosof:array[1..nmax] of Byte;

VilkaCnt,NojCnt:Integer;

tmp,tmp2:integer;

Соседние файлы в папке docx31