Валерий Борисок - Delphi. Трюки и эффекты

Листинг 3.10. Подсчет разницы между положениями указателя мыши

procedure TForm1.Timer1Timer(Sender: TObject);

var

curPos: TPoint;

delta: Real;

begin

if (curPos.X <> lastPos.X) or (curPos.Y <> lastPos.Y) then

begin

GetCursorPos(curPos);

//Вычисляем разницу между текущим и прошлым

//положением мыши

delta := Sqrt(Sqr(curPos.X – lastPos.X) + Sqr(curPos.Y -

lastPos.Y));

distance := distance + delta;

//Не забываем сохранить новые координаты указателя

lastPos := curPos;

if isUpdating then

begin

//Обновим показания в текстовом поле

ShowDistance();

end;

end;

end;

Листинг 3.11.

Активизация/деактивизация режима ввода масштаба

procedure TForm1.cmbScaleClick(Sender: TObject);

begin

if cmbScale.Caption = \'Изменить масштаб\' then

begin

//Начинаем изменение масштаба

StopUpdating();

cmbScale.Caption := \'Принять масштаб\

txtWidth.Enabled := True;

end

else

begin

//Заканчиваем изменение масштаба

txtWidth.Enabled := False;

cmbScale.Caption := \'Изменить масштаб\

StartUpdating();

end;

end;

Листинг 3.12.

Включение/выключение обновления результатов измерения

procedure TForm1.StartUpdating();

begin

//Включаем обновление показаний в текстовом поле

isUpdating := True;

end;

procedure TForm1.StopUpdating();

begin

//Отключаем обновление показаний в текстовом поле

isUpdating := False;

end;

Листинг 3.13.

Инициализация при запуске и код сброса счетчика

procedure TForm1.FormCreate(Sender: TObject);

begin

//Инициализируем координаты мыши

GetCursorPos(lastPos);

StartUpdating();

end;

procedure TForm1.cmbClearClick(Sender: TObject);

begin

//Сбрасываем счетчик пройденного расстояния

distance := 0;

GetCursorPos(lastPos); //Начинаем отсчет с текущей

//позиции указателя

ShowDistance();

end;

Листинг 3.14.

Подчеркивание и изменение цвета надписи

procedure TForm1.lblUnderlineMouseEnter(Sender: TObject);

begin

lblUnderline.Font.Style := [fsUnderline];

lblUnderline.Font.Color := RGB(0, 0, 255);

end;

procedure TForm1.lblUnderlineMouseLeave(Sender: TObject);

begin

lblUnderline.Font.Style := [];

lblUnderline.Font.Color := RGB(0, 0, 0);

end;

Листинг 3.15.

Изменение начертания шрифта

procedure TForm1.cmbItalicBoldMouseMove(Sender: TObject;

Shift: TShiftState; X, Y: Integer);

begin

cmbItalicBold.Font.Style := [fsItalic, fsBold];