interface
type
IScratcher =
interface
procedure
Scratch;
end
;
INipper =
interface
procedure
Nip;
end
;
TAnimal =
class
(TInterfacedObject, INipper)
private
FName:
String
;
private
\\ INipper
procedure
Nip;
protected
function
GetName:
String
; virtual;
public
constructor
Create(aName:
String
);
property
Name:
String
read GetName;
end
;
TCat =
class
(TAnimal , IScratcher )
protected
function
GetName:
String
; override;
private
\\IScratcher
procedure
Scratch;
end
;
implementation
procedure
TAnimal
.
Nip;
begin
Writeln
(
'Nip Nip'
);
end
;
function
TAnimal
.
GetName:
String
;
begin
Result := FName;
end
;
constructor
TAnimal
.
Create(aName:
String
);
begin
FName = aName;
end
;
procedure
TCat
.
Scratch;
begin
Writeln
(
'Scratch Scratch'
);
end
;
function
TAnimal
.
GetName:
String
;
begin
Result :=
'Cat '
+
inherited
GetName;
end
;