////////////////////////////////////////////////////////////////////////////////

// TLiteWindow

// _______________________________________________

// Инициализация / финализация

////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////

// Конструктор

////////////////////////////////////////////////////////////////////////////////

constructor TLiteWindow.Create(AWndParent: THandle);

begin

  inherited;

  // Формируем параметры окна

  CreateWindowParams(FWndParams);

  // Регистрируем класс окна

  RegisterClass(FWndParams.WindowClass);

  // Создаем окно

  with FWndParams do

    CreateWindowEx(ExStyle, WindowClass.lpszClassName, Caption,

      Style, X, Y, Width, Height,

      WndParent, WndMenu, hInstance, Param

    );

end;

////////////////////////////////////////////////////////////////////////////////

// Конструктор элемента с субклассингом

////////////////////////////////////////////////////////////////////////////////

constructor TLiteWindow.CreateSubclassed(AWnd: THandle);

begin

  inherited Create(GetParent(AWnd));

  // Сохраняем оконную функцию

  FWndSubclass := Pointer(GetWindowLong(AWnd, GWL_WNDPROC));

  // Сохраняем дескриптор окна

  FWndHandle   := AWnd;

  // Устанавливаем свою оконную функцию

  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

    // Вызываем старую оконную функцию обработки сообщений

    with TMessage(Msg) do

      Result := CallWindowProc(FWndSubclass, FWndHandle, Msg,

WParam, LParam);

end;