МЕТАКЛАССЫ

ССЫЛКИ НА КЛАССЫ

Язык Object Pascal позволяет рассматривать классы как своего рода объекты, которыми можно манипулировать в программе. Такая возможность рождает новое понятие класс класса; его принято обозначать термином метакласс.

Для поддержки метаклассов введен специальный тип данных ссылка на класс (class reference). Он описывается с помощью словосочетания class of, например:

Code:

type

TResourceGaugeClass = classof TResourceGauge;

 

Переменная типа TResourceGaugeClass объявляется в программе обычным образом:

Code:

var

ClassRef: TResourceGaugeClass;

 

 

Значениями переменной ClassRef могут быть класс TResourceGauge и все порожденные от него классы. Допустимы, например, следующие операторы:

Code:

ClassRef := TResourceGauge;

ClassRef := TDiskGauge;

ClassRef := TMemoryGauge;

 

По аналогии с тем, как для всех классов существует общий предок TObject, у ссылок на классы существует базовый тип TCIass:

Code:

type TCIass = classof TObject;

 

Переменная типа TCIass может ссылаться на любой класс.

Практическая ценность ссылок на классы состоит в возможности создавать программные модули, работающие с любыми классами объектов, даже с теми, которые еще не разработаны.

 

МЕТОДЫ КЛАССОВ

Метаклассы привели к возникновению нового типа методов методов класса. Метод класса оперирует не экземпляром объекта, а непосредственно классом. Он объявляется как обычный метод, но перед словом procedure или function записывается зарезервированное слово class, например:

Code:

type

TResourceGauge = class

...

classfunction GetClassName : string;

end;

 

Псевдопараметр Self, передаваемый в метод класса, содержит не ссылку на объект, а ссылку на класс, поэтому в теле метода нельзя обращаться к полям, методам и свойствам объекта. Зато можно вызывать другие методы класса, например:

Code:

classfunction TResourceGauge.GetClassName: string;

begin

Result := ClassName;

end;

 

Метод ClassName объявлен в классе TObject и возвращает имя класса, к которому применяется. Очевидно, что надуманный метод GetClassName просто дублирует эту функциональность для класса TResourceGauge и всех его наследников.

Методы класса применимы и к классам, и к объектам. В обоих случаях в параметре Self передается ссылка на класс объекта. Пример:

Code:

var

Gauge: TResourceGauge;

S: string;

begin

{ Вызов метода с помощью ссылки на класс }

S := TDiskGauge.GetClassName; { S получит значение 'TDiskGauge' }

Gauge := TDiskGauge.Create('С');

{ Вызов метода с помощью ссылки на объект }

S := Gauge.GetClassName; { S получит значение 'TDiskGauge' }

end;

 

Методы классов могут быть виртуальными. Например, в классе TObject определен виртуальный метод класса Newlnstance. Он служит для распределения памяти под объект и автоматически вызывается конструктором. Его можно перекрыть в своем классе, чтобы обеспечить нестандартный способ выделения памяти для экземпляров. Метод Newlnstance должен перекрываться вместе с другим методом Freelnstance, который автоматически вызывается из деструктора и служит для освобождения памяти. Добавим, что размер памяти, требуемый для экземпляра, можно узнать вызовом предопределенного метода класса InstanceSize.

 

ВИРТУАЛЬНЫЕ КОНСТРУКТОРЫ

Особая мощь ссылок на классы проявляется в сочетании с виртуальными конструкторами. Виртуальный конструктор объявляется с ключевым словом virtual. Вызов виртуального конструктора происходит по фактическому значению ссылки на класс, а не по ее формальному типу. Это позволяет создавать объекты, классы которых неизвестны на этапе компиляции. Механизм виртуальных конструкторов применяется в Delphi при создании форм и компонентов.

На этом закончим изучение теории объектно-ориентированного программирования и в качестве практики рассмотрим несколько широко используемых инструментальных классов Delphi. Разберитесь с их назначением и работой. Это поможет глубже понять ООП и пригодится на будущее.

 

КЛАССЫ ОБЩЕГО НАЗНАЧЕНИЯ В DELPHI

Как показывает практика, в большинстве задач приходится использовать однотипные структуры данных: списки, массивы, множества и т.д. От задачи к задаче изменяются только их элементы, а методы работы сохраняются. Например, для любого списка нужны процедуры вставки и удаления элементов. В связи с этим возникает естественное желание решить задачу «в общем виде», т.е. создать универсальные средства для управления основными структурами данных. Эта идея не нова. Она давно пришла в голову разработчикам инструментальных пакетов, которые быстро наплодили множество вспомогательных библиотек. Эти библиотеки содержали классы объектов для работы со списками, коллекциями (динамические массивы с переменным количеством элементов), словарями (коллекции, индексированные строками) и другими «абстрактными» структурами. Для Delphi тоже разработаны аналогичные классы объектов. Их большая часть сосредоточена в модуле Classes. Наиболее нужными для вас являются списки строк (TStrings, TStringList) и потоки (TSream, THandleSream, TFileStream, TMemoryStream и TBIobStream). Рассмотрим кратко их назначение и применение.

 

КЛАССЫ ДЛЯ ПРЕДСТАВЛЕНИЯ СПИСКА СТРОК

Для работы со списками строк служат классы TStrings и TStringList. Они используются в библиотеке VCL повсеместно и имеют гораздо большую универсальность, чем та, что можно почерпнуть из их названия. Классы TStrings и TStringList служат для представления не просто списка строк, а списка элементов, каждый из которых представляет собой пару строка-объект. Если со строками не ассоциированы объекты, получается обычный список строк.

Класс TStrings используется визуальными компонентами и является абстрактным. Он не имеет собственных средств хранения строк и определяет лишь интерфейс для работы с элементами. Класс TStringList является наследником TStrings и служит для организации списков строк, которые используются отдельно от управляющих элементов. Объекты TStringList хранят строки и объекты в динамической памяти.

Свойства класса TStrings описаны ниже.

Count: Integer число элементов в списке.

Strings[lndex: Integer]: string обеспечивает доступ к массиву строк по индексу. Первая строка имеет индекс, равный 0. Свойство Strings является основным свойством объекта.

Objects[lndex: Integer]: TObject обеспечивает доступ к массиву объектов. Свойства Strings и Objects позволяют использовать объект TStrings как хранилище строк и ассоциированных с ними объектов произвольных классов.

Text: string позволяет интерпретировать список строк как одну большую строку, в которой элементы разделены символами #13#10 (возврат каретки и перевод строки),

Наследники класса TStrings иногда используются для хранения строк вида Имя=3начение, в частности, строк INI-файлов (см. гл. 6). Для удобной работы со строками такой структуры в классе TStrings дополнительно имеются следующие свойства.

Names[lndex: Integer]: string обеспечивает доступ к той части строки, в которой содержится имя.

Values[const Name: string]: string обеспечивает доступ к той части строки, в которой содержится значение. Указывая вместо Name ту часть строки, которая находится слева от знака равенства, вы получаете ту часть, что находится справа.

Управление элементами списка осуществляется с помощью следующих методов:

Add(const S: string): Integer добавляет новую строку S в список и возвращает ее позицию. Новая строка добавляется в конец списка.

Add0bject(const S: string; AObject: TObject): Integer добавляет в список строку S и ассоциированный с ней объект AObject. Возвращает индекс пары строкаобъект.

AddStrings(Strings: TStrings) добавляет группу строк в существующий список. Append(const S: string) делает то же, что и Add, но не возвращает значения. Clear удаляет из списка все элементы.

Delete(lndex: Integer) удаляет строку и ассоциированный с ней объект. Метод Delete, так же как метод Clear, не разрушает объектов, т.е. не вызывает у них деструктор. Об этом вы должны позаботиться сами.

Equals(Strings: TStrings): Boolean возвращает True, если список строк в точности равен тому, что передан в параметре Strings.

Exchange(lndex1, lndex2: Integer) меняет два элемента местами.

GetText: PChar возвращает все строки списка в виде одной большой нуль-терминированной строки.

lndex0f(const S: string): Integer возвращает позицию строки S в списке. Если заданная строка в списке отсутствует, функция возвращает значение 1.

lndexOfName(const Name: string): Integer возвращает позицию строки, которая имеет вид Имя=3начение и содержит в себе Имя, равное Name.

lndexOfObject(AObject: TObject): Integer возвращает позицию объекта AObject в массиве Objects. Если заданный объект в списке отсутствует, функция возвращает значение 1.

lnsert(lndex: Integer; const S: string) вставляет в список строку S в позицию Index.

lnsert0bject(lndex: Integer; const S: string; AObject: TObject) вставляет в список строку S и ассоциированный с ней объект AObject в позицию Index.

LoadFromFile(const FileName: string) загружает строки списка из текстового файла.

LoadFromStream(Stream: TStream) загружает строки списка из потока данных (см. ниже).

Move(Curlndex, Newlndex: Integer) изменяет позицию элемента (пары строка-объект) в списке.

SaveToFile(const FileName: string) сохраняет строки списка в текстовом файле.

SaveToStream(Stream: TStream) сохраняет строки списка в потоке данных.

SetText(Text: PChar) загружает строки списка из одной большой нуль-терминированной строки.

Класс TStringList добавляет к TStrings несколько дополнительных свойств и методов, а также два свойства-события для уведомления об изменениях в списке. Они описаны ниже.

Свойства:

Duplicates: TDuplicates определяет, разрешено ли использовать дублированные строки в списке. Свойство может принимать следующие значения: duplgnore (дубликаты игнорируются), dupAccept (дубликаты разрешены), dupError (дубликаты запрещены, попытка добавить в список дубликат вызывает ошибку).

Sorted: Boolean если имеет значение True, то строки автоматически сортируются в алфавитном порядке.

Методы:

Find(const S: string; var Index: Integer): Boolean выполняет поиск строки S в списке строк. Если строка найдена, Find помещает ее позицию в переменную, переданную в параметре Index, и возвращает True.

Sort сортирует строки в алфавитном порядке.

События:

OnChange: TNotifyEvent указывает на обработчик события, который выполнится при изменении содержимого списка. Событие OnChange генерируется после того, как были сделаны изменения.

