|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
|||
|
|||
Изменение размеров окна без дефолтного обработчика
Приветствуем!
Вопрос по обработке 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. |