Firemonkey erkennen ob sich ein Fenster bewegt

[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