OnChanging: TNotifyEvent указывает на обработчик события, который выполнится при изменении содержимого списка. Событие OnChanging генерируется перед тем, как будут сделаны изменения.

Ниже приводится фрагмент программы, демонстрирующий создание списка строк и манипулирование его элементами:

Code:

var

Items: TStrings;

I: Integer;

begin

{ Создание списка }

Items := TStringList.Create;

Items.Add('Туризм');

Items.Add('Наука');

Items.Insert(1, 'Бизнес');

...

{ Работа со списком }

for I := 0to Items. Count - 1do

Items[I] := Uppercase(Items [I]);

...

{ Удаление списка }

Items.Free;

end;

 

 

КЛАССЫ ДЛЯ ПРЕДСТАВЛЕНИЯ ПОТОКА ДАННЫХ

В Delphi существует иерархия классов для хранения и последовательного ввода-вывода данных. Классы этой иерархии называются потоками. Потоки лучше всего представлять как файлы. Классы потоков обеспечивают различное физическое представление данных:

файл на диске, раздел оперативной памяти, поле в таблице базы данных (см. табл. 1).

Таблица 1.

Класс Описание

TStream Абстрактный поток, от которого наследуются все остальные. Свойства и методы класса TStream образуют базовый интерфейс потоковых объектов.

THandleStream Поток, который хранит свои данные в файле. Для чтения-записи файла используется дескриптор (handle), поэтому поток называется дескрипторным. Дескриптор - это номер открытого файла в операционной системе. Его возвращают низкоуровневые функции создания и открытия файла.

TFileStream Поток, который хранит свои данные в файле. Отличается от ThandleStream тем, что сам открывает (создает) файл по имени, переданному в конструктор.

TMemoryStream Поток, который хранит свои данные в оперативной памяти. Моделирует работу с файлом. Используется для хранения промежуточных результатов, когда файловый поток не подходит из-за низкой скорости передачи данных.

TResourceStream Поток, обеспечивающий доступ к ресурсам в Windows-приложении.

TBIobStream Обеспечивает последовательный доступ к большим полям таблиц в базах данных.

Потоки широко применяются в библиотеке VCL и наверняка вам понадобятся. Поэтому ниже кратко перечислены их общие ключевые свойства и методы.

Общие свойства:

Position: Longint текущая позиция чтения-записи.

Size: Longint текущий размер потока в байтах.

Общие методы:

CopyFrom(Source: TStream; Count: Longint): Longint копирует Count байт из потока Source в свой поток.

Read(var Buffer; Count: Longint): Longint читает Count байт из потока в буфер Buffer, продвигает текущую позицию на Count байт вперед и возвращает число прочитанных байт. Если значение функции меньше значения Count, то в результате чтения был достигнут конец потока.

ReadBuffer(var Buffer; Count: Longint) читает из потока Count байт в буфер Buffer и продвигает текущую позицию на Count байт вперед. Если выполняется попытка чтения за концом потока, то генерируется ошибка.

Seek(0ffset: Longint; Origin: Word): Longint продвигает текущую позицию в потоке на Offset байт относительно позиции, заданной параметром Origin. Параметр Origin может иметь одно из следующих значений: 0 смещение задается относительно начала потока; 1 смещение задается относительно текущей позиции в потоке; 2 смещение задается относительно конца потока.

Write(const Buffer; Count: Longint): Longint записывает в поток Count байт из буфера Buffer, продвигает текущую позицию на Count байт вперед и возвращает реально записанное количество байт. Если значение функции отличается от значения Count, то при записи была ошибка.

WriteBuffer(const Buffer; Count: Longint) записывает в поток Count байт из буфера Buffer и продвигает текущую позицию на Count байт вперед. Если по какой-либо причине невозможно записать все байты буфера, то генерируется ошибка.

Ниже приводится фрагмент программы, демонстрирующий создание файлового потока и запись в него строки:

Code:

var

Stream: TStream;

S: AnsiString;

StrLen: Integer;

begin

{ Создание файлового потока }

Stream := TFileStream.Create('Sample.Dat', fmCreate);

...

{ Запись в поток некоторой строки }

StrLen := Length(S) * SizeOf(Char);

Stream.Write (StrLen, SizeOf (Integer) ) ; { запись длины строки }

Stream.Write (S, StrLen); { запись символов строки }

...

{ Закрытие потока }

Stream.Free;

end;

 

итоги

Теперь для вас нет секретов в мире ООП. Вы на достаточно серьезном уровне познакомились с объектами и их свойствами; узнали, как объекты создаются, используются и уничтожаются. Если не все удалось запомнить сразу не беда. Возвращайтесь к материалам главы по мере решения стоящих перед вами задач, и работа с объектами станет простой, естественной и даже приятной. Когда вы добьетесь понимания того, как работает один объект, то автоматически поймете, как работают все остальные. Теперь мы рассмотрим то, с чем вы встретитесь очень скоро ошибки программирования.

НАСЛЕДОВАНИЕ

ПОНЯТИЕ НАСЛЕДОВАНИЯ

 

Классы инкапсулируют (т.е. включают в себя) поля, методы и свойства; это их первая черта. Следующая не менее важная черта классов способность наследовать поля, методы и свойства других классов. Чтобы пояснить сущность наследования, обратимся к примеру с измерителями ресурсов.

 

Класс TDiskGauge описывает измеритель дискового ресурса и непригоден для измерения ресурса другого типа, например оперативной памяти. С появлением измерителя оперативной памяти нужен новый класс объектов:

Code:

type

TMemoryGauge = class

FPercentCritical: Integer;

constructor Create;

function GetPercentFree: Integer;

procedure SetPercentCritical (Value: Integer) ;

procedure CheckStatus;

property PercentFree: Integer read GetPercentFree;

property PercentCritical: Integer

read FPercentCritical write SetPercentCritical;

end;

 

 

Поля, методы и свойства класса TMemoryGauge аналогичны тем, что определенывклассе TDiskGauge. Отличие состоит в отсутствии поля DriveLetter и другой реализации конструктора Create и метода GetPercentFree. Если в будущем появится класс, описывающий измеритель ресурса какого-то нового типа, то придется снова определять общие для всех классов поля, методы и свойства. Чтобы избавиться от дублирования атрибутов при определении новых классов, воспользуемся механизмом наследования. Прежде всего выделим атрибуты, общие для всех измерителей ресурсов, в отдельный класс TResourceGauge:

Code:

type

TResourceGauge = class

FPercentCritical: Integer;

constructor Create;

function GetPercentFree: Integer;

procedure SetPercentCritical (Value: Integer) ;

procedure CheckStatus;

property PercentFree : Integer read GetPercentFree;

property PercentCritical: Integer

read FPercentCritical write SetPercentCritical;

end;

 

constructor TResourceGauge.Create;

begin

FPercentCritical := 10;

end;

 

function TResourceGauge.GetPercentFree: Integer;

begin

Result := 0;

end;

 

procedure TResourceGauge.SetPercentCritical (Value: Integer);

begin

if (Value >= 0) and (Value < 100) then FPercentCritical := Value;

end;

 

procedure TResourceGauge.CheckStatus;

begin

if GetPercentFree <= FPercentCritical then Beep;

end;

 

 

При реализации класса TResourceGauge ничего не известно о том, что в действительности представляет собой ресурс, поэтому функция GetPercentFree возвращает нуль. Очевидно, что создавать объекты класса TResourceGauge не имеет смысла. Для чего тогда нужен класс TResourceGauge? Ответ: чтобы на его основе породить два других класса TDiskGauge и TMemoryGauge, описывающих конкретные виды измерителей ресурсов, измеритель диска и измеритель памяти:

Code:

type

TDiskGauge = class(TResourceGauge)

DriveLetter: Char;

constructor Create (ADriveLetter: Char) ;

function GetPercentFree: Integer;

end;

 

TMemoryGauge = class(TResourceGauge)

function GetPercentFree: Integer;

end;

 

 

Классы TDiskGauge и TMemoryGauge определены как наследники TResourceGauge (об этом говорит имя в скобках после слова class). Они автоматически включают в себя все описания, сделанные в классе TResourceGauge и добавляют к ним некоторые новые. В результате формируется следующее дерево классов (рис. 1):

 

Рисунок 1

 

Класс, который наследует атрибуты другого класса, называется порожденным классом или потомком. Естественно, что класс, от которого происходит наследование, выступает в роли базового, или предка. В примере класс TDiskGauge является непосредственным потомком класса TResourceGauge. Если от TDiskGauge породить новый класс, то он тоже будет потомком TResourceGauge, но уже не таким близким, как TDiskGauge.

Очень важно, что в отношениях наследования любой класс может иметь только одного непосредственного предка и сколь угодно много потомков. Поэтому все связанные отношением наследования классы образуют иерархию. Примером иерархии классов является библиотека Visual Component Library (VCL); с ее помощью в Delphi обеспечивается разработка Windows-приложений.

ПРЕДОК ПО УМОЛЧАНИЮ

В языке Object Pascal существует предопределенный класс TObject, который служит неявным предком тех классов, для которых предок не указан. Это означает, что объявление

Code:

type

TResourceGauge = class

...

end;

 

эквивалентно следующему:

 

Code:

type

TResourceGauge = class(TObject)

...

end;

 

 

Класс TObject выступает корнем любой иерархии классов. Он содержит ряд методов, которые по наследству передаются всем остальным классам. Среди них конструктор Create, деструктор Destroy, процедура Free и некоторые другие методы.

Таким образом, полная иерархия классов для измерителей ресурсов выглядит так (рис. 2):

 

Рисунок 2

 

ПЕРЕКРЫТИЕ АТРИБУТОВ В НАСЛЕДНИКАХ

В механизме наследования можно условно выделить три основных момента:

§ наследование полей;
§ наследование свойств;
§ наследование методов.

Любой порожденный класс наследует от родительского все поля данных, поэтому классы TDiskGauge и TMemoryGauge автоматически содержат поле FPercentCritical, объявленное в классе TResourceGauge. Доступ к полям предка осуществляется по имени, как если бы они были определены в порожденном классе. В наследниках можно определять новые поля, но их имена должны отличаться от имен полей предка.

