窗口透明

[rzzat1478]

目的:一个窗体一个标签,要求显示标签而窗体透明,源代码如下:Option Explicit
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, _
ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, _
ByVal hObject As Long) As Long

Private Sub Form_Load()
Dim Bitmap
Me.AutoRedraw = True
Bitmap = CreateCompatibleBitmap(Me.hdc, 0, 0)
SelectObject Me.hdc, Bitmap '设置窗体透明
End Sub

Private Sub Label1_DblClick()
End
End Sub
请问要设置哪些属性?

[rzzat1478]

这么惨,一个回复的都没有~~

[迈克揉索芙特]

使窗体拥有透明效果的API
http://dev.csdn.net/article/51/51205.shtm

[迈克揉索芙特]

一、背景
FlashGet的透明效果大家羡慕吧.传统的Windows应用程序想实现半透明效果,一般来说需要处理自己的窗口的WM_Paint消息窗口,很麻烦.现在好了,SetLayeredWindowAttributes是windows的新api,win2000以上才支持,它能使使窗体拥有透明效果.我在Google搜了下,介绍SetLayeredWindowAttributes的文章大多是delphi的和vb的.好不容易找到一篇vc的,依法炮制后,vc的IDE却说我SetLayeredWindowAttributes没有定义!后来想想应该是我的sdk没有升级.于是我在vc安装目录搜索"SetLayeredWindowAttributes"的"*.h"文件,果然没有.怎么办?升级sdk吧.我去微软的网站一看,新的sdk就核心sdk就有二百多m呢(解压后更大),可怜我的硬盘没有一个分区大于200m的了!怎么办,这么好玩的api给看不给用:( 失望之余,我忽然想到了未公开api的使用的方法.这是个系统支持,自己sdk却没有的api,就把他当做windows未公开api试试!



示例代码运行效果图

二、简单介绍一下SetLayeredWindowAttributes:(详见msdn)

BOOL SetLayeredWindowAttributes(
HWND hwnd, // handle to the layered window
COLORREF crKey, // specifies the color key
BYTE bAlpha, // value for the blend function
DWORD dwFlags // action
);
<Requirements>
Windows NT/2000/XP: Included in Windows 2000 and later.
Windows 95/98/Me: Unsupported.
Header: Declared in Winuser.h; include Windows.h.
Library: Use User32.lib.

一些常量:
WS_EX_LAYERED = 0x80000;
LWA_ALPHA = 0x2;
LWA_COLORKEY=0x1
其中dwFlags有LWA_ALPHA和LWA_COLORKEY
LWA_ALPHA被设置的话,通过bAlpha决定透明度.
LWA_COLORKEY被设置的话,则指定被透明掉的颜色为crKey,其他颜色则正常显示.
注:要使使窗体拥有透明效果,首先要有WS_EX_LAYERED扩展属性(旧sdk也没有的).

三、例子代码:
在OnInitDialog()加入:

//加入WS_EX_LAYERED扩展属性
SetWindowLong(this->GetSafeHwnd(),GWL_EXSTYLE,
GetWindowLong(this->GetSafeHwnd(),GWL_EXSTYLE)^0x80000);
HINSTANCE hInst = LoadLibrary("User32.DLL");
if(hInst)
{
typedef BOOL (WINAPI *MYFUNC)(HWND,COLORREF,BYTE,DWORD);
MYFUNC fun = NULL;
//取得SetLayeredWindowAttributes函数指针
fun=(MYFUNC)GetProcAddress(hInst, "SetLayeredWindowAttributes");
if(fun)fun(this->GetSafeHwnd(),0,128,2);
FreeLibrary(hInst);
}

唉!如果装了最新sdk就不用那么麻烦了!
怎么样,效果不错吧!稍加修改还可以作出淡出淡入的效果. 注意第三个参数(128)不要取得太小了,为0的话完全透明,你就找不到窗体了!
小小心得,一吐为快.希望对初学者有所帮助.如有不妥,欢迎指正.

[迈克揉索芙特]

这里有vb的代码：http://topic.csdn.net/t/20050322/19/3872291.html

[舉杯邀明月]

学习................

^_^

[lyserver]

使用路径和区域，例如：
Option Explicit

Private Declare Function BeginPath Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function EndPath Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function PathToRegion Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Private Sub Form_Click()
Unload Me
End Sub

Private Sub Form_Load()
Dim hRgn As Long
Dim strLable As String
Dim rtClient As RECT, rtWindow As RECT

strLable = "我爱你中国"

Me.FontSize = 36
Me.FontBold = True
Me.BackColor = vbRed
Me.ScaleMode = vbPixels

BeginPath Me.hdc
TextOut Me.hdc, 10, 100, strLable, LenB(StrConv(strLable, vbFromUnicode))
EndPath Me.hdc

hRgn = PathToRegion(Me.hdc)
SetWindowRgn Me.hwnd, hRgn, True
DeleteObject hRgn
End Sub

注意字体不能太小，否则会不清楚。

[迈克揉索芙特]

狂汗，原来是：要求显示标签而窗体透明
上面算我没说

[cbm6666]

Option Explicit
'*****************************************透明窗体
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cX As Long, ByVal cY As Long, ByVal wFlags As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Const WS_EX_LAYERED = &H80000
Const GWL_EXSTYLE = (-20)
'Const LWA_ALPHA = &H2
Const LWA_COLORKEY = &H1
Dim Rtn&, TransColor&
Private Sub Form_Load()
TransColor = &HFF0000
Label1.AutoSize = True: Label1.Caption = "CBM666的窗体透明"
Label1.FontSize = 24: Label1.BorderStyle = 0: Label1.BackStyle = 0
Label1.ForeColor = QBColor(10): Label1.Move 0, 0
Me.BorderStyle = 0: Me.Caption = "": Me.BackColor = TransColor
Me.Width = Label1.Width: Me.Height = Label1.Height
Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
Rtn = GetWindowLong(hwnd, GWL_EXSTYLE)
Rtn = Rtn Or WS_EX_LAYERED
SetWindowLong hwnd, GWL_EXSTYLE, Rtn
SetLayeredWindowAttributes hwnd, TransColor, 0, LWA_COLORKEY '将扣去窗口中的蓝色背景
End Sub

Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Unload Me
End Sub

[lyserver]

我的示例代码只是在透明的窗口上显示了文字，如果楼主的确要完整地显示Label，包含Label的边框和背景，那么可以按此思路将Label转换为矩形区域，如果有多个Label，则需进行区域合并，然后再将区域指定为窗口Rgn即可。

[rzzat1478]

谢谢你们了,我的要求只是在源代码上改一下就好了,或者设置一下属性就可以了.

[lyserver]

那你可以将窗口透明的功能封装到类中，使用类暴露方法和属性，VB本身是不能直接完成的。

[zdingyun]

Option   Explicit 
Private   Declare   Function   GetWindowLong   Lib   "user32 "   Alias   "GetWindowLongA "   (ByVal   hwnd   As   Long,   ByVal   nIndex   As   Long)   As   Long 
Private   Declare   Function   SetWindowLong   Lib   "user32 "   Alias   "SetWindowLongA "   (ByVal   hwnd   As   Long,   ByVal   nIndex   As   Long,   ByVal   dwNewLong   As   Long)   As   Long 
Private   Declare   Function   SetLayeredWindowAttributes   Lib   "user32 "   (ByVal   hwnd   As   Long,   ByVal   crKey   As   Long,   ByVal   bAlpha   As   Byte,   ByVal   dwFlags   As   Long)   As   Long 
Const   WS_EX_LAYERED   =   &H80000 
Const   GWL_EXSTYLE   =   (-20) 
Const   LWA_ALPHA   =   &H2 
Const   LWA_COLORKEY   =   &H1 
Dim   sty   As   Long 
Dim   cs   As   Integer 

Private   Sub   Form_Load() 
sty   =   GetWindowLong(Me.hwnd,   GWL_EXSTYLE) 
sty   =   sty   Or   WS_EX_LAYERED 
SetWindowLong   Me.hwnd,   GWL_EXSTYLE,   sty 
SetLayeredWindowAttributes   Me.hwnd,   0,   192,   LWA_ALPHA 
cs   =   255 
End   Sub 

Private   Sub   Timer1_Timer() 
cs   =   cs   -   5 
SetLayeredWindowAttributes   Me.hwnd,   0,   cs,   LWA_ALPHA 
If   cs   <=   15   Then 
cs   =   255 
End   If 
End   Sub 

请观看Timer控件中cs改变使窗体透明效果会发生变化.