Изменение размеров окна без дефолтного обработчика
Приветствуем!
Вопрос по обработке HTCAPTION,HTLEFT,HTTOPLEFT,HTTOP,HTTOPRIGHT,
HTRIGHT,HTBOTTOMRIGHT,HTBOTTOM,HTBOTTOMLEFT
Интересуют диагональный перетаскивания и возможно для остальных есть решения получше,
Код:
program Project1;
uses
WinApi.Windows,
WinApi.Messages,
Classes,
Vcl.Graphics,
Sysutils;
const
CW_UD=Integer(CW_USEDEFAULT);
WS_NORMAL=WS_OVERLAPPEDWINDOW+WS_VISIBLE;
var
Msg:TMSG;
ps:tPAINTSTRUCT;
dc:HDC;
memdc:HDC;
bitmap:HBITMAP;
MousePoint:TPoint;
TempPoint:TPoint;
WindowRect:Trect;
ClientRect:TRect;
HTAction:integer;
Left:Integer;
Top:Integer;
Width:Integer;
Height:Integer;
BGBrush:HBRUSH;
BGColor:TColor;
procedure SetText(Text:String);
begin
SendMessage(Msg.hwnd,WM_SETTEXT,0,Integer(PChar(Text)));
end;
begin
{$REGION 'INIT'}
Msg.hwnd:=CreateWindowEx(WS_EX_DLGMODALFRAME,'#32770',nil,WS_NORMAL,
CW_UD,CW_UD,CW_UD,CW_UD,0,0,hinstance,nil);
GetWindowRect(Msg.hwnd,WindowRect);
Left:=WindowRect.Left;
Top:=WindowRect.Top;
Width:=WindowRect.Right-Left;
Height:=WindowRect.Bottom-Top;
GetClientRect(msg.hwnd,ClientRect);
HTAction:=0;
BGColor:=clWhite;
BGBrush:=CreateSolidBrush(BGColor);
{$ENDREGION}
{$REGION 'RUN'}
while GetMessage(Msg,0,0,0) do begin
case Msg.message of
WM_PAINT:begin
dc:=BeginPaint(msg.hwnd,ps);
memdc:=CreateCompatibleDC(dc);
bitmap:=CreateCompatibleBitmap(dc,ClientRect.Right,ClientRect.Bottom);
SelectObject(memdc,bitmap);
//begin
FillRect(memdc,ClientRect,BGBrush);
//end
BitBlt(dc,0,0,ClientRect.Right,ClientRect.Bottom,memdc,0,0,SRCCOPY);
DeleteObject(bitmap);
DeleteDC(memdc);
EndPaint(msg.hwnd,ps);
end;
{$REGION 'WM_NCLBUTTONDOWN'}
WM_NCLBUTTONDOWN:begin
case Msg.wParam of
{$REGION 'HTCLOSE'}
HTCLOSE:begin
PostQuitMessage(0);
end;
{$ENDREGION}
{$REGION 'HTCAPTION and other'}
HTCAPTION,HTLEFT,HTTOPLEFT,HTTOP,HTTOPRIGHT,
HTRIGHT,HTBOTTOMRIGHT,HTBOTTOM,HTBOTTOMLEFT:begin
GetCursorPos(MousePoint);
HTAction := Msg.wParam;
SetCapture(Msg.hwnd);
end;
{$ENDREGION}
end;
end;
{$ENDREGION}
{$REGION 'WM_MOUSEMOVE'}
WM_MOUSEMOVE:begin
case HTAction of
{$REGION 'HTCAPTION'}
HTCAPTION:begin
GetCursorPos(TempPoint);
Left:=Left+(TempPoint.X - MousePoint.X);
Top:=Top+(TempPoint.Y - MousePoint.Y);
WindowRect.Left:=Left;
WindowRect.Top:=Top;
SetWindowPos(Msg.hwnd,0,Left,Top,0,0,SWP_NOZORDER+SWP_NOSIZE);
MousePoint:=TempPoint;
end;
{$ENDREGION}
{$REGION 'HTLEFT'}
HTLEFT:begin
GetCursorPos(TempPoint);
Left:=Left+(TempPoint.X - MousePoint.X);
Width:=Width-(TempPoint.X - MousePoint.X);
WindowRect.Left:=Left;
WindowRect.Right:=Left+Width;
if Width>GetSystemMetrics(SM_CXMIN) then begin
SetWindowPos(Msg.hwnd,0,Left,Top,Width,Height,SWP_NOZORDER);
GetClientRect(msg.hwnd,ClientRect);
end;
MousePoint:=TempPoint;
end;
{$ENDREGION}
{$REGION 'HTTOPLEFT'}
HTTOPLEFT:begin
end;
{$ENDREGION}
{$REGION 'HTTOP'}
HTTOP:begin
GetCursorPos(TempPoint);
Top:=Top+(TempPoint.Y - MousePoint.Y);
Height:=Height-(TempPoint.Y - MousePoint.Y);
WindowRect.Top:=Top;
WindowRect.Bottom:=Top+Height;
if Height>GetSystemMetrics(SM_CYMIN) then begin
SetWindowPos(Msg.hwnd,0,Left,Top,Width,Height,SWP_NOZORDER);
GetClientRect(msg.hwnd,ClientRect);
end;
MousePoint:=TempPoint;
end;
{$ENDREGION}
{$REGION 'HTTOPRIGHT'}
HTTOPRIGHT:begin
end;
{$ENDREGION}
{$REGION 'HTRIGHT'}
HTRIGHT:begin
GetCursorPos(TempPoint);
Width:=Width+(TempPoint.X - MousePoint.X);
WindowRect.Right:=Left+Width;
SetWindowPos(Msg.hwnd,0,0,0,Width,Height,SWP_NOZORDER+SWP_NOMOVE);
GetClientRect(msg.hwnd,ClientRect);
MousePoint:=TempPoint;
end;
{$ENDREGION}
{$REGION 'HTBOTTOMRIGHT'}
HTBOTTOMRIGHT:begin
end;
{$ENDREGION}
{$REGION 'HTBOTTOM'}
HTBOTTOM:begin
GetCursorPos(TempPoint);
Height:=Height+(TempPoint.Y - MousePoint.Y);
WindowRect.Bottom:=Top+Height;
SetWindowPos(Msg.hwnd,0,0,0,Width,Height,SWP_NOZORDER+SWP_NOMOVE);
GetClientRect(msg.hwnd,ClientRect);
MousePoint:=TempPoint;
end;
{$ENDREGION}
{$REGION 'HTBOTTOMLEFT'}
HTBOTTOMLEFT:begin
end;
{$ENDREGION}
end;
end;
{$ENDREGION}
{$REGION 'WM_LBUTTONUP'}
WM_LBUTTONUP:begin
if HTAction<>0 then begin
HTAction:=0;
ReleaseCapture;
end;
end;
{$ENDREGION}
end;
end;
{$ENDREGION}
{$REGION 'FREE'}
DeleteObject(BGBrush);
{$ENDREGION}
end.
|