Содержание урока 31:
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 Вызов методов дальних предков

Обзор

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

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

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.

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

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

procedure TForm1.FormCreate(Sender: TObject);

begin

ListBox1.Perform(LB_SETHORIZONTALEXTENT, 1000, Longint(0));

end;

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

II. Вставка графики в 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).
 
 

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). Но, на самом деле, не имеет смысла создавать более сотни страниц.

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

Если объект типа 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

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

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

...

var

Btn : TButton;

begin

Btn := TButton.Create(Self);

Btn.Parent:=TWinControl(TabbedNotebook1.Pages.Objects[1]);

...

end;
 
 
 
 

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”.
 
 
 
 

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

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

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

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

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

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

Понятие номера (физического) текущей записи имеет некоторый смысл при работе с таблицами в формате 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 будет рассказано позже.

Это наиболее применяемый в программах компонент для отображения данных. Понятно, что задачи бывают очень разными и требования к 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. “Перетаскивание” окна без помощи Caption.

Для решения этой задачи нужно переопределить обработчик события 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.

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

Проще всего было бы решить эту задачу переопределением соответствующего обработчика и добавлением нового свойства для класса 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, то было бы очень просто построить приложение с изменяемым во время работы программы пользовательским интерфейсом.

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

Как известно, внешний вид окна в 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;
 
 

IV. Распахивание (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 точек.

Внутри приложения это выполняется достаточно просто с помощью вызова функции 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”.
 
 

Эта задача стандартными средствами не решается. Но сделать требуемый вызов можно. Причем, способом, показанным ниже, можно вызвать любой метод для любого класса, однако, в этом случае вся ответственность за правильность работы с методами и полями ложится на программиста. В примере, приведенном ниже, в методе 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 есть свой такой же метод.