Советы по 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; 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;
[000415]



Содержание раздела