Delphi World - Трехмерные формы с изменяющимися размерами
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Трехмерные формы с изменяющимися размерами

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

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

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


procedure TForm1.WMNCPaint(var Msg: TWMNCPaint);
var
  DC: HDC;
  Frame_H: Integer;
  Frame_W: Integer;
  Menu_H: Integer;
  Caption_H: Integer;
  Frame: TRect;
  Extra: Integer;
  Canvas: TCanvas;
begin
  { Задаем значения некоторым параметрам окна }
  Frame_W := GetSystemMetrics(SM_CXFRAME);
  Frame_H := GetSystemMetrics(SM_CYFRAME);
  if (Menu <> nil) then
    Menu_H := GetSystemMetrics(SM_CYMENU)
  else
    Menu_H := -1;
  Caption_H := 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;
  { Позволяем нарисовать стандартные границы формы }
  inherited;
  { Перерисовываем область границ в 3-D стиле }
  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)]);
      { Левая и правая граница, 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)]);
      { Правая и нижняя граница, 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;
      { Левая и верхняя граница области заголовка }
      Pen.Color := clBtnShadow;
      PolyLine([Point(Frame_W - 1, Frame_H + Caption_H + Menu_H - 1),
        Point(Frame_W - 1, Frame_H - 1),
          Point(Frame.Right - Frame_W + 1, Frame_H - 1)]);
      { Левая и верхняя граница области заголовка }
      Pen.Color := clBtnHighlight;
      PolyLine([Point(Frame_W - 1, Frame_H + Caption_H + Menu_H - 1),
        Point(Frame.Right - Frame_W + 1, Frame_H + Caption_H + Menu_H - 1),
          Point(Frame.Right - Frame_W + 1, Frame_H - 1)]);
    end;
  finally
    Canvas.Free;
    ReleaseDC(Handle, DC);
  end; { try-finally }
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;

Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования