Create a sizeable form with a 3D look (Views: 27)
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; |