0：去掉窗体原来的Caption栏
1：自己做一个模拟的Caption栏。
2：拦截鼠标在这个模拟的区域的Mouse消息，鼠标进入的时候，改变消息所指范围，变成NCHITEST，移出时恢复
3：拦截WM_MOUSEDOWN消息，设置起始点。
4：拦截WM_MOUSEMOVE消息，代码如下：
if ssLeft in Shift then
begin
Form1.Left := Form1.Left - (MPos.X-X);
Form1.Top := Form1.Top - (MPos.Y-Y);
end;
全部测试代码：
var
MPos:TPoint; {Position of the Form before drag}
procedure TForm1.Button1Click(Sender: TObject);
var
r:HRGN;
begin
r:=CreateEllipticRgn(0,0,300,300);
SetWindowRgn(handle,r,true);
DeleteObject(r);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
close;
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
MPos.X := X;
MPos.Y := Y;
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if ssLeft in Shift then
begin
Form1.Left := Form1.Left - (MPos.X-X);
Form1.Top := Form1.Top - (MPos.Y-Y);
end;
end;
***************************************
unit epMoveForm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
type
TepMoveForm = class(TGraphicControl)
private
FDown: Boolean;
FOldX, FOldY: Integer;
protected
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer); override;
public
procedure Paint; override;
constructor Create(AOwner: TComponent); override;
published
property Align;
end;
procedure Register;
implementation
constructor TepMoveForm.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Width := 100;
Height := 100;
end;
procedure TepMoveForm.Paint;
begin
// if csDesigning in ComponentState then
with Canvas do
begin
Pen.Style := psDash;
Brush.Style := bsClear;
Rectangle(0, 0, Width, Height);
end
end;
procedure TepMoveForm.MouseMove;
begin
if FDown then
with TForm(Owner) do
SetBounds(Left + X - FOldX, Top + Y - FOldY, Width, Height);
end;
procedure TepMoveForm.MouseUp;
begin
FDown := False;
end;
procedure TepMoveForm.MouseDown;
begin
if (Button = mbleft) and not FDown then FDown := True;
FOldX := X;
FOldy := Y;
end;
procedure Register;
begin
RegisterComponents('Win32', [TepMoveForm]);
end;
end.
此文章由 http://www.ositren.com 收集整理 ,地址为:
http://www.ositren.com/htmls/68084.html