Компьютерный форум
Правила
Вернуться   Компьютерный форум > Форум программистов > Офтопик > Работа > Задания за деньги
Перезагрузить страницу Необходимо прокомментировать код программы.
Ответ
 
Опции темы Опции просмотра
  (#1 (permalink)) Старый
Линус Линус вне форума
Member
 
Сообщений: 25
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Регистрация: 22.12.2014
По умолчанию Необходимо прокомментировать код программы. - 17.03.2015, 21:48

Здравствуйте. Необходимо прокомментировать код программы.
Очень подробное комментирование.Чтобы было все понятно человеку, который ни разу не видел код вообще в жизни.
unit Example02;

interface

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

const
WIDTH_02 = 45;
HEIGHT_02 = 29;
GM_DRAW_02 = GM_USER;

type
TX_02 = 0..WIDTH_02 - 1;
TY_02 = 0..HEIGHT_02 - 1;

// Направление движения - приращения по X и Y
TDirection02 = record
X, Y: -1..1;
end;

TForm02 = class(TForm)
Panel: TPanel;
PaintBox: TPaintBox;
LabelCMaxProcess: TLabel;
LabelMaxProcess: TLabel;
ScrollBarMaxProcess: TScrollBar;
LabelCProcessCount: TLabel;
LabelProcessCount: TLabel;
LabelListCount: TLabel;
ButtonStart: TButton;
ButtonFinish: TButton;

procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ButtonStartClick(Sender: TObject);
procedure ButtonFinishClick(Sender: TObject);
procedure ScrollBarMaxProcessChange(Sender: TObject);

private
CellWidth,
CellHeight: Integer;
ScaleX,
ScaleY: Double;
Group: Integer;
Count,
MaxCount: Integer;

procedure OnDraw(var Mes: TMessage); message GM_DRAW_02;
procedure OnStart(var Mes: TMessage); message GM_PROCESS_START;
procedure OnTermination(var Mes: TMessage); message GM_PROCESS_TERMINATE;
procedure ShowListCount;

public
function CanCreate: Boolean;
end;

TProcess02 = class(TGalaProcess)
private
DeathTick,
DivideTick: Cardinal;
Direction: TDirection02;
Speed: Integer;

protected
procedure Execute; override;
procedure OnNormalTermination; override;
procedure OnPrematureTermination; override;

public
PrevPoint,
NextPoint: TPoint;
Color: TColor;
CanChildCreate: Boolean;

constructor Create(aGroup: Integer; aParentForm: TForm; aPoint: TPoint;
aDirection: TDirection02);
end;

implementation

{$R *.DFM}

const
{$IFDEF RUSSIAN_VERSION}
SWindowCaption = 'Размножающиеся процессы';
SMaxCaption = 'Макс. процессов';
SCountCaption = 'Число процессов';
SStartCaption = 'Start';
SFinishCaption = 'Finish';
{$ENDIF}

var
FormX, FormY: Integer;

{ TForm02 }

procedure TForm02.FormCreate(Sender: TObject);
begin
Left := FormX mod (Screen.DesktopWidth - Width);
Top := FormY mod (Screen.DesktopHeight - Height);
FormX := FormX + 32;
FormY := FormY + 32;
Group := 0;
Count := 0;
MaxCount := 5;
with PaintBox do begin
CellWidth := Width div WIDTH_02;
CellHeight := Height div HEIGHT_02;
ScaleX := Width / WIDTH_02;
ScaleY := Height / HEIGHT_02;
end;
LabelMaxProcess.Caption := IntToStr(MaxCount);
ScrollBarMaxProcess.Position := MaxCount;
Caption := SWindowCaption;
LabelCMaxProcess.Caption := SMaxCaption;
LabelCProcessCount.Caption := SCountCaption;
ButtonStart.Caption := SStartCaption;
ButtonFinish.Caption := SFinishCaption;
ShowListCount;
end;

procedure TForm02.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if Group <> 0 then begin
GalaTheater.DestroyGroup(Group);
Group := 0;
end;
Action := caFree;
end;

procedure TForm02.ButtonStartClick(Sender: TObject);
var
p: TPoint;
d: TDirection02;
begin
try
Group := GalaTheater.GetNewGroup;
p.x := (WIDTH_02 div 4) + Random(WIDTH_02 div 2);
p.y := (HEIGHT_02 div 4) + Random(HEIGHT_02 div 2);
d.x := 1;
d.y := -1;
ButtonStart.Enabled := False;
TProcess02.Create(Group, Self, p, d);
ButtonFinish.Enabled := True;
except
on E: EGalaObjectCreationFail do begin
Application.MessageBox(PChar(E.Message), 'GalaExample', MB_OK);
Group := 0;
end;
end;
end;

procedure TForm02.ButtonFinishClick(Sender: TObject);
begin
if GalaTheater.TryToDestroyGroup(Group) then begin
ButtonFinish.Enabled := False;
ButtonStart.Enabled := True;
end;
end;

procedure TForm02.ScrollBarMaxProcessChange(Sender: TObject);
begin
MaxCount := ScrollBarMaxProcess.Position;
LabelMaxProcess.Caption := IntToStr(MaxCount);
end;

procedure TForm02.OnDraw(var Mes: TMessage);
var
rp, rn: TRect;
begin
with TProcess02(Mes.LParam) do begin
with rp, PrevPoint do begin
Left := Round(ScaleX * x);
Right := Left + CellWidth;
Top := Round(ScaleY * y);
Bottom := Top + CellHeight;
end;
with rn, NextPoint do begin
Left := Round(ScaleX * x);
Right := Left + CellWidth;
Top := Round(ScaleY * y);
Bottom := Top + CellHeight;
end;
with PaintBox.Canvas do begin
Brush.Color := clWhite;
FillRect(rp);
Brush.Color := Color;
FillRect(rn);
end;
end;
end;

procedure TForm02.OnStart(var Mes: TMessage);
begin
ShowListCount;
Inc(Count);
LabelProcessCount.Caption := IntToStr(Count);
end;

procedure TForm02.OnTermination(var Mes: TMessage);
begin
ShowListCount;
Dec(Count);
LabelProcessCount.Caption := IntToStr(Count);
end;

procedure TForm02.ShowListCount;
begin
LabelListCount.Caption := Format('A:%d, T:%d',
[GalaTheater.AllActiveCount, GalaTheater.AllTerminatedCount]);
end;

function TForm02.CanCreate: Boolean;
begin
result := Count < MaxCount;
end;

{ TProcess02 }

procedure TProcess02.Execute;
var
p: TPoint;
d: TDirection02;
const
Border = 3;
begin
FFreeOnTerminate := True;
Priority := -1;
DivideTick := GetTickCount + 1000 + Cardinal(Random(2000));
Send(GM_PROCESS_START);
while (not Terminated) and (GetTickCount < DeathTick) do begin
with NextPoint do begin
x := PrevPoint.x + Direction.x;
y := PrevPoint.y + Direction.y;
if (x <= Low(TX_02)) or (x >= High(TX_02)) then
Direction.x := -Direction.x;
if (y <= Low(TY_02)) or (y >= High(TY_02)) then
Direction.y := -Direction.y;
end;
if (GetTickCount > DivideTick) then begin
DivideTick := GetTickCount + 1000 + Cardinal(Random(2000));
if (PrevPoint.x >= (Low(TX_02) + Border)) and
(PrevPoint.y >= (Low(TY_02) + Border)) and
(PrevPoint.x <= (High(TX_02) - Border)) and
(PrevPoint.y <= (High(TY_02) - Border)) and
((ParentForm as TForm02).CanCreate) then
begin
p := PrevPoint;
d := Direction;
d.x := -d.x;
try
TProcess02.Create(Group, ParentForm, p, d);
except
on EGalaObjectCreationFail do
Beep;
end;
end;
end;
try
Send(GM_DRAW_02, Self, ParentForm, 200);
PrevPoint := NextPoint;
Pause(Speed);
except
on EGalaTimeout do
Terminate;
end;
end;
end;

procedure TProcess02.OnPrematureTermination;
begin
OnNormalTermination;
end;

procedure TProcess02.OnNormalTermination;
begin
Color := clWhite;
Send(GM_DRAW_02);
Send(GM_PROCESS_TERMINATE);
end;

constructor TProcess02.Create(aGroup: Integer; aParentForm: TForm;
aPoint: TPoint; aDirection: TDirection02);
begin
inherited Create(aGroup, aParentForm);
PrevPoint := aPoint;
NextPoint := PrevPoint;
Direction := aDirection;
Color := TColor(Random(Integer(clYellow)));
DeathTick := GetTickCount + 5000 + Cardinal(Random(10000));
Speed := 40 + Random(200);
end;

initialization
FormX := 0;
FormY := 120;

end.
Ответить с цитированием
  (#2 (permalink)) Старый
Линус Линус вне форума
Member
 
Сообщений: 25
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Регистрация: 22.12.2014
По умолчанию прокомментировать код программы. - 17.03.2015, 21:52

Здравствуйте. Необходимо прокомментировать код программы.
Очень подробное комментирование.Чтобы было все понятно человеку, который ни разу не видел код вообще в жизни.
unit Example01;

interface

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

const
GM_DRAW_01 = GM_USER;

type
TForm01 = class(TForm)
Label1: TLabel;
LabelCounter: TLabel;
ButtonStart: TButton;

procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ButtonExitClick(Sender: TObject);
procedure ButtonStartClick(Sender: TObject);

private
Group: Integer;

procedure OnDraw(var Mes: TMessage); message GM_DRAW_01;
end;

TProcess01 = class(TGalaProcess)
protected
procedure Execute; override;
end;

implementation

{$R *.DFM}

const
{$IFDEF RUSSIAN_VERSION}
SWindowCaption = 'Простой счетчик';
SLabelCaption = 'Счет:';
SStartCaption = 'Start';
SFinishCaption = 'Finish';
{$ENDIF}

var
FormX, FormY: Integer;

procedure TForm01.FormCreate(Sender: TObject);
begin
Group := 0;
Left := FormX mod (Screen.DesktopWidth - Width);
Top := FormY mod (Screen.DesktopHeight - Height);
FormX := FormX + 32;
FormY := FormY + Height;
Caption := SWindowCaption;
Label1.Caption := SLabelCaption;
ButtonStart.Caption := SStartCaption;
end;

procedure TForm01.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if (Group <> 0) then begin
GalaTheater.DestroyGroup(Group);
Group := 0;
end;
Action := caFree;
end;

procedure TForm01.ButtonExitClick(Sender: TObject);
begin
Close;
end;

procedure TForm01.ButtonStartClick(Sender: TObject);
begin
if Group = 0 then begin
Group := GalaTheater.GetNewGroup;
TProcess01.Create(Group, Self);
ButtonStart.Caption := SFinishCaption;
end
else begin
if Group <> 0 then begin
GalaTheater.DestroyGroup(Group);
Group := 0;
end;
ButtonStart.Caption := SStartCaption;
LabelCounter.Caption := '0';
end;
end;

procedure TForm01.OnDraw(var Mes: TMessage);
begin
LabelCounter.Caption := IntToStr(PInteger(Mes.LParam)^);
end;

{ TProcess01 }

procedure TProcess01.Execute;
var
Counter: Integer;
begin
Counter := 0;
while not Terminated do begin
Inc(Counter);
Send(GM_DRAW_01, Counter);
Pause(100);
end;
end;

initialization
FormX := 0;
FormY := 120;

end.
Ответить с цитированием
  (#3 (permalink)) Старый
Линус Линус вне форума
Member
 
Сообщений: 25
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Регистрация: 22.12.2014
По умолчанию Код программы прокомментировать - 17.03.2015, 21:58

Здравствуйте. Необходимо прокомментировать код программы.
Очень подробное комментирование.Чтобы было все понятно человеку, который ни разу не видел код вообще в жизни.
unit Example03;

interface

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

const
MAX_BUFFER_COUNT_03 = 8;

type
TBufferSize03 = 0..MAX_BUFFER_COUNT_03 - 1;

TBuffer03 = class(TGalaContainer)
protected
Buffer: array[TBufferSize03] of Integer;
Count: Integer;
PPut: TBufferSize03;
PGet: TBufferSize03;

function CanPut: Boolean;
procedure DoPut(aData: Pointer);
function CanGet: Boolean;
procedure DoGet(aData: Pointer);

public
Put: TGalaContainerChannel;
Get: TGalaContainerChannel;

constructor Create;
end;

TProcessPlus03 = class(TProcessPLus)
protected
procedure Action; override;
end;

TProcessMinus03 = class(TProcessMinus)
protected
procedure Action; override;
end;

TProcessUser03 = class(TGalaProcess)
protected
procedure Execute; override;
end;

TForm03 = class(TFormPMU)
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);

protected
procedure CreatePlus; override;
procedure CreateMinus; override;
procedure CreateUser; override;

public
Buffer: TBuffer03;
end;

implementation

{$R *.DFM}

const
{$IFDEF RUSSIAN_VERSION}
SWindowCaption = 'Буфер между процессами';
SConsume = 'Потребляю';
SWait = 'Жду';

{$ENDIF}

{ TBuffer03 }

function TBuffer03.CanPut: Boolean;
begin
result := Count < MAX_BUFFER_COUNT_03;
end;

procedure TBuffer03.DoPut(aData: Pointer);
begin
Buffer[PPut] := PInteger(aData)^;
Inc(PPut);
if PPut > High(TBufferSize03) then
PPut := Low(TBufferSize03);
Inc(Count);
end;

function TBuffer03.CanGet: Boolean;
begin
result := Count > 0;
end;

procedure TBuffer03.DoGet(aData: Pointer);
begin
PInteger(aData)^ := Buffer[PGet];
Inc(PGet);
if PGet > High(TBufferSize03) then
PGet := Low(TBufferSize03);
Dec(Count);
end;

constructor TBuffer03.Create;
begin
inherited Create(False);
Count := 0;
PPut := Low(TBufferSize03);
PGet := Low(TBufferSize03);
Put := CreateChannel(DoPut, CanPut);
Get := CreateChannel(DoGet, CanGet);
end;

{ TProcessPlus03 }

procedure TProcessPlus03.Action;
begin
(ParentForm as TForm03).Buffer.Put.Send(Self, Counter);
end;

{ TProcessMinus03 }

procedure TProcessMinus03.Action;
begin
(ParentForm as TForm03).Buffer.Put.Send(Self, Counter);
end;

{ TProcessUser03 }

procedure TProcessUser03.Execute;
var
i: Integer;
begin
while not Terminated do begin
Trace(SWait);
(ParentForm as TForm03).Buffer.Get.Send(Self, i);
Send(GM_USER_PM, i);
Trace(SConsume);
Pause(500);
end;
end;

{ TForm03 }

procedure TForm03.FormCreate(Sender: TObject);
begin
inherited;
Buffer := TBuffer03.Create;
Caption := SWindowCaption;
end;

procedure TForm03.FormClose(Sender: TObject; var Action: TCloseAction);
begin
inherited;
Buffer.Free;
end;

procedure TForm03.CreatePlus;
begin
Plus := TProcessPlus03.Create(Group, Self);
end;

procedure TForm03.CreateMinus;
begin
Minus := TProcessMinus03.Create(Group, Self);
end;

procedure TForm03.CreateUser;
begin
User := TProcessUser03.Create(Group, Self);
end;

end.
Ответить с цитированием
  (#4 (permalink)) Старый
Линус Линус вне форума
Member
 
Сообщений: 25
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Регистрация: 22.12.2014
По умолчанию Комментировать код проги - 17.03.2015, 22:01

Здравствуйте. Необходимо прокомментировать код программы.
Очень подробное комментирование.Чтобы было все понятно человеку, который ни разу не видел код вообще в жизни.
unit Example04;

interface

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

type
TProcessUser04 = class(TGalaProcess)
protected
procedure Execute; override;
procedure DoPut(aData: Pointer);

public
Put: TGalaProcessChannel;

constructor Create(aGroup: Integer; aParentForm: TForm);
end;

TProcessPlus04 = class(TProcessPlus)
protected
procedure Action; override;
end;

TProcessMinus04 = class(TProcessMinus)
protected
procedure Action; override;
end;

TForm04 = class(TFormPMU)
procedure FormCreate(Sender: TObject);

protected
procedure CreatePlus; override;
procedure CreateMinus; override;
procedure CreateUser; override;
procedure Enabler; override;
end;

implementation

{$R *.DFM}

const
{$IFDEF RUSSIAN_VERSION}
SWindowCaption = 'Взаимодействие по одному каналу';
SConsume = 'Потребляю';
SWait = 'Жду';

{$ENDIF}

{ TProcessUser04 }

procedure TProcessUser04.Execute;
begin
while not Terminated do begin
Trace(SWait);
Accept(Put);
end;
end;

procedure TProcessUser04.DoPut(aData: Pointer);
begin
Send(GM_USER_PM, aData);
Trace(SConsume);
Pause(500);
end;

constructor TProcessUser04.Create(aGroup: Integer; aParentForm: TForm);
begin
inherited Create(aGroup, aParentForm);
Put := CreateChannel(DoPut);
end;

{ TProcessPlus04 }

procedure TProcessPlus04.Action;
var
p: TGalaProcess;
User: TProcessUser04;
begin
p := (ParentForm as TForm04).User;
if Assigned(p) then begin
User := p as TProcessUser04;
try
User.Put.Send(Self, Counter);
except
on E: EGalaProcessWasTerminated do
Terminate;
end;
end;
end;

{ TProcessMinus04 }

procedure TProcessMinus04.Action;
var
p: TGalaProcess;
User: TProcessUser04;
begin
p := (ParentForm as TForm04).User;
if Assigned(p) then begin
User := p as TProcessUser04;
try
User.Put.Send(Self, Counter);
except
on E: EGalaProcessWasTerminated do
Terminate;
end;
end;
end;

{ TForm04 }

procedure TForm04.FormCreate(Sender: TObject);
begin
inherited;
Caption := SWindowCaption;
end;

procedure TForm04.CreatePlus;
begin
Plus := TProcessPlus04.Create(Group, Self);
end;

procedure TForm04.CreateMinus;
begin
Minus := TProcessMinus04.Create(Group, Self);
end;

procedure TForm04.CreateUser;
begin
User := TProcessUser04.Create(Group, Self);
end;

procedure TForm04.Enabler;
begin
EnablerUser;
end;

end.
Ответить с цитированием
  (#5 (permalink)) Старый
Линус Линус вне форума
Member
 
Сообщений: 25
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Регистрация: 22.12.2014
По умолчанию Код проги прокомментирвать - 17.03.2015, 22:05

Здравствуйте. Необходимо прокомментировать код программы.
Очень подробное комментирование.Чтобы было все понятно человеку, который ни разу не видел код вообще в жизни.
unit Example05;

interface

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

type
TProcessUser05 = class(TGalaProcess)
protected
procedure Execute; override;
procedure DoPutPlus(aData: Pointer);
procedure DoPutMinus(aData: Pointer);

public
PutPlus: TGalaProcessChannel;
PutMinus: TGalaProcessChannel;

constructor Create(aGroup: Integer; aParentForm: TForm);
end;

TProcessPlus05 = class(TProcessPlus)
protected
procedure Action; override;
end;

TProcessMinus05 = class(TProcessMinus)
protected
procedure Action; override;
end;

TForm05 = class(TFormPMU)
procedure FormCreate(Sender: TObject);

protected
procedure CreatePlus; override;
procedure CreateMinus; override;
procedure CreateUser; override;
procedure Enabler; override;
end;

implementation

{$R *.DFM}

const
{$IFDEF RUSSIAN_VERSION}
SWindowCaption = 'Взаимодействие с альтернативой';
SConsume = 'Потребляю ';
SWait = 'Жду';

{$ENDIF}

{ TProcessUser05 }

procedure TProcessUser05.Execute;
begin
while not Terminated do begin
Trace(SWait);
AlternativeAccept([PutPlus, PutMinus]);
end;
end;

procedure TProcessUser05.DoPutPlus(aData: Pointer);
begin
Send(GM_USER_PM, aData);
Trace(SConsume + '+');
Pause(500);
end;

procedure TProcessUser05.DoPutMinus(aData: Pointer);
begin
Send(GM_USER_PM, aData);
Trace(SConsume + '-');
Pause(500);
end;

constructor TProcessUser05.Create(aGroup: Integer; aParentForm: TForm);
begin
inherited Create(aGroup, aParentForm);
PutPlus := CreateChannel(DoPutPlus);
PutMinus := CreateChannel(DoPutMinus);
end;

{ TProcessPlus05 }

procedure TProcessPlus05.Action;
var
p: TGalaProcess;
User: TProcessUser05;
begin
p := (ParentForm as TForm05).User;
if Assigned(p) then begin
User := p as TProcessUser05;
try
User.PutPlus.Send(Self, Counter);
except
on E: EGalaProcessWasTerminated do
Terminate;
end;
end;
end;

{ TProcessMinus05 }

procedure TProcessMinus05.Action;
var
p: TGalaProcess;
User: TProcessUser05;
begin
p := (ParentForm as TForm05).User;
if Assigned(p) then begin
User := p as TProcessUser05;
try
User.PutMinus.Send(Self, Counter);
except
on E: EGalaProcessWasTerminated do
Terminate;
end;
end;
end;

{ TForm05 }

procedure TForm05.FormCreate(Sender: TObject);
begin
inherited;
Caption := SWindowCaption;
end;

procedure TForm05.CreatePlus;
begin
Plus := TProcessPlus05.Create(Group, Self);
end;

procedure TForm05.CreateMinus;
begin
Minus := TProcessMinus05.Create(Group, Self);
end;

procedure TForm05.CreateUser;
begin
User := TProcessUser05.Create(Group, Self);
end;

procedure TForm05.Enabler;
begin
EnablerUser;
end;

end.
Ответить с цитированием
Ads.
  (#6 (permalink)) Старый
Линус Линус вне форума
Member
 
Сообщений: 25
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Регистрация: 22.12.2014
По умолчанию Код программы прокомментировать - 17.03.2015, 22:06

Здравствуйте. Необходимо прокомментировать код программы.
Очень подробное комментирование.Чтобы было все понятно человеку, который ни разу не видел код вообще в жизни.
unit Example06;

interface

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

type
TProcessUser06 = class(TProcessUser05)
protected
procedure Execute; override;
function CanPutPlus: Boolean;
function CanPutMinus: Boolean;

public
constructor Create(aGroup: Integer; aParentForm: TForm);
end;

TForm06 = class(TForm05)
CheckBoxPlus: TCheckBox;
CheckBoxMinus: TCheckBox;

procedure FormCreate(Sender: TObject);
procedure CheckBoxPlusClick(Sender: TObject);
procedure CheckBoxMinusClick(Sender: TObject);

protected
procedure CreateUser; override;

public
EnablePlus: Boolean;
EnableMinus: Boolean;
end;

implementation

{$R *.DFM}

const
{$IFDEF RUSSIAN_VERSION}
SWindowCaption = 'Взаимодействие с условной альтернативой';
SWait = 'Жду';
STimeout = 'Таймаут';
{$ELSE}
SWindowCaption = 'Interaction with conditional alternative';
SWait = 'Wait';
STimeout = 'Timeout';
{$ENDIF}

{ TProcessUser06 }

constructor TProcessUser06.Create(aGroup: Integer; aParentForm: TForm);
begin
inherited Create(aGroup, aParentForm);
PutPlus.Guard := CanPutPlus;
PutMinus.Guard := CanPutMinus;
end;

procedure TProcessUser06.Execute;
begin
while not Terminated do begin
Trace(SWait);
try
AlternativeAccept([PutPlus, PutMinus], 2000);
except
on E: EGalaTimeout do begin
Trace(STimeout);
Pause(500);
end
else
raise;
end;
end;
end;

function TProcessUser06.CanPutPlus: Boolean;
begin
result := (ParentForm as TForm06).EnablePlus;
end;

function TProcessUser06.CanPutMinus: Boolean;
begin
result := (ParentForm as TForm06).EnableMinus;
end;

{ TForm06 }

procedure TForm06.FormCreate(Sender: TObject);
begin
inherited;
EnablePlus := True;
EnableMinus := True;
CheckBoxPlus.Checked := EnablePlus;
CheckBoxMinus.Checked := EnableMinus;
Caption := SWindowCaption;
end;

procedure TForm06.CheckBoxPlusClick(Sender: TObject);
begin
EnablePlus := CheckBoxPlus.Checked;
end;

procedure TForm06.CheckBoxMinusClick(Sender: TObject);
begin
EnableMinus := CheckBoxMinus.Checked;
end;

procedure TForm06.CreateUser;
begin
User := TProcessUser06.Create(Group, Self);
end;

end.
Ответить с цитированием
  (#7 (permalink)) Старый
Линус Линус вне форума
Member
 
Сообщений: 25
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Регистрация: 22.12.2014
По умолчанию прокомментировать код программы. - 17.03.2015, 22:09

Здравствуйте. Необходимо прокомментировать код программы.
Очень подробное комментирование.Чтобы было все понятно человеку, который ни разу не видел код вообще в жизни.
unit Example07;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, ImgList, ComCtrls, StdCtrls, Gala, Phil5;

type
TPhilosopher07 = class(TPhilosopher)
protected
procedure Execute; override;
end;

TForm07 = class(TFormPhil5)
procedure FormCreate(Sender: TObject);

protected
function CreatePhilosopher(aIndex: TPhilIndex): TPhilosopher; override;
end;

implementation

{$R *.DFM}

const
{$IFDEF RUSSIAN_VERSION}
SWindowCaption = 'Пять обедающих философов (дедлок)';

{$ENDIF}

{ TPhilosopher07 }

procedure TPhilosopher07.Execute;
begin
while True do begin
Meditate;
WantToEat;
Sit;
GetRightFork;
GetLeftFork;
Eat;
PutLeftFork;
PutRightFork;
end;
end;

{ TForm07 }

function TForm07.CreatePhilosopher(aIndex: TPhilIndex): TPhilosopher;
begin
result := TPhilosopher07.Create(Group, Self, aIndex);
end;

procedure TForm07.FormCreate(Sender: TObject);
begin
inherited;
Caption := SWindowCaption;
end;

end.
Ответить с цитированием
  (#8 (permalink)) Старый
Линус Линус вне форума
Member
 
Сообщений: 25
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Регистрация: 22.12.2014
По умолчанию Необходимо прокомментировать код программы. - 17.03.2015, 22:10

Здравствуйте. Необходимо прокомментировать код программы.
Очень подробное комментирование.Чтобы было все понятно человеку, который ни разу не видел код вообще в жизни.
unit Example08;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, ImgList, ComCtrls, StdCtrls, Gala, Phil5;

type
TPhilosopher08 = class(TPhilosopher)
protected
procedure Execute; override;
end;

TForm08 = class(TFormPhil5)
procedure FormCreate(Sender: TObject);

protected
function CreatePhilosopher(aIndex: TPhilIndex): TPhilosopher; override;
end;

implementation

{$R *.DFM}

const
{$IFDEF RUSSIAN_VERSION}
SWindowCaption = 'Пять обедающих философов (таймаут)';
{$ENDIF}

{ TPhilosopher08 }

procedure TPhilosopher08.Execute;
begin
while True do begin
Meditate;
WantToEat;
Sit;
repeat
repeat
try
GetRightFork(7000);
except
on E: EGalaTimeout do
BePerplexed
else
raise;
end;
until RightFork.Owner = Self;
try
GetLeftFork(7000);
except
on E: EGalaTimeout do begin
PutRightFork;
BePerplexed;
end
else
raise;
end;
until LeftFork.Owner = Self;
Eat;
PutLeftFork;
PutRightFork;
end;
end;

{ TForm08 }

function TForm08.CreatePhilosopher(aIndex: TPhilIndex): TPhilosopher;
begin
result := TPhilosopher08.Create(Group, Self, aIndex);
end;

procedure TForm08.FormCreate(Sender: TObject);
begin
inherited;
Caption := SWindowCaption;
end;

end.
Ответить с цитированием
  (#9 (permalink)) Старый
Линус Линус вне форума
Member
 
Сообщений: 25
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Регистрация: 22.12.2014
По умолчанию Необходимо прокомментировать код программы. - 17.03.2015, 22:11

Здравствуйте. Необходимо прокомментировать код программы.
Очень подробное комментирование.Чтобы было все понятно человеку, который ни разу не видел код вообще в жизни.
unit Example09;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, ImgList, ComCtrls, StdCtrls, Gala, GalaSignals, Phil5;

type
TPhilosopher09 = class(TPhilosopher)
protected
procedure Execute; override;
end;

TForm09 = class(TFormPhil5)
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);

protected
function CreatePhilosopher(aIndex: TPhilIndex): TPhilosopher; override;

public
Servant: TGalaSemaphore;
end;

implementation

{$R *.DFM}

const
{$IFDEF RUSSIAN_VERSION}
SWindowCaption = 'Пять обедающих философов (слуга)';
{$ENDIF}

{ TPhilosopher09 }

procedure TPhilosopher09.Execute;
begin
while True do begin
Meditate;
WantToEat;
Wait((ParentForm as TForm09).Servant);
Sit;
GetRightFork;
GetLeftFork;
Eat;
PutLeftFork;
PutRightFork;
(ParentForm as TForm09).Servant.Release;
end;
end;

{ TForm09 }

procedure TForm09.FormCreate(Sender: TObject);
begin
Servant := TGalaSemaphore.Create(PHIL_COUNT - 1);
inherited;
Caption := SWindowCaption;
end;

procedure TForm09.FormClose(Sender: TObject; var Action: TCloseAction);
begin
inherited;
Servant.Free;
end;

function TForm09.CreatePhilosopher(aIndex: TPhilIndex): TPhilosopher;
begin
result := TPhilosopher09.Create(Group, Self, aIndex);
end;

end.
Ответить с цитированием
  (#10 (permalink)) Старый
Линус Линус вне форума
Member
 
Сообщений: 25
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Регистрация: 22.12.2014
По умолчанию Код программы прокомментировать - 17.03.2015, 22:12

Здравствуйте. Необходимо прокомментировать код программы.
Очень подробное комментирование.Чтобы было все понятно человеку, который ни разу не видел код вообще в жизни.
unit Example10;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, ImgList, ComCtrls, StdCtrls, Gala, Phil5;

type
TPhilosopher10 = class(TPhilosopher)
protected
procedure Execute; override;
end;

TForm10 = class(TFormPhil5)
procedure FormCreate(Sender: TObject);

protected
function CreatePhilosopher(aIndex: TPhilIndex): TPhilosopher; override;
end;

var
Form10: TForm10;

implementation

{$R *.DFM}

const
{$IFDEF RUSSIAN_VERSION}
SWindowCaption = 'Пять обедающих философов (сигналы)';

{$ENDIF}

{ TPhilosopher10 }

procedure TPhilosopher10.Execute;
begin
while True do begin
Meditate;
WantToEat;
Sit;
NewState(stToGetFork);
case AlternativeWait([RightFork, LeftFork]) of
0: GetLeftFork;
1: GetRightFork;
end;
Eat;
PutLeftFork;
PutRightFork;
end;
end;

{ TForm10 }

function TForm10.CreatePhilosopher(aIndex: TPhilIndex): TPhilosopher;
begin
result := TPhilosopher10.Create(Group, Self, aIndex);
end;

procedure TForm10.FormCreate(Sender: TObject);
begin
inherited;
Caption := SWindowCaption;
end;

end.
Ответить с цитированием
  (#11 (permalink)) Старый
Линус Линус вне форума
Member
 
Сообщений: 25
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Регистрация: 22.12.2014
По умолчанию Необходимо прокомментировать код программы. - 17.03.2015, 22:17

Здравствуйте. Необходимо прокомментировать код программы.
Очень подробное комментирование.Чтобы было все понятно человеку, который ни разу не видел код вообще в жизни.
unit Example11;

interface

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

const
GM_DRAW_11 = GM_USER;
GM_SIGNAL_MONITOR_11 = GM_USER + 1;
GM_PROCESSES_MONITOR_11 = GM_USER + 2;
PROCESSES_AMOUNT_11 = 9;

type
TForm11 = class(TForm)
StringGrid: TStringGrid;
ButtonShow: TButton;
LabelComment: TLabel;

procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ButtonShowClick(Sender: TObject);

private
Group: Integer;
Time0: Cardinal;

procedure OnDraw(var Mes: TMessage); message GM_DRAW_11;
procedure OnSignalMonitor(var Mes: TMessage); message GM_SIGNAL_MONITOR_11;
procedure OnProcessesMonitor(var Mes: TMessage); message GM_PROCESSES_MONITOR_11;

public
Processes: array[0..PROCESSES_AMOUNT_11 - 1] of TGalaProcess;
end;

TProcess11 = class(TGalaProcess)
protected
procedure Execute; override;

public
Counter: Integer;
Index: Integer;

constructor Create(aGroup: Integer; aParentForm: TForm; aIndex: Integer);
end;

TProcessSignalMonitor11 = class(TGalaProcess)
private
FSignal: TGalaSignal;

protected
procedure Execute; override;

public
constructor Create(aGroup: Integer; aParentForm: TForm; aHandle: THandle);
destructor Destroy; override;
end;

TProcessProcessesMonitor11 = class(TGalaProcess)
protected
procedure Execute; override;
end;

implementation

{$R *.DFM}

const
{$IFDEF RUSSIAN_VERSION}
SWindowCaption = 'Отладочный протокол';
SShowCaption = 'Показать';
SComment = 'Данные выводятся в файл протокола...';
SErrorLog = 'Ошибка открытия файла протокола';
SWaitSignal = 'Жду закрытия Блокнота';
SWaitCompletion = 'Жду завершения процессов';

{$ENDIF}

var
FormX, FormY: Integer;

procedure TForm11.FormCreate(Sender: TObject);
var
i: Integer;
begin
Group := GalaTheater.GetNewGroup;
Time0 := GetTickCount();
Left := FormX mod (Screen.DesktopWidth - Width);
Top := FormY mod (Screen.DesktopHeight - Height);
FormX := FormX + 32;
FormY := FormY + 32;
Caption := SWindowCaption;
ButtonShow.Caption := SShowCaption;
LabelComment.Caption := SComment;
StringGrid.RowCount := PROCESSES_AMOUNT_11;
for i := 0 to PROCESSES_AMOUNT_11 - 1 do begin
StringGrid.Cells[0, i] := IntToStr(i + 1);
Processes[i] := TProcess11.Create(Group, Self, i);
end;
TProcessProcessesMonitor11.Create(Group, Self);
end;

procedure TForm11.FormClose(Sender: TObject; var Action: TCloseAction);
begin
GalaTheater.DestroyGroup(Group);
Action := caFree;
end;

procedure TForm11.ButtonShowClick(Sender: TObject);
var
s: String;
r: TRect;
h: THandle;
begin
ButtonShow.Enabled := False;
s := 'notepad.exe ' + GalaTheater.LogFileName;
r.Left := Left + Width;
r.Right := r.Left + 300;
r.Top := Top;
r.Bottom := Top + Height;
h := GalaExec(s, nil, SW_SHOW, r);
if h <> 0 then
TProcessSignalMonitor11.Create(Group, Self, h)
else
Beep;
end;

procedure TForm11.OnDraw(var Mes: TMessage);
var
p: TProcess11;
begin
p := TProcess11(Mes.LParam);
StringGrid.Cells[1, p.Index] := IntToStr(p.Counter);
end;

procedure TForm11.OnSignalMonitor(var Mes: TMessage);
begin
ButtonShow.Enabled := True;
end;

procedure TForm11.OnProcessesMonitor(var Mes: TMessage);
begin
LabelComment.Caption := '';
end;

{ TProcess11 }

procedure TProcess11.Execute;
var
t: Double;
begin
Log(' '#9 + ProcessName + ': '#9 + 'started');
while (not Terminated) and (Counter < 50) do begin
Inc(Counter);
Send(GM_DRAW_11);
t := Int(GetTickCount() - (ParentForm as TForm11).Time0) / 1000.0;
Log(Format('%8.2f '#9'%s: '#9'%d', [t, ProcessName, Counter]));
Trace(IntToStr(Counter));
Pause(100 + Random(200));
end;
Log(' '#9 + ProcessName + ': '#9 + 'finished');
end;

constructor TProcess11.Create(aGroup: Integer; aParentForm: TForm;
aIndex: Integer);
begin
inherited Create(aGroup, aParentForm);
Index := aIndex;
ProcessName := 'Process11.' + IntToStr(aGroup) + '.' + IntToStr(aIndex + 1);
end;

{ TProcessSignalMonitor11 }

constructor TProcessSignalMonitor11.Create(aGroup: Integer; aParentForm: TForm;
aHandle: THandle);
begin
inherited Create(aGroup, aParentForm);
FSignal := TGalaSignal.Create(aHandle);
end;

destructor TProcessSignalMonitor11.Destroy;
begin
FSignal.Free;
inherited Destroy;
end;

procedure TProcessSignalMonitor11.Execute;
begin
Trace(SWaitSignal);
Wait(FSignal);
Send(GM_SIGNAL_MONITOR_11);
end;

{ TProcessProcessesMonitor11 }

procedure TProcessProcessesMonitor11.Execute;
begin
Trace(SWaitCompletion);
WaitCompletion((ParentForm as TForm11).Processes, 30000);
Send(GM_PROCESSES_MONITOR_11);
end;

initialization
FormX := 0;
FormY := 120;

end.
Ответить с цитированием
  (#12 (permalink)) Старый
Линус Линус вне форума
Member
 
Сообщений: 25
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Регистрация: 22.12.2014
По умолчанию Необходимо прокомментировать код программы. - 17.03.2015, 22:19

Здравствуйте. Необходимо прокомментировать код программы.
Очень подробное комментирование.Чтобы было все понятно человеку, который ни разу не видел код вообще в жизни.
unit Example12;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Grids, StdCtrls, Gala, GalaSignals, GalaUtils, ComCtrls;

const
GM_NOTIFICATION_12 = GM_USER;

type
TForm12 = class(TForm)
EditDir: TEdit;
ButtonDir: TButton;
StringGrid: TStringGrid;
ButtonExplorer: TButton;
ButtonAttention: TButton;
ButtonDefault: TButton;

procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ButtonExplorerClick(Sender: TObject);
procedure ButtonAttentionClick(Sender: TObject);
procedure ButtonDirClick(Sender: TObject);

private
Group: Integer;
Count: array[0..5] of Integer;

procedure OnNotification(var Mes: TMessage); message GM_NOTIFICATION_12;

public
Event: array[0..5] of TGalaSignal;
end;

TProcessNotification12 = class(TGalaProcess)
protected
procedure Execute; override;
end;

implementation

{$R *.DFM}

uses
FileCtrl;

const
{$IFDEF RUSSIAN_VERSION}
SWindowCaption = 'Файловые уведомления';
SExplorerCaption = 'Старт Проводника';
SAttentionCaption = 'Внимание';
SEvents: array[0..5] of String =
( 'Создание, удаление и переименование файла',
'Создание и удаление каталога',
'Изменение атрибутов',
'Изменение размера файлов',
'Была запись в файл',
'Событие по кнопке <Внимание>');
{$ELSE}
SWindowCaption = 'File notifications';
SExplorerCaption = 'Start of Explorer';
SAttentionCaption = 'Attention';
SEvents: array[0..5] of String =
( 'Create, delete and rename of file',
'Create and delete of directory',
'Change file attributes',
'Change file size',
'Change last write',
'Event of <Attention> button');
{$ENDIF}

var
FormX, FormY: Integer;

procedure TForm12.FormCreate(Sender: TObject);
const
flag: array[0..4] of Cardinal =
( FILE_NOTIFY_CHANGE_FILE_NAME,
FILE_NOTIFY_CHANGE_DIR_NAME,
FILE_NOTIFY_CHANGE_ATTRIBUTES,
FILE_NOTIFY_CHANGE_SIZE,
FILE_NOTIFY_CHANGE_LAST_WRITE);
var
i: Integer;
Dir: String;
begin
Group := GalaTheater.GetNewGroup;
Left := FormX mod (Screen.DesktopWidth - Width);
Top := FormY mod (Screen.DesktopHeight - Height);
FormX := FormX + 32;
FormY := FormY + 32;
Caption := SWindowCaption;
ButtonExplorer.Caption := SExplorerCaption;
ButtonAttention.Caption := SAttentionCaption;
StringGrid.RowCount := 6;
for i := 0 to 5 do
StringGrid.Cells[0, i] := SEvents[i];
Dir := GalaTheater.ExePath;
AnsiLower(PChar(Dir));
EditDir.Text := Dir;
for i := 0 to 4 do
Event[i] := TGalaChangeNotification.Create(Dir, True, flag[i]);
Event[5] := TGalaEvent.Create(False);
TProcessNotification12.Create(Group, Self);
end;

procedure TForm12.FormClose(Sender: TObject; var Action: TCloseAction);
var
i: Integer;
begin
GalaTheater.DestroyGroup(Group);
for i := 0 to 5 do
Event[i].Free;
Action := caFree;
end;

procedure TForm12.ButtonDirClick(Sender: TObject);
var
i: Integer;
Dir: String;
begin
Dir := EditDir.Text;
if SelectDirectory(Dir, [], 0) then begin
AnsiLower(PChar(Dir));
EditDir.Text := Dir;
for i := 0 to 4 do
(Event[i] as TGalaChangeNotification).NewDir(Dir);
end;
end;

procedure TForm12.ButtonExplorerClick(Sender: TObject);
begin
GalaExec('explorer.exe /n,/e,' + EditDir.Text);
end;

procedure TForm12.ButtonAttentionClick(Sender: TObject);
begin
(Event[5] as TGalaEvent).SetState(True);
end;

procedure TForm12.OnNotification(var Mes: TMessage);
var
i: Integer;
begin
i := PInteger(Mes.LParam)^;
if (i >= 0) and (i <= 5) then begin
Count[i] := Count[i] + 1;
StringGrid.Cells[1, i] := IntToStr(Count[i]);
end
else
Beep;
end;

{ TProcessNotification12 }

procedure TProcessNotification12.Execute;
var
i: Integer;
ok: Boolean;
begin
while not Terminated do begin
Ok := True;
for i := 0 to 4 do
if (ParentForm as TForm12).Event[i].Handle = 0 then
Ok := False;
try
if Ok then
i := AlternativeWait((ParentForm as TForm12).Event, 1000)
else begin
i := 5;
Wait((ParentForm as TForm12).Event[5], 1000);
end;
Send(GM_NOTIFICATION_12, i);
Trace(IntToStr(i));
except
on EGalaTimeout do
;
else
raise;
end;
end;
end;

initialization
FormX := 0;
FormY := 120;

end.
Ответить с цитированием
Ads
  (#13 (permalink)) Старый
Линус Линус вне форума
Member
 
Сообщений: 25
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Регистрация: 22.12.2014
По умолчанию Код программы прокомментировать - 17.03.2015, 22:21

Здравствуйте. Необходимо прокомментировать код программы.
Очень подробное комментирование.Чтобы было все понятно человеку, который ни разу не видел код вообще в жизни.
unit Example13;

interface

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

type
TProcess13 = class(TGalaProcess)
public
Counter: Integer;

protected
procedure Execute; override;
procedure OnNormalTermination; override;
procedure OnPrematureTermination; override;
end;

TForm13 = class(TForm)
GroupBox1: TGroupBox;
StaticText1: TStaticText;
LabelTimer: TLabel;
GroupBox2: TGroupBox;
StaticText2: TStaticText;
TrackBarPriority: TTrackBar;
LabelPriority: TLabel;
ButtonStart: TButton;
ButtonResume: TButton;
ButtonClear: TButton;
TimerDraw: TTimer;

procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure TimerDrawTimer(Sender: TObject);
procedure TrackBarPriorityChange(Sender: TObject);
procedure ButtonStartClick(Sender: TObject);
procedure ButtonResumeClick(Sender: TObject);
procedure ButtonClearClick(Sender: TObject);

private
Group: Integer;
Process1: TProcess13;
Process2: TProcess13;

procedure DisplayPriority;
end;

implementation

{$R *.DFM}

const
{$IFDEF RUSSIAN_VERSION}
SWindowCaption = 'Изменение состояния процесса';
SGroupBox1Caption = 'Процесс с нормальным приоритетом';
SGroupBox2Caption = 'Процесс с изменяемым состоянием';
SPriorityCaption = 'Приоритет';
SStartCaption = 'Создать';
SStopCaption = 'Завершить';
SResumeCaption = 'Возобновить';
SSuspendCaption = 'Остановить';
SClearCaption = 'Очистить оба счетчика';
{$ELSE}
SWindowCaption = 'Changing of the process state';
SGroupBox1Caption = 'The process with normal priority';
SGroupBox2Caption = 'The process with a changed state';
SPriorityCaption = 'Priority';
SStartCaption = 'Create';
SStopCaption = 'Terninate';
SResumeCaption = 'Resume';
SSuspendCaption = 'Suspend';
SClearCaption = 'To clear both counters';
{$ENDIF}

var
FormX, FormY: Integer;

{ TProcess13 }

procedure TProcess13.Execute;
var
i: Integer;
t: Cardinal;
begin
t := GetTickCount + 1000;
while not Terminated do begin
for i := 0 to 100000 do begin
if GetTickCount > t then begin
t := GetTickCount + 1000;
Pause(10);
end;
end;
Inc(Counter);
end;
end;

procedure TProcess13.OnNormalTermination;
begin
Counter := 0;
end;

procedure TProcess13.OnPrematureTermination;
begin
Counter := 0;
end;


{ TForm13 }

procedure TForm13.FormCreate(Sender: TObject);
begin
Group := GalaTheater.GetNewGroup;
Left := FormX mod (Screen.DesktopWidth - Width);
Top := FormY mod (Screen.DesktopHeight - Height);
FormX := FormX + 32;
FormY := FormY + 32;
Caption := SWindowCaption;
GroupBox1.Caption := SGroupBox1Caption;
GroupBox2.Caption := SGroupBox2Caption;
ButtonStart.Caption := SStopCaption;
ButtonResume.Caption := SSuspendCaption;
ButtonClear.Caption := SClearCaption;
Process1 := TProcess13.Create(Group, Self);
Process2 := TProcess13.Create(Group, Self);
DisplayPriority;
end;

procedure TForm13.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Process1 := nil;
Process2 := nil;
GalaTheater.DestroyGroup(Group);
Action := caFree;
end;

procedure TForm13.TimerDrawTimer(Sender: TObject);
begin
if LabelTimer.Font.Color = clWhite then
LabelTimer.Font.Color := clBlack
else
LabelTimer.Font.Color := clWhite;
if Assigned(Process1) then
StaticText1.Caption := IntToStr(Process1.Counter)
else
StaticText1.Caption := '';
if Assigned(Process2) then
StaticText2.Caption := IntToStr(Process2.Counter)
else
StaticText2.Caption := '';
end;

procedure TForm13.TrackBarPriorityChange(Sender: TObject);
begin
if Assigned(Process2) then
Process2.Priority := TrackBarPriority.Position;
DisplayPriority;
end;

procedure TForm13.ButtonStartClick(Sender: TObject);
begin
if Assigned(Process2) then begin
Process2.Terminate;
Process2 := nil;
ButtonStart.Caption := SStartCaption;
ButtonResume.Caption := SSuspendCaption;
ButtonResume.Enabled := False;
TrackBarPriority.Enabled := False;
end
else begin
Process2 := TProcess13.Create(Group, Self);
ButtonStart.Caption := SStopCaption;
ButtonResume.Enabled := True;
ButtonResume.Caption := SSuspendCaption;
TrackBarPriority.Enabled := True;
TrackBarPriority.Position := 0;
end;
DisplayPriority;
end;

procedure TForm13.ButtonResumeClick(Sender: TObject);
begin
if Assigned(Process2) then begin
if Process2.Suspended then begin
Process2.Resume;
ButtonResume.Caption := SSuspendCaption;
end
else begin
Process2.Suspend;
ButtonResume.Caption := SResumeCaption;
end;
end;
end;

procedure TForm13.ButtonClearClick(Sender: TObject);
begin
if Assigned(Process1) then
Process1.Counter := 0;
if Assigned(Process2) then
Process2.Counter := 0;
end;

procedure TForm13.DisplayPriority;
begin
if Assigned(Process2) then
LabelPriority.Caption := SPriorityCaption + ': ' +
IntToStr(TrackBarPriority.Position)
else
LabelPriority.Caption := '';
end;

initialization
FormX := 0;
FormY := 120;

end.
Ответить с цитированием
  (#14 (permalink)) Старый
Линус Линус вне форума
Member
 
Сообщений: 25
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Регистрация: 22.12.2014
По умолчанию прокомментировать код программы. - 17.03.2015, 22:22

Здравствуйте. Необходимо прокомментировать код программы.
Очень подробное комментирование.Чтобы было все понятно человеку, который ни разу не видел код вообще в жизни.
unit ExamplesForm;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Menus, ComCtrls, ExtCtrls, Gala;

type
TFormMain = class(TForm)
PanelControl: TPanel;
ComboBoxExample: TComboBox;
ButtonStart: TButton;
ListView: TListView;

procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ButtonStartClick(Sender: TObject);
private
procedure OnProcessStart(var Mes: TMessage);
message GM_PROCESS_START;
procedure OnProcessTrace(var Mes: TMessage);
message GM_PROCESS_TRACE;
procedure OnProcessTermination(var Mes: TMessage);
message GM_PROCESS_TERMINATE;
end;

var
FormMain: TFormMain;

implementation

{$R *.DFM}

uses
Example01,
Example02,
Example03,
Example04,
Example05,
Example06,
Example07,
Example08,
Example09,
Example10,
Example11,
Example12,
Example13;

const
EXAMPLES_AMOUNT = 13;
{$IFDEF RUSSIAN_VERSION}
SWindowCaption = 'Использование Gala-библиотеки';
SButtonCaption = 'Start';
SButtonHint = 'Пример';
SExampleCaption: array[1..EXAMPLES_AMOUNT] of String =
( 'Самый простой - проще не бывает',
'Размножающиеся процессы',
'Буфер между процессами',
'Взаимодействие процессов по одному каналу',
'Взаимодействие процессов с альтернативой',
'Взаимодействие процессов с условной альтернативой',
'Пять обедающих философов (возможность дедлока)',
'Пять обедающих философов (решение - таймаут)',
'Пять обедающих философов (решение - слуга)',
'Пять обедающих философов (альтернативные сигналы)',
'Отладочный протокол и Завершение процессов',
'Файловые уведомления и События',
'Изменение состояния процесса'
);
SColumnCaption: array[0..2] of String = ('Группа', 'Процесс', 'Состояние');

{$ENDIF}

{ TFormMain }

procedure TFormMain.FormCreate(Sender: TObject);
var
i: Integer;
begin
Left := 0;
Top := 0;
Randomize;
TGalaTheater.Create;
GalaTheater.NotificationWindow := Handle;
Caption := SWindowCaption;
ButtonStart.Caption := SButtonCaption;
ButtonStart.Hint := SButtonHint;
for i := 1 to EXAMPLES_AMOUNT do
ComboBoxExample.Items.Add(SExampleCaption[i]);
ComboBoxExample.ItemIndex := 0;
for i := 0 to 2 do
ListView.Columns[i].Caption := SColumnCaption[i];
Application.HelpFile := ChangeFileExt(Application.ExeName, '.hlp');
end;

procedure TFormMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
GalaTheater.Log('Close');
GalaTheater.DestroyAllProcesses;
end;

procedure TFormMain.FormDestroy(Sender: TObject);
begin
GalaTheater.Free;
end;

procedure TFormMain.ButtonStartClick(Sender: TObject);
begin
case (ComboBoxExample.ItemIndex + 1) of
01: TForm01.Create(Self).Show;
02: TForm02.Create(Self).Show;
03: TForm03.Create(Self).Show;
04: TForm04.Create(Self).Show;
05: TForm05.Create(Self).Show;
06: TForm06.Create(Self).Show;
07: TForm07.Create(Self).Show;
08: TForm08.Create(Self).Show;
09: TForm09.Create(Self).Show;
10: TForm10.Create(Self).Show;
11: TForm11.Create(Self).Show;
12: TForm12.Create(Self).Show;
13: TForm13.Create(Self).Show;
end;
end;


procedure TFormMain.OnProcessStart(var Mes: TMessage);
var
item: TListItem;
p: TGalaProcess;
begin
item := ListView.Items.Add;
p := TGalaProcess(Mes.LParam);
if Assigned(item) then begin
with item, p do begin
Data := p;
Caption := IntToStr(Group);
SubItems.Add(ProcessName);
SubItems.Add(TraceString);
end;
end;
end;

procedure TFormMain.OnProcessTrace(var Mes: TMessage);
var
item: TListItem;
p: TGalaProcess;
begin
p := TGalaProcess(Mes.LParam);
item := ListView.FindData(-1, p, False, False);
if Assigned(item) then
item.SubItems.Strings[1] := p.TraceString;
end;

procedure TFormMain.OnProcessTermination(var Mes: TMessage);
var
item: TListItem;
p: TGalaProcess;
begin
p := TGalaProcess(Mes.LParam);
item := ListView.FindData(-1, p, False, False);
if Assigned(item) then
ListView.Items.Delete(item.Index);
end;

end.
Ответить с цитированием
  (#15 (permalink)) Старый
Линус Линус вне форума
Member
 
Сообщений: 25
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Регистрация: 22.12.2014
По умолчанию Необходимо прокомментировать код программы. - 17.03.2015, 22:23

Здравствуйте. Необходимо прокомментировать код программы.
Очень подробное комментирование.Чтобы было все понятно человеку, который ни разу не видел код вообще в жизни.
unit Phil5;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ImgList, ExtCtrls, ComCtrls, StdCtrls, Gala, GalaSignals;

const
PHIL_COUNT = 5;

type
TPhilState = (stToMeditate, stWantToEat, stToSit,
stToGetFork, stToGetRightFork, stToGetLeftFork,
stToEat,
stToPutFork, stToPutForks, stToPutRightFork, stToPutLeftFork,
stOnTimeout, stInPerplexity);
TPhilIndex = 1..PHIL_COUNT;
TFormPhil5 = class;
TPhilosopher = class;

TFork = class(TGalaMutex)
protected
procedure AfterWaiting(p: TGalaProcess); override;
public
Owner: TGalaProcess;
procedure Release; override;
end;

TPhilosopher = class(TGalaProcess)
protected
Index: TPhilIndex;
LeftFork,
RightFork: TFork;
State: TPhilState;
procedure NewState(aState: TPhilState; aTime: Cardinal = 0);
procedure Meditate;
procedure WantToEat;
procedure Sit;
procedure Eat;
procedure BePerplexed;
procedure GetLeftFork(aTimeout: Cardinal = INFINITE);
procedure GetRightFork(aTimeout: Cardinal = INFINITE);
procedure PutLeftFork;
procedure PutRightFork;
public
constructor Create(aGroup: Integer; aParentForm: TForm; aIndex: TPhilIndex);
end;

TFormPhil5 = class(TForm)
PanelHome: TPanel;
PaintBoxHome: TPaintBox;
PanelRoom: TPanel;
PaintBoxRoom: TPaintBox;
ImageListPhil: TImageList;
ImageListFork: TImageList;
LabelState: TLabel;
TreeViewState: TTreeView;
DrawTimer: TTimer;
ButtonDefault: TButton;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure DrawTimerTimer(Sender: TObject);
protected
function CreatePhilosopher(aIndex: TPhilIndex): TPhilosopher;
virtual; abstract;
public
Group: Integer;
Philosopher: array[TPhilIndex] of TPhilosopher;
Fork: array[TPhilIndex] of TFork;
end;

implementation

{$R *.DFM}

const
{$IFDEF RUSSIAN_VERSION}
SPhilState: array[TPhilState] of String =
( 'думаю',
'хочу есть',
'сажусь',
'беру вилку',
'беру правую вилку',
'беру левую вилку',
'ем',
'кладу вилку',
'кладу обе вилки',
'кладу правую вилку',
'кладу левую вилку',
'вилки нет!!!',
'недоумеваю'
);
SPhilName = 'Философ ';
SLabelState = 'Мнемоники состояний';
{$ENDIF}

var
FormX, FormY: Integer;

{ TFork }

procedure TFork.AfterWaiting(p: TGalaProcess);
begin
Owner := p;
end;

procedure TFork.Release;
begin
Owner := nil;
inherited Release;
end;

{ TPhilosopher }

constructor TPhilosopher.Create(aGroup: Integer;
aParentForm: TForm; aIndex: TPhilIndex);
begin
inherited Create(aGroup, aParentForm);
Index := aIndex;
RightFork := (ParentForm as TFormPhil5).Fork[Index];
if Index = High(TPhilIndex) then
LeftFork := (ParentForm as TFormPhil5).Fork[Low(TPhilIndex)]
else
LeftFork := (ParentForm as TFormPhil5).Fork[Succ(Index)];
State := stToMeditate;
ProcessName := SPhilName + IntToStr(Index);
FStackSize := 8000;
FSuspendedOnStart := True;
end;

procedure TPhilosopher.NewState(aState: TPhilState; aTime: Cardinal);
begin
State := aState;
Trace(SPhilState[State]);
if aTime <> 0 then
Pause(aTime);
end;

procedure TPhilosopher.Meditate;
begin
NewState(stToMeditate, 4000 + Random(8000));
end;

procedure TPhilosopher.WantToEat;
begin
NewState(stWantToEat, 1000);
end;

procedure TPhilosopher.Sit;
begin
NewState(stToSit, 2000);
end;

procedure TPhilosopher.Eat;
begin
NewState(stToEat, 2000 + Random(7000));
end;

procedure TPhilosopher.BePerplexed;
begin
NewState(stOnTimeout, 2000);
NewState(stInPerplexity, 1000 + Random(3000));
end;

procedure TPhilosopher.GetLeftFork(aTimeout: Cardinal);
begin
NewState(stToGetLeftFork);
Wait(LeftFork, aTimeout);
Pause(1000);
end;

procedure TPhilosopher.GetRightFork(aTimeout: Cardinal);
begin
NewState(stToGetRightFork);
Wait(RightFork, aTimeout);
Pause(1000);
end;

procedure TPhilosopher.PutLeftFork;
begin
NewState(stToPutLeftFork);
LeftFork.Release;
Pause(1000);
end;

procedure TPhilosopher.PutRightFork;
begin
NewState(stToPutRightFork);
RightFork.Release;
Pause(1000);
end;

{ TFormPhil5 }

procedure TFormPhil5.FormCreate(Sender: TObject);
var
i: TPhilIndex;

procedure ToMnemo(aState: TPhilState);
var
Node: TTreeNode;
begin
with TreeViewState.Items do
begin
Node := AddChild(nil, SPhilState[aState]);
Node.ImageIndex := Ord(aState);
Node.SelectedIndex := Ord(aState);
end;
end;

begin
Left := FormX mod (Screen.DesktopWidth - Width);
Top := FormY mod (Screen.DesktopHeight - Height);
FormX := FormX + 32;
FormY := FormY + 32;
Group := GalaTheater.GetNewGroup;
for i := Low(TPhilIndex) to High(TPhilIndex) do
Fork[i] := TFork.Create(False);
for i := Low(TPhilIndex) to High(TPhilIndex) do
Philosopher[i] := CreatePhilosopher(i);
GalaTheater.ResumeGroup(Group);
ToMnemo(stToMeditate);
ToMnemo(stWantToEat);
ToMnemo(stToSit);
ToMnemo(stToGetFork);
ToMnemo(stToEat);
ToMnemo(stOnTimeout);
ToMnemo(stInPerplexity);
LabelState.Caption := SLabelState;
end;

procedure TFormPhil5.FormClose(Sender: TObject; var Action: TCloseAction);
var
i: TPhilIndex;
begin
GalaTheater.DestroyGroup(Group);
for i := Low(TPhilIndex) to High(TPhilIndex) do
Fork[i].Free;
Action := caFree;
end;

procedure TFormPhil5.DrawTimerTimer(Sender: TObject);
const
RFORK = 45;
RTABLE = RFORK + 18;
RPHIL = RTABLE + 18;
var
i, j: TPhilIndex;
st: TPhilState;
f, F0: Double;
X0, Y0,
x, y: Integer;
bmp: TBitmap;
begin
X0 := PaintBoxRoom.ClientWidth div 2;
Y0 := PaintBoxRoom.ClientHeight div 2;
F0 := 2 * Pi / PHIL_COUNT;

bmp := TBitmap.Create;
try
bmp.Width := PaintBoxHome.ClientWidth;
bmp.Height := PaintBoxHome.ClientHeight;
bmp.Canvas.Font := Font;
for i := Low(TPhilIndex) to High(TPhilIndex) do
begin
st := Philosopher[i].State;
if st <= stWantToEat then
begin
x := (PaintBoxHome.ClientWidth div PHIL_COUNT) * Ord(i) - 33;
y := (PaintBoxHome.ClientHeight div 2) - 16;
ImageListPhil.Draw(bmp.Canvas, x, y, Ord(st));
bmp.Canvas.TextOut(x, y, IntToStr(Ord(i)));
end;
end;
PaintBoxHome.Canvas.Draw(0, 0, bmp);
finally
bmp.Free;
end;

bmp := TBitmap.Create;
try
bmp.Width := PaintBoxRoom.ClientWidth;
bmp.Height := PaintBoxRoom.ClientHeight;
bmp.Canvas.Font := Font;
for i := Low(TPhilIndex) to High(TPhilIndex) do
begin
st := Philosopher[i].State;
if st > stWantToEat then
begin
f := F0 * (Ord(i) - 1);
x := X0 - Round(RPHIL * Sin(f)) - 16;
y := Y0 - Round(RPHIL * Cos(f)) - 16;
ImageListPhil.Draw(bmp.Canvas, x, y, Ord(st));
bmp.Canvas.TextOut(x, y, IntToStr(Ord(i)));
end;
if Assigned(Fork[i].Owner) then
begin
j := (Fork[i].Owner as TPhilosopher).Index;
f := F0 * (Ord(j) - 1);
if (j = i) then
f := f - F0 / 3
else
f := f + F0 / 3;
x := X0 - Round(RPHIL * Sin(f)) - 16;
y := Y0 - Round(RPHIL * Cos(f)) - 16;
end
else
begin
f := F0 * (Ord(i) - 1) - F0 / 2;
x := X0 - Round(RFORK * Sin(f)) - 16;
y := Y0 - Round(RFORK * Cos(f)) - 16;
end;
ImageListFork.Draw(bmp.Canvas, x, y, 0);
bmp.Canvas.TextOut(x, y, IntToStr(Ord(i)));
end;
bmp.Canvas.Arc(X0 - RTABLE, Y0 - RTABLE,
X0 + RTABLE + 1, Y0 + RTABLE + 1,
X0, Y0 - RTABLE, X0 + 1, Y0 - RTABLE);
PaintBoxRoom.Canvas.Draw(0, 0, bmp);
finally
bmp.Free;
end;
end;


initialization
FormX := 0;
FormY := 120;

end.
Ответить с цитированием
Ответ

Опции темы
Опции просмотра

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Trackbacks are Вкл.
Pingbacks are Вкл.
Refbacks are Выкл.


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Системный блок для игр дома. Прошу оценить и прокомментировать Norstein Оценка конфигурации 12 17.09.2013 16:24
Помогите, прокомментировать готовую программу! Катёна_ С/С++ 0 19.01.2012 11:28
Завершение резидентной программы из другой программы ANUBIS Assembler 3 07.11.2010 17:07
Необходимо для программы сделать специфический контрол кнопки PhantomM Visual Basic 0 30.08.2008 20:52
Какие настройки необходимо делать перед компиляцией программы Radm C++ Builder 2 02.08.2007 11:41
Что необходимо изучить? [GANQ] QWERTY Работа 7 02.08.2006 05:35
Нет ничего невозможного как можно прокомментировать Dian Мысли вслух 140 06.11.2005 01:31
Как сделать запуск программы из другой программы Alexandr P Вопросы начинающих программистов 1 24.05.2005 15:58
При запуске программы необходимо проверка наличая файла на винчестере DeusEx C++ Builder 5 26.05.2004 12:35
Необходимо вывести карту памяти работающей программы Vasis С/С++ 1 12.11.2003 08:23
При написании программы исчезает окно самой программы Anonymous Visual C++ 3 09.11.2003 23:38
Запуск программы main.exe и принудительно закрытие программы real Delphi 2 10.06.2003 13:15



Powered by vBulletin® Version 3.8.7
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.
Нardforum.ru - компьютерный форум и программирование, форум программистов