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

    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    ShowModaclass="underline" 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;