Имя Пароль
Зарегистрироваться


* При перепечатке материалов ссылка на www.SeoLiga.ru обязательна! RSS



Сабклассинг окон с помощью Windows API
19 февраля 2009

В следующем примере будет показано, как усовершенствовать кнопку (Button), поле ввода (Edit). Вот список усовершенствований:
1) Для кнопки: создать такую кнопку, которая при нажатии левой кнопки мыши отображала бы текущую дату;
2) Для поля ввода: запретить контекстное меню; установить шрифт для текста синего цвета

Разберем, как это выглядит в теории. Для создания кнопки, отображающей дату, мы должны получить текущую дату функцией GetLocalTime. В переданной функции структуре будет находиться текущая дата. Нас интересует только текущие час, минута и секунда. Мы преобразуем полученные значения в строковый формат и дополняем нулями слева, если это необходимо. После этого отображаем дату на кнопке, по срабатыванию таймера.

Что касается поля ввода, то для запрета контекстного меню необходимо проигнорировать сообщение WM_CONTEXTMENU, после чего осуществить выход из оконной процедуры. Для изменения цвета текста необходимо использовать функция SetTextColor для контекста Edit'а. Этот контекст можно получить, обрабатывая сообщение WM_CTLCOLOREDIT (обратите внимание, что это сообщение посылается родительскому окну поля ввода). Данное сообщение посылается при каждой отрисовке Edit'а, передавая в параметре WParam контекст для рисования. Не следует забывать включить прозрачность фона функцией SetBkMode (хотя для нашего примера эта функция ничего не изменяет, попробуйте использовать другие цвета, чтобы убедиться в её надобности).
код Pascal/Delphi

Program SampleProject03;

{$R *.res}
{$R WinXP.res}

Uses
Windows,
Messages,
SysUtils;

Procedure InitCommonControls; Stdcall; External 'comctl32.dll';

Const
{ Идентификатор таймера }
BtnTimer = 450;
{ Константы с заголовками дочерних окон }
StaticInfoText = 'Метка без сабклассирования';
BtnText = 'Кнопка для сабклассирования';

Var
{ Главное окно }
HWnd: THandle;
{ Три дочерних компонента для сабклассирования }
Btn, Edit, InfoStatic: THandle;

{ Устанавливает для окна AWindow шрифт для контролов по умолчанию }
Procedure SetDefFont(AWindow: THandle);
Begin
SendMessage(AWindow, WM_SETFONT, GetStockObject(DEFAULT_GUI_FONT), 1);
End;

{ Косвенно-вызваемая процедура сообщений таймера }
{ Эта процедура выполняется при каждом срабатывании таймера }
Procedure BtnTimerProc(HWnd: THandle; Msg: Cardinal;
IDEvent, DWTime: Cardinal); Stdcall;
Var
{ Переменная, куда будет помещено текущее время }
Time: TSystemTime;
{ Для анализа времени }
Hour, Minute, Second: String;
Begin
{ Получаем время }
GetLocalTime(Time);
{ Инициализируем переменные }
Hour := IntToStr(Time.wHour);
Minute := IntToStr(Time.wMinute);
Second := IntToStr(Time.wSecond);
{ Добавляем нули при необходимости }
If Length(Hour) = 1 Then Hour := '0' + Hour;
If Length(Minute) = 1 Then Minute := '0' + Minute;
If Length(Second) = 1 Then Second := '0' + Second;
{ Отображаем дату }
SetWindowText(HWnd, PChar(Hour + ':' + Minute + ':' + Second));
End;

{ Модифицированная оконная процедура поля ввода }
Function EditWinProc(HWnd: THandle; Msg: Cardinal;
WParam, LParam: Integer): Cardinal; Stdcall;
Begin
Case Msg Of
{ Запрещаем показ контекстного меню }
WM_CONTEXTMENU:
Begin
Result := 0;
MessageBeep(0);
Exit;
End;
End;
{ Не забываем вызвать оригинальную оконную процедуру }
Result := CallWindowProc(Pointer(GetWindowLong(HWnd, GWL_USERDATA)),
Hwnd, Msg, WParam, LParam);
End;

{ Модифицированная оконная процедура кнопки }
Function BtnWinProc(HWnd: THandle; Msg: Cardinal;
WParam, LParam: Integer): Cardinal; Stdcall;
Begin
Case Msg Of
{ При нажатии мыши запускаем таймер, интервал - 10 миллисекунд }
WM_LBUTTONDOWN: SetTimer(HWnd, BtnTimer, 10, @BtnTimerProc);

{ При отпускании мыши уничтожаем таймер }
WM_LBUTTONUP:
Begin
KillTimer(HWnd, BtnTimer);
{ Восстанавливаем прежний текст }
SetWindowText(HWnd, BtnText);
End;
End;
{ Не забываем вызвать оригинальную оконную процедуру }
Result := CallWindowProc(Pointer(GetWindowLong(HWnd, GWL_USERDATA)),
Hwnd, Msg, WParam, LParam);
End;

{ Оконная процедура главного окна }
Function MainWinProc(HWnd: THandle; Msg: Cardinal;
WParam, LParam: Integer): Cardinal; Stdcall;

{ Конвертирует сроку PChar в String }
Function StrPas(Const AStr: PChar): String;
Begin
Result := AStr;
End;

Begin
Case Msg Of

{ Здесь будет произведено создание дочерних окон }
WM_CREATE:
Begin
InfoStatic := CreateWindowEx(0, 'Static', StaticInfoText,
WS_CHILD Or WS_VISIBLE Or SS_LEFT,
8, 8, 270, 16, HWnd, 0, HInstance, NIL);
SetDefFont(InfoStatic);

