Объявление класса
<Имя класса> = class(<Имя базового класса>)
private
<Объявление закрытых полей и методов>
// Все, что объявлено здесь, может быть использовано только в данном модуле
protected
<Объявление открытых полей и методов>
// Все, что объявлено здесь, может быть использовано
// и в данном модуле, и во всех классах-наследниках данного класса
public
<Объявление открытых полей и методов>
// Все, что объявлено здесь, может быть использовано везде, где виден класс
published
<Объявление открытых полей и методов>
end;
Всё, что объявлено в разделе published, может быть использовано везде, где виден класс.
Раздел published может присутствовать, только если включен режим «динамическая идентификация типа данных» (Run-time type information, Run-time type identification, RTTI), который позволяет определить тип данных переменной или объекта во время выполнения программы.
Режим RTTI должен быть включен с помощью ключа {$M+}.
http://www.rsdn.ru/Forum/message/704173.flat.aspx
Конструктор
Объявление:
constructor TList1.Create;
begin
inherited Create;
// inherited;
pHead := Nil;
pTail := Nil;
nItems := 0;
end;
Обращение:
MyList1 := TList1.Create;
Обращение происходит к методу класса.
Деструктор
Объявление:
destructor TList1.Destroy;
begin
inherited Destroy;
// inherited;
end;
Обращение:
MyList1.Destroy;
Обращение происходит к методу объекта.
Пример построения линейного однонаправленного списка,
использующий ООП
Проект строится в «DOS-овском» режиме и имеет имя Project1 (по умолчанию). Для его построения из верхнего меню следует пройти маршрутом:
File – New – Other – Console Application.
Список формируется на основе данных из текстового файла, содержащего чётное количество строк. Каждая нечётная строка содержит фамилию работника, каждая чётная – его месячный заработок.
Образец такого файла:
Inanov
24000
Sidorov
19000
Petrov
28000
Petrov
17500
Andrianov
21000
Andreev
27500
Yakovlev
32500
Проект состоит из четырёх файлов, содержащих коды на языке Pascal.
Файл Project1.dpr обращается к кодам (описаниям классов), представленным в трёх файлах-«устройствах» Unit1.pas, Unit2.pas, Unit3.pas, присоединённых к проекту.
В файле Unit1.pas описан базовый класс MyList1Class, способный к формированию линейного однонаправленного списка в оперативной памяти. Каждый новый элемент списка ставится в конец списка. Назначение методов класса пояснено комментариями.
В файле Unit2.pas описан класс MyList2Class – наследник базового класса MyList1Class. Все методы базового класса сохраняют силу, а в дополнение появляются два новых метода: PrependItem и PrependFromFile. С их помощью каждый новый элемент списка ставится в начало списка.
Текст файла Project1.dpr:
program Project1;
{$APPTYPE CONSOLE}
uses
SysUtils,
Unit1 in 'Unit1.pas',
Unit2 in 'Unit2.pas',
Unit3 in 'Unit3.pas';
var
MyList1: MyList1Class;
MyList2: MyList2Class;
MyList3: MyList3Class;
begin
MyList1 := MyList1Class.Create;
MyList1.AppendFromFile('c: List1.txt');
MyList1.ShowList;
WriteLN;
MyList2 := MyList2Class.Create;
MyList2.PrependFromFile('c: List2.txt');
MyList2.ShowList;
WriteLN;
MyList3 := MyList3Class.Create;
MyList3.InsertFromFile('c: List1.txt');
MyList3.ShowList;
Readln;
end.
Текст файла Unit1.pas:
unit Unit1;
interface
type
pPersonType = ^PersonType;
PersonType = record
sName: string[40];
Salary: double;
pNext: pPersonType;
end;
MyList1Class = Class(TObject)
protected
pHead, pTail: pPersonType;
public
constructor Create;
destructor Destroy;
function AloneItem(sName: string; Salary: double;
var pNew: pPersonType): boolean;
procedure AppendItem(sName: string; Salary: double);
procedure AppendFromFile(sFileName: string);
procedure ShowList;
end;
implementation
constructor MyList1Class.Create;
begin
pHead := Nil;
pTail := Nil;
end;
destructor MyList1Class.Destroy;
begin
// Код будет написан позже!
end;
function MyList1Class.AloneItem(sName: string; Salary: double;
var pNew: pPersonType): boolean;
begin
New(pNew);
if pNew = Nil then Halt; // Нет места в памяти – прекращаем работу.
pNew^.sName := sName;
pNew^.Salary := Salary;
pNew^.pNext := Nil;
if pHead = Nil then
begin
pHead := pNew; pTail := pNew;
AloneItem := True;
end
else
AloneItem := False;
end;
procedure MyList1Class.AppendItem(sName: string; Salary: double);
var
pNew: pPersonType;
begin
if not AloneItem(sName, Salary, pNew) then
begin
pTail^.pNext := pNew;
pTail := pNew;
end;
end;
procedure MyList1Class.AppendFromFile(sFileName: string);
var
F: Text;
sName: string[40];
Salary: double;
begin
Assign(F, sFileName);
{$I-}
Reset(F);
{$I+}
if IOResult <> 0 then
begin
WriteLN('File ', sFileName, ' not found');
Halt;
end;
while not EOF(F) do
begin
Readln(F, sName);
Readln(F, Salary);
AppendItem(sName, Salary);
end;
end;
procedure MyList1Class.ShowList;
var pCurr: pPersonType;
begin
pCurr := pHead;
Writeln('Name':40, ' ', 'Salary');
Writeln('----':40, ' ', '------');
while pCurr <> Nil do
begin
Writeln(pCurr^.sName:40, ' ', pCurr^.Salary:8:2);
pCurr := pCurr^.pNext;
end;
end;
end.
Текст файла Unit2.pas:
unit Unit2;
interface
uses Unit1;
type
MyList2Class = Class(MyList1Class)
public
procedure PrependItem(sName: string; Salary: double);
procedure PrependFromFile(sFileName: string);
end;
implementation
procedure MyList2Class.PrependItem(sName: string; Salary: double);
var
pNew: pPersonType;
begin
if not AloneItem(sName, Salary, pNew) then
begin
pNew^.pNext := pHead;
pHead := pNew;
end;
end;
procedure MyList2Class.PrependFromFile(sFileName: string);
var
F: Text;
sName: string[40];
Salary: double;
begin
Assign(F, sFileName);
{$I-}
Reset(F);
{$I+}
if IOResult <> 0 then
begin
WriteLN('File ', sFileName, ' not found');
Halt;
end;
while not EOF(F) do
begin
Readln(F, sName);
Readln(F, Salary);
PrependItem(sName, Salary);
end;
end;
end.
Текст файла Unit3.pas:
unit Unit3;
interface
uses Unit1, Unit2, Math;
type
MyList3Class = Class(MyList2Class)
public
function CompareTwoRecords(var R1, R2: PersonType): integer;
procedure InsertItem(sName: string; Salary: double);
procedure InsertFromFile(sFileName: string);
end;
implementation
function MyList3Class.CompareTwoRecords(
var R1, R2: PersonType): integer;
// Функция возвращает:
// –1, если запись R1 «меньше» записи R2
// +1, если запись R1 «больше» записи R2
// 0, если запись R1 «равна» записи R2
var
l1, l2, l0, i: integer;
begin
l1 := Length(R1.sName);
l2 := Length(R2.sName);
l0 := Min(l1, l2);
for i := 1 to l0 do
if R1.sName[i] < R2.sName[i] then
begin
CompareTwoRecords := -1;
exit;
end
else
if R1.sName[i] > R2.sName[i] then
begin
CompareTwoRecords := +1;
exit;
end;
if l1 < l2 then
begin
CompareTwoRecords := -1;
exit;
end
else
if l1 > l2 then
begin
CompareTwoRecords := +1;
exit;
end;
if R1.Salary < R2.Salary then
begin
CompareTwoRecords := -1;
exit;
end
else
if R1.Salary > R2.Salary then
begin
CompareTwoRecords := +1;
exit;
end;
// Если уж сюда попали, значит, никаких различий между записями не найдено.
CompareTwoRecords := 0;
end;
procedure MyList3Class.InsertItem(sName: string; Salary: double);
var
pNew, pCurr, pPrev: pPersonType;
pc: pChar;
begin
if AloneItem(sName, Salary, pNew) then EXIT;
if CompareTwoRecords(pNew^, pHead^) < 0 then
begin
pNew^.pNext := pHead;
pHead := pNew;
exit;
end;
pPrev := pHead;
pCurr := pPrev^.pNext;
while pCurr <> Nil do
begin
if CompareTwoRecords(pNew^, pCurr^) < 0 then
begin
pPrev^.pNext := pNew;
pNew^.pNext := pCurr;
exit;
end;
pPrev := pCurr;
pCurr := pCurr^.pNext;
end;
pPrev^.pNext := pNew;
pTail := pNew;
end;
procedure MyList3Class.InsertFromFile(sFileName: string);
var
F: Text;
sName: string[40];
Salary: double;
begin
Assign(F, sFileName);
{SI-}
Reset(F);
{SI+}
if IOResult <> 0 then
begin
WriteLN('File ', sFileName, ' not not found');
Halt;
end;
while not EOF(F) do
begin
ReadLN(F, sName);
ReadLN(F, Salary);
InsertItem(sName, Salary);
end;
end;
end.