Виртуальная библиотека Delphi - [36]

  WindowMsg.Msg    := Msg;
  WindowMsg.WParam := WParam;
  WindowMsg.LParam := LParam;
  // Обрабатываем его
  WindowProcedure(WindowMsg);
  // Возвращаем результат обратно системе
  Result := WindowMsg.Result;
end;

////////////////////////////////////////////////////////////////////////////////
// Виртуальная функция для обработки оконных сообщений
////////////////////////////////////////////////////////////////////////////////
procedure TLiteFrame.WindowProcedure(var Msg: TMessage);
begin
  // Распределяем сообщения по обработчикам
  Dispatch(Msg);
end;

Реализация оконного класса TLiteWindow

////////////////////////////////////////////////////////////////////////////////
// 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;

Реализация диалогового класса TLiteDialog

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

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