При изменении размеров окна без заголовка сначала отрисовывается рамка будущих размеров

Delphi , Программа и Интерфейс , Размеры и Положение

Автор: i-s-v
WEB-сайт: http://isv.iatp.org.ua

Вот пример для правого нижнего угла окна, в котором расположен Image1 (или еще что-нибудь)

...
const
  MinHeight = 200;
  MinWidth = 200; //Минимальная ширина и высота формы. При желании
  можна и впихнуть максимальную

var
  isResizing: boolean = false;
  oldPos: TPoint;
  WRect: TRect;
  ...

procedure TfrmMain.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  isResizing := true;
  oldPos := Mouse.CursorPos;
  GetWindowRect(Handle, WRect); //получаем прямоугольник окна
  DrawFocusRect(GetDC(0), WRect); //АПИ функция, рисующая рамку
end;

procedure TfrmMain.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  dx, dy: integer;
begin
  if isResizing then
  begin
    DrawFocusRect(GetDC(0), WRect); //стираем предыдущую рамку
    dx := Mouse.CursorPos.X - oldPos.X;
    dy := Mouse.CursorPos.Y - oldPos.Y;
    if (WRect.Right - WRect.Left + dx > MinWidth) and (WRect.Right + dx <
      Screen.Width) then
      WRect.Right := WRect.Right + dx;
    if (WRect.Bottom - WRect.Top + dy > MinHeight) and (WRect.Bottom + dy <
      Screen.Height) then
      WRect.Bottom := WRect.Bottom + dy;
  end;
  oldPos := Mouse.CursorPos;
  DrawFocusRect(GetDC(0), WRect);
end;
end;

procedure TfrmMain.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if isResizing then
  begin
    DrawFocusRect(GetDC(0), WRect);
    BoundsRect := WRect;
  end;
  isResizing := false;
end;

Here's the translation of the provided text into Russian:

Код, написанный на Delphi, используется для создания формы, которая может быть изменена размером при перетаскивании правого нижнего угла формы. Форма имеет контрол изображения (Image1), но этот код не рисует ничего, связанного с изображением.

Когда вы начинаете изменять размер формы, старая позиция курсора мыши хранится в oldPos. Затем в каждом последующем событии MouseMove новая позиция курсора мыши рассчитывается путем вычитания oldPos из текущей позиции курсора. Разница (dx и dy) используется для обновления размера прямоугольника окна формы (WRect). Новый размер принимается только если он больше или равен минимальной высоте и ширине, установленным в MinHeight и MinWidth, соответственно.

рамка вокруг изменяемой области рисуется с помощью функции DrawFocusRect. Позиция и размер рамки рассчитываются на основе WRect.

В событии Image1MouseUp границы формы обновляются для соответствия новому размеру WRect, а затем isResizing устанавливается в false.

Некоторые предложения по улучшению:

• Вы можете добавить условие, проверяющее, находится ли курсор мыши внутри рамки изменяемой области. Если нет, вы можете выйти из процедуры без рисования.
• Вы можете улучшить производительность, вызывая GetWindowRect и DrawFocusRect только когда это необходимо (например, только на каждом событии MouseMove).
• Вы можете добавить условие, проверяющее, является ли новый размер формы валидным (т.е., не меньше минимального размера). Если нет, вы можете сбросить размер формы к предыдущему значению.
• Вы можете сделать код более гибким, позволяя пользователю задавать минимальные и максимальные размеры для формы в свойствах формы, а не жестко закодированными.

Вот пример модификации события Image1MouseMove:

procedure TfrmMain.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
  dx, dy: integer;
begin
  if isResizing then
  begin
    DrawFocusRect(GetDC(0), WRect); // стираем предыдущую рамку
    dx := Mouse.CursorPos.X - oldPos.X;
    dy := Mouse.CursorPos.Y - oldPos.Y;
    if (WRect.Right - WRect.Left + dx > MinWidth) and
       (WRect.Right + dx < Screen.Width) then
      WRect.Right := WRect.Right + dx;
    if (WRect.Bottom - WRect.Top + dy > MinHeight) and
       (WRect.Bottom + dy < Screen.Height) then
      WRect.Bottom := WRect.Bottom + dy;

    // Проверяем, находится ли курсор внутри рамки изменяемой области
    if (X >= WRect.Right - 10) and (Y >= WRect.Bottom - 10) then
      DrawFocusRect(GetDC(0), WRect); // рисуем рамку
  end;
  oldPos := Mouse.CursorPos;
end;

Вот пример модификации события Image1MouseUp:

procedure TfrmMain.Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if isResizing then
  begin
    DrawFocusRect(GetDC(0), WRect); // стираем рамку
    BoundsRect := WRect;

    // Проверяем, является ли новый размер формы валидным (т.е., не меньше минимального размера)
    if WRect.Right - WRect.Left < MinWidth then
      WRect.Right := WRect.Left + MinWidth;
    if WRect.Bottom - WRect.Top < MinHeight then
      WRect.Bottom := WRect.Top + MinHeight;

    isResizing := false;
  end;
end;

При изменении размеров окна без заголовка сначала отрисовывается рамка будущих размеров.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Размеры и Положение ::