Firemonkey erkennen ob sich ein Fenster bewegt

[Peter666]

Hi,

ich brauche in einem Projekt die Möglichkeit zu erkennen ob sich ein Fenster bewegt. Unter VCL würde ich einfach WM_MOVE abgreifen, das geht aber nicht so einfach unter Firemonkey und da ich es für OSX und Windows brauche frage ich mich ob das nicht schon jemand in der Form realisiert hat? Aktuell hole ich über einen Timer die Position des Formulars. Das ist gelinde gesagt selbst für mich unterirdisch.

Peter

[CHackbart]

Eventuell so?

Delphi-Quellcode:

unit FMX.LayoutForm;

interface

uses System.Classes, FMX.Types, FMX.Layouts, FMX.Forms
{$IFDEF MSWINDOWS}, Winapi.Windows, Winapi.Messages{$ENDIF};

type
  TVirtualLayout = class(TLayout)
  protected
    FView: TForm;
{$IFDEF MSWINDOWS}
    FObjectInstance: Pointer;
    FDefWindowProc: Pointer;
    FWndHandle: HWND;
    procedure MainWndProc(var Message: TMessage);
{$ELSE}
    FTimer: TTimer;
{$ENDIF}
    procedure DoResized; override;
    procedure DoTimer(Sender: TObject);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy(); override;
  end;

implementation

uses System.Types {$IFDEF MSWINDOWS}, FMX.Platform.Win {$ENDIF};

constructor TVirtualLayout.Create(AOwner: TComponent);
begin
  inherited;
  FView := TForm.CreateNew(nil);
  FView.BorderStyle := TFmxFormBorderStyle.None;
  FView.Transparency := true;
  FView.Name := 'TOSDWindow';

{$IFNDEF MSWINDOWS}
  FTimer := TTimer.Create(self);
  FTimer.Parent := self;
  FTimer.Enabled := false;
  FTimer.OnTimer := DoTimer;
  FTimer.Interval := 25;
{$ENDIF}
end;

destructor TVirtualLayout.Destroy();
begin
{$IFDEF MSWINDOWS}
  if FDefWindowProc <> nil then
  begin
    SetWindowLong(FWndHandle, GWL_WNDPROC, IntPtr(FDefWindowProc));
    FDefWindowProc := nil;
  end;
  if FObjectInstance <> nil then
  begin
    FreeObjectInstance(FObjectInstance);
    FObjectInstance := nil;
  end;
{$ELSE}
  FTimer.Free;
{$ENDIF}
  inherited;
end;

procedure TVirtualLayout.DoTimer(Sender: TObject);
var
  LForm: TCommonCustomForm;
  R: TRectF;
begin
  if FView.Parent is TCommonCustomForm then
  begin
    LForm := TCommonCustomForm(FView.Parent);
    R := LForm.ClientRect;
    R.Offset(LForm.ClientToScreen(PointF(0, 0)));
    FView.SetBoundsF(R);
  end;
end;

{$IFDEF MSWINDOWS}
procedure TVirtualLayout.MainWndProc(var Message: TMessage);
begin
  if Root.GetObject is TCommonCustomForm then
  begin
    if Message.Msg=WM_MOVE then
    begin
     DoTimer(nil);
    end;
    if (Message.Result = 0) then
      TCommonCustomForm(Root.GetObject).Dispatch(Message);

    with Message do
    begin
      if Result = 0 then
        Result := CallWindowProc(FDefWindowProc, FWndHandle, Msg,
          WParam, LParam);
    end;
  end;
end;
{$ENDIF}

procedure TVirtualLayout.DoResized;
var
  LForm: TCommonCustomForm;
  i: integer;
begin
  inherited;
  if not(csDesigning in ComponentState) and (ParentedVisible) and (Root <> nil)
    and (Root.GetObject is TCommonCustomForm) then
  begin
    for i := ChildrenCount - 1 downto 0 do
      if (Children[i].Name <> '') then
        Children[i].Parent := FView;

    LForm := TCommonCustomForm(Root.GetObject);
    FView.Parent := LForm;
    DoTimer(nil);
    FView.Visible := true;
    FView.StyleBook := LForm.StyleBook;
    FView.OnKeyUp := LForm.OnKeyUp;
    FView.OnKeyDown := LForm.OnKeyDown;
    FView.OnMouseDown := LForm.OnMouseDown;
    FView.OnMouseMove := LForm.OnMouseMove;
    FView.OnMouseUp := LForm.OnMouseUp;
    FView.OnMouseWheel := LForm.OnMouseWheel;
    FView.BringToFront;

{$IFDEF MSWINDOWS}
    if FObjectInstance = nil then
    begin
      FObjectInstance := MakeObjectInstance(MainWndProc);
      if FObjectInstance <> nil then
      begin
        FWndHandle := WindowHandleToPlatform(LForm.Handle).Wnd;
        FDefWindowProc := Pointer(GetWindowLong(FWndHandle, GWL_WNDPROC));
        SetWindowLong(FWndHandle, GWL_WNDPROC, IntPtr(FObjectInstance));
      end;
    end;
{$ELSE}
    FTimer.Enabled := false;
{$ENDIF}
  end
  else
  begin
    for i := FView.ChildrenCount - 1 downto 0 do
      if (FView.Children[i].Name <> '') then
        FView.Children[i].Parent := self;

    FView.Parent := nil;

    FView.Visible := false;
  end;
end;

end.

Christian

[himitsu]

Ich dachte erst "ohh, es kommt ja beim OnResize vorbei ... perfekt einfache Lösung",
aber neeee, im TCommonCustomForm.SetBoundsF falsch verguckt.

Egal ... kann man dennoch nutzen.

Delphi-Quellcode:

  protected
    procedure SetBoundsF(const ALeft, ATop, AWidth, AHeight: Single); override;

Ob es auch im OSX/iOS funktioniert, mußt'e aber mal ausprobieren.



War auch ganz einfach zu finden.
Manuell oder im Debugger schauen, wo es vorbei kommt, wenn man z.B. Left:= etwas zuweist.

Gibt es dort EventCaller (OnResize/DoResize/Resize/oderso), dann ab in den FormDesigner, Haltepunkt/ShowMessage/Exception rein und ausprobieren. (oder eben Haltepunkt an dieser Stelle)

[Peter666]

SetboundsF ist genau das was ich gesucht habe, vielen lieben Dank

[himitsu]

Zitat von himitsu:

Ich dachte erst "ohh, es kommt ja beim OnResize vorbei ... perfekt einfache Lösung",
aber neeee, im TCommonCustomForm.SetBoundsF falsch verguckt.

Egal ... kann man dennoch nutzen.

Delphi-Quellcode:

  protected
    procedure SetBoundsF(const ALeft, ATop, AWidth, AHeight: Single); override;

Ob es auch im OSX/iOS funktioniert, mußt'e aber mal ausprobieren.



War auch ganz einfach zu finden.
Manuell oder im Debugger schauen, wo es vorbei kommt, wenn man z.B. Left:= etwas zuweist.

Gibt es dort EventCaller (OnResize/DoResize/Resize/oderso), dann ab in den FormDesigner, Haltepunkt/ShowMessage/Exception rein und ausprobieren. (oder eben Haltepunkt an dieser Stelle)

Und dann schauen, ob es auch aufgerufen wird, wenn man die Form extern verschiebt.