Виртуальная библиотека Delphi

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

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

// _______________________________________________

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

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

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

// _______________________________________________

// Диалоговый класс

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

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

// ______________________________________________

// Модальный диалоговый класс

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

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;

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

// _______________________________________________

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

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

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

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

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

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