Наследование свойств и методов имеет свои особенности.

Свойство базового класса можно перекрыть (от англ. override) в производном классе, например чтобы добавить ему новый атрибут доступа или связать с другим полем или методом.

Метод базового класса тоже можно перекрыть в производном классе, например чтобы изменить логику его работы. Обратимся, например, к классам TDiskGauge и TMemoryGauge. В них методы SetPercentCritical и CheckStatus унаследованы от TResourceGauge, так как логика их работы не зависит от типа ресурса. А вот метод GetPercentFree перекрыт, так как способ вычисления процента свободного пространства специфичен для диска и оперативной памяти:

Code:

function TDiskGauge.GetPercentFree: Integer;

var

Drive: Byte;

begin

Drive := Ord(DriveLetter) - Ord('A') + 1;

Result := DiskFree(Drive) * 100div DiskSize(Drive) ;

end;

 

function TMemoryGauge.GetPercentFree: Integer; { uses Windows; }

var

MemoryStatus: TMemoryStatus;

begin

MemoryStatus.dwLength := SizeOf(MemoryStatus);

GlobalMemoryStatus(MemoryStatus);

Result := 100 - MemoryStatus.dwMemoryLoad;

end;

 

 

В классе TDiskGauge перекрыт еще и конструктор Create. Это необходимо для инициализации дополнительного поля DriveLetter:

Code:

constructor TDiskGauge.Create (ADriveLetter: Char) ;

begin

inherited Create;

DriveLetter := ADriveLetter;

end;

 

Как видно из примера, в наследнике можно вызвать перекрытый метод предка, указав перед именем метода зарезервированное слово inherited. Кстати, данный пример демонстрирует важный принцип реализации конструкторов: сначала вызывается конструктор предка, а затем инициализируются дополнительные поля данных. В деструкторах применяется обратная последовательность действий: сначала разрушаются данные, недоступные предку, а затем вызывается унаследованный деструктор.

 

СОВМЕСТИМОСТЬ ОБЪЕКТОВ РАЗЛИЧНЫХ КЛАССОВ

Для классов, связанных отношением наследования, вводится новое правило совместимости типов. Вместо объекта базового класса можно подставить объект любого производного класса. Обратное неверно. Например, переменной типа TResourceGauge можно присвоить значение переменной типа TDiskGauge:

Code:

var

R: TResourceGauge;

...

R := TDiskGauge.Create;

...

 

 

Объектная переменная R формально имеет тип TResourceGauge, а фактически связана с экземпляром класса TDiskGauge.

Правило совместимости классов чаще всего применяется при передаче объектов в параметрах процедур и функций. Например, если процедура работает с объектом класса TResourceGauge, то вместо него можно передать объект класса TDiskGauge или TMemoryGauge.

 

КОНТРОЛЬ И ПРЕОБРАЗОВАНИЕ ТИПОВ

Поскольку реальный экземпляр объекта может оказаться наследником класса, указанного при описании объектной переменной или параметра, бывает необходимо проверить, к какому классу принадлежит объект на самом деле. Чтобы программист мог выполнять такого рода проверки, каждый объект хранит информацию о своем классе. В Object Pascal существуют операторы is и as, с помощью которых выполняется соответственно проверка на тип (type checking) и преобразование к типу (type casting).

Например, чтобы выяснить, принадлежит ли некоторый объект Obj, объявленный в программе как

Code:

var

Obj: TObject;

 

 

к классу TResourceGauge или его наследнику, следует записать

Code:

if Obj is TResourceGauge then{ да, принадлежит } ;

 

Для преобразования объекта к нужному типу используется оператор as, например:

Code:

with Obj as TResourceGauge do CheckStatus;

 

 

Стоит отметить, что для объектов применим и обычный способ приведения типа:

Code:

with TResourceGauge(Obj ) do CheckStatus;

 

 

Вариант с оператором as лучше, поскольку безопасен. Он генерирует ошибку (точнее, исключительную ситуацию) при выполнении программы (run-time error), если реальный экземпляр объекта Obj несовместим с классом TResourceGauge. Забегая вперед, скажем, что ошибку приведения типа можно обработать и таким образом избежать досрочного завершения приложения.

 

ВИРТУАЛЬНЫЕ МЕТОДЫ

ПОНЯТИЕ ВИРТУАЛЬНОГО МЕТОДА

Все методы, которые до сих пор рассматривались, имеют одну общую черту все они статические. При обращении к статическому методу компилятор точно знает класс, которому данный метод принадлежит. Поэтому, например, обращение к статическому методу GetPereentFree в методе CheckStatus компилируется в вызов TResourceGauge.GetPercentFree:

Code:

procedure TResourceGauge.CheckStatus;

begin

if GetPereentFree <= FPercentCritical then Beep;

{ if TResourceGauge.GetPereentFree <= FPercentCritical then Beep; }

end;

 

Метод CheckStatus работает неправильно в наследниках TResourceGauge, так как внутри него вызов перекрытого метода GetPereentFree не происходит. Конечно, в классах TDiskGauge и TMemoryGauge можно продублировать все методы и свойства, которые прямо или косвенно вызывают GetPereentFree, но при этом теряются преимущества наследования. ООП предлагает изящное решение этой проблемы метод GetPereentFree всего-навсего объявляется виртуальным:

Code:

type

TResourceGauge = class

...

function GetPereentFree: Integer; virtual;

...

end;

 

В производных классах виртуальный метод перекрывается с использованием ключевого слова override. Перекрытый метод должен иметь точно такой же формат (список параметров, а для функций еще и тип возвращаемого значения), что и перекрываемый:

Code:

type

TDiskGauge = class(TResourceGauge)

...

function GetPercentFree: Integer; override;

end;

 

TMemoryGauge = class(TResourceGauge)

function GetPercentFree: Integer; override;

end;

 

Суть виртуальных методов в том, что они вызываются по фактическому типу экземпляра, а не по формальному типу, записанному в программе. Поэтому после сделанных изменений метод CheckStatus будет работать так, как ожидает программист:

Code:

procedure TResourceGauge.CheckStatus;

begin

if GetPercentFree <= FPercentCritical then Beep;

{ if «фактический класс>.GetPercentFree <= FpercentCritical then Beep; }

end;

 

Работа виртуальных методов основана на механизме позднего связывания (late binding). В отличие от раннего связывания (early binding), характерного для статических методов, позднее связывание основано на вычислении адреса вызываемого метода при выполнении программы. Метод вычисляется по хранящемуся в каждом объекте описателю типа.

Благодаря механизму наследования и виртуальным методам, в Delphi реализуется такая концепция ООП как полиморфизм. Полиморфизм существенно облегчает труд программиста, так как обеспечивает повторное использование кода уже написанных методов.

 

АБСТРАКТНЫЕ ВИРТУАЛЬНЫЕ МЕТОДЫ

При построении иерархии часто возникает ситуация, когда работа виртуального метода в базовом классе неизвестна и наполняется содержанием только в наследниках. Так случилось, например, с методом GetPercentFree, который в классе TResourceGauge состоит всего из одного оператора: Result := 0. Конечно, тело метода можно сделать пустым или почти пустым (так мы и поступили), но лучше воспользоваться директивой abstract:

Code:

type

TResourceGauge = class

...

function GetPercentFree : Integer; virtual; abstract;

...

end;

 

Директива abstract записывается после слова virtual и исключает необходимость написания кода виртуального метода для данного класса. Такой метод называется абстрактным, т.е. подразумевает конкретное логическое действие, а не способ его реализации. Абстрактные виртуальные методы часто используются при создании классов-полуфабрикатов. Свою реализацию такие методы получают в законченных наследниках.

 

ДИНАМИЧЕСКИЕ МЕТОДЫ

Разновидностью виртуальных методов являются так называемые динамические методы. При их объявлении вместо слова virtual записывается ключевое слово dynamic, например:

Code:

type

TResourceGauge = class

...

function GetPercentFree: Integer; dynamic; abstract;

...

end;

 

В наследниках динамические методы перекрываются так же, как и виртуальные, т.е. с помощью зарезервированного слова override.

Семантически динамические и виртуальные методы идентичны. Различие состоит только в механизме их вызова. Методы, объявленные с директивой virtual, вызываются максимально быстро, но платой за это является большой размер системных таблиц, с помощью которых происходит их диспетчеризация. Размер этих таблиц начинает сказываться с увеличением числа классов в иерархии. Методы, объявленные с директивой dynamic, вызываются несколько дольше, но при этом таблицы диспетчирования имеют более компактный вид, что способствует экономии памяти. Таким образом, программисту предоставляются два способа оптимизации объектов: по скорости работы (virtual) или по объему памяти (dynamic).

 

МЕТОДЫ ОБРАБОТКИ СООБЩЕНИЙ

Специализированной формой динамических методов являются методы обработки сообщений. Они объявляются с помощью ключевого слова message, за которым следует целочисленная константа номер сообщения, например:

Code:

type

TMyControl = class(TWinControl)

procedure WMPaint (varMessage: TWMPaint) ; message WM_PAINT;

end;

 

Методы обработки сообщений всегда имеют формат процедуры и содержат единственный var-параметр. При перекрытии метода его название и имя параметра не имеют значения. Вызовом соответствующего обработчика занимается метод Dispatch, наследуемый из класса TObject.

Методы обработки сообщений применяются внутри библиотеки VCL для обработки сообщений Windows и редко нужны ее пользователям, т.е. нам с вами.

 

КЛАССЫ В ПРОГРАММНЫХ МОДУЛЯХ

Классы очень удобно собирать в модули. При этом их описание помещается в секцию interface, а код методов в секцию implementation. Создавая модули классов, нужно придерживаться следующих правил:

q все классы, предназначенные для использования за пределами модуля, следует определять в секции interface;
q описание классов, предназначенных для употребления внутри модуля, следует располагать в секции implementation;
q если модуль В использует модуль А, то в модуле В можно определять классы, порожденные от классов модуля А.

Соберем рассмотренные ранее классы TResourceGauge, TDiskGauge и TmemoryGauge в отдельный модуль Resgauge:

 

Code:

 

unit Resgauge;

 

