2008年7月9日星期三

无边框窗体拖动大小

今天有一个朋友问我怎样可以拖拽一个没有边框的窗体,使其改变大小。于是很快想到一个消息
WM_NCHITTEST

该消息用来描述,当关标移动或当按下或当释放了鼠标按扭的时候,就会发送一个WM_NCHITTEST消息给一个窗口若鼠标未被捕获,则这条消息发送给光标所在的窗口。否则,这条消息公布给捕获鼠标的窗口。
参数
xPos = LOWORD(Lparam);//LParam低位字的值。指出光标的X坐标。该坐标值是相对于屏幕左上角的坐标。
yPos = HIWORD(LParam);//LParam高位字的值。指出光标的y坐标。

返回值 DefWindowProc函数的返回值是下列值之一,以指示光标热点的位置:
HTBORDER 光标热点在一个窗口的边界上,该窗口不具有可变大小的边界
HBOTTOM 在一个窗口下面的水平边界上
HBOTTOMLEFT 在一个窗口的边界的左下角
HBOTTOMRIGHT 在边界右下脚
HTCAPTION 在标题栏中
HTCLIENT 在客户区
HTERROR 在屏幕北京或窗口之间的分界线上(与HTNOWHERE类似,所不同的是DefWindowProc函数产生一个系统响铃以指示出错)
HTGROWBOX 在尺寸框中(与HTSIZE相同)
HTHSCROLL 在水平滚动栏
HTLEFT 在左边界
HTMENU 在菜单中
HTNOWHERE 在屏幕或窗口之间的分界线上
HTREDUCE 在一个最小化的按扭上
HTRIGHT 在窗口右边界
HTSIZE 在尺寸框中
HTSYSMENU 在一个System菜单或在一个子窗口的Close按扭中
HTTOP 在上边界
HTTOPLEFT 在左上角
HTTOPRIGHT 在右上角
HTTRANSPARENT 在当前被其他窗口覆盖的窗口中
HTVSCROLL 在垂直滚动栏中
HTZOOM 在最大化按扭上
注释 可使用MAKEPOINTS宏将lParam参数转换为一个Points结构
参见 DefWindowProc,GetCapture

于是我们可知道要可拖动窗体主要就是要截获该消息,然后让消息的结果返回为HBOTTOM, HBOTTOMLEFT, HBOTTOMRIGHT,HTLEFT , HTTOP ,HTTOPLEFT ,HTTOPRIGHT 等则可。于是写下如下代码:


procedure TForm1.WMNchist(var Msg: TMessage);
var
MouseX,MouseY: integer;
begin
MouseX := LOWORD(Msg.LParam);
MouseY := HIWORD(Msg.LParam);
if(MouseX >= Left + Width - 2) and (MouseY >= Top + Height - 2) then
Msg.Result := HTBOTTOMRIGHT
else if (MouseX <= Left + 2) and (MouseY <= Top + 3) then
Msg.Result := HTTOPLEFT
else if (MouseX <= Left + 2) and (MouseY<= Top + Height - 2) then
Msg.Result := HTBOTTOMLEFT
else if MouseX >= Left + Width -2 then
Msg.Result := HTRIGHT
else if MouseY >= Top + Height - 2 then
Msg.Result := HTBOTTOM
else if Mousex <= Left + 2 then
Msg.Result := HTLEFT
else if MouseY <= Top + 2 then
Msg.Result := HTTOP
else Inherited;
end;
这样,这个窗体就可实现了无边框拖动改变大小了。
于是我将程序发给了他!结果他说他那边运行没有效果,消息没有触发!原来他说,他在窗体上放了一个
Panel为Client占据了窗体,于是自然就触发不了窗体的WM_NCHITTEST消息了。
在看看,该消息的消息返回结果,发现有一个HTTRANSPARENT,该结果就表示透明掉当前的这个窗口
这样,他就会将消息向下继续传递给他的Parent窗口。
于是写下如下
procedure TPanel.WMNchist(var Msg: TMessage);
begin
Inherited;
Msg.Result := HTTRANSPARENT;
end;

这样消息就被传递到了Form窗体了。

整体代码如下:


unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls;

type
TPanel = Class(ExtCtrls.TPanel)
procedure WMNchist(var Msg: TMessage);message WM_NCHITTEST;
end;
TForm1 = class(TForm)
pnl1: TPanel;
private
{ Private declarations }
protected
procedure WMNchist(var Msg: TMessage);message WM_NCHITTEST;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.WMNchist(var Msg: TMessage);
var
MouseX,MouseY: integer;
begin
MouseX := LOWORD(Msg.LParam);
MouseY := HIWORD(Msg.LParam);
if(MouseX >= Left + Width - 2) and (MouseY >= Top + Height - 2) then
Msg.Result := HTBOTTOMRIGHT
else if (MouseX <= Left + 2) and (MouseY <= Top + 3) then
Msg.Result := HTTOPLEFT
else if (MouseX <= Left + 2) and (MouseY<= Top + Height - 2) then
Msg.Result := HTBOTTOMLEFT
else if MouseX >= Left + Width -2 then
Msg.Result := HTRIGHT
else if MouseY >= Top + Height - 2 then
Msg.Result := HTBOTTOM
else if Mousex <= Left + 2 then
Msg.Result := HTLEFT
else if MouseY <= Top + 2 then
Msg.Result := HTTOP
else Inherited;
end;

{ TPanel }

procedure TPanel.WMNchist(var Msg: TMessage);
begin
Inherited;
Msg.Result := HTTRANSPARENT;
end;

end.

没有评论: