博客
关于我
强烈建议你试试无所不能的chatGPT,快点击我
VB窗体半透明的方法
阅读量:5170 次
发布时间:2019-06-13

本文共 2179 字,大约阅读时间需要 7 分钟。

'-----------------------------'使用说明:'1.新建一个标准exe工程'2.放置1个CommandButton 控件(使用默认名)'3.把下面的代码复制进去就可以了'-----------------------------Option Explicit'Transparancy API'sPrivate Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As LongPrivate Declare Function UpdateLayeredWindow Lib "user32" (ByVal hWnd As Long, ByVal hdcDst As Long, pptDst As Any, psize As Any, ByVal hdcSrc As Long, pptSrc As Any, crKey As Long, ByVal pblend As Long, ByVal dwFlags As Long) As LongPrivate Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As LongPrivate Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPrivate Const GWL_EXSTYLE = (-20)Private Const LWA_COLORKEY = &H1Private Const LWA_ALPHA = &H2Private Const ULW_COLORKEY = &H1Private Const ULW_ALPHA = &H2Private Const ULW_OPAQUE = &H4Private Const WS_EX_LAYERED = &H80000Public Function isTransparent(ByVal hWnd As Long) As BooleanOn Error Resume NextDim Msg As LongMsg = GetWindowLong(hWnd, GWL_EXSTYLE)If (Msg And WS_EX_LAYERED) = WS_EX_LAYERED ThenisTransparent = TrueElseisTransparent = FalseEnd IfIf Err ThenisTransparent = FalseEnd IfEnd FunctionPublic Function MakeTransparent(ByVal hWnd As Long, ByVal Perc As Integer) As LongDim Msg As LongOn Error Resume NextPerc = 100If Perc < 0 Or Perc > 255 ThenMakeTransparent = 1ElseMsg = GetWindowLong(hWnd, GWL_EXSTYLE)Msg = Msg Or WS_EX_LAYEREDSetWindowLong hWnd, GWL_EXSTYLE, MsgSetLayeredWindowAttributes hWnd, 0, Perc, LWA_ALPHAMakeTransparent = 0End IfIf Err ThenMakeTransparent = 2End IfEnd FunctionPublic Function MakeOpaque(ByVal hWnd As Long) As LongDim Msg As LongOn Error Resume NextMsg = GetWindowLong(hWnd, GWL_EXSTYLE)Msg = Msg And Not WS_EX_LAYEREDSetWindowLong hWnd, GWL_EXSTYLE, MsgSetLayeredWindowAttributes hWnd, 0, 0, LWA_ALPHAMakeOpaque = 0If Err ThenMakeOpaque = 2End IfEnd Function'透明Private Sub Command1_Click() MakeTransparent Me.hWnd, 120 '这里的120是透明度,在0~255之间取值End Sub

  

转载于:https://www.cnblogs.com/mengkun/p/4280301.html

你可能感兴趣的文章
开源框架中常用的php函数
查看>>
nginx 的提升多个小文件访问的性能模块
查看>>
set&map
查看>>
集合类总结
查看>>
4.AE中的缩放,书签
查看>>
给一次重新选择的机会_您还会选择程序员吗?
查看>>
Mysql MHA高可用集群架构
查看>>
心急的C小加
查看>>
编译原理 First,Follow,select集求法
查看>>
iOS开发 runtime实现原理以及实际开发中的应用
查看>>
android 学习资源网址
查看>>
qt安装遇到的错误
查看>>
java:Apache Shiro 权限管理
查看>>
objective c的注释规范
查看>>
FreeNas安装配置使用
查看>>
Django(一)框架简介
查看>>
Python操作SQLite数据库的方法详解
查看>>
菜单和工具条(二)
查看>>
hadoop17---RPC和Socket的区别
查看>>
使用JMeter代理录制app测试脚本
查看>>