Библиотека WinLight

// WinLite, библиотека классов и функций для работы с Win32 API
// (c) Николай Мазуркин, 1999-2000
// _____________________________________________________________________________
// Оконные классы
////////////////////////////////////////////////////////////////////////////////
unit WinLite;
interface
uses Windows, Messages;
Инициализационные структуры
Объявление структур, которые используются для формирования параметров вновь создаваемых окон и диалогов соответственно.
////////////////////////////////////////////////////////////////////////////////
// Параметры для создания окна
////////////////////////////////////////////////////////////////////////////////
type
 TWindowParams = record
  Caption : PChar;
  Style : DWord;
  ExStyle : DWord;
  X : Integer;
  Y : Integer;
  Width : Integer;
  Height : Integer;
  WndParent : THandle;
  WndMenu : THandle;
  Param : Pointer;
  WindowClass : TWndClass;
 end;
////////////////////////////////////////////////////////////////////////////////
// Параметры для создания диалога
////////////////////////////////////////////////////////////////////////////////
type
 TDialogParams = record
  Template : PChar;
  WndParent : THandle;
 end;
Декларация базового класса TLiteFrame
Базовый класс для окон и диалогов. Инкапсулирует в себе дескриптор окна и объявляет общую оконную процедуру. Реализует механизм message-процедур.
////////////////////////////////////////////////////////////////////////////////
// TLiteFrame
// _____________________________________________________________________________
// Базовый класс для объектов TLiteWindow, TLiteDialog, TLiteDialogBox
////////////////////////////////////////////////////////////////////////////////
type
 TLiteFrame = class(TObject)
 private
  FWndCallback: Pointer;
  FWndHandle : THandle;
  FWndParent : THandle;
  function  WindowCallback(hWnd: HWnd; Msg, WParam, LParam:Longint):Longint; stdcall;
 protected
  procedure  WindowProcedure(var Msg: TMessage); virtual;
 public
  property  WndHandle: THandle read FWndHandle;
  property  WndCallback: Pointer read FWndCallback;
 public
  constructor Create(AWndParent: THandle); virtual;
  destructor Destroy; override;
 end;
Декларация оконного класса TLiteWindow
Создание уникального класса окна и создание окна. Возможность субклассинга стороннего окна.
////////////////////////////////////////////////////////////////////////////////
// TLiteWindow
// _____________________________________________________________________________
// Оконный класс
////////////////////////////////////////////////////////////////////////////////
type
 TLiteWindow = class(TLiteFrame)
 private
  FWndParams : TWindowParams;
  FWndSubclass: Pointer;
 protected
  procedure  CreateWindowParams(var WindowParams: TWindowParams); virtual;
 public
  procedure  DefaultHandler(var Msg); override;
  constructor Create(AWndParent: THandle); override;
  constructor CreateSubclassed(AWnd: THandle); virtual;
  destructor Destroy; override;
 end;
Декларация диалогового класса TLiteDialog
Загрузка шаблона диалога и создание диалога.
////////////////////////////////////////////////////////////////////////////////
// TLiteDialog
// _____________________________________________________________________________
// Диалоговый класс
////////////////////////////////////////////////////////////////////////////////
type
 TLiteDialog = class(TLiteFrame)
 private
  FDlgParams : TDialogParams;
 protected
  procedure  CreateDialogParams(var DialogParams: TDialogParams); virtual;
 public
  procedure  DefaultHandler(var Msg); override;
  constructor Create(AWndParent: THandle); override;
  destructor Destroy; override;
 end;
Декларация модального диалогового класса TLiteDialogBox
Загрузка шаблона диалога и создание диалога. Модальный показ диалога.
////////////////////////////////////////////////////////////////////////////////
// TLiteDialogBox
// _____________________________________________________________________________
// Модальный диалоговый класс
////////////////////////////////////////////////////////////////////////////////
type
 TLiteDialogBox = class(TLiteFrame)
 private
  FDlgParams : TDialogParams;
 protected
  procedure  CreateDialogParams(var DialogParams: TDialogParams); virtual;
 public
  procedure  DefaultHandler(var Msg); override;
 public
  function  ShowModal: Integer;
 end;
