Обработка WM_GETMINMAXINFO

[TrueCrypt]

Приветствую, реально ли как-то без особых костылей научить ф-ю WndProc обрабатывать сабж?

Делал через SetWindowLong, работает, но очень уж костыльно выглядит.

[Brovin Yaroslav]

Нет.

Как вариант, можно модифицировать FMX.Platform.Win и просто добавить пересылку Dispatch сообщений прямо форме. Тогда в самой форме можно будет по VCL-ному перехватывать сообщения.

Открываем модуль FMX.Platform.Win.pas и находим процедуру ориентировочно 2088 строчка:

function WndProc(hwnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;

В тело добавляем код по пересылке сообщения:

begin 
  { TODO -okewald -cVerify : We need to ensure Result is initialized. }
  Result := 0;
  LForm := FindWindow(hwnd);

  // Вставка по пересылке сообщения форме
  if LForm <> nil then
  begin
    TMsg.Msg := uMsg;
    TMsg.WParam := wParam;
    TMsg.LParam := lParam;
    TMsg.Result := 0;

    LForm.Dispatch(TMsg);
   
    uMsg := TMsg.Msg;
    wParam := TMsg.WParam;
    lParam := TMsg.LParam;
  end;

После этого в форме можно перехватывать сообщение:

uses
  ..., Winapi.Messages;

type
  TForm19 = class(TForm)
  private
    procedure WMGetMinMaxInfo(var AMessage: TMessage); message WM_GETMINMAXINFO;
  end;

var
  Form19: TForm19;

implementation

{$R *.fmx}

{ TForm19 }

procedure TForm19.WMGetMinMaxInfo(var AMessage: TMessage);
begin
end;

Если надо возвращать результат, как в случае с WM_GETMINMAXINFO, то в FMX.Platform

[TrueCrypt]

Благодарю за ответ, пытался исходник поредактировать — винда на права доступа ругалась. Сделал так:

unit Forms.Persistent;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  {$IF Defined(WIN32) OR Defined(WIN64)}
  Winapi.Windows, FMX.Platform.Win, Winapi.Messages,
  {$ENDIF}
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs;

type
  TfrmPersistent = class(TForm)
  {$IF Defined(WIN32) OR Defined(WIN64)}
  private
    FHwnd: HWND;
    FOldWndProc: LONG_PTR;
  protected
    procedure CreateHandle; override;
    procedure DestroyHandle; override;
  {$ENDIF}
  end;

implementation

{$R *.fmx}

{$IF Defined(WIN32) OR Defined(WIN64)}

{ TfrmPersistent }

procedure TfrmPersistent.CreateHandle;

  function WindowProc(hwnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
  var
    frm: TCommonCustomForm;
  begin
    frm := FindWindow(hwnd);
    Assert(frm.InheritsFrom(TfrmPersistent));

    if Assigned(frm) then
    begin
      if uMsg = WM_GETMINMAXINFO then
      begin
        with PMinMaxInfo(LParam)^.ptMinTrackSize, frm do
        begin
          X := 950 + Width - ClientWidth;
          Y := 500 + Height - ClientHeight;
        end;

        Result := 0;
      end else
        Result := CallWindowProc(Ptr(TfrmPersistent(frm).FOldWndProc), hwnd, uMsg, WParam, lParam);
    end else
      Result := DefWindowProc(hwnd, uMsg, wParam, lParam);
  end;

begin
  inherited CreateHandle;

  FHwnd       := WindowHandleToPlatform(Handle).Wnd;
  FOldWndProc := GetWindowLongPtr(FHwnd, GWL_WNDPROC);

  SetWindowLongPtr(FHwnd, GWL_WNDPROC, NativeInt(@WindowProc));
end;

procedure TfrmPersistent.DestroyHandle;
begin
  Assert(FHwnd <> 0);
  SetWindowLongPtr(FHwnd, GWL_WNDPROC, FOldWndProc);

  inherited DestroyHandle;
end;
{$ENDIF}

end.

Может кому пригодится.

[TrueCrypt]

Обнаружил проблему, что в х64 ф-я FindWindow возвращает nil. В WindowProc приходит какой-то левый хендл окна.

Вообще, какое-то странное поведение у обезьяны начинается, по стеку там вообще откуда-то из лева приходит вызов этого колбека. И очень отличается от поведения в х86.

Изменено 16 марта, 2016 пользователем TrueCrypt

[TrueCrypt]

Более гибкий вариант, работающий как под х86, так и под х64:

unit Forms.Persistent;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  {$IF Defined(WIN32) OR Defined(WIN64)}
  System.Generics.Collections, Winapi.Windows, FMX.Platform.Win, Winapi.Messages,
  {$ENDIF}
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs;

type
  TfrmPersistent = class(TForm)
  {$IF Defined(WIN32) OR Defined(WIN64)}
  private
    class var Callbacks: TDictionary<HWND, Pointer>;
    class constructor ClassCreate;
    class destructor ClassDestroy;
  protected
    procedure CreateHandle; override;
    procedure DestroyHandle; override;
  {$ENDIF}
  end;

implementation

{$R *.fmx}

{$IF Defined(WIN32) OR Defined(WIN64)}

{ TfrmPersistent }

function WindowProc(hwnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
  frm: TCommonCustomForm;
  oldProc: Pointer;
begin
  frm := FindWindow(hwnd);

  if Assigned(frm) and (uMsg = WM_GETMINMAXINFO) then
  begin
    with PMinMaxInfo(LParam)^.ptMinTrackSize, frm do
    begin
      X := 950 + Width - ClientWidth;
      Y := 500 + Height - ClientHeight;
    end;

    Result := 0;
  end else
  if TfrmPersistent.Callbacks.TryGetValue(hwnd, oldProc) and Assigned(oldProc) then
    Result := CallWindowProc(oldProc, hwnd, uMsg, wParam, lParam)
  else
    Result := DefWindowProc(hwnd, uMsg, wParam, lParam);
end;

procedure TfrmPersistent.CreateHandle;
var
  wnd: HWND;
begin
  inherited CreateHandle;

  wnd := FormToHWND(Self);

  if wnd <> 0 then
  begin
    Callbacks.Add(wnd, Ptr(GetWindowLongPtr(wnd, GWLP_WNDPROC)));

    SetWindowLongPtr(wnd, GWLP_WNDPROC, NativeInt(@WindowProc));
  end;
end;

procedure TfrmPersistent.DestroyHandle;
var
  wnd: HWND;
  oldProc: Pointer;
begin
  wnd := FormToHWND(Self);

  if (wnd <> 0) and Callbacks.TryGetValue(wnd, oldProc) then
    SetWindowLongPtr(wnd, GWLP_WNDPROC, NativeInt(oldProc));

  inherited DestroyHandle;
end;

class constructor TfrmPersistent.ClassCreate;
begin
  Callbacks := TDictionary<HWND, Pointer>.Create;
end;

class destructor TfrmPersistent.ClassDestroy;
begin
  Callbacks.Free;
end;
{$ENDIF}

end.

Похоже, что при компиляции в х64, вложенные процедуры как-то хитро компилируются, в итоге либо кривой стек возникает, либо еще что, поэтому пришлось колбек вынести в глобальный метод.

Изменено 17 марта, 2016 пользователем TrueCrypt

[ENERGY]

В 16.03.2016 в 21:25, TrueCrypt сказал:

Обнаружил проблему, что в х64 ф-я FindWindow возвращает nil. В WindowProc приходит какой-то левый хендл окна.

Вообще, какое-то странное поведение у обезьяны начинается, по стеку там вообще откуда-то из лева приходит вызов этого колбека. И очень отличается от поведения в х86.

Это не связано конкретно с FMX. 

https://stackoverflow.com/questions/10162749/why-cannot-take-address-to-a-nested-local-function-in-64-bit-delphi/10162859#10162859