Edit := CreateWindowEx(WS_EX_CLIENTEDGE, 'Edit', NIL,
WS_CHILD Or WS_VISIBLE Or ES_LEFT,
8, 28, 300, 21, HWnd, 0, HInstance, NIL);
SetDefFont(Edit);
{ Выделяем весь текст }
SendMessage(Edit, EM_SETSEL, 0, -1);
{ Далее делаем сабклассинг поля ввода }
SetWindowLong(Edit, GWL_USERDATA,
SetWindowLong(Edit, GWL_WNDPROC, LongInt(@EditWinProc)));

Btn := CreateWindowEx(0, 'Button', BtnText, WS_CHILD Or WS_VISIBLE
Or BS_PUSHBUTTON, 8, 52, 300, 25, HWnd, 0,
HInstance, NIL);
SetDefFont(Btn);
{ Далее делаем сабклассинг кнопки }
SetWindowLong(Btn, GWL_USERDATA,
SetWindowLong(Btn, GWL_WNDPROC, LongInt(@BtnWinProc)));
End;

WM_KEYDOWN:
{ Закрытие окна по нажатию Enter'а }
If WParam = VK_RETURN Then PostQuitMessage(0);

{Данное сообщение посылается при отрисовке Edit'a;
вы можете использовать переданный контекст для рисования
фона, либо для смены цвета текста; после завершения рисования
верните модифицированный контекст как результат сообщения и не
забудьте сделать выход из оконной процедуры, так как в противном
случае DefWindowProc снова разукрасит Edit в стандартный системный цвет }
WM_CTLCOLOREDIT:
Begin
{ Устанавливаем прозрачность фона }
SetBkMode(WParam, TRANSPARENT);
{ Устанавливаем цвет шрифта }
SetTextColor(WParam, $FF0000);
{ Возвращаем нужный нам контекст }
Result := WParam;
Exit;
End;

WM_DESTROY:
Begin
{ Выход для освобождения памяти }
PostQuitMessage(0);
End;
End;
{ Обработка всех остальных сообщений по умолчанию }
Result := DefWindowProc(HWnd, Msg, WParam, LParam);
End;

Procedure WinMain;
Var
Msg: TMsg;
{ Оконный класс }
WndClassEx: TWndClassEx;
Begin
{ Подготовка структуры класса окна }
ZeroMemory(@WndClassEx, SizeOf(WndClassEx));

{************* Заполнение структуры нужными значениями ******************* }

{ Размер структуры }
WndClassEx.cbSize := SizeOf(TWndClassEx);
{ Имя класса окна }
WndClassEx.lpszClassName := 'SubclassSampleWnd';
{ Стиль класса, не окна }
WndClassEx.style := CS_VREDRAW Or CS_HREDRAW;
{ Дескриптор программы (для доступа к сегменту данных) }
WndClassEx.hInstance := HInstance;
{ Адрес оконной процедуры }
WndClassEx.lpfnWndProc := @MainWinProc;
{ Иконки }
WndClassEx.hIcon := LoadIcon(HInstance, MakeIntResource('MAINICON'));
WndClassEx.hIconSm := LoadIcon(HInstance, MakeIntResource('MAINICON'));
{ Курсор }
WndClassEx.hCursor := LoadCursor(0, IDC_ARROW);
{ Кисть для заполнения фона }
WndClassEx.hbrBackground := COLOR_BTNFACE + 1;
{ Меню }
WndClassEx.lpszMenuName := NIL;

{ Регистрация оконного класса в Windows }
If RegisterClassEx(WndClassEx) = 0 Then
MessageBox(0, 'Невозможно зарегистрировать класс окна',
'Ошибка', MB_OK Or MB_ICONHAND)
Else
Begin
{ Создание окна по зарегистрированному классу }
HWnd := CreateWindowEx(0, WndClassEx.lpszClassName,
'Subclassing Sample by Rrader', WS_OVERLAPPEDWINDOW And Not WS_BORDER
And Not WS_MAXIMIZEBOX And Not WS_SIZEBOX,
Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT), 320, 116, 0, 0,
HInstance, NIL);

If HWnd = 0 Then
MessageBox (0, 'Окно не создалось!',
'Ошибка', MB_OK Or MB_ICONHAND)
Else
Begin
{ Показ окна }
ShowWindow(HWnd, SW_SHOWNORMAL);
{ Обновление окна }
UpdateWindow(HWnd);

{ Цикл обработки сообщений }
While GetMessage(Msg, 0, 0, 0) Do
Begin
TranslateMessage(Msg);
DispatchMessage(Msg);
End;
{ Выход по прерыванию цикла }
Halt(Msg.WParam);
End;
End;
End;

Begin
InitCommonControls;
{ Создание окна }
WinMain;
End.

Теги: Borland Delphi

Статьи по теме:

OnLocaleError
ShowDeleted
Географические информационные системы (Geographical Information System)
Печать мемо полей
Создание сокета
Общая тенденция развития систем делопроизводства и документооборота
Типы данных
Свойство AllDataSets
Использование выражений
IsDeleted
Компонент TQRExpr
Свойство Transparent
Свойство ShowProgress
Локальная сеть Token Ring
Программные средства мультимедиа
| Borland Delphi | ext |
 


Пн Вт Ср Чт Пт Сб Вс
1 2 3
4 5 6 7 8 9 10
11 12 13 14 15 16 17
18 19 20 21 22 23 24
25 26 27 28 29 30


     



Rambler's Top100

Данный сайт или домен продается ICQ: 403-353-727

© 2009 Seoliga.ru | Borland Delphi | Сабклассинг окон с помощью Windows API. Регион сайта: Москва и Санкт-Петербург