fork download 
  1. {$mode objfpc} {$h+} {$modeswitch duplicatelocals}
  2.  
  3. uses
  4. 	SysUtils;
  5.  
  6. type
  7. 	IVegetable = interface;
  8. 	TVegetable = class;
  9.  
  10. 	IVegetableGarden = interface
  11. 		procedure Plant(const v: IVegetable);
  12. 		procedure RollCall;
  13. 		function GetName: string;
  14. 		property name: string read GetName;
  15. 	end;
  16.  
  17. 	TVegetableGarden = class(TInterfacedObject, IVegetableGarden)
  18. 		name: string;
  19. 		constructor Create(const name: string);
  20. 		destructor Destroy; override;
  21. 		procedure Plant(const v: IVegetable);
  22. 		procedure RollCall;
  23. 		function GetName: string;
  24. 	private
  25. 		vegetables: array of IVegetable;
  26. 	end;
  27.  
  28. 	IVegetable = interface
  29. 		procedure RespondToRollCall;
  30. 		procedure SetGarden(const garden: TVegetableGarden);
  31. 	end;
  32.  
  33. 	TVegetable = class(TInterfacedObject, IVegetable)
  34. 		garden: TVegetableGarden;
  35. 		name: string;
  36. 		weight: single;
  37. 		constructor Create(const name: string; const weight: single);
  38. 		destructor Destroy; override;
  39. 		procedure RespondToRollCall;
  40. 		procedure SetGarden(const garden: TVegetableGarden);
  41. 	end;
  42.  
  43. 	constructor TVegetableGarden.Create(const name: string);
  44. 	begin
  45. 		inherited Create;
  46. 		self.name := name;
  47. 	end;
  48.  
  49. 	destructor TVegetableGarden.Destroy;
  50. 	var
  51. 		i: SizeInt;
  52. 	begin
  53. 		writeln('Огород «', name, '» уничтожается.');
  54. 		for i := 0 to High(vegetables) do
  55. 			vegetables[i].SetGarden(nil);
  56. 		inherited Destroy;
  57. 	end;
  58.  
  59. 	procedure TVegetableGarden.Plant(const v: IVegetable);
  60. 	begin
  61. 		SetLength(vegetables, length(vegetables) + 1);
  62. 		vegetables[High(vegetables)] := v;
  63. 		v.SetGarden(self);
  64. 	end;
  65.  
  66. 	procedure TVegetableGarden.RollCall;
  67. 	var
  68. 		i: SizeInt;
  69. 	begin
  70. 		for i := 0 to High(vegetables) do
  71. 			vegetables[i].RespondToRollCall;
  72. 	end;
  73.  
  74. 	function TVegetableGarden.GetName: string;
  75. 	begin
  76. 		result := name;
  77. 	end;
  78.  
  79. 	constructor TVegetable.Create(const name: string; const weight: single);
  80. 	begin
  81. 		inherited Create;
  82. 		self.name := name;
  83. 		self.weight := weight;
  84. 	end;
  85.  
  86. 	destructor TVegetable.Destroy;
  87. 	begin
  88. 		writeln('Овощ «', name, '» уничтожается.');
  89. 		inherited Destroy;
  90. 	end;
  91.  
  92. 	procedure TVegetable.RespondToRollCall;
  93. 	begin
  94. 		writeln('<', garden.name, '>: ', name, ', вес ', FloatToStrF(weight, ffGeneral, 6, 0), ' кг');
  95. 	end;
  96.  
  97. 	procedure TVegetable.SetGarden(const garden: TVegetableGarden);
  98. 	begin
  99. 		self.garden := garden;
  100. 	end;
  101.  
  102. 	procedure Main;
  103. 	var
  104. 		garden: IVegetableGarden;
  105. 	begin
  106. 		garden := TVegetableGarden.Create('ОВОЩИ');
  107. 		garden.Plant(TVegetable.Create('картофель', 1.4));
  108. 		garden.Plant(TVegetable.Create('чеснок', 0.05));
  109. 		garden.Plant(TVegetable.Create('Рируру', 54));
  110. 		garden.Plant(TVegetable.Create('PoppyFanboy', 65));
  111. 		garden.RollCall;
  112. 	end;
  113.  
  114. begin
  115. 	Main;
  116. end.
Success #stdin #stdout 0s 4192KB
comments (?)
stdin 
Standard input is empty
stdout 
<ОВОЩИ>: картофель, вес 1.4 кг
<ОВОЩИ>: чеснок, вес 0.05 кг
<ОВОЩИ>: Рируру, вес 54 кг
<ОВОЩИ>: PoppyFanboy, вес 65 кг
Огород «ОВОЩИ» уничтожается.
Овощ «картофель» уничтожается.
Овощ «чеснок» уничтожается.
Овощ «Рируру» уничтожается.
Овощ «PoppyFanboy» уничтожается.
https://ideone.com/TqMVTj
language:
Pascal (fpc 3.0.4)
created:
5 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!