Программирование на основе Win32 API в Delphi (статья)

Code:

//         WinLite, библиотека классов и функций для работы с Win32 API

//                       (c) Николай Мазуркин,

// _____________________________________________________________________________

//                                Оконные классы

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

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.