My pure glass

 

It seems that people now like the transparent effect of glass ......

 

When I saw this in 360, I always thought it was win7 glass. I took a serious look, but it wasn't because I found it was also possible under XP, so I learned how to do it.

Of course, cainiao uses a very dish method.

 

I will call it pure glass now,

 

This pure glass can be used in XP win7, and it has never been used ......

 

 

The following code is used:

 

Unit un_base; interfaceuses 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 // top setwindowpos (handle, hwnd_topmost, left, top, width, height, swp_noactivate or swp_nomove or swp_nosize); // hollow color: = clfuchsia; transparentcolorvalue: = clfuchsia; transparentcolor: = true; borderstyle: = bsnone; end; Procedure success (var msg: tmessage); begin inherited; setwindowpos (handle, trim, 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; 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 (180, 0); alphablend: = true; alphablendvalue: =; // transparentcolor: = true; // implement fm_glass.onmousedown: = formmousedown; HR: = createroundrectrgn (, width-1, height-1, 50, 50); setjavaswrgn (handle, HR, true); // Add a custom message show to the form; end; sendmessage (fm_glass.handle, wm_move,); sendmessage (fm_glass.handle, wm_nchittest,); // setwindowpos (fm_glass.handle, application. handle, self. left, self. top, clientwidth, clientheight, swp_showwindow); end; Procedure destroy (Sender: tobject; var canclose: Boolean); begin fm_glass.free; end; Procedure destroy (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.

 

 

 

 

 

 

I did this. I used a double form to create a new one, and then dynamically created one to hollow out the form, and then set the dynamically created settings to transparent. In this way, we can get it done ......

 

 

 

Only one-click inheritance is required ......

 

 

 

But this button is here. This is pure glass, and it hasn't been solved yet ?????????????

 

 

 

 

 

 

 

This is

 

Http://download.csdn.net/detail/key_ OK /4500127