• 0
TrueCrypt

Обработка WM_GETMINMAXINFO

Вопросы

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

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

Поделиться сообщением


Ссылка на сообщение
Поделиться на другие сайты

5 ответов на этот вопрос

  • 2

Нет.

Как вариант, можно модифицировать 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

Поделиться сообщением


Ссылка на сообщение
Поделиться на другие сайты
  • 2

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

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.

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

Поделиться сообщением


Ссылка на сообщение
Поделиться на другие сайты
  • 0

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

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

Изменено пользователем TrueCrypt

Поделиться сообщением


Ссылка на сообщение
Поделиться на другие сайты
  • 0

Более гибкий вариант, работающий как под х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, вложенные процедуры как-то хитро компилируются, в итоге либо кривой стек возникает, либо еще что, поэтому пришлось колбек вынести в глобальный метод.

Изменено пользователем TrueCrypt

Поделиться сообщением


Ссылка на сообщение
Поделиться на другие сайты
  • 0
В 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

Поделиться сообщением


Ссылка на сообщение
Поделиться на другие сайты

Для публикации сообщений создайте учётную запись или авторизуйтесь

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

Создать учетную запись

Зарегистрируйте новую учётную запись в нашем сообществе. Это очень просто!

Регистрация нового пользователя

Войти

Уже есть аккаунт? Войти в систему.

Войти

  • Последние посетители   0 пользователей онлайн

    Ни одного зарегистрированного пользователя не просматривает данную страницу