Советы по Delphi
"Трехмерные" формы с изменяющимися размерами
Попробуйте нижеприведенные обработчики событий 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;trywith Canvas do beginHandle := 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 beginBrush.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;finallyCanvas.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 beginHitCode := HTNOWHERE;end; Msg.Result := HitCode;end; |
