Урок 30, ПОСЛЕДНИЙ: Примеры вызовов API Windows в Delphi.

Содержание урока:
1.0  Обзор
1.1  Стандартная страница Палитры Компонент TMainMenu, TPopupMenu, TMemo, TListBox, TComboBox
1.2  Страница “Additional” Палитры Компонент TSpeedButton, TTabSet, TNoteBook, TTabbedNoteBook
1.3  Страница “System” Палитры Компонент TOLEContainer
1.4  Страница “Data Access” Палитры Компонент TDataSource, TTable, TQuery
1.5  Страница “Data Controls” Палитры Компонент TDBGrid
1.6  Окна в Delphi
1.7  Обработка событий от клавиатуры
2.0  Вызов методов дальних предков

1. 0 Обзор

   Разработчики библиотеки визуальных компонент (VCL) Delphi очень серьезно поработали над ее проектированием и воплощением в реальность. Как показывает практика, стандартного набора объектов обычно достаточно для создания реальных приложений. И, что более существенно, им (разработчикам) удалось решить очень сложную задачу, стоящую перед создателями любой среды визуального программирования - скрыть от программиста сложность и трудоемкость программирования в Windows и, в то же время, не лишать его возможности доступа к тем богатым возможностям системы, которые предоставляет Windows API.

   В данной главе на примерах показано, как с помощью вызовов Windows API можно управлять объектами из VCL. Кроме того, здесь же можно найти описание некоторых программных трюков, которые помогут придать вашей программе оригинальный вид.

1.1 Стандартная страница Палитры Компонент

Компоненты, расположенные на странице “Standard”, представляют из себя объектную оболочку для стандартных управляющих элементов Windows. Поэтому для них существуют ограничения, накладываемые самой системой. Например, 32Кб - максимальный размер текста в TMemo.

TMainMenu, TPopupMenu

Добавление картинки (BitMap) в меню.

Для добавления в меню картинки можно использовать функцию API Windows SetMenuItemBitmaps(), например, следующим образом:

…
implementation
…
var
BMP1, BMP2 : TBitMap;
…

procedure TForm1.FormCreate(Sender: TObject);
begin
BMP1:=TBitMap.Create;
BMP1.LoadFromFile('c:\images\uncheck.bmp');
BMP2:=TBitMap.Create;
BMP2.LoadFromFile('c:\images\check.bmp');
SetMenuItemBitmaps(File1.Handle, 1, MF_BYPOSITION, BMP1.Handle, BMP2.Handle);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
BMP1.Free;
BMP2.Free;
end;

   File1 это объект класса TMenuItem - пункт меню “File”. Значения параметров при вызове функции можно посмотреть в справочнике по Windows API.
При уничтожении меню освобождения связанных с ним картинок не происходит и их надо уничтожать вручную.
Вторая картинка BMP2 отображается рядом с пунктом меню, когда он выбран (Checked=True).

TMemo

Компонент класса TMemo может содержать до 32К текста (для Windows 3.x) вследствие ограничения Windows. В Delphi 2.0 предел увеличен до 64К (в декабрьской бета-версии).

I. Определение позиции каретки в TMemo.

Можено использовать сообщения Windows API EM_LINEFROMCHAR и EM_LINEINDEX для определения текущей позиции каретки.

procedure TForm1.ShowPosition;
var
LineNum: longint;
CharNum: longint;
begin
LineNum:= Memo1.Perform(EM_LINEFROMCHAR, Memo1.SelStart,0);
CharNum:= Memo1.Perform(EM_LINEINDEX, LineNum, 0);
Label1.Caption := 'Line : '+ IntToStr(LineNum+1);
Label2.Caption := 'Position :' + IntToStr((Memo1.SelStart -
CharNum)+1);
end;

Метод Perform, определенный в классе TControl, посылает сообщение своему же объекту, то есть его использование имеет тот же эффект, что и вызов функции API SendMessage():

SendMessage(Memo1.Handle,EM_LINEFROMCHAR, Memo1.SelStart,0);

II. Операция UnDo в TMemo.

Отмена последнего редактирования (операция UnDo) в объекте класса TMemo выполняется так же с помощью сообщений, посылаемых в данный объект:

procedure TForm1.UnDoClick(Sender: TObject);
begin
if Memo1.Perform(EM_CANUNDO, 0, 0)<>0 then
Memo1.Perform(EM_UNDO, 0, 0);
end;

В справочнике по Windows API описаны сообщения, которые можно послать в объект TMemo для управления его поведением. Кроме вышеназванных, имеется еще несколько полезных:

