设置窗体透明但是窗体上的图片不透明...网上的好多都是骗人的...

2008-12-22 04:51:20 340 阅读 AI 写同款 · GEO 优化AI 选题数据监测一键分发 ›

Qt 设置窗体透明在音频开发中，窗体多半为半透明、圆角窗体，如下为Qt 5.5 VS2013实现半透明方法总结。阅读详情

网上的代码:



Option Explicit



'设置透明窗体

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

Public 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



sty = GetWindowLong(Me.hwnd, GWL_EXSTYLE)

sty = sty Or WS_EX_LAYERED

SetWindowLong Me.hwnd, GWL_EXSTYLE, sty

SetLayeredWindowAttributes Me.hwnd, 0, 200, LWA_ALPHA

这些代码是控件和窗体一起透明了...
希望各位大侠有没有更好的解决方法最好有例子并测试成功...

...全文

Qt 设置窗体透明本文福利，莬费领取Qt开发学习资料包、技术视频，内容包括（C++语言基础，Qt编程入门，QT信号与槽机制，QT界面开发-图像绘制，QT网络，QT数据库编程，QT项目实战，QSS，OpenCV，Quick模块，面试题等等）↓↓↓↓↓↓见下面↓↓文章底部点击莬费领取↓↓。在音频开发中，窗体多半为半透明、圆角窗体，如下为Qt 5.5 VS2013实现半透明方法总结。3）选择菜单Action，修改背景颜色透明度。3）效果图如下（录制gif时刷新有点延时）5）效果如下（录频有点重影）2、通过图片贴图，设置局部透明。阅读详情

evjen

API 1,488 成员 23,270 内容

+ 关注 + 加入社区

切换为时间正序

ZOUYONG0929 2008-12-25

打赏
举报

两个控件A,B.
A遮蔽了B
A透明
B的改变能在A里看到吗?

lyserver 2008-12-24

打赏
举报

再添加一个功能，让窗口透明但窗口背景图片不透明（此效果只针对图片小于窗口的效果明显）
Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) 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 CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Const RGN_OR = 2
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Type POINTAPI
x As Long
y As Long
End Type
Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long

Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long

Private Sub Form_Click()
Unload Me
End Sub

Private Sub Form_Load()
Dim i As Long, ctl As Object, hRgn As Long, tRgn As Long, nLeft As Long, nTop As Long
Dim rc As RECT, pt(1) As POINTAPI

Set Me.Picture = LoadPicture("c:\1936_1.jpg")
Me.ScaleMode = vbPixels
nLeft = Me.Left \ Screen.TwipsPerPixelX
nTop = Me.Top \ Screen.TwipsPerPixelY

For i = 0 To Me.Controls.Count - 1
Set ctl = Me.Controls(i)
pt(0).x = ctl.Left - nLeft
pt(0).y = ctl.Top - nTop
pt(1).x = pt(0).x + ctl.Width
pt(1).y = pt(0).y + ctl.Height
ClientToScreen Me.hwnd, pt(0)
ClientToScreen Me.hwnd, pt(1)
tRgn = CreateRectRgn(pt(0).x, pt(0).y, pt(1).x, pt(1).y)
If hRgn = 0 Then
hRgn = tRgn
Else
CombineRgn hRgn, hRgn, tRgn, RGN_OR
DeleteObject tRgn
End If
Next
'让背景图片不透明
pt(0).x = -nLeft
pt(0).y = -nTop
pt(1).x = Me.ScaleX(Me.Picture.Width, vbHimetric, vbPixels) + pt(0).x
pt(1).y = Me.ScaleY(Me.Picture.Height, vbHimetric, vbPixels) + pt(0).y
ClientToScreen Me.hwnd, pt(0)
ClientToScreen Me.hwnd, pt(1)
tRgn = CreateRectRgn(pt(0).x, pt(0).y, pt(1).x, pt(1).y)
If hRgn = 0 Then
hRgn = tRgn
Else
CombineRgn hRgn, hRgn, tRgn, RGN_OR
DeleteObject tRgn
End If
SetWindowRgn Me.hwnd, hRgn, True
DeleteObject hRgn
End Sub

zzyong00 2008-12-24

打赏
举报

[Quote=引用 5 楼 lyserver 的回复:]
这是俺以前回答的半透明控件的例子：
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private D…
[/Quote]
不错，顶顶

lyserver 2008-12-24

打赏
举报

这是我刚才写的窗口透明控件不透明的代码，未使用常见的SetLayeredWindowAttributes函数。
Option Explicit
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) 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 CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Const RGN_OR = 2
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Type POINTAPI
x As Long
y As Long
End Type
Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long

Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long

