初学者想的纯玻璃，期待大牛们更好的方法来改进

菜鸟想的纯玻璃，期待大牛们更好的方法来改进




胡思乱想


看到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);  
  
    
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


没分了 ，只剩一分 

[解决办法]
之前也研究过类似的东西，参考过这两种方案，推荐第二种
http://blog.csdn.net/srxumin/article/details/4410917
http://www.cnblogs.com/jxsoft/archive/2011/06/02/2067714.html