SetWindowLong(FWndHandle, GWL_WNDPROC, DWord(WndCallback));
end;
////////////////////////////////////////////////////////////////////////////////
// Деструктор
////////////////////////////////////////////////////////////////////////////////
destructor TLiteWindow.Destroy;
begin
// Наш объект - объект субклассиннга ?
if FWndSubclass = nil then
begin
// Уничтожаем класс окна
UnregisterClass(FWndParams.WindowClass.lpszClassName, hInstance);
// Уничтожаем окно
if IsWindow(FWndHandle) then DestroyWindow(FWndHandle);
end
else
// Восстанавливаем старую оконную функцию
SetWindowLong(FWndHandle, GWL_WNDPROC, DWord(FWndSubclass));
// Уничтожение по умолчанию
inherited;
end;
////////////////////////////////////////////////////////////////////////////////
// Формирование параметров окна по умолчанию
////////////////////////////////////////////////////////////////////////////////
procedure TLiteWindow.CreateWindowParams(
var WindowParams: TWindowParams);
var
WndClassName : string;
begin
// Формируем имя класса
Str(DWord(Self), WndClassName);
WndClassName := ClassName+':'+WndClassName;
// Заполняем информацию о классе окна
with FWndParams.WindowClass do
begin
style := CS_DBLCLKS;
lpfnWndProc := WndCallback;
cbClsExtra := 0;
cbWndExtra := 0;
lpszClassName := PChar(WndClassName);
hInstance := hInstance;
hIcon := LoadIcon(0, IDI_APPLICATION);
hCursor := LoadCursor(0, IDC_ARROW);
hbrBackground := COLOR_BTNFACE + 1;
lpszMenuName := '';
end;
// Заполняем информацию об окне
with FWndParams do
begin
WndParent := FWndParent;
Caption := 'Lite Window';
Style := WS_OVERLAPPEDWINDOW or WS_VISIBLE;
ExStyle := 0;
X := Integer(CW_USEDEFAULT);
Y := Integer(CW_USEDEFAULT);
Width := Integer(CW_USEDEFAULT);
Height := Integer(CW_USEDEFAULT);
WndMenu := 0;
Param := nil;
end;
end;
////////////////////////////////////////////////////////////////////////////////
// TLiteWindow
// ______________________________________________
// Функции обработки сообщений
////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////
// Обработчик сообщений по умолчанию
////////////////////////////////////////////////////////////////////////////////
procedure TLiteWindow.DefaultHandler(var Msg);
begin
// Наш объект - объект субклассиннга ?
if FWndSubclass = nil then
// Вызываем системную функцию обработки сообщений
with TMessage(Msg) do
Result := DefWindowProc(FWndHandle, Msg, WParam, LParam)
else
