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 .