Реализация базового класса TLiteFrame
implementation
////////////////////////////////////////////////////////////////////////////////
// TLiteFrame
// _____________________________________________________________________________
// Инициализация / финализация
////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////
// Конструктор
////////////////////////////////////////////////////////////////////////////////
constructor TLiteFrame.Create(AWndParent: THandle);
begin
 inherited Create;
 // Запоминаем дескриптор родительского окна
 FWndParent := AWndParent;
 // Создаем место под блок обратного вызова
 FWndCallback := VirtualAlloc(nil,12,MEM_RESERVE or MEM_COMMIT,PAGE_EXECUTE_READWRITE);
 // Формируем блок обратного вызова
 asm
  mov EAX, Self
  mov ECX, [EAX].TLiteFrame.FWndCallback
  mov word ptr [ECX+0], $6858  // pop EAX
  mov dword ptr [ECX+2], EAX // push _Self_
  mov word ptr [ECX+6], $E950  // push EAX
  mov EAX, OFFSET(TLiteFrame.WindowCallback)
  sub EAX, ECX
  sub EAX, 12
  mov dword ptr [ECX+8], EAX // jmp TLiteFrame.WindowCallback
 end;
end;
////////////////////////////////////////////////////////////////////////////////
// Деструктор
////////////////////////////////////////////////////////////////////////////////
destructor TLiteFrame.Destroy;
begin
 // Уничтожаем структуру блока обратного вызова
 VirtualFree(FWndCallback, 0, MEM_RELEASE);
 // Уничтожение по умолчанию
 inherited;
end;
////////////////////////////////////////////////////////////////////////////////
// TLiteFrame
// _____________________________________________________________________________
// Функции обработки сообщений
////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////
// Функция обратного вызова для получения оконных сообщений
////////////////////////////////////////////////////////////////////////////////
function TLiteFrame.WindowCallback(hWnd: HWnd; Msg, WParam, LParam: Integer): Longint;
var
 WindowMsg : TMessage;
begin
 // Запоминаем дескриптор окна, если это первый вызов оконной процедуры
 if FWndHandle = 0 then FWndHandle := hWnd;
 // Формируем сообщение
 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
// _____________________________________________________________________________
// Инициализация / финализация
////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////
// Конструктор
////////////////////////////////////////////////////////////////////////////////
constructor TLiteDialog.Create(AWndParent: THandle);
begin
 inherited;
 // Формируем параметры диалога
 CreateDialogParams(FDlgParams);
 // Создаем диалог
 with FDlgParams do
  CreateDialogParam(hInstance, Template, WndParent, WndCallback, 0);
end;
////////////////////////////////////////////////////////////////////////////////
// Деструктор
////////////////////////////////////////////////////////////////////////////////
destructor TLiteDialog.Destroy;
begin
 // Уничтожаем диалог
 if IsWindow(FWndHandle) then DestroyWindow(FWndHandle);
 // Уничтожение по умолчанию
 inherited;
end;
////////////////////////////////////////////////////////////////////////////////
// Формирование параметров диалога по умолчанию
////////////////////////////////////////////////////////////////////////////////
procedure TLiteDialog.CreateDialogParams(var DialogParams: TDialogParams);
begin
 DialogParams.WndParent := FWndParent;
 DialogParams.Template := '';
end;
////////////////////////////////////////////////////////////////////////////////
// Обработка сообщений по умолчанию
////////////////////////////////////////////////////////////////////////////////
procedure TLiteDialog.DefaultHandler(var Msg);
begin
 // Возвращаемые значения по умолчанию
 with TMessage(Msg) do
  if Msg = WM_INITDIALOG then Result := 1
  else Result := 0;
end;
Реализация модального диалогового класса TLiteDialogBox
////////////////////////////////////////////////////////////////////////////////
// TLiteDialogBox
// _____________________________________________________________________________
// Инициализация / финализация
////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////
// Формирование параметров диалога по умолчанию
////////////////////////////////////////////////////////////////////////////////
procedure TLiteDialogBox.CreateDialogParams(var DialogParams: TDialogParams);
begin
 DialogParams.WndParent := FWndParent;
 DialogParams.Template := '';
end;
////////////////////////////////////////////////////////////////////////////////
// Активизация модального диалога
////////////////////////////////////////////////////////////////////////////////
function TLiteDialogBox.ShowModal: Integer;
begin
 // Формируем параметры диалога
 CreateDialogParams(FDlgParams);
 // Показываем диалог
 with FDlgParams do
  Result := DialogBoxParam(hInstance, Template, WndParent, WndCallback, 0);
end;
////////////////////////////////////////////////////////////////////////////////
// Обработка сообщений по умолчанию
////////////////////////////////////////////////////////////////////////////////
procedure TLiteDialogBox.DefaultHandler(var Msg);
begin
 // Возвращаемые значения по умолчанию
 with TMessage(Msg) do
  if Msg = WM_INITDIALOG then Result := 1
  else Result := 0;
end;
end.

Отправить комментарий

Проверка
Антиспам проверка
Image CAPTCHA
...