Объявим в разделе глобальных переменных строку, содержащую нажатый символ:
key: string; {содержит нажатый символ}
Функция обработки сообщений примет вид:
function WindowProc (Window: HWnd; Message, WParam: LongInt; LParam: LongInt): LongInt; stdcall;
Var
dc: HDC;
MyPaint: TPaintStruct;
Brush: hBrush;
Pen: hPen;
Begin
WindowProc:= 0;
Case Message of
wm_Destroy:
Begin
PostQuitMessage (0);
Exit;
end;
wm_Paint:
Begin
dc:= BeginPaint (Window, MyPaint);
Brush:= CreateSolidBrush (RGB (colorR, colorG, colorB));
Pen:= CreatePen (PS_SOLID, 1, RGB (colorR, colorG, colorB));
SelectObject (dc, Brush);
SelectObject (dc, Pen);
Rectangle(dc,0,0,maxx_size,maxy_size);
TextOut(dc,0,0,pchar(sWidth),Length(sWidth)); {вывод ширины окна}
TextOut(dc,0,15,pchar(sHeight),Length(sHeight)); {вывод высоты окна}
TextOut(dc,0,30,pchar(key),Length(key)); {вывод нажатого символа}
DeleteObject (Pen);
DeleteObject (Brush);
EndPaint (Window, MyPaint);
ReleaseDC (Window, dc);
end;
WM_CLOSE:
Begin
{вывод на экран запроса}
If MessageDlg('Завершить приложение?', mtConfirmation,MbOkCancel,0) <> idOK then
exit; {если Ok, то выход}
end;
WM_CREATE:
Begin
randomize; //инициалицация ГСЧ
colorR:= random(256); //
colorG:= random(256); //задание цвета фона
colorB:= random(256); //
end;
WM_SIZE:
Begin
GetWindowRect(Window, Rectangl); {получение прямоугольника, описывающего форму}
{создание записей с размерами окна}
sWidth:= 'width: ' + IntToStr(Rectangl.Right - Rectangl.Left);
sHeight:= 'height: ' + IntToStr(Rectangl.Bottom - Rectangl.Top);
end;
WM_CHAR:
Begin
key:= 'key: ' + Chr(wParam);
InvalidateRect(Window, nil, False); //перерисовка окна
end;
end;
WindowProc:= DefWindowProc (Window, Message, WParam, LParam);
end;
Теперь при нажатии на какую либо клавишу эта клафиша отображается на форме.
рис.7 Результат работы программы
Модифицируйте свое приложение, так, чтобы при нажатии на форме левой кнопки мыши рисовался эллипс красного цвета, а при нажатии правой кнопки он исчезал.
Добавим в программу глобальные константы и переменную:
Const
x1 = 100; //
y1 = 100; //координаты, по которым строится эллипс
x2 = 600; //
y2 = 300; //
Var
construct: boolean; {ключ, для построения эллипса}
Перепишем функцию обработки сообщений:
function WindowProc (Window: HWnd; Message, WParam: LongInt; LParam: LongInt): LongInt; stdcall;
Var
dc: HDC;
MyPaint: TPaintStruct;
Brush: hBrush;
Pen: hPen;
Begin
WindowProc:= 0;
Case Message of
wm_Destroy:
Begin
PostQuitMessage (0);
Exit;
end;
wm_Paint:
Begin
dc:= BeginPaint (Window, MyPaint);
Brush:= CreateSolidBrush (RGB (colorR, colorG, colorB));
Pen:= CreatePen (PS_SOLID, 1, RGB (colorR, colorG, colorB));
SelectObject (dc, Brush);
SelectObject (dc, Pen);
Rectangle(dc,0,0,maxx_size,maxy_size);
TextOut(dc,0,0,pchar(sWidth),Length(sWidth)); {вывод ширины окна}
TextOut(dc,0,15,pchar(sHeight),Length(sHeight)); {вывод высоты окна}
TextOut(dc,0,30,pchar(key),Length(key)); {вывод нажатого символа}
if construct then {рисование эллипса(при установленном ключе)}
Begin
Brush:= CreateSolidBrush (RGB (255, 0, 0));
Pen:= CreatePen (PS_SOLID, 1, RGB (255, 0, 0));
SelectObject (dc, Brush);
SelectObject (dc, Pen);
Ellipse (dc, x1, y1, x2, y2);
end;
DeleteObject (Pen);
DeleteObject (Brush);
EndPaint (Window, MyPaint);
ReleaseDC (Window, dc);
end;
WM_CLOSE:
Begin
{вывод на экран запроса}
If MessageDlg('Завершить приложение?', mtConfirmation,MbOkCancel,0) <> idOK then
exit; {если Ok, то выход}
end;
WM_CREATE:
Begin
randomize; //инициалицация ГСЧ
colorR:= random(256); //
colorG:= random(256); //задание цвета фона
colorB:= random(256); //
construct:= false; //установка ключа при создании окна
end;
WM_SIZE:
Begin
GetWindowRect(Window, Rectangl); {получение прямоугольника, описывающего форму}
{создание записей с размерами окна}
sWidth:= 'width: ' + IntToStr(Rectangl.Right - Rectangl.Left);
sHeight:= 'height: ' + IntToStr(Rectangl.Bottom - Rectangl.Top);
end;
WM_CHAR:
Begin
key:= 'key: ' + Chr(wParam);
InvalidateRect(Window, nil, False); //перерисовка окна
end;
WM_LBUTTONDOWN: //сообщение нажатия ЛКМ
Begin
construct:= true; //включение ключа
InvalidateRect(Window, nil, False); //перерисовка окна
end;
WM_RBUTTONDOWN: //сообщение нажатия ПКМ
Begin
construct:= false; //выключение ключа
InvalidateRect(Window, nil, False); //перерисовка окна
end;
end;
WindowProc:= DefWindowProc (Window, Message, WParam, LParam);
end;
После запуска программы на выполнения и нажатия левой кнопки мыши на форме появляется эллипс:
рис.8 Результат работы программы
После нажатия правой кнопкой мыши эллипс пропадает:
Ниже представлена усовершенствованная версия этой программы, здесь размеры прямоугольника, отвечающего за цвет фона, меняются, если меняются размеры формы, а также положением и размерами эллипса можно управлять мышью, также после построения эллипс можно перетаскивать, также с помощью мыши.
program TestMessages;
Uses
Windows, Messages, Dialogs, Sysutils;
Const
AppName = 'Test';
maxx_size = 800;
maxy_size = 600;
Var
Window: HWnd; {Ссылка на окно, позволяет однозначно определить каждое окно}
Message: TMsg; {Сообщение – реакция ядра Windows на какое-либо событие}
WindowClass: TWndClass; {Структура класса окна, включает адрес оконной функции, обрабатывающей поступающие от Windows сообщения, атрибуты всех окон, принадлежащих этому классу, т.е. задаются основные свойства класса}
colorR, colorG, colorB: integer; {переменные цвета для формы }
Rectangl: TRect; { прямоугольник, хранящий данные о параметрах окна }
width, height: integer; {высота и ширина формы}
sWidth, sHeight: string; {строки с размерами, выводящиеся на форму}
key: string; {содержит нажатый символ}
construct: boolean; {ключ, для построения эллипса}
driving: boolean; {ключ для изменения размеров эллипса}
move: boolean; {ключ переноса}
startX, startY, newX, newY: integer; {координаты построения эллипса}
x1, y1: integer; {координаты до события перемещения}
dx, dy: integer; {приращение координат}
point: TPoint; {координаты кусора относительно формы}
{Специальная оконная функция, обрабатывающая сообщения, посылаемые окну. Вызывается непосредственно ядром Windows (косвенно-вызываемая – callback function). Параметры эквивалентны полям структуры типа TMsg}
function WindowProc (Window: HWnd; Message, WParam: LongInt; LParam: LongInt): LongInt; stdcall;
Var
dc: HDC;
MyPaint: TPaintStruct;
Brush: hBrush;
Pen: hPen;
x, y: real; {для новой системы координат}
a, b: real; {полуоси эллипса}
shot: boolean; {ключ попадания курсором в эллипс}
Begin
WindowProc:= 0;
Case Message of
wm_Destroy:
Begin
PostQuitMessage (0);
Exit;
end;
wm_Paint:
Begin
dc:= BeginPaint (Window, MyPaint);
Brush:= CreateSolidBrush (RGB (colorR, colorG, colorB));
Pen:= CreatePen (PS_SOLID, 1, RGB (colorR, colorG, colorB));
SelectObject (dc, Brush);
SelectObject (dc, Pen);
Rectangle(dc,0,0,width,height);
TextOut(dc,0,0,pchar(sWidth),Length(sWidth)); {вывод ширины окна}
TextOut(dc,0,15,pchar(sHeight),Length(sHeight)); {вывод высоты окна}
TextOut(dc,0,30,pchar(key),Length(key)); {вывод нажатого символа}
if construct then {рисование эллипса(при установленном ключе)}
Begin
Brush:= CreateSolidBrush (RGB (255, 0, 0));
Pen:= CreatePen (PS_SOLID, 1, RGB (255, 0, 0));
SelectObject (dc, Brush);
SelectObject (dc, Pen);
Ellipse (dc, startX, startY, newX, newY);
end;
DeleteObject (Pen);
DeleteObject (Brush);
EndPaint (Window, MyPaint);
ReleaseDC (Window, dc);
end;
WM_CLOSE:
Begin
{вывод на экран запроса}
If MessageDlg('Завершить приложение?', mtConfirmation,MbOkCancel,0) <> idOK then
exit; {если Ok, то выход}
end;
WM_CREATE:
Begin
randomize; //инициализация ГСЧ
colorR:= random(256); //
colorG:= random(256); //задание цвета фона
colorB:= random(256); //
width:= maxx_size; //начальная ширина
height:= maxy_size; //начальная высота
driving:= false; //установка ключа изменения
construct:= false; //установка ключа рисования
move:= false; //установка ключа переноса
end;
WM_SIZE:
Begin
GetWindowRect(Window, Rectangl); {получение прямоугольника, описывающего форму}
{создание записей с размерами окна}
width:= Rectangl.Right - Rectangl.Left;
height:= Rectangl.Bottom - Rectangl.Top;
sWidth:= 'width: ' + IntToStr(width);
sHeight:= 'height: ' + IntToStr(height);
end;
WM_CHAR:
Begin
key:= 'key: ' + Chr(wParam);
InvalidateRect(Window, nil, False); //перерисовка окна
end;
WM_MOUSEMOVE:
Begin
x1:= point.x; //положение курсора до события его перемещения
y1:= point.y; //
GetCursorPos(point); //получение координат относительно экрана
ScreenToClient(Window, point); //получение координат относительно формы
if driving then //если ЛКМ нажата но не отпущена
begin
newX:= point.x;
newY:= point.y;
InvalidateRect(Window, nil, False); //перерисовка
end;
if move then //если левая кнопка нажата, а правая еще нет
Begin
dx:= point.x - x1; //приращение Х
dy:= point.y - y1; //приращение У
startX:= startX + dx; //
startY:= startY + dy; //изменение координат,
newX:= newX + dx; //по котором строится эллипс
newY:= newY + dy; //
InvalidateRect(Window, nil, False); //перерисовка
end;
end;
WM_LBUTTONDOWN: //нажатие ЛКМ
Begin
If construct then
Begin
a:= Abs((newX - startX)/ 2); //вычисление полуосей эллипса
b:= Abs((newY - startY)/ 2); //
//ввод новой системы координат
if newX >= startX then x:= newX - a else x:= startX - a;
if newY >= startY then y:= newY - b else y:= startY - b;
//проверка на попадание курсора в эллипс
shot:= sqr(point.x - x)/sqr(a) + sqr(point.y - y)/sqr(b) <= 1;
if shot then move:= true //если попали, то разрешается перетаскивание
End
else begin //если ЛКМ зажата первый раз после нажатия ПКМ
construct:= true; //ключ рисования включен
driving:= true; //ключ изменения включен
startX:= point.x; //начальные координаты эллипса
startY:= point.y; //
newX:= point.x; //новые координаты (следствие перемещения курсора)
newY:= point.y; //
end;
end;
WM_LBUTTONUP: //отпускание ЛКМ
Begin
driving:= false; //ключ изменения выключен
move:= false; //отмена разрешения на перенос
end;
WM_RBUTTONDOWN: //нажатие ПКМ
Begin
construct:= false; //ключ рисования выключен
InvalidateRect(Window, nil, False); //перерисовка (без овала)
end;
end;
WindowProc:= DefWindowProc (Window, Message, WParam, LParam);
end;
{Точка входа в программу, которая получает управление от ядра Windows:}
Begin
{Всем полям структуры присваиваются определённые значения (определяются атрибуты окна)}