EM_EMPTYUNDOBUFFER Сбрасывает флажок UnDo
EM_GETHANDLE Получает указатель на буфер с текстом
EM_LINESCROLL Прокрутка текста в окне TMemo
EM_SETHANDLE Установка указателя на буфер с текстом
EM_SETTABSTOPS Устанавливает табуляцию в окне с текстом

TListBox, TComboBox

Windows накладывает ограничение на количество элементов в списке этих управляющих элементов. В случае Windows 3.x это количество равно 5440, в Windows’95 - 32767.

III. Как получить горизонтальную прокрутку (scrollbar) в ListBox?

Так же как в случае с TMemo, здесь можно использовать сообщения. Например, сообщение может быть отослано в момент создания формы:

procedure TForm1.FormCreate(Sender: TObject);
begin
ListBox1.Perform(LB_SETHORIZONTALEXTENT, 1000, Longint(0));
end;

Второй параметр в вызове - ширина прокрутки в точках.

IV. Вставка графики в ListBox.

   У класса TListBox (и TComboBox тоже) есть свойство Style, определяющее порядок рисования объекта. По-умолчанию оно установлено в lbStandard и за внешний вид объекта отвечает Windows. Если установить это значение в lbOwnerDrawFixed или lbOwnerDrawVariable, то можно несколько разнообразить внешний вид объекта. Давайте построим для примера ListBox, отображающий названия файлов формата .BMP из какой-либо директории вместе с их картинками.

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

procedure TForm1.Button1Click(Sender: TObject);
var
s : String;
begin
s:='c:\windows\*.bmp'#0;
ListBox1.Perform(LB_DIR, DDL_READWRITE, Longint(@s[1]));
end;

Здесь мы указали ListBox’у, какие файлы требуется отображать.
Далее, как уже было сказано, свойство Style нужно установить в lbOwnerDrawFixed и создать обработчик события OnDrawItem:

