好像 现在的人很喜欢毛玻璃 的透明效果……
看到360 做的这个,一直以为是WIN7下 毛玻璃,认真一看,还不是,因为我发现它在XP下也是可以的, 所以就学着玩做了一个
当然菜鸟用了很菜的方法
我现在就把它叫做纯玻璃吧,
这个纯玻璃可以在 XP WIN7 使用,别的没玩过 ……
以下是代码
unit Un_base;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls;
type
Tfm_base = class(TForm)
Button1: TButton;
procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure Button1Click(Sender: TObject);
private
public
{ Public declarations }
procedure WMMOVE(var Msg: TMessage); message WM_MOVE;
procedure WMNchist(var Msg: TMessage);message WM_NCHITTEST;
end;
var
fm_base: Tfm_base;
implementation
{$R *.dfm}
var
fm_glass: TForm;
const
Distance:Integer=60;
procedure Tfm_base.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
const
sc_dragmove = $f012;
begin
releasecapture;
twincontrol(application.mainform).perform(wm_syscommand,sc_dragmove, 0);
end;
procedure Tfm_base.FormCreate(Sender: TObject);
begin
//置顶
SetWindowPos(Handle,HWND_TOPMOST,Left,Top,Width,Height,SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);
//镂空
Color := clFuchsia;
TransparentColorValue := clFuchsia;
TransparentColor := True;
BorderStyle:= bsNone;
end;
procedure Tfm_base.WMMOVE(var Msg: TMessage);
begin
Inherited;
SetWindowPos(Handle,HWND_TOPMOST,Left,Top,Width,Height,SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);
if Assigned(fm_glass) then begin fm_glass.Top:=Self.Top-Distance;
fm_glass.Left:=Self.Left-Distance;
end;
end;
procedure Tfm_base.FormShow(Sender: TObject);
var
hr :thandle;
begin
fm_glass:=Tform.create(Application);
with fm_glass do begin
BorderStyle:=bsNone;
//Parent:=Self;
Name:='fm_glass';
top:= Self.Top-Distance;
Left:= Self.Left-Distance;
Height:=Self.Height+2*Distance;
Width:=Self.Width+2*Distance;
Color:=RGB(0,0,0);
AlphaBlend:=True;
AlphaBlendValue:=180;
//TransparentColor:=True;//实现镂空
fm_glass.OnMouseDown:=FormMouseDown;
hr:=createroundrectrgn(0,0,width-1,height-1,50,50);
setwindowrgn(handle,hr,true); //给窗体添加自定义消息
Show;
end;
sendmessage(fm_glass.Handle,WM_MOVE,1,0);
sendmessage(fm_glass.Handle,WM_NCHITTEST,1,0);
// SetWindowPos(fm_glass.Handle, Application.Handle, Self.Left,Self.Top,ClientWidth, ClientHeight , SWP_SHOWWINDOW);
end;
procedure Tfm_base.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
fm_glass.Free;
end;
procedure Tfm_base.Button1Click(Sender: TObject);
begin
Application.Terminate;
end;
procedure Tfm_base.WMNchist(var Msg: TMessage);
var
MouseX,MouseY: integer;
begin
{ with fm_glass do begin
MouseX := LOWORD(Msg.LParam);
MouseY := HIWORD(Msg.LParam);
if(MouseX >= Left + Width - 5) and (MouseY >= Top + Height - 5) then
Msg.Result := HTBOTTOMRIGHT
else if (MouseX <= Left + 5) and (MouseY <= Top + 3) then
Msg.Result := HTTOPLEFT
else if (MouseX <= Left + 5) and (MouseY<= Top + Height - 5) then
Msg.Result := HTBOTTOMLEFT
else if MouseX >= Left + Width -5 then
Msg.Result := HTRIGHT
else if MouseY >= Top + Height - 5 then
Msg.Result := HTBOTTOM
else if Mousex <= Left + 5 then
Msg.Result := HTLEFT
else if MouseY <= Top + 5 then
Msg.Result := HTTOP
else Inherited;
end; }
end;
end.
原理我是这样做 ,利用双窗体, 新建一个,然后动态创建一个 把窗体镂空掉,然后把动态创建的设置透明。这样就搞定了……
使用 的时候只 要一键继承就可以了……
可是这样做这个按钮就在这儿了,这人纯玻璃这个还没解决?????????????
这是下载地址
http://download.csdn.net/detail/key_ok/4500127