Private Sub Form_Click()
Unload Me
End Sub

Private Sub Form_Load()
Dim i As Long, ctl As Object, hRgn As Long, tRgn As Long, nLeft As Long, nTop As Long
Dim rc As RECT, pt(1) As POINTAPI

Me.ScaleMode = vbPixels
nLeft = Me.Left \ Screen.TwipsPerPixelX
nTop = Me.Top \ Screen.TwipsPerPixelY

For i = 0 To Me.Controls.Count - 1
Set ctl = Me.Controls(i)
pt(0).x = ctl.Left - nLeft
pt(0).y = ctl.Top - nTop
pt(1).x = pt(0).x + ctl.Width
pt(1).y = pt(0).y + ctl.Height
ClientToScreen Me.hwnd, pt(0)
ClientToScreen Me.hwnd, pt(1)
tRgn = CreateRectRgn(pt(0).x, pt(0).y, pt(1).x, pt(1).y)
If hRgn = 0 Then
hRgn = tRgn
Else
CombineRgn hRgn, hRgn, tRgn, RGN_OR
DeleteObject tRgn
End If
Next
SetWindowRgn Me.hwnd, hRgn, True
DeleteObject hRgn
End Sub

嗷嗷叫的老马 2008-12-24

打赏
举报

顶顶!

lyserver 2008-12-24

打赏
举报

这是俺以前回答的半透明控件的例子：
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function OffsetRect Lib "user32" (lpRect As RECT, ByVal X As Long, ByVal Y As Long) As Long
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 Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
Private Const DT_SINGLELINE = &H20
Private Const DT_CENTER = &H1
Private Const DT_VCENTER = &H4

Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long

Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long

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 Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Const SW_SHOW = 5
Private Const SW_HIDE = 0

Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function AlphaBlend Lib "msimg32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal widthSrc As Long, ByVal heightSrc As Long, ByVal blendFunct As Long) As Boolean

Dim m_hMemDC As Long
Dim m_hMemBmp As Long, m_hMemBmpPrev As Long
Dim m_rcControl As RECT

Private Sub UserControl_Initialize()
UserControl.AutoRedraw = True
m_hMemDC = CreateCompatibleDC(UserControl.hdc)
End Sub

Private Sub UserControl_Terminate()
If m_hMemBmp <> 0 Then
DeleteObject SelectObject(m_hMemDC, m_hMemBmpPrev)
End If
DeleteDC m_hMemDC
End Sub

Public Sub Translucence()
Dim hdc As Long
Dim tPt As POINTAPI

'获得控件当前位置和大小
ClientToScreen UserControl.hwnd, tPt
ScreenToClient UserControl.ContainerHwnd, tPt
Call GetClientRect(UserControl.hwnd, m_rcControl)
OffsetRect m_rcControl, tPt.X, tPt.Y
'创建一幅内存位图
If m_hMemBmp <> 0 Then
DeleteObject (SelectObject(m_hMemDC, m_hMemBmpPrev))
End If
m_hMemBmp = CreateCompatibleBitmap(UserControl.hdc, m_rcControl.Right, m_rcControl.Bottom)
m_hMemBmpPrev = SelectObject(m_hMemDC, m_hMemBmp)

'隐藏控件
ShowWindow UserControl.hwnd, SW_HIDE
DoEvents

'保存控件容器的图像到内存位图中
Dim hDesktopDC As Long
hDesktopDC = GetDC(UserControl.hwnd)
BitBlt m_hMemDC, 0, 0, m_rcControl.Right, m_rcControl.Bottom, hDesktopDC, 0, 0, vbSrcCopy
ReleaseDC 0, hDesktopDC

'通过alpha效果进行半透明渲染
UserControl.AutoRedraw = True
AlphaBlend m_hMemDC, 0, 0, m_rcControl.Right, m_rcControl.Bottom, UserControl.hdc, 0, 0, m_rcControl.Right, m_rcControl.Bottom, 5242880
UserControl.AutoRedraw = False

'显示控件
ShowWindow UserControl.hwnd, SW_SHOW

'将渲染后的结果复制到控件中
BitBlt UserControl.hdc, 0, 0, m_rcControl.Right, m_rcControl.Bottom, m_hMemDC, 0, 0, vbSrcCopy
End Sub

Private Sub UserControl_Paint()
BitBlt UserControl.hdc, 0, 0, m_rcControl.Right, m_rcControl.Bottom, m_hMemDC, 0, 0, vbSrcCopy
End Sub

