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.