2004. október 27., szerda

Synchronize the movement of two forms


Problem/Question/Abstract:

How can I reposition a form relative to another form, which is being dragged by the mouse? I am thinking of a kind of movement synchronization. TControl.WMMove is unfortunately declared private.

Answer:

The following is a primitive example, but it should get you started:

unit FollowForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Forms, Controls, Buttons,
  StdCtrls, ExtCtrls;

type
  TFrmFollow = class(TForm)
    BtnValidate: TBitBtn;
    BtnSave: TBitBtn;
    BtnPreview: TBitBtn;
    BtnPrint: TBitBtn;
    BtnExit: TBitBtn;
    BtnHelp: TBitBtn;
    procedure BtnExitClick(Sender: TObject);
  private
    FOldOwnerWindowProc: TWndMethod; {WindowProc for FOwnerForm}
    FOwnerForm: TForm;
    {Window subclassing methods:}
    procedure HookForm;
    procedure UnhookForm;
    procedure WndProcForm(var AMsg: TMessage);
  protected
    procedure CreateWnd;
      override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

var
  FrmFollow: TFrmFollow;

implementation

{$R *.DFM}

resourcestring
  SRGSBadUseOfFF = 'FollowForm can only be owned by another form';

constructor TFrmFollow.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  if AOwner <> nil then
  begin
    if AOwner is TForm then
      FOwnerForm := TForm(AOwner)
    else
      {Owner is not a form}
      raise Exception.CreateRes(@SRGSBadUseOfFF);
  end;
end;

procedure TFrmFollow.CreateWnd;
begin
  inherited;
  if csDesigning in ComponentState then
    Exit; {Don't need to hook when designing}
  if Enabled and Assigned(FOwnerForm) then
    HookForm; {Hook the main form's Window}
end;

destructor TFrmFollow.Destroy;
begin
  if not (csDesigning in ComponentState) then
    UnhookForm; {Stop interfering ...}
  inherited Destroy;
end;

procedure TFrmFollow.HookForm;
begin
  {Hook the windows procedure of my owner only if I have an owner, the Owner's
  window handle has been created and we are not in design mode.}
  FOldOwnerWindowProc := nil;
  if Assigned(FOwnerForm) and FOwnerForm.HandleAllocated then
  begin
    if not (csDesigning in ComponentState) then
    begin
      FOldOwnerWindowProc := FOwnerForm.WindowProc;
      FOwnerForm.WindowProc := WndProcForm;
    end;
  end;
end;

procedure TFrmFollow.UnhookForm;
begin
  {If we are "hooked" then undo what Hookform did}
  if Assigned(FOldOwnerWindowProc) then
  begin
    if (FOwnerForm <> nil) and (FOwnerForm.HandleAllocated) then
    begin
      FOwnerForm.WindowProc := FOldOwnerWindowProc;
    end;
    FOldOwnerWindowProc := nil;
    FOwnerForm := nil;
  end;
end;

{WndProcForm is our replacement for our WindowProc. We grab any Windows
messages that we need here.}

procedure TFrmFollow.WndProcForm(var AMsg: TMessage);
var
  cmdType: Word;
  xPos: Word;
  yPos: Word;
begin
  if Enabled then
  begin
    case AMsg.Msg of
      WM_MOVE:
        begin
          xPos := FOwnerForm.Left;
          yPos := FOwnerForm.Top;
          Caption := Format('%d:%d', [xPos, yPos]);
          SetBounds(xPos + 12, yPos + 12, Width, Height);
          BringToFront;
        end;
      WM_SIZE, WM_EXITSIZEMOVE:
        begin
          BringToFront;
        end;
      WM_SYSCOMMAND:
        begin
          cmdType := AMsg.WParam and $FFF0;
          case cmdType of
            SC_MAXIMIZE, SC_SIZE:
              begin
                xPos := FOwnerForm.Left;
                yPos := FOwnerForm.Top;
                Caption := Format('%d:%d', [xPos, yPos]);
                SetBounds(xPos, yPos, Width, Height);
                BringToFront;
              end;
          end;
        end;
    end;
  end;
  {Call the default windows procedure}
  FOldOwnerWindowProc(AMsg);
end;

procedure TFrmFollow.BtnExitClick(Sender: TObject);
begin
  Close;
end;

end.

Nincsenek megjegyzések:

Megjegyzés küldése