interface

 

type

 

TResourceGauge = class

private

FPercentCritical: Integer;

procedure SetPercentCritical(Value: Integer);

protected

function GetPercentFree: Integer; virtual; abstract;

public

constructor Create;

procedure CheckStatus;

property PercentFree: Integer read GetPercentFree;

property PercentCritical: Integer read FPercentCritical write SetPercentCritical;

end;

 

 

TDiskGauge = class(TResourceGauge)

private

DriveLetter: Char;

protected

function GetPercentFree : Integer; override;

public

constructor Create (ADriveLetter: Char) ;

end;

 

TMemoryGauge = class (TResourceGauge)

protected

function GetPercentFree: Integer; override;

end;

 

implementation

 

uses

SysUtils, Windows;

 

{ TResourceGauge }

 

constructor TResourceGauge.Create;

begin

FPercentCritical := 10;

end;

 

procedure TResourceGauge.SetPercentCritical(Value: Integer);

begin

if (Value >= 0) and (Value < 100) then FPercentCritical := Value;

end;

 

procedure TResourceGauge.CheckStatus;

begin

if PercentFree <= PercentCritical then Beep;

end;

 

{ TDiskGauge }

 

constructor TDiskGauge.Create (ADriveLetter: Char) ;

begin

inherited Create;

DriveLetter := ADriveLetter;

end;

 

function TDiskGauge.GetPercentFree: Integer;

var

Drive: Byte;

begin

Drive := Ord (DriveLetter) - Ord('A') + 1;

Result := DiskFree(Drive) * 100div DiskSize(Drive) ;

end;

 

{ TMemoryGauge }

 

function TMemoryGauge.GetPercentFree: Integer;

var

MemoryStatus: TMemoryStatus ;

begin

MemoryStatus.dwLength := SizeOf(MemoryStatus);

GlobalMemoryStatus(MemoryStatus);

Result := 100 - MemoryStatus.dwMemoryLoad;

end;

 

end.

 

Как можно заметить, в описании классов присутствуют новые слова private, protected и public. С их помощью регулируется видимость частей класса для других модулей и основной программы. Назначение каждой директивы поясняется ниже.

 

ВИДИМОСТЬ АТРИБУТОВ ОБЪЕКТА

Программист имеет возможность ограничить видимость атрибутов класса для других программистов (и для себя в том числе). Для этого служат директивы private, protected, public, published, automated (последние две директивы не используется в модуле Resgauge).

 

Private. Все, что объявлено в секции private, недоступно за пределами модуля. Секция private позволяет скрыть те поля и методы, которые относятся к так называемым особенностям реализации. Например, в этой секции объявлены поле FPercentCritical и метод SetPercentCritical.

 

Public. Поля, методы и свойства, объявленные в секции public, не имеют никаких ограничений на использование, т.е. всегда видны за пределами модуля. Все, что помещается в секцию public, служит для манипуляций с объектами и составляет программный интерфейс класса. Например, в этой секции объявлены конструктор Create, процедура CheckStatus, свойства PercentFree и PercentCritical.

 

Protected. Поля, методы и свойства, объявленные в секции protected, видны за пределами модуля только потомкам данного класса; остальным частям программы они не видны. Так же как и private, директива protected позволяет скрыть особенности реализации класса, но в отличие от нее разрешает другим программистам порождать новые классы и обращаться к полям, методам и свойствам, которые составляют так называемый интерфейс разработчика. В эту секцию обычно помещаются виртуальные методы чтения и записи свойств. Примером такого метода является GetPercentFree.

 

Published. Устанавливает правила видимости те же, что и директива public. Особенность состоит в том, что для элементов, помещенных в секцию published, компилятор генерирует информацию о типе, которая позволяет превращать объекты в компоненты визуальной среды разработки. Секцию published разрешено использовать только тогда, когда для самого класса или его предка включена директива компилятора $TYPEINFO.

 

Automated. Устанавливает правила видимости те же, что и директива public. Директива automated используется в наследниках класса TAutoObject при создании серверов OLE Automation. Для помещенных в эту секцию методов и свойств компилятор генерирует специальную информацию о типе, которая обеспечивает их видимость за пределами приложения.

Перечисленные секции могут чередоваться в объявлении класса в произвольном порядке, однако в пределах секции сначала следует описание полей, а потом методов и свойств. Если в определении классанет ключевых слов private, protected, public, published и automated, то дляобычных классов всем полям, методам и свойствам приписывается атрибут видимости public, а для тех классов, что порождены от классов VCL атрибут видимости published.

Заметим, что внутри модуля не действуют никакие ограничения видимости на атрибуты реализованного в модуле класса. Это, кстати, отличается от соглашений, принятых в других языках программирования, в частности в C++.

 

УКАЗАТЕЛИ НА МЕТОДЫ ОБЪЕКТОВ

В Object Pascal существуют процедурные типы данных для методов объектов. Внешне объявление процедурного типа для метода отличается от обычного словосочетанием of object, записанным после прототипа процедуры или функции:

Code:

type

TFewResourcesEvent = procedure (Sender: TObject) ofobject;

 

Переменная такого типа называется указателем на метод (method pointer). Она занимает в памяти 8 байт и хранит одновременно ссылку на объект и адрес его метода:

Code:

var

OnFewResources: TFewResourcesEvent = nil;

 

Методы объектов, объявленные по приведенному выше шаблону, становятся совместимы по типу с переменной OnFewResources.

Code:

type

Tform1 = class(TForm)

procedure FewResources (Sender: TObject) ;

end;

var

Form1: Tform1;

 

Ecли переменную OnFewResources связать с методом FewResources объекта Form1

Code:

OnFewResources:= Form1.FewResources;

 

и переписать метод CheckStatus,

 

Code:

procedure TResourceGauge.CheckStatus ;

begin

if PercentFree <= PercentCritical then

if Assigned(OnFewResources) then OnFewResources(Self) ;

end;

 

то выдача предупреждения о нехватке ресурсов будет переадресована (говорят еще делегирована) методу FewResources объекта Form1. Обратите внимание, что вызов метода через указатель происходит лишь в том случае, если указатель не равен nil. Эта проверка выполняется с помощью стандартной функции Assigned, которая возвращает True, если ее аргумент является связанным указателем.

Делегирование позволяет сосредоточить в одном объекте обработку событий, возникающих в других объектах. Это избавляет программиста от необходимости порождать многочисленные классы-наследники и перекрывать в них виртуальные методы. Делегирование широко применяется в Delphi. Например, все компоненты делегируют обработку своих событий форме, на которой они находятся.

Хорошо, создайте на основе опубликованного ниже кода модуль PropDemo.pas и добавьте новый компонент в палитру компонентов. Расположите его на форме и сохраните ее. Затем посмотрите файл DFM каким-либо шестнадцатиричным редактором и проверьте наличие определенных свойств по их именованным тэгам. Вы можете также попробовать закрыть форму и модуль, а затем открыть его с помощью пункта меню File | Open file..., изменив тип файла в выпадающем списке на *.DFM.

 

Mike Scott

Mobius Ltd.

Code:

unit PropDemo;

 

{ Демонстрация DefineProperties.Mike Scott, CIS 100140,2420. }

 

interface

 

uses

SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,

Forms, Dialogs;

 

type

TDemoProps = class(TComponent)

private

{ Private declarations }

FStringThing: string;

FThing: record

i, j, k: integer;

x, y: real;

ch: char;

end;

procedure ReadStringThing(Reader: TReader);

procedure WriteStringThing(Writer: TWriter);

procedure ReadThing(Stream: TStream);

procedure WriteThing(Stream: TStream);

protected

{ Protected declarations }

procedure DefineProperties(Filer: TFiler); override;

public

{ Public declarations }

constructor Create(AOwner: TComponent); override;

published

{ Published declarations }

end;

 

procedureRegister;

 

implementation

 

constructor TDemoProps.Create(AOwner: TComponent);

 

begin

inherited Create(AOwner);

{ создайте любые данные, чтобы было что передать в поток}

FStringThing := 'Всем привет!';

with FThing do

begin

i := 1;

j := 2;

k := 3;

x := PI;

y := 180 / PI;

ch := '?';

end;

end;

 

procedure TDemoProps.ReadStringThing(Reader: TReader);

begin

FStringThing := Reader.ReadString;

end;

 

procedure TDemoProps.WriteStringThing(Writer: TWriter);

begin

Writer.WriteString(FStringThing);

end;

 

procedure TDemoProps.ReadThing(Stream: TStream);

begin

Stream.ReadBuffer(FThing, sizeof(FThing));

end;

 

procedure TDemoProps.WriteThing(Stream: TStream);

begin

Stream.WriteBuffer(FThing, sizeof(FThing));

end;

 

procedure TDemoProps.DefineProperties(Filer: TFiler);

 

begin

inherited DefineProperties(Filer);

Filer.DefineProperty('StringThing', ReadStringThing, WriteStringThing,

FStringThing <> '');

Filer.DefineBinaryProperty('Thing', ReadThing, WriteThing, true);

end;

 

procedureRegister;

begin

RegisterComponents('Samples', [TDemoProps]);

end;

 

end.

 

 

 

 

Взято из Советов по Delphi отВалентина Озерова

Сборник Kuliba

Существует ли возможность переключения набора данных, используемого DBNavigator на набор данных активного элемента управления без из прямого указания?

 

Все, что вы хотите, поместится в пару строк кода. Добавьте "TypInfo" в список используемых модулей и сделайте примерно следующее:

 

Code:

var

PropInfo: PPropInfo;

begin

PropInfo := GetPropInfo(PTypeInfo(ActiveControl.ClassInfo), 'DataSource');

if (PropInfo <> nil)

and (PropInfo^.PropType^.Kind = tkClass)

and (GetTypeData(PropInfo^.PropType)^.ClassType = TDataSource) then

DBNavigator1.DataSource := TDataSource(GetOrdProp(ActiveControl, PropInfo));

end;

 

 

 

Некоторая избыточность в проверках гарантирует вам, что вам не попадется некий странный объект (от сторонних производителей компонентов, например), имеющий свойство DataSource, но не типа TDataSource.

 

 

