我的纯玻璃_大悟还俗-CSDN博客

本文链接：https://blog.csdn.net/key_ok/article/details/7866826

好像现在的人很喜欢毛玻璃的透明效果……

看到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.