9. Выведите на форму (TextOut), текущий нажатый символ на клавиатуре (сообщение wm_char).
Объявим в разделе глобальных переменных строку, содержащую нажатый символ:
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 Результат работы программы
10. Модифицируйте свое приложение, так, чтобы при нажатии на форме левой кнопки мыши рисовался эллипс красного цвета, а при нажатии правой кнопки он исчезал.
Добавим в программу глобальные константы и переменную:
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
{Всем полям структуры присваиваются определённые значения (определяются атрибуты окна)}
with WindowClass do begin
Style := cs_HRedraw or cs_VRedraw; {Стиль окна класса: окно будет перерисовываться при изменении его горизонтальных и вертикальных размеров}
lpfnWndProc := @WindowProc; {Указатель на оконную функцию, которая будет обрабатывать все сообщения, посылаемые окну}
cbClsExtra := 0; {Выделенная память, используемая программой по своему усмотрению}
cbWndExtra := 0; {Выделенная память, используемая программой по своему усмотрению}
hInstance := 0; {Ссылка на экземпляр программы, используется ядром Windows для однозначного определения сегмента данных экземпляра программы}
hIcon := LoadIcon (0, idi_Application); {Ссылка на иконку для окна, для отображения минимизированного окна, в данном случае – иконка, соответствующая приложению}
hCursor := LoadCursor (0, idc_Arrow); {Ссылка на курсор, в данном случае – в виде стрелки}
hbrBackground := GetStockObject (White_Brush); {Ссылка на шаблон заполнения фона для окна}
lpszMenuName := ''; {Ссылка на строку с именем меню}
lpszClassName := AppName; {Имя класса}
end;
{ Регистрация окна с заданными атрибутами. Параметр функции – структура типа TWndClass, содержащая атрибуты окон данного класса}
If RegisterClass (WindowClass) = 0 then
Halt (255); {Регистрация невозможна, завершение работы программы}
Window := CreateWindow {Создает окно и возвращает ссылку на окно типа HWnd}
(AppName, {Имя класса, к которому принадлежит создаваемое окно}
'Моя форма', {Заголовок окна}
ws_OverlappedWindow, {Стиль окна, в данном случае – комбинация стилей}
cw_UseDefault, {X – начальная позиция верхнего левого угла, в данном случае – значение по умолчанию}
cw_UseDefault, {Y – начальная позиция верхнего левого угла, в данном случае – значение по умолчанию}
800, {Width – начальная ширина окна, в данном случае – значение по умолчанию}
600, {Height – начальная ширина окна, в данном случае – значение по умолчанию}
0, {WndParent – родительское окно данного окна}
0, {Menu – меню, используемое данным окном}
HInstance, {Instance – указывает на экземпляр программы, этот параметр указывается, чтобы оконная функция имела доступ к сегменту данных программы}
nil); {Param – определяет дополнительную информацию, посылаемую через сообщение wm_Create}
{Окно создано, его необходимо отобразить на экране}
ShowWindow (Window, CmdShow); {Отображает или делает невидимым указанное окно}
UpdateWindow (Window); {Указывает прикладной программе, что часть окна нуждается в перерисовке}
{После того, как окно отбражено на экране, управление передаётся циклу обработки сообщений. GetMessage извлекает сообщения из очереди и помещается в структуру типа TMsg.Для всех сообщений, отличных от wm_Quit (завершение работы программы), эта функция возвращает ненулевое значение, и цикл продолжает обработку сообщений}
while GetMessage (Message, 0, 0, 0) do {GetMessage возвращает сообщение из очереди GetMessagePos}
begin
{TranslateMessage передает структуру типа TMsg ядру Windows для преобразования сообщений о введенных символах}
TranslateMessage (Message); {Переводит сообщение виртуальных клавиш в символьное сообщение}
DispatchMessage (Message); {Передает сообщение оконной функции указанного окна}
{После того, как оконная функция обработала сообщение, управление возвращается в цикл обработки сообщений}
end; {конец цикла обработки сообщений}
Halt (Message.wParam); {Программа завершается}
end.
Контрольные вопросы: