При изменении размеров окна без заголовка сначала отрисовывается рамка будущих размеров

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: i-s-v

WEB-сайт: http://isv.iatp.org.ua

Вот пример для правого нижнего угла окна, в котором расположен Image1 (или еще что-нибудь)

const

MinHeight = 200;

MinWidth = 200; //Минимальная ширина и высота формы. При желании

можна и впихнуть максимальную

var

isResizing: boolean = false;

oldPos: TPoint;

WRect: TRect;

procedure TfrmMain.Image1MouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

isResizing := true;

oldPos := Mouse.CursorPos;

GetWindowRect(Handle, WRect); //получаем прямоугольник окна

DrawFocusRect(GetDC(0), WRect); //АПИ функция, рисующая рамку

end;

procedure TfrmMain.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,

Y: Integer);

var

dx, dy: integer;

begin

if isResizing then

begin

DrawFocusRect(GetDC(0), WRect); //стираем предыдущую рамку

dx := Mouse.CursorPos.X — oldPos.X;

dy := Mouse.CursorPos.Y — oldPos.Y;

if (WRect.Right — WRect.Left dx > MinWidth) and (WRect.Right dx <

Screen.Width) then

WRect.Right := WRect.Right dx;

if (WRect.Bottom — WRect.Top dy > MinHeight) and (WRect.Bottom dy <

Screen.Height) then

WRect.Bottom := WRect.Bottom dy;

end;

oldPos := Mouse.CursorPos;

DrawFocusRect(GetDC(0), WRect);

end;

end;

procedure TfrmMain.Image1MouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

if isResizing then

begin

DrawFocusRect(GetDC(0), WRect);

BoundsRect := WRect;

end;

isResizing := false;

end;

{/codecitation}

Добавить комментарий