Карта сайта Kansoftware
НОВОСТИУСЛУГИРЕШЕНИЯКОНТАКТЫ
Разработка программного обеспечения
KANSoftWare

Программирование на основе Win32 API в Delphi Часть 4

Delphi , ОС и Железо , Windows

Библиотека WinLight

Code:

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

Николай Мазуркин, 1999-2000

Взято из http://forum.sources.ru

Статья Программирование на основе Win32 API в Delphi Часть 4 раздела ОС и Железо Windows может быть полезна для разработчиков на Delphi и FreePascal.


Комментарии и вопросы


Ваше мнение или вопрос к статье в виде простого текста (Tag <a href=... Disabled). Все комментарии модерируются, модератор оставляет за собой право удалить непонравившейся ему комментарий.

заголовок

e-mail

Ваше имя

Сообщение

Введите код




Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.



:: Главная :: Windows ::


реклама

::


©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007
Rambler's Top100
24.11.2017 19:21:18/0.069278955459595/2