调用代码如下：
Private Sub Form_Activate()
Me.UserControl11.Translucence
End Sub

ZOUYONG0929 2008-12-22

打赏
举报

以前我也想要窗体透明控件不透明网上找了好多.最终结果是不可能实现.(模拟方法除外)

ZOUYONG0929 2008-12-22

打赏
举报

要的是半透明就难办点
要的是完全透明就好办了窗体背景色和 SetLayeredWindowAttributes Me.hwnd, "窗体背景色", 0, LWA_COLORKEY
那你的控件就不透明了
如果半透明的话 LWA_ALPHA 那是没办法的 XP是没办法实现的
不过有个替代的办法不过CPU挺累
设置完全透明+半透明窗体 +Hook
还有窗体+picuture(有句柄的都行) 不是说用BItbit 实时拷贝背景那样好像也难办是用Setparent 不过有麻烦坐标系统乱了(我想了N久都没想出个办法解决)

jy497759649 2008-12-22

打赏
举报

http://dl4.csdn.net/fd.php?i=58677838249577&s=5ddaf8d8c082c7feca68648a54653526

ftz820127 2008-12-22

打赏
举报

色红为异形窗口的屏蔽色255,0,0



  Option Explicit

  Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

  'hwnd   -----------     Long，欲为其取得信息的窗口的句柄

  'nIndex   ---------     Long，请参考GetWindowLong函数的nIndex参数的说明

  'dwNewLong   ------     Long，由nIndex指定的窗口信息的新值

    

  Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long

      'hwnd   -----------     Long，欲为其获取信息的窗口的句柄

      'nIndex   ---------     Long，欲取回的信息，可以是下述任何一个常数：

      'GWL_EXSTYLE

      '扩展窗口样式

      'GWL_STYLE

      '窗口样式

      'GWL_WNDPROC

      '该窗口的窗口函数的地址

      'GWL_HINSTANCE

      '拥有窗口的实例的句柄

      'GWL_HWNDPARENT

      '该窗口之父的句柄?不要用SetWindowWord来改变这个值

      'GWL_ID

      '对话框中一个子窗口的标识符

      'GWL_USERDATA

      '含义由应用程序规定

      'DWL_DLGPROC

      '这个窗口的对话框函数地址

      'DWL_MSGRESULT

      '在对话框函数中处理的一条消息返回的值

      'DWL_USER

      '含义由应用程序规定

        

  Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long

  'hwnd   --透明窗体的句柄

  'crKey   --为颜色值

  'bAlpha     --   透明度，取值范围是[0,255]

  'dwFlags   --   透明方式，可以取两个值：当取值为LWA_ALPHA时，crKey参数无效，

  'bAlpha参数有效；当取值为LWA_COLORKEY时，bAlpha参数有效而窗体中的所有颜色为crKey的地方将变为透明

    

  Const WS_EX_LAYERED = &H80000

  Const GWL_EXSTYLE = (-20)         '窗体扩展式样

  Const LWA_COLORKEY = &H1           '关键颜色(异形窗体)

  Const LWA_ALPHA = &H2             '透明度

  Const LWA_COLORKEY_ALPHA = &H3         '透明   +   异形

    

Private Declare Function ReleaseCapture Lib "user32" () As Long

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

  

Const HTCAPTION = 2

Const WM_NCLBUTTONDOWN = &HA1



Private Sub Command1_Click()

    End

End Sub



  Private Sub Form_Load()

          Dim NewStyle     As Long     '窗体的新式样

          Dim WinStyle     As Long     '记录窗体原来的式样

          WinStyle = GetWindowLong(Me.hwnd, GWL_EXSTYLE)         '获得窗体的扩展式样

          NewStyle = WinStyle + WS_EX_LAYERED           '窗体新式样

          SetWindowLong Me.hwnd, GWL_EXSTYLE, NewStyle         '付值给窗体新的式样

          SetLayeredWindowAttributes Me.hwnd, RGB(255, 0, 0), 200, LWA_COLORKEY_ALPHA               '异形+半透明

            

'          SetLayeredWindowAttributes Me.hwnd, 0, 128, LWA_ALPHA           '半透明

'          SetLayeredWindowAttributes Me.hwnd, RGB(255, 0, 0), 0, LWA_COLORKEY               '异形

  End Sub



Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

    If Button = 1 Then

        Call ReleaseCapture

        Call SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)

    End If

End Sub

设置窗体透明但是窗体上的图片不透明...网上的好多都是骗人的...

相关推荐