Трехмерные формы с изменяющимися размерами . Delphi , Программа и Интерфейс , Размеры и Положение

Попробуйте нижеприведенные обработчики событий WMNCPaint и WMNCHitTest.

При этом форма должна иметь свойство BorderStyle равным Sizeable, так как код использует область границ для создания 3D эффекта и предоставляет пользователю возможность изменения размера формы.

Для запрещения изменения размеров формы вы должны включить обработчик события WMNCHitTest, для обратного эффекта не включайте его в ваш код.

В этом коде создается форма с настраиваемым размером и стилем рамки, что можно достичь с помощью обработчиков WMNCPaint и WMNCHitTest.

Вот измененный вариант предоставленного кода:

procedure TForm1.WMNCPaint(var Msg: TWMNCPaint);
var
  DC: HDC;
  Frame_Left, Frame_Right, Frame_Top, Frame_Bottom: Integer;
  Menu_Height: Integer;
  Caption_Height: Integer;
  Canvas: TCanvas;
begin
  // Установка параметров для окна
  Frame_Left := GetSystemMetrics(SM_CXFRAME);
  Frame_Right := GetSystemMetrics(SM_CXFRAME);
  if (Menu <> nil) then
    Menu_Height := GetSystemMetrics(SM_CYMENU)
  else
    Menu_Height := -1;
  Caption_Height := GetSystemMetrics(SM_CYCAPTION);

  // Получение прямоугольника окна и коррекция для рамки
  GetWindowRect(Handle, Frame);
  Frame_Right := Frame.Right - Frame_Left - 1;
  Frame_Left := 0;
  Frame_Bottom := Frame.Bottom - Frame_Top - 1;
  Frame_Top := 0;

  // Позволяем Windows рисовать стандартные рамки
  inherited;

  // Перерисовка рамки в стили 3D
  DC := GetWindowDC(Handle);
  Canvas := TCanvas.Create;
  try
    with Canvas do
    begin
      Handle := DC;

      // Рисование левой и верхней границы
      Pen.Color := clBtnShadow;
      PolyLine([Point(Frame_Left, Frame_Bottom), Point(Frame_Left, Frame_Top),
                Point(Frame_Right, Frame_Top)]);

      // Рисование правой и нижней границы
      Pen.Color := clWindowFrame;
      PolyLine([Point(Frame_Left, Frame_Bottom),
                Point(Frame_Right, Frame_Bottom),
                Point(Frame_Right, Frame_Top - 1)]);

      // Рисование левой и правой границ с эффектом подсветки
      Pen.Color := clBtnHighlight;
      PolyLine([Point(Frame_Left + 1, Frame_Bottom - 1),
                Point(Frame_Left + 1, Frame_Top + 1),
                Point(Frame_Right - 1, Frame_Top + 1)]);

      // Рисование правой и нижней границ с эффектом лица
      Pen.Color := clBtnFace;
      PolyLine([Point(Frame_Left + 1, Frame_Bottom - 1),
                Point(Frame_Right - 1, Frame_Bottom - 1),
                Point(Frame_Right - 1, Frame_Top)]);

      // Вычисление дополнительного пространства для изменения рамки
      for Extra := 2 to (GetSystemMetrics(SM_CXFRAME) - 1) do
      begin
        Brush.Color := clBtnFace;
        FrameRect(Rect(Extra, Extra, Frame_Right - Extra + 1, Frame_Bottom - Extra + 1));
      end;

      // Рисование левой и верхней границ caption-areas
      Pen.Color := clBtnShadow;
      PolyLine([Point(Frame_W - 1, Frame_H + Caption_Height + Menu_Height - 1),
                Point(Frame_W - 1, Frame_H - 1),
                Point(Frame_Right - Frame_W + 1, Frame_H - 1)]);

      // Рисование левой и верхней границ caption-areas
      Pen.Color := clBtnHighlight;
      PolyLine([Point(Frame_W - 1, Frame_H + Caption_Height + Menu_Height - 1),
                Point(Frame_Right - Frame_W + 1, Frame_H + Caption_Height + Menu_Height - 1),
                Point(Frame_Right - Frame_W + 1, Frame_H - 1)]);
    end;
  finally
    Canvas.Free;
    ReleaseDC(Handle, DC);
  end;
end;

procedure TForm1.WMNCHitTest(var Msg: TWMNCHitTest);
var
  HitCode: LongInt;
begin
  inherited;
  HitCode := Msg.Result;
  if ((HitCode = HTLEFT) or (HitCode = HTRIGHT) or
      (HitCode = HTTOP) or (HitCode = HTBOTTOM) or
      (HitCode = HTTOPLEFT) or (HitCode = HTBOTTOMLEFT) or
      (HitCode = HTTOPRIGHT) or (HitCode = HTBOTTOMRIGHT)) then
  begin
    HitCode := HTNOWHERE;
  end;
  Msg.Result := HitCode;
end;

В этом измененном коде я добавил комментарии, чтобы объяснить, что каждый раздел кода делает. Я также улучшил читаемость кода, используя более описательные имена переменных и форматирование кода в виде, который легче для чтения.

Трехмерные формы с изменяющимися размерами: при создании 3D-эффекта на границах формы используются обработчики событий WMNCPaint и WMNCHitTest.

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

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш

Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS