...VB高手来~挑战VB极限!!█████在线等!!███████
发布网友
发布时间：2024-10-23 22:44
共5个回答
热心网友
时间：2024-10-27 22:29
将label1的backstyle属性设置为0-transparent即可。
透明窗体，顾名思义，就是窗体是透明的，透过窗体可以看到窗体下面
的东西。实现透明窗体的原理也很简单：首先得到主窗口的矩形区域，
再得到客户区的矩形区域，然后用CombineRgn函数，使用异或操作，将
重叠部分去除，再使用SetWindowRgn函数设置窗体区域，就行了。
下面的例子实现了该功能。
>>步骤1----建立新工程。
>>步骤2----编写如下代码：
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd _
As Long, lpRECT As RECT) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hWnd _
As Long, lpRECT As RECT) As Long
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn _
As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, _
ByVal nCombineMode As Long) As Long
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As _
Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) _
As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal hWnd _
As Long, lpPoint As POINTAPI) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As _
Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Const RGN_XOR = 3
Private Type POINTAPI
x As Long
Y As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private rctClient As RECT, rctFrame As RECT
Private hClient As Long, hFrame As Long
Public Sub MakeTransparent(frm As Form)
GetFrameClientRgn frm
SetWindowRgn frm.hWnd, hFrame, True
End Sub
Private Sub GetFrameClientRgn(frm As Form)
GetWindowRect frm.hWnd, rctFrame
GetClientRect frm.hWnd, rctClient
'将窗口矩形坐标转换为屏幕坐标
Dim lpTL As POINTAPI, lpBR As POINTAPI
lpTL.x = rctFrame.Left
lpTL.Y = rctFrame.Top
lpBR.x = rctFrame.Right
lpBR.Y = rctFrame.Bottom
ScreenToClient frm.hWnd, lpTL
ScreenToClient frm.hWnd, lpBR
rctFrame.Left = lpTL.x
rctFrame.Top = lpTL.Y
rctFrame.Right = lpBR.x
rctFrame.Bottom = lpBR.Y
rctClient.Left = Abs(rctFrame.Left)
rctClient.Top = Abs(rctFrame.Top)
rctClient.Right = rctClient.Right + Abs(rctFrame.Left)
rctClient.Bottom = rctClient.Bottom + Abs(rctFrame.Top)
rctFrame.Right = rctFrame.Right + Abs(rctFrame.Left)
rctFrame.Bottom = rctFrame.Bottom + Abs(rctFrame.Top)
rctFrame.Top = 0
rctFrame.Left = 0
hClient = CreateRectRgn(rctClient.Left, rctClient.Top, _
rctClient.Right, rctClient.Bottom)
hFrame = CreateRectRgn(rctFrame.Left, rctFrame.Top, _
rctFrame.Right, rctFrame.Bottom)
CombineRgn hFrame, hClient, hFrame, RGN_XOR
End Sub
Private Sub Form_Resize()
MakeTransparent Me
End Sub
>>步骤3----编译运行，是不是看到效果了
热心网友
时间：2024-10-27 22:28
API声明省略了
Dim HRNG as long
HRNG=CreateRectRgn(Label1.Left,Label1.Top,Label1.Left+Label1.Width,Label1.Top+Label1.Height)
SetWindowRgn(me.hwnd,HRNG,true)
这两个API就可以了，没试过，不知道能不能成功，但原理是这样的。
热心网友
时间：2024-10-27 22:33
像迅雷的那个小图标一样的透明么？
添加一个模块代码如下：
Public Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Public Const WS_EX_LAYERED = &H80000
Public Const GWL_EXSTYLE = (-20)
Public Const LWA_ALPHA = &H2
Public Const LWA_COLORKEY = &H1
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Sub Form_Load()
Dim sty As Long
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
End Sub
可将SetLayeredWindowAttributes Me.hwnd, 0, 192, LWA_ALPHA句中的192数值进行修改为12或其它数值:
SetLayeredWindowAttributes Me.hwnd, 0, 12, LWA_ALPHA
再观看其窗体加载的效果.
热心网友
时间：2024-10-27 22:32
楼上的是把所有窗体上的白色设置为透明,包括标题或其他窗体上的白色部分,运行效果不是很好,
具体代码如下: 很简单把
Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 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 CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Const RGN_AND = 1
'将两个区域相加
Private Const RGN_COPY = 5
'创建hSrcRgn1的拷贝
Private Const RGN_DIFF = 4
'将两个区域相减
Private Const RGN_OR = 2
'将两个区域进行或操作
Private Const RGN_XOR = 3
'将两个区域进行异或操作
Private Const RGN_MAX = RGN_COPY
Private Const RGN_MIN = RGN_AND
Private Sub Reset(f1 As Form)
Dim hSrcRgn4 As Long
hSrcRgn4 = CreateRectRgn(Label1.Left / Screen.TwipsPerPixelX, Label1.Top / Screen.TwipsPerPixelY, (Label1.Left + Label1.Width) / Screen.TwipsPerPixelX, (Label1.Top + Label1.Height) / Screen.TwipsPerPixelY)
SetWindowRgn f1.hWnd, hSrcRgn4, True
End Sub
Private Sub Form_Click()
End
End Sub
Private Sub Form_Load()
Me.BorderStyle = 0
'设置窗口形状
Reset Form1
End Sub
这个也可以，效果不同，label也省略了
Option Explicit
Private Const RGN_AND = 1
Private Type RECT
Left As Long: Top As Long: Right As Long: Bottom As Long
End Type
Private Declare Function BeginPath Lib "gdi32" (ByVal hDC As Long) 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 EndPath Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function PathToRegion Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function GetRgnBox Lib "gdi32" (ByVal hRgn As Long, lpRect As RECT) As Long
Private Declare Function CreateRectRgnIndirect Lib "gdi32" (lpRect As RECT) As Long
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject 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 ReleaseCapture Lib "User32" () As Long
Public hRgn1 As Long, hRgn2 As Long
Private Sub Form_Load()
Dim rct As RECT
BeginPath hDC
Me.Font.Name = "华文行楷"
Me.Font.Bold = True
Me.Font.Size = 28
TextOut hDC, 30, 30, "Label就在这里吧", 15
EndPath hDC
hRgn1 = PathToRegion(hDC)
GetRgnBox hRgn1, rct
hRgn2 = CreateRectRgnIndirect(rct)
CombineRgn hRgn2, hRgn2, hRgn1, RGN_AND
DeleteObject hRgn1
SetWindowRgn hwnd, hRgn2, 1
End Sub
热心网友
时间：2024-10-27 22:35
在窗体中添加一label控件，拷贝以下代码到窗体代码中。
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
Private Const WS_EX_LAYERED = &H80000
Private Const GWL_EXSTYLE = (-20)
Private Const LWA_COLORKEY = &H1
Private Sub Form_Load()
Dim rtn As Long
Me.BackColor = vbWhite
Label1.FontSize = 30
Label1.AutoSize = True
Label1.BackStyle = 0
rtn = GetWindowLong(hwnd, GWL_EXSTYLE)
rtn = rtn Or WS_EX_LAYERED
SetWindowLong hwnd, GWL_EXSTYLE, rtn
SetLayeredWindowAttributes hwnd, &HFFFFFF, 0, LWA_COLORKEY
End Sub
另外也可以通过API制作文字型窗体，需要的话我可以再提供。希望对你有帮助！
