Трехмерные формы с изменяющимися размерами

Попробуйте нижеприведенные обработчики событий 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);

=O2>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;

« Предыдущая статья		Следующая статья »