Create a sizeable form with a 3D look

Problem/Question/Abstract:

How to create a sizeable form with a 3D look

Answer:

Try these handlers for the WMNCPaint and WMNCHitTest messages. The form should have the Sizeable border style as the code uses the sizeable border area for drawing the 3D effect, whether or not you want the user to be able to resize. To prohibit resizing, include the WMNCHitTest handler, to allow it, leave it out.

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
  { Predetermine some window parameters }
  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;
  { Let standard frame draw }
  inherited;
  { Repaint frame area in 3-D style }
  DC := GetWindowDC(Handle);
  Canvas := TCanvas.Create;
  try
    with Canvas do
    begin
      Handle := DC;
      { Left and Top edges }
      Pen.Color := clBtnShadow;
      PolyLine([Point(Frame.Left, Frame.Bottom), Point(Frame.Left, Frame.Top),
        Point(Frame.Right, Frame.Top)]);
      { Right and Bottom edges }
      Pen.Color := clWindowFrame;
      PolyLine([Point(Frame.Left, Frame.Bottom), Point(Frame.Right, Frame.Bottom),
        Point(Frame.Right, Frame.Top - 1)]);
      { Left and Top edge, 1 pixel in }
      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)]);
      { Right and Bottom edge, 1 pixel in }
      Pen.Color := clBtnFace;
      PolyLine([Point(Frame.Left + 1, Frame.Bottom - 1), Point(Frame.Right - 1,
        Frame.Bottom - 1),
        Point(Frame.Right - 1, Frame.Top)]);
      { Remainder of Sizing border }
      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;
      { Left and Top Edge of Caption Area }
      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)]);
      { Right and Bottom Edge of Caption Area }
      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;
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;