Взято из Советов по Delphi отВалентина Озерова

Сборник Kuliba

 

 

Code:

{

You sometimes wish to store multiple information in a given class like

in the example: alltogether when it belongs together.

Thus accessing this information from out of the class can be achieved

using property declaration. Its a good way to "clean your code" and

make it as "logic" as possible.

You also may have to store or load information from your class using

file or stream technology. This can be done at once for the recorded

information from within the given class.

}

 

type

TPersonRecord = Record

FirstName: String;

LastName: String;

BirthDate: TDate;

End;

 

TForm4 = class(TForm)

Button1: TButton;

procedure Button1Click(Sender: TObject);

private

fActualUser: TPersonRecord;

...

procedure SaveActualUser(S: TFileStream); // it's an example

procedure LoadActualUser(S: TFileStream);

...

public

property FirstName: stringread fActualUser.FirstName

write fActualUser.FirstName;

property LastName : stringread fActualUser.LastName

write fActualUser.LastName;

property BirthDate: TDate read fActualUser.BirthDate

write fActualUser.BirthDate;

end;

 

procedure TForm4.SaveActualUser(S: TFileStream);

begin

// All that stuff at once in your Stream

S.Write(fActualUser, SizeOf(fActualUser))

end;

 

procedure TForm4.LoadActualUser(S: TFileStream);

begin

// All that stuff at once back in your class

S.Read(fActualUser, SizeOf(fActualUser));

end;

 

 

https://delphiworld.narod

DelphiWorld 6.0

"Сабклассинг и суперклассинг в Delphi для начинающих"

 

В данной статье я постараюсь рассказать об использовании двух мощных средств технологии Windows API - сабклассинга и суперклассинга. Все примеры к статье были составлены мною. Вы найдете их в прикрепленном к статье файле.

 

Сабклассинг

 

Сабклассинг (subclassing) - контроль сообщений окон путем модификации оконной процедуры последних. Сабклассинг подразумевает использование изменённой оконной процедуры до оригинальной (а её можно вовсе и не использовать), позволяя нам создать сколь угодно заготовок оконных процедур для данного объекта. Хотя на практике обычно используется только одна.

 

Оконная процедура

 

Оконная процедура (window procedure) - специальная функция любого окна, имеющего дескриптор, которая принимает и обрабатывает все поступающие окну сообщения (от других программ или от Windows). Оконная процедура является косвенно вызываемой (callback) пользовательской (user-defined) функцией. Соответственно, реакцию на сообщения задаёт программист.

 

Оконная процедура - самое существенное из всего того, что принадлежит окну, поэтому сабклассинг является очень мощной технологией, необходимой для полноценной работы с Windows API. Важно уметь правильно обрабатывать сообщения, чтобы использовать сабклассинг.

 

Оконная процедура обычно назначается при создании окна, когда заполняется структура класса последнего TWndClass(Ex).

 

Оконная процедура имеет такой прототип:

Code:

Function XWindowProc(HWnd: THandle; Msg: Cardinal;

WParam, LParam: Integer): Integer; Stdcall;

 

Где X - любой префикс (можно и опустить), по которому можно идентифицировать

нужную оконную процедуру (например, Edit или New).

 

Рассмотрим, какие параметры передаются при вызове оконной процедуры. В параметре HWnd передаётся дескриптор окна, классу которого принадлежит оконная процедура. В параметре Msg передаётся идентификатор поступившего сообщения. В параметрах WParam и LParam передаётся дополнительная информация, которая зависит от типа посланного сообщения.

 

Возвращаемый функцией результат должен определить программист.

 

Рекомендуется обрабатывать сообщения через оператор Case:

 

Code:

Case Msg Of

WM_DESTROY:

End;

Чтобы сообщение не обрабатывалось оригинальной оконной процедурой, необходимо после своих действий осуществить выход из блока Case:

 

Code:

Case Msg Of

WM_CLOSE:

Begin

MessageBox(0, 'WM_CLOSE', 'Caption', MB_OK);

{ Осуществляем выход из текущей процедуры }

Exit;

End;

End;

Этот способ применяется также для того, чтобы функция DefWindowProc не обрабатывала сообщение. Данная функция предназначена для выполнения стандартных действий системы при поступлении очередного сообщения. В сабклассинге она практически не используется (её роль выполняет оригинальная оконная процедура, в которой, быть может, и находится вызов DefWindowProc).

 

Для вызова оконной процедуры по её адресу используется функция CallWindowProc. По параметрам она аналогична любой оконной процедуре, но помимо этого она имеет еще один параметр, определяющий адрес требуемой оконной процедуры для вызова (параметр первый).

Code:

...

{ Тип первого параметра представляет собой простой указатель }

TFarProc = Pointer;

TFNWndProc = TFarProc;

...

Function CallWindowProc(lpPrevWndFunc: TFNWndProc; HWnd: HWND; Msg: Cardinal;

WParam: Integer; LParam: Integer): Integer; Stdcall;

 

Функция CallWindowProc позволяет нам, по сути, менять поведение окна, ведь мы можем сабклассировать его множество раз с сохранением адресов оконных процедур, а потом вызывать нужные оконные процедуры по надобности. Но на практике эта функция используется для вызова одной оригинальной оконной процедуры окна, которая была до его сабклассирования.

 

После детального рассмотрения основ сабклассинга непосредственно перейдём к его реализации в Delphi.

 

Примечание: суперклассинг, как один из видов сабклассинга, будет описан далее отдельно!

 

Примечание: сабклассинг для окон, принадлежащих чужим процессам, в данной статье не рассматривается! В частности, для начинающих программистов он достаточно сложен.

 

Основная функция сабклассирования окна: SetWindowLong. Вообще, эта функция предназначена для изменения определённого атрибута окна (функция может изменять атрибут как самого окна, так и атрибут его класса). Рассмотрим её параметры.

 

Объявление функции:

Code:

Function SetWindowLong(HWnd: HWND; nIndex: Integer;

dwNewLong: LongInt): LongInt; Stdcall;

 

Параметр HWnd определяет окно, с которым будет производиться работа. Параметр nIndex определяет индекс аттрибута, который мы хотим изменить. Пока нас будут интересовать значения GWL_WNDPROC и GWL_USERDATA. Первый индекс определяет, что изменения затронут оконную процедуру окна, второй - то, что будет изменена специальная внутренняя четырёхбайтовая переменная, которой обладает каждое окно. В ней удобно хранить адрес старой оконной процедуры при сабклассинге.

 

Рассмотрим, как по шагам засабклассировать окно.

Создаём заготовку новой оконной процедуры;

Помещаем в переменную GWL_USERDATA адрес старой оконной процедуры;

Изменяем адрес оконной процедуры на новый.

Последние два действия можно объединить в одно, так как функция SetWindowLong возвращает предыдущее значение изменённого параметра.

 

Далее я публикую примеры кода, в которых будут рассмотрены способы сабклассирования окон как средствами VCL, так и средствами WinAPI. Все примеры кода хорошо комментированы.

 

Сабклассинг окон на VCL

 

В VCL на компонентном уровне сабклассинг реализуется достаточно просто и быстро. Его использование предпочтительней, чем использование сабклассинга на WinAPI (разумеется, при программировании с VCL) - всегда, если возможно, делайте сабклассинг именно через VCL. Для сабклассирования оконного компонента необходимо расширить его функциональность путём добавления обработчика желаемого сообщения, либо через перекрытие оконной процедуры компонента.

 

Ниже приведен пример сабклассирования компонента TEdit таким образом, чтобы последний не реагировал на вставку текста:

Code:

Unit UMain;

 

Interface

 

Uses

Windows, Messages, SysUtils, Classes,

Graphics, Controls, Forms, Dialogs,

StdCtrls;

 

Type

TMainForm = Class(TForm)

procedure FormCreate(Sender: TObject);

procedure FormDestroy(Sender: TObject);

Private

{ Private declarations }

Public

{ Public declarations }

End;

 

{ Новый класс с дополнительным методом,

который вызвается при сообщении WM_PASTE }

 

TNewEdit = Class(TEdit)

Protected

{ Обработчик сообщения }

Procedure WMCopy(Var Msg: TWMPaste); Message WM_PASTE;

End;

 

Var

MainForm: TMainForm;

{ Экземпляр нового класса }

Edit: TNewEdit;

 

Implementation

 

{$R *.dfm}

 

{ TNewEdit }

 

Procedure TNewEdit.WMCopy(Var Msg: TWMPaste);

Begin

{ Игнорируем сообщение }

Msg.Result := 0;

End;

 

Procedure TMainForm.FormCreate(Sender: TObject);

Begin

{ Создание и размещение компонента на форме }

Edit := TNewEdit.Create(Self);

Edit.Parent := Self;

Edit.Left := 8;

Edit.Top := 8;

Edit.Width := MainForm.Width - 23;

{ Следующий метод работать не будет }

Edit.PasteFromClipboard;

End;

 

Procedure TMainForm.FormDestroy(Sender: TObject);

Begin

Edit.Free;

End;

 

End.

Таким образом, чтобы засабклассировать оконный компонент, нужно просто реализовать свой обработчик сообщений. Есть еще один способ, который заключается в модификации оконной процедуры компонента на VCL-уровне:

Code:

Unit UMain;

 

Interface

 

Uses

Windows, Messages, SysUtils, Classes,

Graphics, Controls, Forms, Dialogs,

StdCtrls;

 

Type

TMainForm = Class(TForm)

procedure FormCreate(Sender: TObject);

procedure FormDestroy(Sender: TObject);

Private

{ Private declarations }

Public

{ Public declarations }

End;

 

TNewEdit = Class(TEdit)

Protected

{ Перекрытая оконная процедура компонента }

Procedure WndProc(Var Msg: TMessage); Override;

End;

 

Var

MainForm: TMainForm;

{ Экземпляр нового класса }

Edit: TNewEdit;

 

Implementation

 

{$R *.dfm}

 

{ TNewEdit }

 

Procedure TNewEdit.WndProc(Var Msg: TMessage);

Begin

Case Msg.Msg Of

WM_PASTE:

Begin

Msg.Result := 0;

{ Звуковой сигнал, оповещающий пользователя о

невозможности вставки текста }

