{Извлекает младшую часть слова lParam}
Oldy := HiWord(lParam);
Oldx := LoWord(lParam);
thisShape[CurrentPoint].theShape := CurrentShape;
thisShape[CurrentPoint].PenWidth := PenWidth;
thisShape[CurrentPoint].PenColor := PenColor;
thisShape[CurrentPoint].PenStyle := PenStyle;
MouseDown := True;
end;
{
procedure LButtonUp
LButtonUp обрабатывает сообщение wm_LButtonUp , создаваемое когда пользователь отпускает левую кнопку мыши. Это действие позволяет другим окнам получать сообщения от мыши и сохранять положение мыши как другой угол прямоугольника ограничения.
}
procedure LButtonUp(HWindow: HWnd; lParam: LongInt);
begin
ReleaseCapture;
{Освобождает заголовок мыши, восстанавливая нормальную обработку ввода.}
{ Для работы с функцией IntersectRect прямоугольники, }
{ должны быть сохранены как left, top, right, bottom. }
SetRect(thisShape[CurrentPoint].Points,
Min(thisShape[CurrentPoint].Points.Left, LoWord(lParam)),
Min(thisShape[CurrentPoint].Points.Top, HiWord(lParam)),
Max(thisShape[CurrentPoint].Points.Left, LoWord(lParam)),
Max(thisShape[CurrentPoint].Points.Top, HiWord(lParam)));
{Заполняет thisShape[CurrentPoint].Points указанными кооpдинатами.}
{ Если линия должна быть нарисована}
{ из верхнего-правого в нижний-левый ,то она имеет отрицательный }
{наклон. Иначе линия будет иметь полжительный наклон.}
if CurrentShape = id_Line then
begin
if (thisShape[CurrentPoint].Points.Left = LoWord(lParam)) or
(thisShape[CurrentPoint].Points.Top = HiWord(lParam)) then
thisShape[CurrentPoint].Slope := -1
else
thisShape[CurrentPoint].Slope := 1;
end;
{ Отметить область окна нуждающуюся в изменении }
InvalidateRect(HWindow, @thisShape[CurrentPoint].Points, False);
{Делает неактивной область пользователя }
{в окне, добавляя @thisShape[CurrentPoint].Points}
{ к области обновления окна. }
UpdateWindow(HWindow); {Если область обновления окна непуста, то посылает сообщение wm_Paint}
{пpямо оконной функции данного окна.}
MouseDown := False;
Oldx := -1;
Oldy := -1;
end;
var
SaveROP: Integer;
{
procedure DoMouseMove
DoMouseMove обрабатывает сообщение wm_MouseMove,посылаемое когда пользователь перемещает мышь. Когда пользователь перемещает мышь удерживая левую кнопку мыши, эта процедура рисует текущую фигуру используя растровую операцию NOTXORPEN. Когда используется этот способ, то рисуемое дважды тоже самое изображение возвращается к первоначальному состоянию.
NOTXORPEN изменяет цвета: черное на черном белое, черное на белом черное и белое на белом белое.
}
procedure DoMouseMove(HWindow: HWnd; lParam: LongInt);
var
HandleDC: HDC;
begin
if MouseDown then
begin
HandleDC := GetDC(HWindow);
{ Удаляется старая фигура. }
SaveROP := SetROP2(HandleDC, r2_NotXORPen);
{Устанавливает текущий pежим рисования в значение,}
{заданное DrawMode. Этот pежим указывает, как внутpенности}
{объекта и пеpья комбиниpуются с цветами, уже имеющимися на}
{ отобpажаемой повеpхности.}
{Возвpащаемое значение:Пpедыдущий pежим pисования.}
DrawMyShape(HandleDC, thisShape[CurrentPoint].Points.Left,
thisShape[CurrentPoint].Points.top, Oldx, Oldy,
thisShape[CurrentPoint].theShape,
thisShape[CurrentPoint].PenWidth,
thisShape[CurrentPoint].PenColor, 1,thisShape[CurrentPoint].PenStyle);
{ В этой точке slope должен быть положительным потому}
{ координаты не могли быть изменены.}
{ Следующий шаг рисует новую фигуру.}
Oldx := LoWord(lParam);
Oldy := HiWord(lParam);
DrawMyShape(HandleDC, thisShape[CurrentPoint].Points.Left,
thisShape[CurrentPoint].Points.Top, Oldx, Oldy,
thisShape[CurrentPoint].theShape,
thisShape[CurrentPoint].PenWidth,
thisShape[CurrentPoint].PenColor, 1,thisShape[CurrentPoint].PenStyle);
SetROP2(HandleDC, SaveROP);
ReleaseDC(HWindow, HandleDC);
{Освобождает общий или оконный (не влияющий на класс или локальность) }
{ контекст устpойства, делая его доступным для дpугих пpикладных задач.}
end;
end;
{
function DoWMCommand
DoWMCommand обрабатывает сообщение wm_Command . wm_Command
посылается тогда когда пользователь выбирает любой пункт меню.
Эта функция изменяет текущее состояние выбронной формы соответственно выбору меню пользователя.
}
function DoWMCommand(wParam: Word): Integer;
begin
DoWMCommand := 1;
case wParam of
cm_Exit:
PostQuitMessage(0); {Выход из приложения}
cm_Line:
CurrentShape := id_Line; {текущая фигура-линия}
cm_Ellipse:
CurrentShape := id_Ellipse;{текущая фигура-эллипс}
cm_Rectangle:
CurrentShape := id_Rectangle; {текущая фигура-прямоугольник}
cm_RoundRect:
CurrentShape := id_RoundRect; {текущая фигура-прямоугольник с скруглёнными углами}
Уважаемый посетитель!
Чтобы распечатать файл, скачайте его (в формате Word).
Ссылка на скачивание - внизу страницы.