При изменении размеров окна без заголовка сначала отрисовывается рамка будущих размеров
Автор: 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;
|