MessageBeep(0);

{ Выход после обработки необходим, чтобы

оригинальная оконная процедура не имела

возможности обработать WM_PASTE; в противном

случае вставка текста всё равно произойдёт }

Exit;

End;

End;

{ Не забывайте вызывать унаследованную оконную процедуру }

Inherited WndProc(Msg);

End;

 

Procedure TMainForm.FormCreate(Sender: TObject);

Begin

{ Создание и размещение компонента на форме }

Edit := TNewEdit.Create(Self);

Edit.Parent := Self;

Edit.Left := 8;

Edit.Top := 8;

Edit.Width := MainForm.Width - 23;

{ Следующий метод работать не будет }

Edit.PasteFromClipboard;

End;

 

Procedure TMainForm.FormDestroy(Sender: TObject);

Begin

Edit.Free;

End;

 

End.

 

Этот способ по функциональности ничем не отличается от первого (только озвучкой).

 

Вот и всё! Думаю, что Вы разобрались в примерах и мы можем переходить к сабклассингу средствами Windows API. Ту часть кода примеров, которые не относятся к теме статьи, я снабдил краткими комментариями.

 

Сабклассинг окон с помощью Windows API

 

В следующем примере будет показано, как усовершенствовать кнопку (Button) и поле ввода (Edit). Вот список усовершенствований:

 

1) Для кнопки: создать такую кнопку, которая при нажатии левой кнопки мыши отображала бы текущую дату;

2) Для поля ввода: запретить контекстное меню; установить шрифт для текста синего цвета

 

Разберем, как это выглядит в теории. Для создания кнопки, отображающей дату, мы должны получить текущую дату функцией GetLocalTime. В переданной функции структуре будет находиться текущая дата. Нас интересует только текущие час, минута и секунда. Мы преобразуем полученные значения в строковый формат и дополняем нулями слева, если это необходимо. После этого отображаем дату на кнопке, по срабатыванию таймера.

 

Что касается поля ввода, то для запрета контекстного меню необходимо проигнорировать сообщение WM_CONTEXTMENU, после чего осуществить выход из оконной процедуры. Для изменения цвета текста необходимо использовать функция SetTextColor для контекста Edit'а. Этот контекст можно получить, обрабатывая сообщение WM_CTLCOLOREDIT (обратите внимание, что это сообщение посылается родительскому окну поля ввода). Данное сообщение посылается при каждой отрисовке Edit'а, передавая в параметре WParam контекст для рисования. Не следует забывать включить прозрачность фона функцией SetBkMode (хотя для нашего примера эта функция ничего не изменяет, попробуйте использовать другие цвета, чтобы убедиться в её надобности).

 

Code:

Program SampleProject03;

 

{$R *.res}

{$R WinXP.res}

 

Uses

Windows,

Messages,

SysUtils;

 

Procedure InitCommonControls; Stdcall; External'comctl32.dll';

 

Const

{ Идентификатор таймера }

BtnTimer = 450;

{ Константы с заголовками дочерних окон }

StaticInfoText = 'Метка без сабклассирования';

BtnText = 'Кнопка для сабклассирования';

 

Var

{ Главное окно }

HWnd: THandle;

{ Три дочерних компонента для сабклассирования }

Btn, Edit, InfoStatic: THandle;

 

{ Устанавливает для окна AWindow шрифт для контролов по умолчанию }

Procedure SetDefFont(AWindow: THandle);

Begin

SendMessage(AWindow, WM_SETFONT, GetStockObject(DEFAULT_GUI_FONT), 1);

End;

 

{ Косвенно-вызваемая процедура сообщений таймера }

{ Эта процедура выполняется при каждом срабатывании таймера }

Procedure BtnTimerProc(HWnd: THandle; Msg: Cardinal;

IDEvent, DWTime: Cardinal); Stdcall;

Var

{ Переменная, куда будет помещено текущее время }

Time: TSystemTime;

{ Для анализа времени }

Hour, Minute, Second: String;

Begin

{ Получаем время }

GetLocalTime(Time);

{ Инициализируем переменные }

Hour := IntToStr(Time.wHour);

Minute := IntToStr(Time.wMinute);

Second := IntToStr(Time.wSecond);

{ Добавляем нули при необходимости }

If Length(Hour) = 1Then Hour := '0' + Hour;

If Length(Minute) = 1Then Minute := '0' + Minute;

If Length(Second) = 1Then Second := '0' + Second;

{ Отображаем дату }

SetWindowText(HWnd, PChar(Hour + ':' + Minute + ':' + Second));

End;

 

{ Модифицированная оконная процедура поля ввода }

Function EditWinProc(HWnd: THandle; Msg: Cardinal;

WParam, LParam: Integer): Cardinal; Stdcall;

Begin

Case Msg Of

{ Запрещаем показ контекстного меню }

WM_CONTEXTMENU:

Begin

Result := 0;

MessageBeep(0);

Exit;

End;

End;

{ Не забываем вызвать оригинальную оконную процедуру }

Result := CallWindowProc(Pointer(GetWindowLong(HWnd, GWL_USERDATA)),

Hwnd, Msg, WParam, LParam);

End;

 

{ Модифицированная оконная процедура кнопки }

Function BtnWinProc(HWnd: THandle; Msg: Cardinal;

WParam, LParam: Integer): Cardinal; Stdcall;

Begin

Case Msg Of

{ При нажатии мыши запускаем таймер, интервал - 10 миллисекунд }

WM_LBUTTONDOWN: SetTimer(HWnd, BtnTimer, 10, @BtnTimerProc);

 

{ При отпускании мыши уничтожаем таймер }

WM_LBUTTONUP:

Begin

KillTimer(HWnd, BtnTimer);

{ Восстанавливаем прежний текст }

SetWindowText(HWnd, BtnText);

End;

End;

{ Не забываем вызвать оригинальную оконную процедуру }

Result := CallWindowProc(Pointer(GetWindowLong(HWnd, GWL_USERDATA)),

HWnd, Msg, WParam, LParam);

End;

 

{ Оконная процедура главного окна }

Function MainWinProc(HWnd: THandle; Msg: Cardinal;

WParam, LParam: Integer): Cardinal; Stdcall;

 

{ Конвертирует сроку PChar в String }

Function StrPas(Const AStr: PChar): String;

Begin

Result := AStr;

End;

 

Begin

Case Msg Of

 

{ Здесь будет произведено создание дочерних окон }

WM_CREATE:

Begin

InfoStatic := CreateWindowEx(0, 'Static', StaticInfoText,

WS_CHILD Or WS_VISIBLE Or SS_LEFT,

8, 8, 270, 16, HWnd, 0, HInstance, NIL);

SetDefFont(InfoStatic);

 

Edit := CreateWindowEx(WS_EX_CLIENTEDGE, 'Edit', NIL,

WS_CHILD Or WS_VISIBLE Or ES_LEFT,

8, 28, 300, 21, HWnd, 0, HInstance, NIL);

SetDefFont(Edit);

{ Выделяем весь текст }

SendMessage(Edit, EM_SETSEL, 0, -1);

{ Далее делаем сабклассинг поля ввода }

SetWindowLong(Edit, GWL_USERDATA,

SetWindowLong(Edit, GWL_WNDPROC, LongInt(@EditWinProc)));

 

Btn := CreateWindowEx(0, 'Button', BtnText, WS_CHILD Or WS_VISIBLE

Or BS_PUSHBUTTON, 8, 52, 300, 25, HWnd, 0,

HInstance, NIL);

SetDefFont(Btn);

{ Далее делаем сабклассинг кнопки }

SetWindowLong(Btn, GWL_USERDATA,

SetWindowLong(Btn, GWL_WNDPROC, LongInt(@BtnWinProc)));

End;

 

WM_KEYDOWN:

{ Закрытие окна по нажатию Enter'а }

If WParam = VK_RETURN Then PostQuitMessage(0);

 

{Данное сообщение посылается при отрисовке Edit'a;

вы можете использовать переданный контекст для рисования

фона, либо для смены цвета текста; после завершения рисования

верните модифицированный контекст как результат сообщения и не

забудьте сделать выход из оконной процедуры, так как в противном

случае DefWindowProc снова разукрасит Edit в стандартный системный цвет }

WM_CTLCOLOREDIT:

Begin

{ Устанавливаем прозрачность фона }

SetBkMode(WParam, TRANSPARENT);

{ Устанавливаем цвет шрифта }

SetTextColor(WParam, $FF0000);

{ Возвращаем нужный нам контекст }

Result := WParam;

Exit;

End;

 

WM_DESTROY:

Begin

{ Выход для освобождения памяти }

PostQuitMessage(0);

End;

End;

{ Обработка всех остальных сообщений по умолчанию }

Result := DefWindowProc(HWnd, Msg, WParam, LParam);

End;

 

Procedure WinMain;

Var

Msg: TMsg;

{ Оконный класс }

WndClassEx: TWndClassEx;

Begin

{ Подготовка структуры класса окна }

ZeroMemory(@WndClassEx, SizeOf(WndClassEx));

 

{************* Заполнение структуры нужными значениями ******************* }

 

{ Размер структуры }

WndClassEx.cbSize := SizeOf(TWndClassEx);

{ Имя класса окна }

WndClassEx.lpszClassName := 'SubclassSampleWnd';

{ Стиль класса, не окна }

WndClassEx.style := CS_VREDRAW Or CS_HREDRAW;

{ Дескриптор программы (для доступа к сегменту данных) }

WndClassEx.hInstance := HInstance;

{ Адрес оконной процедуры }

WndClassEx.lpfnWndProc := @MainWinProc;

{ Иконки }

WndClassEx.hIcon := LoadIcon(HInstance, MakeIntResource('MAINICON'));

WndClassEx.hIconSm := LoadIcon(HInstance, MakeIntResource('MAINICON'));

{ Курсор }

WndClassEx.hCursor := LoadCursor(0, IDC_ARROW);

{ Кисть для заполнения фона }

WndClassEx.hbrBackground := COLOR_BTNFACE + 1;

{ Меню }

WndClassEx.lpszMenuName := NIL;

 

{ Регистрация оконного класса в Windows }

If RegisterClassEx(WndClassEx) = 0Then

MessageBox(0, 'Невозможно зарегистрировать класс окна',

'Ошибка', MB_OK Or MB_ICONHAND)

Else

Begin

{ Создание окна по зарегистрированному классу }

HWnd := CreateWindowEx(0, WndClassEx.lpszClassName,

'Subclassing Sample by Rrader', WS_OVERLAPPEDWINDOW AndNot WS_BORDER

AndNot WS_MAXIMIZEBOX AndNot WS_SIZEBOX,

Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT), 320, 116, 0, 0,

HInstance, NIL);

 

