В данной статье мы рассмотрим проблему сдвига изображения при зумировании в VCL MDI приложении на Delphi. Вопрос касается реализации функциональности зумирования изображения в модальном окне, где изображение отображается в компоненте TImage. При зумировании изображение начинает сдвигаться вверх и влево, что делает интерфейс неприятным и неудобным для пользователя. Мы разберем причины возникновения этой проблемы и предложим несколько решений для её устранения.
Описание проблемы
Проблема возникает при реализации зумирования изображения в модальном окне с использованием события FormMouseWheel. Вместо того, чтобы при зумировании фокусироваться на курсоре мыши, изображение начинает сдвигаться вверх и влево, что делает интерфейс неприемлемым для пользователя. Причина этого смещения заключается в накоплении ошибок округления при многократных вычислениях позиций и масштабирования изображения.
Анализ кода
Для реализации зумирования используется следующий код:
procedure TfrmVisualizaImagem.FormMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
const
ZoomFactor: array[Boolean] of Single = (0.9, 1.1);
var
R: TRect;
Position: TPoint;
begin
Position := ImgRecibo.ScreenToClient(MousePos);
if PtInRect(imgRecibo.ClientRect, Position) and ((WheelDelta > 0) or
((WheelDelta < 0) and (imgRecibo.Height > 20) and (imgRecibo.Width > 20))) then
begin
R := imgRecibo.BoundsRect;
R.Left := imgRecibo.Left + Position.X - Round(ZoomFactor[WheelDelta > 0] * Position.X);
R.Top := imgRecibo.Top + Position.Y - Round(ZoomFactor[WheelDelta > 0] * Position.Y);
R.Right := R.Left + Round(ZoomFactor[WheelDelta > 0] * imgRecibo.Width);
R.Bottom := R.Top + Round(ZoomFactor[WheelDelta > 0] * imgRecibo.Height);
imgRecibo.BoundsRect := R;
Handled := True;
end;
end;
Этот код работает корректно при первых нескольких зумированиях, но со временем изображение начинает сдвигаться. Причина этого заключается в том, что при каждом зумировании позиция изображения пересчитывается, что приводит к накоплению небольших ошибок округления.
Причина проблемы
Основная причина проблемы заключается в том, что при каждом зумировании позиция изображения пересчитывается, что приводит к накоплению небольших ошибок округления. Эти ошибки могут быть незначительными на каждом шаге, но при многократных вычислениях они накапливаются и становятся заметными.
Кроме того, переменная MousePos в событии FormMouseWheel указывает на абсолютную позицию курсора мыши на экране, а не на позицию внутри компонента TImage. Когда вы изменяете позицию компонента TImage, это может влиять на расчеты позиции курсора внутри компонента, что приводит к смещению изображения.
Решение проблемы
Чтобы устранить проблему сдвига изображения при зумировании, можно использовать следующие подходы:
1. Использование фиксированной точки для зумирования
Вместо того чтобы пересчитывать позицию изображения на каждом шаге зумирования, можно использовать фиксированную точку для зумирования. Это предотвратит накопление ошибок округления и обеспечит стабильность позиции изображения.
Пример кода для реализации этого подхода:
procedure TfrmVisualizaImagem.FormMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
const
ZoomFactor: array[Boolean] of Single = (0.9, 1.1);
var
R: TRect;
Position: TPoint;
DeltaX, DeltaY: Integer;
begin
Position := ImgRecibo.ScreenToClient(MousePos);
if PtInRect(imgRecibo.ClientRect, Position) and ((WheelDelta > 0) or
((WheelDelta < 0) and (imgRecibo.Height > 20) and (imgRecibo.Width > 20))) then
begin
DeltaX := Position.X - imgRecibo.Left;
DeltaY := Position.Y - imgRecibo.Top;
imgRecibo.Width := Round(imgRecibo.Width * ZoomFactor[WheelDelta > 0]);
imgRecibo.Height := Round(imgRecibo.Height * ZoomFactor[WheelDelta > 0]);
imgRecibo.Left := Position.X - DeltaX;
imgRecibo.Top := Position.Y - DeltaY;
Handled := True;
end;
end;
В этом коде мы сохраняем расстояние между курсором мыши и левым верхним углом изображения (DeltaX и DeltaY). Затем мы применяем зумирование к изображению, сохраняя фиксированную точку для зумирования.
2. Использование свойства Stretch
Ещё один вариант решения проблемы — использование свойства Stretch компонента TImage. Это свойство позволяет автоматически масштабировать изображение, чтобы оно полностью заполняло компонент, сохраняя пропорции. Однако, чтобы избежать искажений, необходимо также учитывать пропорции изображения.
Пример кода для реализации этого подхода:
procedure TfrmVisualizaImagem.FormMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
const
ZoomFactor: array[Boolean] of Single = (0.9, 1.1);
var
Position: TPoint;
ScaleFactor: Single;
begin
Position := ImgRecibo.ScreenToClient(MousePos);
if PtInRect(imgRecibo.ClientRect, Position) and ((WheelDelta > 0) or
((WheelDelta < 0) and (imgRecibo.Height > 20) and (imgRecibo.Width > 20))) then
begin
ScaleFactor := ZoomFactor[WheelDelta > 0];
ImgRecibo.Width := Round(ImgRecibo.Width * ScaleFactor);
ImgRecibo.Height := Round(ImgRecibo.Height * ScaleFactor);
Handled := True;
end;
end;
В этом коде мы просто умножаем текущие размеры изображения на коэффициент зумирования, сохраняя пропорции. Это предотвращает сдвиг изображения при зумировании.
3. Использование свойства Proportional
Ещё одним вариантом решения проблемы является использование свойства Proportional компонента TImage. Это свойство позволяет автоматически масштабировать изображение, чтобы оно полностью заполняло компонент, сохраняя пропорции. Однако, чтобы избежать искажений, необходимо также учитывать пропорции изображения.
Пример кода для реализации этого подхода:
procedure TfrmVisualizaImagem.FormMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
const
ZoomFactor: array[Boolean] of Single = (0.9, 1.1);
var
Position: TPoint;
ScaleFactor: Single;
begin
Position := ImgRecibo.ScreenToClient(MousePos);
if PtInRect(imgRecibo.ClientRect, Position) and ((WheelDelta > 0) or
((WheelDelta < 0) and (imgRecibo.Height > 20) and (imgRecibo.Width > 20))) then
begin
ScaleFactor := ZoomFactor[WheelDelta > 0];
imgRecibo.Width := Round(imgRecibo.Width * ScaleFactor);
imgRecibo.Height := Round(imgRecibo.Height * ScaleFactor);
Handled := True;
end;
end;
В этом коде мы просто умножаем текущие размеры изображения на коэффициент зумирования, сохраняя пропорции. Это предотвращает сдвиг изображения при зумировании.
Заключение
В данной статье мы рассмотрели проблему сдвига изображения при зумировании в VCL MDI приложении на Delphi. Мы разобрали причины возникновения этой проблемы и предложили несколько решений для её устранения. Основные подходы включают использование фиксированной точки для зумирования, использование свойства Stretch и использование свойства Proportional. Эти решения помогут вам создать более стабильный и удобный интерфейс для пользователей.
Статья посвящена решению проблемы сдвига изображения при зумировании в VCL MDI приложении на Delphi, вызванной накоплением ошибок округления, и предлагает методы её устранения, такие как использование фиксированной точки, свойства Stretch и Proportional.
Комментарии и вопросы
Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS
Telegram-канал