没有标题栏的窗体可缩放(NetAnts)

I

import

Unregistered / Unconfirmed
GUEST, unregistred user!
procedure TForm1.CreateParams(var Params:TCreateParams);
begin
inherited CreateParams(Params);
Params.Style := WS_SIZEBOX or
WS_POPUP or
WS_BORDER;
end;
*******************
procedure TForm1.FormCreate(Sender: TObject);
begin
borderstyle:=bsSizeable;
setwindowlong(handle,gwl_style,getwindowlong(handle,gwl_style) and not ws_caption);
clientheight:=height;
end;
************************
TForm1=class(TForm)
...
public
procedure CreateParams(var Params: TCreateParams); override;
// 加入这一行
end;
// Copy 如下代码即可
procedure TForm1.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do
begin
Style := (Style or WS_POPUP) xor (ws_dlgframe);
///如果要凹下去的效果,则加入下面这行,否则去掉
ExStyle := ws_ex_clientedge;
end;
end;
***************
怎样可以不要Form的标题栏和边界但可以保留改变Form的大小的功能:
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
private
procedure WmNCHitTest(var Msg : TWMNCHitTest); message WM_NCHITTEST;
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.WmNCHitTest(var Msg: TWMNCHitTest);
const v=10; //border width
var p:TPoint;
begin
p:=Point(Msg.XPos,Msg.YPos);
p:=ScreenToClient(p);
if PtInRect(Rect(0,0,v,v),p) then
Msg.Result:=HTTOPLEFT
else if PtInRect(Rect(Width-v,Height-v,Width,Height),p) then
Msg.Result:=HTBOTTOMRIGHT
else if PtInRect(Rect(Width-v,0,Width,v),p) then
Msg.Result:=HTTOPRIGHT
else if PtInRect(Rect(0,Height-v,v,Height),p) then
Msg.Result:=HTBOTTOMLEFT
else if PtInRect(Rect(v,0,Width-v,v),p) then
Msg.Result:=HTTOP
else if PtInRect(Rect(0,v,v,Height-v),p) then
Msg.Result:=HTLEFT
else if PtInRect(Rect(Width-v,v,Width,Height-v),p) then
Msg.Result:=HTRIGHT
else if PtInRect(Rect(v,Height-v,Width-v,Height),p) then
Msg.Result:=HTBOTTOM;
Inherited;
end;
end.
*************************
类似网络蚂蚁的悬浮窗体
源码:
protected:
virtual void __fastcall CreateParams(TCreateParams & Param);
void __fastcall TForm2::CreateParams(TCreateParams & Param)
{
//调用基类
TForm::CreateParams(Param);
//去掉窗口标题区
Param.Style=Param.Style & ~WS_CAPTION;
Param.Style=Param.Style | WS_POPUP;
//设为总在最上面
Param.ExStyle=Param.ExStyle | WS_EX_TOPMOST;
//设Windows Owner为Desktop Window
Param.WndParent=GetDesktopWindow();
}
注意:
1、Windows Owner与Windows Parent不同,用::SetParent函数和设置Form?->Parent这能设置Windows Parent,不能设置Windows Owner,要实现FlashGet的悬浮窗必须要设置Windows Owner。
2、Form的BorderStyle要设为bsToolWindow,不然在任务栏上会显示出这个窗口的标题,将Caption设为空也没有用。
 
顶部