If HWnd = 0Then

MessageBox (0, 'Окно не создалось!',

'Ошибка', MB_OK Or MB_ICONHAND)

Else

Begin

{ Показ окна }

ShowWindow(HWnd, SW_SHOWNORMAL);

{ Обновление окна }

UpdateWindow(HWnd);

 

{ Цикл обработки сообщений }

While GetMessage(Msg, 0, 0, 0) Do

Begin

TranslateMessage(Msg);

DispatchMessage(Msg);

End;

{ Выход по прерыванию цикла }

Halt(Msg.WParam);

End;

End;

End;

 

Begin

InitCommonControls;

{ Создание окна }

WinMain;

End.

 

Все примеры очень простые, они должны дать Вам базовое представление о сабклассинге.

 

Теперь можно переходить к суперклассингу.

 

Суперклассинг

 

Сабклассинг особенно удобен, когда дело касается изменения одного окна, класс которого не совпадает с другими окнами, подлежащими сабклассированию. А что, если нам нужно засабклассировать сотню Edit'ов? Сабклассинг здесь будет громоздким. Решением этой проблемы является суперклассинг.

 

Суперклассинг (superclassing) - создание и регистрация нового класса окна в системе. После чего этот класс окна готов к использованию.

 

VCL-суперклассинг мы рассматривать не будем. Думаю, Вам понятно, что реализация суперклассинга на VCL - это создание компонентов. При создании оконного компонента в Delphi вы неявно создаёте подобие суперкласса. После этого вы можете использовать хоть сотню таких компонентов (например, создать из них массив). Заметьте, что такой компонент будет, как правило не стандартным, например, кнопка TBitBtn. Чтобы Вам было понятней, почему это суперкласс, можете посмотреть имя класса окна компонента через любой сканер окон (я использовал InqSoft Window Scanner) - это имя будет совпадать с тем именем, которое обозначает имя компонента в Delphi (например, TBitBtn или TLabeledEdit). Из этого мы можем сделать вывод, что суперклассинг прекрасно прижился в Delphi и широко там используется.

 

У каждого потомка класса TWinControl в Delphi есть метод CreateParams. Можете воспользоваться им, чтобы изменить название класса окна.

 

Гораздо более интересен суперклассинг на WinAPI. Необходимо уметь его использовать.

 

Рассмотрим, как по шагам создать суперкласс.

Вызываем функцию GetClassInfoEx, чтобы получить информацию о классе окна, который мы будем далее модернизировать. Эта функция заполнит переданную ей запись TWndClassEx параметрами класса;

Изменяем всё, что нам нужно в полученной записи. Нужно задать свое имя класса, размер структуры, а также дескриптор HInstance, также нас будет интересовать оконная процедура - мы также изменим её у класса;

Регистрируем новый класс при помощи функции RegisterClassEx;

По окончании работы программы освобождаем класс функцией UnregisterClass.

Далее новый класс можно использовать. В примерах я буду делать простые изменения в классах окон.

 

Давайте рассмотрим функции для суперклассинга более подробно.

 

Суперклассинг начинается с функции GetClassInfoEx.

 

Объявление функции:

Code:

Function GetClassInfoEx(Instance: Cardinal; Classname: PChar;

Var WndClass: TWndClassEx): LongBool; Stdcall;

 

Первый параметр функции - дескриптор приложения, которое создало класс. Если же Вы желаете модифицировать предопределённые класс окон Windows (например, классы 'Button', 'Edit', 'ListBox' и т. п.), то передайте нуль в параметре.

 

Следующий параметр - собственно название интересующего Вас класса. Сюда можно передать атом (см. ниже)

 

В последнем параметре передается структура типа TWndClassEx, в которую в случае успешного вызова функции будет помещена информация о классе.

 

Когда информация о классе получена, можно изменить его (что обязательно к этому, сказано выше).

 

После подготовки класса окна Вы регистрируете его в Windows с помощью функции RegisterClassEx.

 

 

Code:

Function RegisterClassEx(Const WndClass: TWndClassEx): Word; Stdcall;

 

 

Функция возвращает атом, который по сути есть числовое уникальное значение. Это будет идентификатор класса окна в системе.

 

По завершению работы приложения желательно уничтожить класс. В противном случае - "утечка памяти".

Для этого существует функция UnregisterClass:

 

Code:

Function UnregisterClass(lpClassName: PChar; hInstance: Cardinal): LongBool; Stdcall;

 

Эта функция уничтожает класс окна из Windows, освобождая память, ранее под него выделенную.

 

Первый параметр функции - имя класса для деинсталляции. Обратите внимание, что эта функция сможет уничтожить только класс, который был зарегистрирован приложением, чей дескриптор передан во втором параметре. Глобальные предопределённые классы (см. выше) Windows (например, класс Edit) не могут быть уничтожены. В первом параметре также разрешается передавать атом-идентификатор класса.

 

Для полного ознакомления с суперклассингом следует обобщить знания о самом классе окна.

 

Класс окна

Вообще, класс окна - объемная тема. Мы рассмотрим её самые главные особенности.

 

Класс окна (window class) - набор свойств, который используются как шаблон для создания окон. Класс окна всегда можно расширить, изменить. Давайте подробнее разберем атрибуты класса.

 

Первый атрибут - имя класса. Оно позволяет отличать одни классы от других. Классы с одинаковыми именами считаются идентичными. После создания окна по классу это окно может подвергнуться сабклассингу. Сабклассинг не изменяет класс окна. Не делайте имена классов длиннее 64 символов.

 

Второй атрибут - это адрес оконной процедуры для окна. Об оконной процедуре подробно рассказано выше.

 

Третий атрибут - дескриптор приложения (или DLL), которое зарегистрировало класс.

 

Четвёртый - курсор окна при создании.

 

Пятый - дескриптор большой иконки для окна.

 

Шестой - тоже дескриптор иконки, но маленькой. Этого атрибута нет у структуры типа TWndClass (поняли, в чем отличие TWndClass от TWndClassEx?).

 

Седьмой - дескриптор кисти, которой будет зарисована клиентская область окна.

 

Восьмой - дескриптор меню, которое присваивается окну при создании.

 

Девятый - стили класса (см. ниже)

 

Десятый - дополнительная память, выделяемая классу (тип Integer).

 

Одиннадцатый - дополнительная память (Integer), выделяемая под каждое окно класса.

 

Напоследок рассмотрим стили класса. Стили класса - это комбинация значений, которые определяют поведение класса.

Вот они:

 

CS_BYTEALIGNCLIENT - выстраивает клиентскую часть окна на границу байта, что позволяет достичь большей производительности при отрисовке;

 

CS_BYTEALIGNWINDOW - то же, что и CS_BYTEALIGNCLIENT, только увеличивает производительность при перемещении окна;

 

CS_CLASSDC - создает контекст устройства, который разделяется между всеми наследниками этого класса - общий контекст для рисования;

 

CS_DBLCLKS - разрешает обработку сообщений при двойном щелчке мыши;

 

CS_GLOBALCLASS - разрешает создание окон с независимыми идентификаторами (HInstance) приложений. Создаётся глобальный класс. Если этот флаг не указан, то значение HInstance при создании окна должно быть таким же как и при регистрации класса RegisterClass(Ex).

 

CS_HREDRAW - перерисовывает окно при его перемещении по горизонтали (и при изменении горизонтальных размеров);

 

CS_VREDRAW - перерисовывает окно при его перемещении по вертикали (и при изменении вертикальных размеров);

 

CS_NOCLOSE - убирает команду "Закрыть" из системного меню окна;

 

CS_OWNDC - создает уникальный контекст устройства для каждого вновь создаваемого окна.

 

На суперклассинг я публикую один пример, в котором на главном окне будет создано 10 "измененных" Edit'ов. Каждый такой Edit при клике на нём мышки уничтожит себя сам.

Code:

Program SampleProject04;

 

{$R *.res}

{$R WinXP.res}

 

Uses

Windows, Messages;

 

Procedure InitCommonControls; Stdcall; External'comctl32.dll';

 

Var

{ Главное окно }

HWnd: THandle;

