Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > Программа и интерфейс
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 20.12.2021, 22:56
chiacorp chiacorp вне форума
Прохожий
 
Регистрация: 03.12.2021
Сообщения: 10
Версия Delphi: Delphi 2010
Репутация: 10
По умолчанию Изменение размеров окна без дефолтного обработчика

Приветствуем!
Вопрос по обработке 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.
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 16:17.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter