Author: Jonas Bilinkevicius
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:
1 unit FollowForm;
2
3 interface
4
5 uses
6 Windows, Messages, SysUtils, Classes, Graphics, Forms, Controls, Buttons,
7 StdCtrls, ExtCtrls;
8
9 type
10 TFrmFollow = class(TForm)
11 BtnValidate: TBitBtn;
12 BtnSave: TBitBtn;
13 BtnPreview: TBitBtn;
14 BtnPrint: TBitBtn;
15 BtnExit: TBitBtn;
16 BtnHelp: TBitBtn;
17 procedure BtnExitClick(Sender: TObject);
18 private
19 FOldOwnerWindowProc: TWndMethod; {WindowProc for FOwnerForm}
20 FOwnerForm: TForm;
21 {Window subclassing methods:}
22 procedure HookForm;
23 procedure UnhookForm;
24 procedure WndProcForm(var AMsg: TMessage);
25 protected
26 procedure CreateWnd;
27 override;
28 public
29 constructor Create(AOwner: TComponent); override;
30 destructor Destroy; override;
31 end;
32
33 var
34 FrmFollow: TFrmFollow;
35
36 implementation
37
38 {$R *.DFM}
39
40 resourcestring
41 SRGSBadUseOfFF = 'FollowForm can only be owned by another form';
42
43 constructor TFrmFollow.Create(AOwner: TComponent);
44 begin
45 inherited Create(AOwner);
46 if AOwner <> nil then
47 begin
48 if AOwner is TForm then
49 FOwnerForm := TForm(AOwner)
50 else
51 {Owner is not a form}
52 raise Exception.CreateRes(@SRGSBadUseOfFF);
53 end;
54 end;
55
56 procedure TFrmFollow.CreateWnd;
57 begin
58 inherited;
59 if csDesigning in ComponentState then
60 Exit; {Don't need to hook when designing}
61 if Enabled and Assigned(FOwnerForm) then
62 HookForm; {Hook the main form's Window}
63 end;
64
65 destructor TFrmFollow.Destroy;
66 begin
67 if not (csDesigning in ComponentState) then
68 UnhookForm; {Stop interfering ...}
69 inherited Destroy;
70 end;
71
72 procedure TFrmFollow.HookForm;
73 begin
74 {Hook the windows procedure of my owner only if I have an owner, the Owner's
75 window handle has been created and we are not in design mode.}
76 FOldOwnerWindowProc := nil;
77 if Assigned(FOwnerForm) and FOwnerForm.HandleAllocated then
78 begin
79 if not (csDesigning in ComponentState) then
80 begin
81 FOldOwnerWindowProc := FOwnerForm.WindowProc;
82 FOwnerForm.WindowProc := WndProcForm;
83 end;
84 end;
85 end;
86
87 procedure TFrmFollow.UnhookForm;
88 begin
89 {If we are "hooked" then undo what Hookform did}
90 if Assigned(FOldOwnerWindowProc) then
91 begin
92 if (FOwnerForm <> nil) and (FOwnerForm.HandleAllocated) then
93 begin
94 FOwnerForm.WindowProc := FOldOwnerWindowProc;
95 end;
96 FOldOwnerWindowProc := nil;
97 FOwnerForm := nil;
98 end;
99 end;
100
101 {WndProcForm is our replacement for our WindowProc. We grab any Windows
102 messages that we need here.}
103
104 procedure TFrmFollow.WndProcForm(var AMsg: TMessage);
105 var
106 cmdType: Word;
107 xPos: Word;
108 yPos: Word;
109 begin
110 if Enabled then
111 begin
112 case AMsg.Msg of
113 WM_MOVE:
114 begin
115 xPos := FOwnerForm.Left;
116 yPos := FOwnerForm.Top;
117 Caption := Format('%d:%d', [xPos, yPos]);
118 SetBounds(xPos + 12, yPos + 12, Width, Height);
119 BringToFront;
120 end;
121 WM_SIZE, WM_EXITSIZEMOVE:
122 begin
123 BringToFront;
124 end;
125 WM_SYSCOMMAND:
126 begin
127 cmdType := AMsg.WParam and $FFF0;
128 case cmdType of
129 SC_MAXIMIZE, SC_SIZE:
130 begin
131 xPos := FOwnerForm.Left;
132 yPos := FOwnerForm.Top;
133 Caption := Format('%d:%d', [xPos, yPos]);
134 SetBounds(xPos, yPos, Width, Height);
135 BringToFront;
136 end;
137 end;
138 end;
139 end;
140 end;
141 {Call the default windows procedure}
142 FOldOwnerWindowProc(AMsg);
143 end;
144
145 procedure TFrmFollow.BtnExitClick(Sender: TObject);
146 begin
147 Close;
148 end;
149
150 end.
|