procedure TForm1.ListBox1DrawItem(Control: TWinControl;
Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
Bitmap: TBitmap;
Offset: Integer;
BMPRect : TRect;
begin
with (Control as TListBox).Canvas do
begin
{очищаем прямоугольник}
FillRect(Rect);
{считываем картинку}
Bitmap:=TBitMap.Create;
Bitmap.LoadFromFile('c:\windows\'+ListBox1.Items[Index]);
if Bitmap <> nil then begin
{вычисляем квадрат для показа картинки}

BMPRect:=Bounds(Rect.Left + 2, Rect.Top + 2,
Rect.Bottom-Rect.Top-2, Rect.Bottom-Rect.Top-2);
{рисуем картинку}
StretchDraw(BMPRect, BitMap);
Offset := Rect.Bottom-Rect.Top + 6;
end;
{выводим текст}
TextOut(Rect.Left+Offset,Rect.Top,Listbox1.Items[Index]);
{не забыть освободить!}
Bitmap.Free;
end;
end;

Чтобы картинки получились побольше, значение свойства ItemHeight можно увеличить.

Есть около двух десятков сообщений, которые можно послать в объекты класса TListBox и TComboBox. Подробнее о них можно узнать в справочнике по Windows API (on-line Help).

1.2 Страница “Additional” Палитры Компонент

Компоненты, размещенные на этой странице представляют из себя объектную оболочку для управляющих элементов, появившихся в более поздних версиях Windows.

TSpeedButton

I. Эмуляция потери фокуса.

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

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
if ActiveControl is TEdit then
(ActiveControl as TEdit).OnExit(ActiveControl);
end;

Обработчик события должен быть определен, иначе возникнет GPF.

II. Обработка двойного щелчка мышью.

Если значение свойства GroupIndex равно 0, то двойное нажатие будет воспринято объектом как два одиночных. Если требуется, чтобы в результате двойного щелчка кнопка не фиксировалась в нажатом состоянии, то ее свойство AllowAllUp устанавливается в True, и в обработчике события кнопка возвращается в прежнее состояние:

procedure TForm1.SpeedButton1DblClick(Sender: TObject);
begin
SpeedButton1.Down:= Not SpeedButton1.Down;
Do_Something;
end;

TTabSet, TNoteBook

Ограничения по количеству страниц для этих объектов - 16364 (еще одно “магическое число” из класса TList). Но, на самом деле, не имеет смысла создавать более сотни страниц.

III. Переход на страницу по ее имени.

Если объект типа TTabSet содержит большое количество страниц, то пролистывать их в поисках нужной - дело утомительное. Проще найти ее по имени. Предположим, что имя страницы вводится в Edit1 :

procedure TMultPageDlg.Edit1Change(Sender: TObject);
var
i : Integer;
s1, s2: String;
begin
s1:=Edit1.Text;
if s1 = '' then Exit;
for i:=TabSet.Tabs.Count-1 downto 0 do begin
s2:=Copy(TabSet.Tabs[i], 1, Ord(s1[0]));
if CompareText(s1, s2)<=0 then
TabSet.TabIndex:=i;
end;
end;

TTabbedNoteBook

IV.  Добавление новых объектов во время выполнения программы.

После создания нового объекта, нужно в его свойстве Parent указать требуемую страницу TabbedNotebook:

...
var
Btn : TButton;
begin
Btn := TButton.Create(Self);
Btn.Parent:=TWinControl(TabbedNotebook1.Pages.Objects[1]);
...
end;

1.3  Страница “System” Палитры Компонент

TOLEContainer

   TOLEContainer - компонент, который нужно использовать во время дизайна с осторожностью, поскольку вся информация о нем сохраняется в .DFM файле. И если попытаться использовать встроенный (embedded) OLE-объект большого размера, то при сохранении формы может возникнуть ошибка “Out of resource”.

I. Хранение OLE-объектов в базе данных

   Использование технологии OLE для хранения информации в базе данных оправдано, если эта информация неоднородна. Иногда возникает необходимость одновременно сохранять в таблице и использовать в дальнейшем графические изображения, документы в формате Microsoft Word, звук и тому подобное. К сожалению, в стандартном наборе компонент отсутствует компонент вроде TDbOleContainer. Однако, обойтись без него можно достаточно просто.

   Для хранения OLE-объекта подойдет поле типа BLOB, а для работы с этим объектом - существующий компонент TOLEContainer. Если предполагается использовать таблицу на разных компьютерах, то OLE-объект нужно делать встроенным (embedded) и следить за тем, чтобы присутствовали соответствующие OLE-серверы.
Итак, сперва нужно заполнить таблицу:

{создание и инициализация OLE-объекта во время выполнения}
procedure TForm1.OLEInitClick(Sender: TObject);
var
OLE : TOLEContainer;
Info : Pointer;
begin
{создание OLE-контейнера}
OLE:=TOLEContainer.Create(Self);
OLE.Name:='Temp_OLE';
OLE.Parent:=Self;
{вызов диалога инициализации OLE-объекта}
if InsertOLEObjectDlg(Self, 0, Info) then begin
OLE.PInitInfo := Info;
ReleaseOLEInitInfo(Info);
end
else
OLE.Free;

end;

{уничтожение OLE-контейнера}
procedure TForm1.OLEFreeClick(Sender: TObject);
begin
FindComponent('Temp_OLE').Free;
end;

{сохранение OLE-объекта в BLOB поле}
procedure TForm1.InsertClick(Sender: TObject);
var
OLE : TOLEContainer;
TBS : TBlobStream;
begin
OLE:=FindComponent('Temp_OLE') as TOLEContainer;
if Assigned(OLE) then
with OLE do begin
{добавляем в таблицу новую запись}
Table1.Insert;
{создаем поток, связанный с BLOB полем}

TBS:=TBlobStream.Create(Table1.FieldByName('OLE') as
TBLOBField, bmReadWrite);
{сохраняем OLE-объект в поток}
SaveToStream(TBS as TStream);
{уничтожаем поток}
TBS.Free;
Exit;
end;
end;

{завершаем редактирование таблицы}
procedure TForm1.PostClick(Sender: TObject);
begin
if Table1.State <> dsBrowse then Table1.Post;
end;

   Вторая часть проблемы - чтение OLE-объекта из таблицы и обновление информации при его модификации. Здесь можно предложить динамически создавать OLE-контейнер и считывать OLE-объект из потока, связанного с BLOB полем. И делать это каждый раз при переходе на новую запись (перехватывать для DataSource событие OnDataChange). Либо вытаскивать информацию по запросу пользователя, а уничтожать OLE-контейнер при переходе на новую запись.

{считывание OLE-объекта из таблицы}
procedure TForm1.ViewClick(Sender: TObject);
var
OLE : TOLEContainer;
TBS : TBLOBStream;
begin
{создаем OLE-контейнер}
OLE:=TOLEContainer.Create(Self);
OLE.Parent:=Self;
OLE.Name:='Temp_OLE';
{создаем поток для BLOB поля}
TBS:=TBLOBStream.Create(Table1.FieldByName('OLE') as
TBLOBField, bmRead);
{инициализируем OLE-объект}
OLE.LoadFromStream(TBS as TStream);

{уничтожаем поток}
TBS.Free;
end;

{сохранение модифицированного OLE-объекта}
procedure TForm1.SaveClick(Sender: TObject);
var
TBS : TBLOBStream;
OLE : TOLEContainer;
begin
{находим объект}
OLE:=FindComponent('Temp_OLE') as TOLEContainer;
if Assigned(OLE) then
with OLE do
{сохраняем, если был модифицирован}
if Modified then begin
Table1.Edit;
{очищаем BLOB поле}
TBLOBField(Table1.FieldByName('OLE')).Clear;

{создаем поток}
TBS:= TBlobStream.Create(Table1.FieldByName('OLE') as
TBLOBField, bmReadWrite);
{сохраняем объект}
SaveToStream(TBS as TStream);
{уничтожаем поток}
TBS.Free;
Table1.Post;
end;
end;

{уничтожение OLE-контенера при переходе на другую запись}
procedure TForm1.DataSource1DataChange(Sender: TObject;
Field: TField);
begin

if Table1.State = dsBrowse then
FindComponent('Temp_OLE').Free;
end;

В примерах выше предполагается наличие таблицы с BLOB полем, которое называется “OLE”.

1.4 Страница “Data Access” Палитры Компонент

   Компоненты, расположенные на данной странице представляют из себя объектную оболочку для BDE (Borland Database Engine) - библиотеки доступа к данным. Компоненты TTable, TQuery, TStoredProc, TDataBase и TBatchMove (а так же TSession, который включен в Палитру в версии Delphi 2.0) имеют свои низкоуровневые аналоги. Хотя эти объекты достаточно полно реализуют возможности BDE, тем не менее, существуют некоторые задачи, решить которые можно только с помощью прямых вызовов функций BDE. Например, сменить пароль в таблице Paradox или упаковать таблицу dBase. Но об этом позже, а сейчас - о компонентах на странице “Data Access”.

TDataSource

I. Определение момента перехода на другую запись.

Если в момент вызова обработчика события OnDataChange для TDataSource
состояние его DataSet есть dsBrowse, то произошел переход на другую запись.

procedure TForm1.DataSource1DataChange(Sender: TObject;
Field: TField);
begin
if DataSource1.DataSet.State = dsBrowse then
Do_Somehing;
end;

TTable, TQuery

II.  Проблемы при создании таблиц.

   Как известно, класс TTable имеет метод для создания таблиц CreateTable, который использует при этом структуры FieldDefs и IndexDefs. Однако, некоторые возможности не реализованы (видимо из соображений общности - TTable должен работать одинаково с таблицами разных форматов). Два примера на эту тему: используя TTable нельзя создать автоинкрементное поле для таблицы формата Paradox и нельзя указать разрядность и число знаков после запятой для числового поля в таблице dBase. В подобных случаях лучше использовать Local SQL (и компонент TQuery). Выражение SQL, решающее первую проблему:

CREATE TABLE “PDX_TBL.DB”
(
KOD AUTOINC,
FIELD1 CHAR(10),
PRIMARY KEY (KOD)
)

Выражение SQL, решающее вторую проблему:

CREATE TABLE “DB_TBL.DBF”
(
KOD INTEGER,
FIELD1 DECIMAL (10,3)
)

III. Добавление записи в DataSet, не имеющий первичного ключа.

   Не вдаваясь в теорию реляционных СУБД, скажу, что BDE не очень хорошо работает с наборами данных, у которых нет первичного ключа и нельзя однозначно идентифицировать запись. Для программиста, использующего компонент TTable для доступа к таблице без первичного ключа, проблемы возникают при добавлении в такую таблицу новой записи. Для того, чтобы состояние TTable соответствовало состоянию физической таблицы, ее требуется переоткрыть (Close, а потом Open). Метод Refresh не поможет - он проходит только при наличии первичного ключа. После пероткрытия возникает проблема, как позиционироваться на запись, которая была текущей до переоткрытия. Найти ее можно только перебором записей, поскольку закладки (BookMark) для такой таблицы нестабильны.

   В случае с объектом класса TQuery, работающим с живым набором данных (live dataset), ситуация аналогичная. Не имеет значения, что запрос выполняется для таблицы, имеющей первичный ключ - результатом такого запроса все равно является набор данных, у которого нет ни первичного ключа, ни индексов.

IV. Определение номера текущей записи.

   Понятие номера (физического) текущей записи имеет некоторый смысл при работе с таблицами в формате dBase. Этот номер меняется достаточно редко, только при упаковке удаленных записей в таблице. В случае таблиц Paradox можно говорить только о логическом номере записи: место записи меняется при добавлении/удалении новой записи или при наложении индекса. Для данных на SQL сервере понятия “номер записи” не имеет смысла вообще (этого понятия нет в теории реляционных баз данных).

   Так как компоненты TQuery и TTable должны работать одинаково с данными различного формата, то у них нет свойства, отражающего номер записи.
Так как же быть программисту, если он работает с данными в формате dBase и желает, все-таки, что бы номер записи присутствовал на форме? Ему придется использовать прямой вызов функции BDE (подключив сперва к программе модули DBITYPES и DBIPROCS):

function TForm1.GetRecNo : Longint;
var
Pr : RECProps;
begin
dbiGetRecord(Table1.Handle, dbiNoLock, NIL, @Pr);
Result:=Pr.iPhyRecNum;
end;

Функция GetRecNo возвращает номер записи, ее можно использовать, например, для определения вычисляемого поля (обработчик OnCalcFields) и отражать это поле в DBGrid первым.
Более подробно о вызовах BDE будет рассказано позже.

1. 5 Страница “Data Controls” Палитры Компонент

TDBGrid

   Это наиболее применяемый в программах компонент для отображения данных. Понятно, что задачи бывают очень разными и требования к TDBGrid также очень разнообразны. Но в первой версии Delphi этот объект достаточно прост, он не умеет отображать графические и мемо-поля, в него нельзя поместить CheckBox или ComboBox. Есть достаточно много претензий к данному компоненту, но есть уверенность, что в Delphi 2.0 многие проблемы, связанные с этим компонентом, решены. Однако, многое можно сделать и с той версией DBGrid, что поставляется с Delphi 1.0.

I. Унаследованные свойства.

   Многие проблемы можно решить простым переносом некоторых свойств и методов из раздела protected в декларации класса TDBGrid в разделы public и published. Лучше всего создать новый класс - наследника от TDBGrid:


TNewDBGrid = class(TDBGrid)
public
{прямоугольник для указанной ячейки}
function CellRect(ARow, AСol : Integer) : TRect;
{текущий столбец}
property Col;
{текущая строка}
property Row;
{счетчик столбцов}
property ColCount;
{ширина столбцов}
property ColWidths;
{счетчик строк}
property RowCount;
{высота строк}
property RowHeights;
published

{количество “зафиксированных” столбцов}
property FixedCols;
{обработчики событий от мыши}
property OnClick;
property OnMouseMove;
property OnMouseUp;
property OnMouseDown;
end;

. . .

function TNewDBGrid.CellRect(ARow, Acol : Integer) : TRect;
begin
Result:= inherited CellRect(ARow, ACol);
end;

   В примере приведены не все возможные методы и свойства для публикации. Некоторые могут быть полезны. Информацию об этих свойствах и методах можно подчерпнуть из исходных текстов библиотеки и в пункте меню среды Delphi “View|Browser”. Но некоторые свойства, вроде FixedRows, работают не так как ожидается, поскольку их значения переопределяется внутри объекта.

II. Вертикальный ScrollBar.

   Обычно возникает вопрос, почему позиция движка в вертикальном ScrollBar’е не соответствует позиции текущей записи в таблице. Ответ частично был дан в предыдущем пункте: не всегда можно говорить о номере текущей записи. Но при желании можно заставить ScrollBar отображать позицию текущей записи в таблице, разумеется, только в случае локальных данных. Например так:

procedure TForm1.DataSource1DataChange(Sender: TObject;
Field: TField);
begin
if Table1.State = dsBrowse then begin
SetScrollRange(DBGrid1.Handle, SB_VERT, 0,
Table1.RecordCount-1, False);
SetScrollPos(DBGrid1.Handle, SB_VERT, GetRecNo-1, False);
end;
end;

   Процедура GetRecNo (приведена в предыдущем пункте) возвращает номер записи. Недостаток данного способа состоит в том, что при переходе на другую запись движок будет перерисовываться два раза, один раз в процедуре Paint, а второй раз в OnDataChange.

III.  Обработчик события OnDrawDataCell.

   Большое количество задач можно решить, если использовать событие перерисовки ячейки в DBGrid. Например: выделить цветом отрицательные значения или целиком колонку, вывести картинку в ячейке DBGrid, поместить DBCheckBox или DBComboBox в ячейку и многое другое. Ниже приведен вариант, в котором отрицательные значения выделяются красным цветом:

procedure TForm1.DBGrid1DrawDataCell(Sender: TObject; const
Rect: TRect; Field: TField; State: TGridDrawState);
begin
with DBGrid1.Canvas do begin
if (Not (gdFocused in State)) and
(Field.FieldName='BALANCE') and
(Field.AsFloat<0) then begin
Brush.Color:=clRed;
Font.Color:=clWhite;
end;
FillRect(Rect);
TextOut(Rect.Left, Rect.Top, Field.Text);
end;
end;

1. 6  Окна в Delphi

   Большинство видимых компонентов в Delphi (все компоненты, имеющие предком класс TWinControl) являются для Windows полноценными окнами. При доступе к этим компонентам из Windows API используется свойство Handle каждого компонента. Ниже приводится несколько “фокусов”, которые можно произвести с окнами компонентов, включая TForm.

. eщи Caption.

   Достаточно известен способ “перетаскивания” окна приложения без Caption (caption - поле заголовка вверху формы), этот способ описан и в разделе технической информации на CD-ROM с Delphi 1.02.
Для решения этой задачи нужно переопределить обработчик события WM_NCHITTEST для окна следующим образом:

type

TForm1 = class(TForm)
. . .
private
procedure WMNCHitTest(var M: TWMNCHitTest);
message wm_NCHitTest;
. . .
end;

. . .

procedure TForm1.WMNCHitTest(var M: TWMNCHitTest);
begin
{вызов унаследованного обработчика события}
inherited;
{если событие произошло в клиентской области,}
if M.Result = htClient then
{то пусть Windows думает, что это произошло на Caption}
M.Result := htCaption;
end;

   Теперь окно можно будет переместить на экране, даже если оно совсем не имеет Caption. Однако, неприятно то, что для такого окна не будут вызываться обработчики событий, связанных с мышкой (OnClick, OnMouseMove и т.д.).
   Все, что было сейчас проделано с формой (объектом класса TForm) можно применить и к остальным оконным компонентам. Нам никто не запрещает и для них переопределить обработку события WM_NCHITTEST.

I. Объекты, перетаскиваемые во время работы программы.

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

type
TMoveMemo = class(TMemo)
private
FMoveable : Boolean;
procedure WMNCHitTest(var M : TWMNCHitTest);
message WM_NCHitTest;
published
property Moveable:Boolean read FMoveable write FMoveable;
end;

. . .
procedure TMoveMemo.WMNCHitTest(var M : TWMNCHitTest);
begin
inherited;
if (not (csDesigning in ComponentState)) and FMoveable then
if M.Result = htClient then
M.Result:=htCaption;
end;

   Свойство Moveable определяет, можно ли объект перетаскивать. Если бы все оконные объекты имели такой обработчик события и свойство Moveable, то было бы очень просто построить приложение с изменяемым во время работы программы пользовательским интерфейсом.

II.  Внешний вид окна.

   Как известно, внешний вид окна в Windows определяется при его создании параметром Style (тип Longint). Полный список возможных значений этого параметра можно найти в справочнике по Windows API, все они начинаются с префикса WS_ (например, WS_CAPTION, WS_MAXIMIZED).

   Изменить внешний вид окна во время выполнения программы можно, если изменить значение его параметра Style. Для этого используется вызов функции API SetWindowLong(). Конечно, в случае формы (TForm) можно обойтись свойствами этого класса (но не всегда). Но в случае с обычными оконными компонентами получается забавный эффект. Попробуйте изменить стиль обычной кнопки (TButton):

procedure TForm1.Button2Click(Sender: TObject);
var
Style : Longint;
begin
{старый стиль окна}
Style:=GetWindowLong(Button1.Handle, GWL_STYLE);
{меняем стиль окна}
Style:=Style or WS_OVERLAPPEDWINDOW;
SetWindowLong(Button1.Handle, GWL_STYLE, Style);
{обновление окна (Invalidate не сработает)}
SetWindowPos(Button1.Handle, HWND_TOP, 0, 0, 0, 0,
SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER or SWP_DRAWFRAME
or SWP_NOACTIVATE);

end;

Указать свой стиль окна во время его создания можно, если переопределить для любого оконного объекта (включая TForm) процедуру CreateParams:

type
TForm1 = class(TForm)
. . .
procedure CreateParams(var Params:TCreateParams);
override;
. . .
end;

. . .

procedure TForm1.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.Style:=Params.Style and not WS_CAPTION;
end;

III. Распахивание (maximize) и захлопывание (minimize) окон.

   Иногда нужно, чтобы окно при нажатии кнопки “Maximize” распахивалось не на весь экран, а только на часть его. Вспомните редактор исходных текстов в среде Delphi. Эта задача, как и многие другие, решается написанием обработчика соответствующего события - WM_GETMINMAXINFO. Это сообщение посылается системой в окно при максимизации окна или при изменении его размеров с помощью рамки. Окно возвращает требуемые размеры и положение.

TForm1 = class(TForm)
. . .
private
procedure WMGetMinMaxInfo(var M: TWMGetMinMaxInfo);
message WM_GETMINMAXINFO;
. . .
end;

. . .

procedure TForm1.WMGetMinMaxInfo(var M: TWMGetMinMaxInfo);
begin
{на всякий случай}
inherited;
{указываем верхнюю границу окна ниже другого окна}
M.MinMaxInfo^.PTMaxPosition.Y := Form2.Top+Form2.Height;
end;

   С помощью обработчика данного события устанавливается не только место и размер распахнутого полностью окна, но и минимальные/максимальные размеры окна при изменении их с помощью рамки. Пример, установка в обработчике события WM_GETMINMAXINFO

m.minmaxinfo^.ptMinTrackSize.y := 100;
m.minmaxinfo^.ptMaxTrackSize.y := 300;

не даст сделать вертикальный размер окна менее 100 и более 300 точек.

1.7 Обработка событий от клавиатуры

I. Эмуляция нажатия клавиши.

   Внутри приложения это выполняется достаточно просто с помощью вызова функции Windows API SendMessage() (можно воспользоваться и методом Perform того объекта (или формы), кому посылается сообщение о нажатой клавише).
Код

Memo1.Perform(WM_CHAR, Ord(‘A’), 0);
или
SendMessage(Memo1.Handle, WM_CHAR, Ord(‘A’), 0);

приведет к печати символа “A” в объекте Memo1.

II. Перехват нажатий клавиши внутри приложения.

   Задача решается очень просто. Можно у формы установить свойство KeyPreview в True и обрабатывать событие OnKeyPress. Второй способ - перехватывать событие OnMessage для объекта Application.

III. Перехват нажатия клавиши в Windows.

Существуют приложения, которым необходимо перехватывать все нажатия клавиш в Windows, даже если в данный момент активно другое приложение. Это может быть, например, программа, переключающая раскладку клавиатуры, резидентный словарь или программа, выполняющая иные действия по нажатию “горячей” комбинации клавиш.

   Перехват всех событий в Windows (в том числе и событий от клавиатуры) выполняется с помощью вызова функции SetWindowsHook(). Данная функция регистрирует в системе Windows ловушку (hook) для определенного типа событий/сообщений. Ловушка - это пользовательская процедура, которая будет обрабатывать указанное событие.
Основное здесь то, что эта процедура должна всегда присутствовать в памяти Windows. Поэтому ловушку помещают в DLL и загружают эту DLL из программы. Пока хоть одна программа использует DLL, та не может быть выгружена из памяти. Приведем пример такой DLL и программы, ее использующей. В примере ловушка перехватывает нажатие клавиш на клавиатуре, проверяет их и, если это клавиши “+” или “-”, посылает соответствующее сообщение в конкретное приложение (окно). Окно ищется по имени его класса (“TForm1”) и заголовку (caption, “XXX”).

{текст библиотеки}
library SendKey;

uses
WinTypes, WinProcs, Messages;

const
{пользовательские сообщения}
wm_NextShow_Event = wm_User + 133;
wm_PrevShow_Event = wm_User + 134;
{handle для ловушки}
HookHandle: hHook = 0;

var
SaveExitProc : Pointer;

{собственно ловушка}
function Key_Hook(Code: integer; wParam: word; lParam: Longint): Longint; export;
var
H: HWND;
begin
{если Code>=0, то ловушка может обработать событие}

if Code >= 0 then
begin
{это те клавиши?}
if ((wParam = VK_ADD)or(wParam = VK_SUBTRACT)) and
(lParam and $40000000 = 0) then
begin
{ищем окно по имени класса и по заголовку}
H := FindWindow('TForm1', 'XXX');
{посылаем сообщение}
if wParam = VK_ADD then
SendMessage(H, wm_NextShow_Event, 0, 0)
else
SendMessage(H, wm_PrevShow_Event, 0, 0);
end;
{если 0, то система должна дальше обработать это событие}

{если 1 - нет}
Result:=0;
end
else
{если Code<0, то нужно вызвать следующую ловушку}
Result := CallNextHookEx(HookHandle,Code, wParam, lParam);
end;

{при выгрузке DLL надо снять ловушку}
procedure LocalExitProc; far;
begin
if HookHandle<>0 then
begin
UnhookWindowsHookEx(HookHandle);
ExitProc := SaveExitProc;
end;
end;

{инициализация DLL при загрузке ее в память}
begin
{устанавливаем ловушку}
HookHandle := SetWindowsHookEx(wh_Keyboard, Key_Hook,

hInstance, 0);
if HookHandle = 0 then
MessageBox(0, 'Unable to set hook!', 'Error', mb_Ok)
else begin
SaveExitProc := ExitProc;
ExitProc := @LocalExitProc;
end;
end.

Размер такой DLL в скомпилированном виде будет около 3Кб, поскольку в ней не используются объекты из VCL.

Далее приведен код модуля в Delphi, который загружает DLL и обрабатывает сообщения от ловушки, просто отображая их в Label1.

unit Unit1;

interface

uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;

{пользовательские сообщения}
const
wm_NextShow_Event = wm_User + 133;
wm_PrevShow_Event = wm_User + 134;

type
TForm1 = class(TForm)
Label1: TLabel;
procedure FormCreate(Sender: TObject);
private
{обработчики сообщений}
procedure WM_NextMSG (Var M : TMessage);
message wm_NextShow_Event;

procedure WM_PrevMSG (Var M : TMessage);
message wm_PrevShow_Event;
end;

var
Form1: TForm1;
P : Pointer;

implementation

{$R *.DFM}

{загрузка DLL}
function Key_Hook : Longint; far; external 'SendKey';

procedure TForm1.WM_NextMSG (Var M : TMessage);
begin
Label1.Caption:='Next message';
end;

procedure TForm1.WM_PrevMSG (Var M : TMessage);
begin
Label1.Caption:='Previous message';
end;

procedure TForm1.FormCreate(Sender: TObject);

begin
{если не использовать вызов процедуры из DLL в программе,
то компилятор удалит загрузку DLL из программы}
P:=@Key_Hook;
end;
end.

Конечно, свойство Caption в этой форме должно быть установлено в “XXX”.

2. 0  Вызов методов дальних предков

   Проблема в следующем. Допустим, есть иерархия классов, у которых перекрывается (override) один и тот же виртуальный (или динамический - не важно) метод, и в одной из реализаций этого метода вы хотите вызвать виртуальный метод предка своего предка (“дедушки”, “прадедушки” и т.д.). Новая объектная модель Delphi допускает только вызов методов непосредственного предка (с помощью ключевого слова inherited) либо вызов методов класса с префиксом - типом класса (например, TLevel1.ClassName).

   Эта задача стандартными средствами не решается. Но сделать требуемый вызов можно. Причем, способом, показанным ниже, можно вызвать любой метод для любого класса, однако, в этом случае вся ответственность за правильность работы с методами и полями ложится на программиста. В примере, приведенном ниже, в методе VirtualFunction класса TLevel3 напрямую вызывается метод класса TLevel1 (метод “деда”). В функции Level1Always всегда вызывается метод класса TLevel1 для любого его наследника.

{декларация классов}
TLevel1 = class(TComponent)
public
function VirtualFunction: string; virtual;
end;

TLevel2 = class(TLevel1)
public
function VirtualFunction: string; override;
end;

TLevel3 = class(TLevel2)
public
function VirtualFunction: string; override;
end;

function Level1Always(MyLevel: TLevel1): string;

implementation

type
PClass = ^TClass;

{виртуальная функция “дедушки”}
function TLevel1.VirtualFunction: string;

begin
Result := 'Level1';
end;

{виртуальная функция “отца”, вызывает унаследованный метод “дедушки”}
function TLevel2.VirtualFunction: string;
begin
Result := inherited VirtualFunction+' Level2';
end;

{виртуальная функция самого младшего класса, вызывает
напрямую метод “дедушки”, минуя “отца”}

function TLevel3.VirtualFunction: string;
var
ClassOld: TClass;
begin
ClassOld := PClass(Self)^;

PClass(Self)^ := Self.ClassParent.ClassParent;
Result := VirtualFunction + ' Level3';
PClass(Self)^ := ClassOld;
end;

function Level1Always(MyObject: TObject): string;
var
ClassOld: TClass;
begin
ClassOld := PClass(MyObject)^;
PClass(MyObject)^ := TLevel1;
Result := (MyObject as TLevel1).VirtualFunction;
PClass(MyObject)^ := ClassOld;
end;

   Как же это работает? Стандартные, так называемые объектные типы (object types - class of ...), на самом деле представляют из себя указатель на VMT (Virtual Method Table) - таблицу виртуальных методов, который (указатель) лежит по смещению 0 в экземпляре класса. Воспользовавшись этим, мы сначала сохраняем 'старый тип класса' - указатель на VMT, присваиваем ему указатель на VMT нужного класса, делаем вызов и восстанавливаем все как было. Причем нигде не требуется, чтобы один из этих классов был бы порожден от другого, т.е. функция Level1Always вызовет требуемый метод для любого экземпляра любого класса.

Если в функции Level1Always попробовать сделать вызов

Result := MyObject.VirtualFunction;

то будет ошибка на стадии компиляции, так как у класса TObject нет метода VirtualFunction.
Другой вызов

Result := (MyObject as TLevel3).VirtualFunction;

будет пропущен компилятором, но вызовет Run-time ошибку, даже если передается экземпляр класса TLevel3 или один из его потомков, так как информация о типе объекта была изменена.
   Динамически распределяемые (dynamic) методы можно вызывать точно таким же образом, т.к. информация о них тоже хранится в VMT.
Статические методы объектов вызываются гораздо более простым способом, например

var
MyLevel3: TLevel3;
...
(MyLevel3 as TLevel1).SomeMethode;

вызовет метод класса TLevel1 даже если у MyLevel3 есть свой такой же метод.

А теперь, я с вами прощаюсь. Удачи всем!