Предотвращение изменения курсора при изменении размера и стилях Delphi

Question

У меня есть размерная форма, которая может быть изменена по горизонтали, но не по вертикали (я установил constraintss.minwidth в исходную ширину формы. Я хочу, чтобы курсор не менялся на измените размер курсора, когда курсор находится над левым краем или углом, курсор должен меняться только по верхней или нижней границе. Существует решение, которое работает без стилей VCL: http://codeverge.com/embarcadero.delphi.vcl.using/how-to-hide-resize-mouse-cursor/1071845. Однако у меня такое же требование кроме того, что я использую VCL Style (Luna), и кажется, что WM_NCHITTEST не запускается, когда используется стиль, и пример в ссылке не работает.

Как я могу помешать курсору перейти на курсор изменения размера когда используется стиль VCL?

Answer 1

Разнообразные сообщения об ошибках разветвлены от WndProc от TWinControl. Если крючок стиля сообщает, что обрабатывается сообщение, возвращается WndProc и сообщение не отправляется. Вот почему обработчик сообщения WM_NCHITTEST формы не запускается, когда он написан в стиле.

Таким образом, один из вариантов заключается в переопределении WndProc формы.

type 
    TTestForm = class(TForm) 
    protected 
    procedure WndProc(var Message: TMessage); override; 
    ... 

procedure TTestForm.WndProc(var Message: TMessage); 
begin 
    inherited; 
    if (Message.Msg = WM_NCHITTEST) and (Message.Result in [HTLEFT, HTRIGHT]) then 
    Message.Result := HTBORDER; 
end; 

Другим вариантом является использование потомка крючка стиля в использовании, который переопределяет обработку сообщения.

type 
    TTestForm = class(TForm) 
    ... 
    end; 

implementation 

uses 
    themes; 

type 
    TTestFormStyleHook = class(TFormStyleHook) 
    protected 
    procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST; 
    end; 

procedure TTestFormStyleHook.WMNCHitTest(var Message: TWMNCHitTest); 
begin 
    inherited; 
    case Message.Result of 
    HTLEFT, HTRIGHT: Message.Result := HTBORDER; 
    HTTOPLEFT, HTTOPRIGHT: Message.Result := HTTOP; 
    HTBOTTOMLEFT, HTBOTTOMRIGHT: Message.Result := HTBOTTOM; 
    end; 
end; 

initialization 
    TCustomStyleEngine.RegisterStyleHook(TTestForm, TTestFormStyleHook); 

end.