Александр Бусаров
дата публикации 17-07-2011 14:33
В предыдущей статье был создан модуль, который, как первый блин вышел немного комом. Однако идея объектного подхода в целом удачная.
К сожалению, я с WinAPI во всех деталях знаком слабо, чтобы наперед грамотно продумать архитектуру и реализацию. Некоторые аспекты возникают по мере чтения msdn. Но надеюсь, что, несмотря на допущенные мною незначительные ошибки (как архитектурные, так и логические), статья будет полезной для определенного круга программистов. А сейчас мы пробежимся по злачным местам старого модуля, и взглянем этим ошибкам в лицо.
Кусок кода из старого модуля:
procedure TWindow.RegClass;
var wndClassEx: TWndClassEx;
begin
if not GetClassInfoEx(HInstance, PChar(ClassName), wndClassEx) then
begin
wndClassEx:=GetWndClassInfo;
if RegisterClassEx(wndClassEx)=0 then raise ERegisterClass.Create;
end;
end;
|
|
Товарищ Dmitry в комментариях к предыдущей статье верно подметил. В ситуации с многопоточностью проверка GetClassInfoEx может и проскочить, если один поток "умирает" анрегистрирует класс, то второй может подумать, что класс уже зарегистрирован. Оптимально оказалось просто "внаглую" регистрировать класс при каждом создании окна. Если класс уже зарегистрирован — то новый не зарегистрируется. Если хоть одно окно этого класса существует — то удалить класс нельзя. Осталось только создание хендла окна обернуть в одну глобальную критическую секцию с регистрацией классов:
EnterCriticalSection(RegCS);
RegClass;
CreateWND(parent);
LeaveCriticalSection(RegCS);
|
|
И:
EnterCriticalSection(RegCS);
DestroyWND;
UnregClass;
LeaveCriticalSection(RegCS);
|
|
Кусок кода из старого модуля внутри оконной функции:
if wndMsg.Result<>0 then
Result:=DefWindowProc(handle, msg, wPrm, lPrm)
else
Result:=0;
|
|
В случае обработки сообщения не всегда нужно возвращать 0. Переписано на:
if assigned(wnd) then
begin
wndMsg.Msg:=Msg;
wndMsg.wParam:=wPrm;
wndMsg.lParam:=lPrm;
wndMsg.Result:=-1;
wnd.Dispatch(wndMsg);
Result:=wndMsg.Result;
end
|
|
Используются возможности TObject.Dispatch; Если TObject.Dispatch; не находит соответствующий message метод, то вызывается TObject.DefaultHandler внутри которого происходит вызов DefWindowProc.
В предыдущем модуле для того, чтобы определить объект в оконной функции, для которого вызывать TObject.Dispatch — происходил поиск по массиву внутри app.FindByHandle(handle). Такой подход может существенно повлиять на производительность при большом количестве окон. Способ нахождения объекта окна изменен с использованием WinAPI возможностей: GetProp SetProp функций.
Внутри CreateWND сразу после создания окна добавляем свойство через SetProp:
FHandle:=CreateWindowEx(params.ExStyle, PChar(s), PChar(string(ClassName)), params.Style,
params.Pos.X, params.Pos.Y, params.Size.X, params.Size.Y, parent, 0, HInstance, nil);
if FHandle=0 then raise EWindowCreation.Create;
if not SetProp(FHandle, PROP_OBJDATA, Cardinal(Self)) then raise EWindowCreation.Create;
|
|
Внутри обработчика WM_NCDESTROY свойство удаляется:
if GetProp(Handle, PROP_OBJDATA)<>0 then RemoveProp(Handle, PROP_OBJDATA);
|
|
Внутри оконной функции находим окно через GetProp:
function WndProc(handle: HWND; Msg: Cardinal; wPrm: WPARAM; lPrm: LPARAM): integer; stdcall;
var wnd: TBaseWindow;
wndMsg: TWindowMsg;
begin
wnd:=TBaseWindow(GetProp(handle, PROP_OBJDATA));
if assigned(wnd) then
begin
wndMsg.Msg:=Msg;
wndMsg.wParam:=wPrm;
wndMsg.lParam:=lPrm;
wndMsg.Result:=-1;
wnd.Dispatch(wndMsg);
Result:=wndMsg.Result;
end
else
begin
Result:=DefWindowProc(handle, msg, wPrm, lPrm);
end;
end;
|
|
Поскольку мы теперь не нуждаемся в массиве хендлов внутри TApp, то нужно предусмотреть выход из TApp.Run:
while GetMessage(msg, 0, 0, 0) do
begin
TranslateMessage(msg);
DispatchMessage(msg);
for i := 0 to Length(FDestroyArr) - 1 do FDestroyArr[i].Free;
SetLength(FDestroyArr, 0);
if FWNDCount=0 then PostQuitMessage(0);
end;
|
|
Я добавил счетчик окон, который я увеличиваю при создании каждого класса TWindow и уменьшаю при уничтожении. Как только все окошки уничтожены — то произойдет выход из цикла.
В модуле была допущена еще одна ошибка. Уничтожение объекта происходило внутри WM_DESTROY, что не совсем правильно. Во-первых, это сообщение сначала будет приходить родителю, а потом потомкам, что значит, что родитель будет "умирать" первым. Во-вторых, это не самое последнее сообщение, которое приходит окну, следовательно, мы не сможем обработать WM_NCDESTROY. WM_DESTROY заменен на обработчик WM_NCDESTROY. Теперь безопасное удаление объекта находится внутри этого обработчика.
В старом модуле архитектура не позволяла сразу указать родительское окно. Вследствие этого, чтобы создать потомка, нужно было самому вызывать SetParent после создания объекта. Такая возможность была добавлена. Теперь в конструктор можно сразу передать хендл окна:
constructor Create(parent: HWND = 0); virtual;
|
|
Архитектура старого модуля так же не позволяла создавать окна на базе глобальных системных классов. Был доступен только GetWndClassInfo метод для переопределения. Теперь этих методов 3:
function IsGlobalClass: boolean; dynamic;
function GlobalClassName: string; dynamic;
procedure ClassInfo(var cInfo: TWndClassEx); dynamic;
|
|
Функция IsGlobalClass должна вернуть true если окно будет создано на базе глобального класса. Если класс глобальный, то будет вызвана GlobalClassName функция, которая должна вернуть имя глобального класса. Если IsGlobalClass=false, то будет вызван ClassInfo метод.
Если мы захотим получить какие либо сообщения окна, созданного от глобального 'BUTTON' класса, то не тут-то было. Ни одного сообщения мы не получим. Если подумать, то становится понятно почему. У глобального класса определена своя оконная функция. И при вызове DispatchMessage наше сообщение попадет именно в ту, другую оконную функцию. Поэтому, для того чтобы можно было все-таки "подсмотреть" сообщения у таких окошек, я пришел к выводу что лучше всего после создания окошка подменить ему оконную функцию через SetWindowLong. Подмена происходит внутри CreateWND:
if IsGlobalClass then FPrevWndProc:=Pointer(SetWindowLong(Handle, GWL_WNDPROC, Integer(@WndProc)));
|
|
Соответственно внутри DefaultHandler-а вызывается либо предыдущая оконная функция, либо оконная функция по умолчанию:
procedure TBaseWindow.DefaultHandler(var Message);
begin
inherited;
if Assigned(FPrevWndProc) then
TWindowMsg(Message).Result:=CallWindowProc(FPrevWndProc, Handle, TWindowMsg(Message).Msg,
TWindowMsg(Message).wParam, TWindowMsg(Message).lParam)
else
TWindowMsg(Message).Result:=DefWindowProc(Handle, TWindowMsg(Message).Msg,
TWindowMsg(Message).wParam, TWindowMsg(Message).lParam);
end;
|
|
Важно заметить что "подсматривать" оконные сообщения у класса нужно осторожно, и в большинстве случаев после "подсматривания" такого сообщения рекомендуется вызывать DefaultHandler вручную. DefaultHandler можно не вызывать, если действительно нужно чтобы сообщение не дошло до стандартной оконной функции.
Помимо сабклассинга оконной функции, описанного выше, есть еще одна группа интересных сообщений, связанных именно с глобальными классами. Чтобы программист мог определить реакцию на нажатие простых кнопок и т.п. без хитрых сабклассингов — используется WM_COMMAND сообщение, которое посылается родительскому окну. Если мы на своей форме расположим кнопку, то WM_COMMAND от кнопки придет именно окну. Поскольку наша форма ничего не должна знать о контролах лежащих на ней, то лучше, чтобы WM_COMMAND обрабатывал наш объект-кнопка. Поэтому у TWindow определен обработчик WM_COMMAND:
procedure TBaseWindow.WMCommand(var msg: TWindowMsg);
var wnd: TBaseWindow;
begin
if IsWindow(msg.lParam) then
begin
wnd:=TBaseWindow(GetProp(msg.lParam, PROP_OBJDATA));
if assigned(wnd) then
begin
if wnd=self then
wnd.ProcessCommand(msg.wParam)
else
wnd.Dispatch(msg);
end;
end;
msg.Result:=0;
end;
|
|
Как видно, мы перенаправляем обработку WM_COMMAND внутрь нашей кнопки. Внутри обработчика кнопки будет вызван wnd.ProcessCommand(msg.wParam). Это виртуальный метод для будущих переопределений, в котором мы собственно и будем обрабатывать команды.
К слову, VCL использует похожий подход, перенаправляет сообщения объектам, только вместо ProcessCommand вызывается Dispatch, но с новым диапазоном констант. Если заглянуть в Controls.pas то можно заметить эти константы:
CN_BASE = $BC00;
CN_CHARTOITEM = CN_BASE + WM_CHARTOITEM;
CN_COMMAND = CN_BASE + WM_COMMAND;
CN_COMPAREITEM = CN_BASE + WM_COMPAREITEM;
CN_CTLCOLORBTN = CN_BASE + WM_CTLCOLORBTN;
CN_CTLCOLORDLG = CN_BASE + WM_CTLCOLORDLG;
CN_CTLCOLOREDIT = CN_BASE + WM_CTLCOLOREDIT;
CN_CTLCOLORLISTBOX = CN_BASE + WM_CTLCOLORLISTBOX;
CN_CTLCOLORMSGBOX = CN_BASE + WM_CTLCOLORMSGBOX;
CN_CTLCOLORSCROLLBAR = CN_BASE + WM_CTLCOLORSCROLLBAR;
CN_CTLCOLORSTATIC = CN_BASE + WM_CTLCOLORSTATIC;
CN_DELETEITEM = CN_BASE + WM_DELETEITEM;
|
|
Поскольку наш код лежит слишком низко над WinAPI по сравнению с VCL, то я решил, чтобы множества констант ненароком не пересеклись использовать непосредственно вызов ProcessCommand вместо Dispatch. Хотя ничего в принципе не мешает использовать такой же подход через смещения.
Методы:
function GetExStyle: DWORD; virtual;
function GetStyle: DWORD; virtual;
|
|
у TWindow теперь объеденены в один:
procedure CreateParams(var params: TWndParams); dynamic;
|
|
Структура TWndParams декларирована так:
TWndParams = packed record
Style : Cardinal;
ExStyle: Cardinal;
Pos : TPoint;
Size : TPoint;
end;
|
|
Как видно из структуры, теперь можно задать размер и позицию создаваемого окна.
Класс TWindow переименован в TBaseWindow. Почему — не знаю.
Сам модуль: untWndOPP переименован в untWnd. Тоже не знаю, зачем и почему.
Пока функциональность нашего модуля под вопросом. Непонятно как можно использовать его, и вообще, какие преимущества дает нам этот ООП подход. Поэтом я написал модуль untCtrls.pas. Он прекрасно демонстрирует ООП подход в создании окон. Первый класс, который там описан:
TWindow = class (TBaseWindow)
private
function ScreenToClientRect(rct: TRect): TRect;
function ClientToScreenRect(rct: TRect): TRect;
procedure SetHeight(const Value: integer);
procedure SetLeft(const Value: integer);
procedure SetTop(const Value: integer);
procedure SetWidth(const Value: integer);
function GetHeight: integer;
function GetLeft: integer;
function GetTop: integer;
function GetWidth: integer;
function GetCaption: string;
procedure SetCaption(const Value: string);
function GetVisible: boolean;
procedure SetVisible(const Value: boolean);
protected
procedure CreateParams(var params: TWndParams); override;
public
property Caption: string read GetCaption write SetCaption;
property Visible: boolean read GetVisible write SetVisible;
property Left : integer read GetLeft write SetLeft;
property Top : integer read GetTop write SetTop;
property Width : integer read GetWidth write SetWidth;
property Height: integer read GetHeight write SetHeight;
end;
|
|
Это TWindow. Функциональность данного класса видна в его свойствах. Возможность задать позицию окна, заголовок, показать/спрятать окно. Все, больше никакой дополнительной функциональностью он не обладает. По умолчанию создается WS_OVERLAPPEDWINDOW.
Далее у нас целая серия контролов унаследованных от этого TWindow:
TButton = class (TWindow)
TCheckBox = class (TWindow)
TRadioButton = class (TWindow)
TGroupBox = class (TWindow)
TBaseEdit = class (TWindow)
|
|
Окна всех этих контролов созданы от глобальных классов. У всех у них перекрыт IsGlobalClass и GlobalClassName. Для обработки команд перекрыт ProcessCommand.
В целом реализация очень простая. Я не буду описывать подробности. Достаточно заглянуть в модуль, там все очень просто, уверяю вас.
Но есть одна деталь, на которой я должен остановиться. Рассмотрим на примере глобального класса EDIT. Судя по описанию msdn, этот класс идеально подойдет нам для создания аналогов TEdit и TMemo. С классом связано много стилей, которые мы можем указать, но у некоторых стилей есть особенность. Мы не можем менять этот стиль после создания окна. Среди таких стилей: ES_AUTOHSCROLL, ES_AUTOVSCROLL, ES_CENTER, ES_LEFT, ES_NOHIDESEL.
Пересоздать просто так окно без уничтожения объекта мы не можем, т.к. архитектурно заложено, что у нас объект уничтожается при WM_NCDESTROY. Поэтому изменить такой стиль внутри объекта не представляется возможным. Убиваем хендл, нам приходит WM_NCDESTROY и наш объект уничтожается.
Фактически — нам нужна возможность создавать контрол разных стилей, но создавать для каждого случая отдельный класс — бред. Поэтому для TBaseEdit я определил дополнительный конструктор:
constructor TBaseEdit.CreateStyled(parent: HWND; Style: Cardinal);
begin
FcStyle:=Style;
Create(parent);
end;
|
|
А CreateParams стал таким:
procedure TBaseEdit.CreateParams(var params: TWndParams);
begin
inherited;
if FcStyle<>0 then
params.Style:=FcStyle or WS_CHILD or WS_CLIPSIBLINGS or WS_MAXIMIZEBOX
else
params.Style:=ES_AUTOHSCROLL or ES_AUTOVSCROLL or WS_CHILD or WS_CLIPSIBLINGS or WS_MAXIMIZEBOX;
params.ExStyle:=WS_EX_CLIENTEDGE;
params.Size.X:=121;
params.Size.Y:=21;
end;
|
|
Как видим — это развязало нам руки. Если указан FcStyle, то будет создано окно именно этого стиля, в противном случае будет создано дефолт окно.
Здесь многие могут заявить, что это костыль. Но увы, наша архитектура слишком низко привязана к WinAPI. У нас каждый объект полагает, что он существует только с одним хендлом, и как только хендл "умирает" объект просит TApp убить его, как бы жестоко это не звучало.
Если вы заглянете в проект, прилагаемый к статье, то увидите там модуль untForm.pas, в котором объявлена наша форма:
TMyForm = class (TWindow)
private
FGroupBox: TGroupBox;
FRad1: TRadioButton;
FRad2: TRadioButton;
FRad3: TRadioButton;
FRad4: TRadioButton;
FChck: TCheckBox;
FEdit: TEdit;
FBtn : TButton;
FMemo: TMemo;
procedure CheckClick(sender: TObject);
procedure BtnClick(sender: TObject);
public
procedure AfterConstruction; override;
end;
|
|
Ничего не напоминает? Примерно так же VCL подсовывает нам свой Unit1.pas когда мы создаем проект. Просто наследник от TForm. Когда кидаем кнопку на форму у нас она появляется в полях объекта. VCL выполняет за нас еще одну рутинную работу. Он создает все эти TButton-ы и TEdit-ы, а так же инициализирует их начальными значениями. К сожалению этого мы пока автоматизировать не можем. Поэтому в AfterConstruction у нас происходит создание и инициализация всех контролов на форме.
Внимательный читатель, который уже изучил модуль спросит: "Мы создаем множество объектов. Почему мы ничего не уничтожаем?". А очень внимательный читатель вспомнит, уничтожение у нас происходит в WM_NCDESTROY. WM_NCDESTROY сначала обходит все дочерние окна, а только затем приходит в родительское. Таким образом, у нас гарантируется удаление всех объектов, которые имеют родителя.
В целом пример неплохо демонстрирует работу с формами в VCL стиле. Удобно, понятно, привычно, чего я собственно и добивался.
К сожалению, наша архитектура не дает такой гибкости, как VCL. И я уже описал, почему такое происходит: высокая привязанность к хендлу окна. А сделать код независимым от окна не так-то просто + наше приложение раздуется в размере.
Но у нашей архитектуры есть и положительные черты. Во-первых, изначально мы закладывались на многопоточность, чего не дает нам VCL. Во-вторых — база вышла небольшая и легкая, а это значит, что даже если есть баги — их легче выявить. Модифицировать нашу базу так же значительно легче.
Честно говоря, я планировал написать другую статью. С большим количеством примеров. Но "работа над ошибками" от предыдущей статьи вышла объемной. Поэтому только 1 пример. Я постараюсь написать еще статью, с большим количеством примеров. Возможно, даже перепишу пару своих готовых программ, которые сейчас лежат в разделе [Полигон].
Так же я постараюсь развить модуль untCtrls.pas, дополнить его как можно большим количеством стандартных классов.
Если вас этот модуль заинтересовал, можете тоже поучаствовать в его развитии, я буду только рад ;)
К материалу прилагаются файлы:
 Обсуждение материала [ 15-02-2012 11:21 ] 3 сообщения |
