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

// Базовый класс для объектов 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;
  // Формируем сообщение