{ Массив Edit'ов }

Edits: Array[0..9] Of THandle;

{ Сюда будет помещено значение оригинальной оконной процедуры класса Edit }

OldProc: Pointer;

 

{ Устанавливает для окна AWindow шрифт для контролов по умолчанию }

Procedure SetDefFont(AWindow: THandle);

Begin

SendMessage(AWindow, WM_SETFONT, GetStockObject(DEFAULT_GUI_FONT), 1);

End;

 

{ Модифицированная оконная процедура каждого поля ввода }

Function EditWinProc(HWnd: THandle; Msg: Cardinal;

WParam, LParam: Integer): Cardinal; Stdcall;

Begin

Case Msg Of

{Уничтожение Edit'а }

WM_LBUTTONDOWN: DestroyWindow(HWnd);

End;

{ Вызов оригинальной оконной процедуры }

Result := CallWindowProc(OldProc,

HWnd, Msg, WParam, LParam);

End;

 

{ Оконная процедура главного окна }

Function MainWinProc(HWnd: THandle; Msg: Cardinal;

WParam, LParam: Integer): Cardinal; Stdcall;

Var

TmpEdit: TWndClassEx;

I: Integer;

Begin

Case Msg Of

{ Здесь будет произведено создание дочерних окон }

WM_CREATE:

Begin

{ Начало суперклассинга }

IfNot GetClassInfoEx(0, 'Edit', TmpEdit) Then Halt;

{ Запоминаем оконную процедуры для правильной работы окна }

OldProc := TmpEdit.lpfnWndProc;

{ Модификация класса }

TmpEdit.cbSize := SizeOf(TWndClassEx);

TmpEdit.lpfnWndProc := @EditWinProc;

TmpEdit.lpszClassName := 'Sample04EditWindowClass';

TmpEdit.hInstance := GetModuleHandle(NIL);

{ Регистрация класса }

If RegisterClassEx(TmpEdit) = 0Then Halt;

{ Подготовка массива }

FillChar(Edits, SizeOf(Edits), 0);

For I := Low(Edits) To High(Edits) Do

Begin

Edits[I] := CreateWindowEx(WS_EX_CLIENTEDGE,

'Sample04EditWindowClass', 'Sample',

WS_CHILD Or WS_VISIBLE Or ES_LEFT,

8, 28, 300, 21, HWnd, 0, HInstance, NIL);

SetDefFont(Edits[I]);

End;

End;

 

WM_KEYDOWN:

{ Закрытие окна по нажатию Enter'а }

If WParam = VK_RETURN Then PostQuitMessage(0);

 

WM_DESTROY:

Begin

{ Уничтожение классов}

UnregisterClass('Sample04EditWindowClass', HInstance);

{ Выход для освобождения памяти }

PostQuitMessage(0);

End;

End;

{ Обработка всех остальных сообщений по умолчанию }

Result := DefWindowProc(HWnd, Msg, WParam, LParam);

End;

 

Procedure WinMain;

Var

Msg: TMsg;

{ Оконный класс }

WndClassEx: TWndClassEx;

Begin

{ Подготовка структуры класса окна }

ZeroMemory(@WndClassEx, SizeOf(WndClassEx));

 

{************* Заполнение структуры нужными значениями ******************* }

 

{ Размер структуры }

WndClassEx.cbSize := SizeOf(TWndClassEx);

{ Имя класса окна }

WndClassEx.lpszClassName := 'SuperclassSampleWnd';

{ Стиль класса, не окна }

WndClassEx.style := CS_VREDRAW Or CS_HREDRAW;

{ Дескриптор программы (для доступа к сегменту данных) }

WndClassEx.hInstance := HInstance;

{ Адрес оконной процедуры }

WndClassEx.lpfnWndProc := @MainWinProc;

{ Иконки }

WndClassEx.hIcon := LoadIcon(HInstance, MakeIntResource('MAINICON'));

WndClassEx.hIconSm := LoadIcon(HInstance, MakeIntResource('MAINICON'));

{ Курсор }

WndClassEx.hCursor := LoadCursor(0, IDC_ARROW);

{ Кисть для заполнения фона }

WndClassEx.hbrBackground := COLOR_BTNFACE + 1;

{ Меню }

WndClassEx.lpszMenuName := NIL;

 

{ Регистрация оконного класса в Windows }

If RegisterClassEx(WndClassEx) = 0Then

MessageBox(0, 'Невозможно зарегистрировать класс окна',

'Ошибка', MB_OK Or MB_ICONHAND)

Else

Begin

{ Создание окна по зарегистрированному классу }

HWnd := CreateWindowEx(0, WndClassEx.lpszClassName,

'Superclassing Sample by Rrader', WS_OVERLAPPEDWINDOW AndNot WS_BORDER

AndNot WS_MAXIMIZEBOX AndNot WS_SIZEBOX,

Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT), 320, 116, 0, 0,

HInstance, NIL);

 

If HWnd = 0Then

MessageBox (0, 'Окно не создалось!',

'Ошибка', MB_OK Or MB_ICONHAND)

Else

Begin

{ Показ окна }

ShowWindow(HWnd, SW_SHOWNORMAL);

{ Обновление окна }

UpdateWindow(HWnd);

 

{ Цикл обработки сообщений }

While GetMessage(Msg, 0, 0, 0) Do

Begin

TranslateMessage(Msg);

DispatchMessage(Msg);

End;

{ Выход по прерыванию цикла }

Halt(Msg.WParam);

End;

End;

End;

 

Begin

InitCommonControls;

{ Создание окна }

WinMain;

End.

Этобылобазовоезнакомствоссабклассингомисуперклассингом. Надеюсь, материалданнойстатьипоможетВамприпрограммировании!

Автор:Rrader

 

Взято с Vingrad

В иерархии VCL в большинстве случаев существует уровень объектов-"предшественников" (TCustomXXXX), в которых многие свойства скрыты. Для унаследованных от таких "предшественников" объектов можно "открывать" на выбор те или иные свойства. А как можно скрыть свойства, которые объявлены в published-области от Object Inspector'а, но при этом оставить возможность доступа во время работы программы? Решение состоит в объявлении свойства "по новой" в public-области. В примере скрытым будет у объекта TMyControl свойство Height.

 

Code:

TMyControl = class(TWinControl)

protected

procedure SetHeight(Value: Integer);

function GetHeight: Integer;

public

property Height: Integer read GetHeight write SetHeight;

end;

 

procedure TMyControl.SetHeight(Value: Integer);

begin

inherited Height := Value;

end;

 

function TMyControl.GetHeight;

begin

Result := inherited Height;

end;

Одна из вещей, которую вы могли бы захотеть реализовать - пользовательский интерфейс, предоставляющий доступ к файлу персональных данных. ООП предоставляет вам безусловно лучшие механизмы для его хранения, создания, и эксплуатации, делая эти вещи понятными и легкими для понимания.

 

Вот как вы можете сделать это. Забудьте об диалоговом окне хотя бы на минуту и сконцентрируйтесь на создании файла персональных данных. Скажем, вы редактируете запись человека со следующими полями: First Name, Last Name, Age и Active. Скажем, вам нужны следующие операции при работе с записью: добавление, изменение, удаление и построение списка.

 

Вам необходимо создать невизуальный объект доступа к файлу, инкапсулирующий вышеупомянутую функциональность. Это может выглядеть приблизительно так:

 

 

Code:

interface

 

PPersonRecord = ^TPersonRecord;

TPersonRecord = record

 

FirstName: string;

LastName: string;

Age: Byte;

Active: Boolean;

end;

 

TPersonFile = class(TObject)

private

 

FFileName: TFileName;

FFile: fileof TPersonRec;

public

 

constructor Create(AFileName: TFileName);

destructor Destroy; override;

procedure LoadRecord(Index: Integer);

procedure SaveRecord(Index: Integer);

procedure Add(NewPersonRecord: TPersonRecord);

procedure Change(ChangedPersonRecord: TPersonRecord; Index: Integer);

procedure Delete(Index: Integer);

procedure List(AStringList: TStringList);

property Person[Index: Integer]: TPersonRecord read LoadRecord write

SaveRecord;

end;

 

implementation

 

constructor TPersonFile.Create(AFileName: TFileName);

begin

 

inherited.Create;

AssignFile(FFile, AFileName);

Reset(FFile, SizeOf(TPersonRec));

New(FPersonRecord);

end;

 

destructor TPersonFile.Destroy;

begin

 

CloseFile(FFile);

Dispose(FPersonRecord);

inherited Destroy;

end;

 

function TPersonFile.LoadRecord(Index: Integer): PPersonRec;

begin

 

{ позиция файла в точке коррекции для чтения записи }

{ ... }

end;

 

procedure TPersonFile.SaveRecord(Index: Integer);

begin

 

{ позиция файла в точке коррекции для записи записи }

{ ... }

end;

 

procedure TPersonFile.Add(NewPersonRecord: TPersonRecord);

begin

 

{ файл позиционируется в конец для записи записи }

{ ... }

end;

 

procedure TPersonFile.Change(ChangedPersonRecord: TPersonRecord; Index:

Integer);

begin

 

{ именение TStatus ??? }

{ позиция файла в точке коррекции для записи записи }

{ ... }

end;

 

procedure TPersonFile.Delete(Index: Integer);

begin

 

{ изменение TStatus ??? }

{ позиция файла в точке коррекции для записи записи }

{ ... }

end;

 

procedure TPersonFile.List(AStringList: TStringList);

begin

 

{ в цикле обходим все записи, пополняя AStringList??? }

end;

 

 

 

 

 

 

OK, я надеюсь вы поняли мою идею. Вышеприведенный код взят мною из головы и, вероятно, несвободен от ошибок, поскольку я не до конца понял как работает тип file (для доступа к бинарному файлу я использую TFileStream), но идея следующая: инкапсуляция ваших функций работы с файлом в невизуальный объект как показано выше.

 

Теперь вы можете начать думать о ваших диалогах. Вам необходимо создать диалог, у которого в обработчике события OnCreate была бы примерно такая строчка кода:

Code:

 

MyPersonFile := TPersonFile.Create('c:\person.dat');

 

 

 

 

 

 

 

Естественно, вам необходим модуль, в котором вы объявляете TPersonFile в секции используемых модулей, а в классе формы необходимо поле с именем MyPersonFile. Вам также необходимо помнить об освобождении MyPersonFile в методе формы onClose. Я думаю вы сообразите как разместить в вашей программе необходимые элементы управления (менюшки, кнопки и прочие причиндалы), хотя бы для того, чтобы с помощью них можно было бы открыть файл.

 

Теперь вы должны разместить на форме компоненты типа Edit, CheckBox и др., отображающие и позволяющие редактировать поля записи через свойство Record. Убедитесь в том, что вы поддерживаете должный порядок, и освобождаете объект (запись) после его создания и использования. Конечно, эту работу красивой не назовешь, но от нее вас никто еще не освобождал. Вот красота ООП:

 

*После создания комбинации объект / форма диалога вся работа уже сделана.*

 

Вот другая хорошая вещь:

 

*Если вы изменяете ваш пользовательский интерфейс (например, при отказе от кучи диалогов или от использования Delphi (молчу-молчу)), ООП предоставляет вам простой и легкий в использовании способ переноса логики приложения, инкапсулированной в объекте TPersonFile.

 

https://delphiworld.narod

DelphiWorld 6.0

Вы можете менять свойство "owner" и после создания компонента с помощью методов InsertComponent() и RemoveComponent().

 

Взято из

DELPHI VCL FAQПеревод с английского

Подборку, перевод и адаптацию материала подготовил Aziz(JINX)

специально для Королевства Дельфи