如何使窗体半透明

johnwww 2002-10-27 10:06:37
如何使窗体半透明
...全文
42 8 打赏 收藏 转发到动态 举报
写回复
用AI写文章
8 条回复
切换为时间正序
请发表友善的回复…
发表回复
ztchen 2002-10-31
  • 打赏
  • 举报
回复
说得有道理,但你也可以画个窗体呀,反正达到效果就可以了。
Sean918 2002-10-31
  • 打赏
  • 举报
回复
简单的实现如下:

加一个timer控件渐变效果:

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 Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long

Const WS_EX_LAYERED = &H80000
Const GWL_EXSTYLE = (-20)
Const LWA_ALPHA = &H2

Dim rtn As Long, num

Private Sub Form_Load()
Form1.Visible = False
Form1.Timer1.Enabled = True
Form1.AutoRedraw = True
End Sub

Private Sub Timer1_Timer()
If num < 251 Then
If num > 0 Then Form1.Visible = True

num = num + 5
rtn = GetWindowLong(hwnd, GWL_EXSTYLE)
rtn = rtn Or WS_EX_LAYERED
SetWindowLong hwnd, GWL_EXSTYLE, rtn

SetLayeredWindowAttributes hwnd, 0, num, LWA_ALPHA
Else
Timer1.Enabled = False
End If
End Sub
seemon 2002-10-27
  • 打赏
  • 举报
回复
用.net吧。
good_sun 2002-10-27
  • 打赏
  • 举报
回复
98下不可能,XP下半透明的方法:
下面代码输入至模块中:

Option Explicit

'得到系统版本的API
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type

'半透明的API
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 GWL_EXSTYLE = (-20)
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_ALPHA = 2
Private Const LWA_COLORKEY = 1

Public Sub AlphaForm(Frm As Form, ByVal AlphaValue As Long)
'首先检测操作系统版本
Dim tmpOS As OSVERSIONINFO, rt As Long
tmpOS.dwOSVersionInfoSize = Len(tmpOS)
rt = GetVersionEx(tmpOS)

'如果没有通过则退出
If rt = 0 Or tmpOS.dwMajorVersion < 5 Then Exit Sub

'半透明窗体
Dim rtn As Long
rtn = GetWindowLong(Frm.hwnd, GWL_EXSTYLE) Or WS_EX_LAYERED
SetWindowLong Frm.hwnd, GWL_EXSTYLE, rtn
SetLayeredWindowAttributes Frm.hwnd, 0, AlphaValue, LWA_ALPHA
End Sub

AlphaValue即半透明的值,范围0-255
使用时用:
AlphaForm Me,100
zyl910 2002-10-27
  • 打赏
  • 举报
回复
在Win9X不可能实现窗体的半透明的!

以前回答的:
====================================================================
在Win9X不可能实现窗体的半透明
那是受Windows对窗体的绘制方式的限制
Windows系统实际上是把所有显示的窗体的内容放在一个位图中
等窗体需要更新时
就会设置窗体的绘制区域(就是把在它上面的窗体的区域屏蔽掉)
在发送WM_PAINT、WM_NCPAINT消息让程序去绘制
所以本窗体下屏幕是不会更新的
而半透明的计算是需要下层图形的(透明计算公式:绘制的RGB分量 = 下层图形该点的RGB分量 + CLng((上层图形该点的RGB分量 - 下层图形该点的RGB分量) * 透明度),0<=透明度<=1,0完全透明,1不透明)

至于游戏中为什么能半透明
原理实在是太简单
PhotoShop用过吗
就是用多图层合并办到的

你没有注意吗
游戏中的背景层都是这个游戏的画面
根本不是Windows桌面
而且此窗体非彼窗体
这根本不是Windows系统的窗体
这是游戏中画出来的窗体

这样 上层图形、下层图形 都知道了,计算一下显示的颜色,半透明效果不就出来了!
ketao_78 2002-10-27
  • 打赏
  • 举报
回复
.net下面有个属性很容易实现
w18ily 2002-10-27
  • 打赏
  • 举报
回复
制作半透明窗体和形状不规则的窗体

作者:iProgram

  请注意这是 Windows 2000 新增的API函数。

制作半透明窗体和形状不规则的窗体

函数SetLayeredWindowAttributes

  使用这个函数,可以轻松的实现半透明窗体。按照微软的要求,透明窗体窗体在创建时应使用WS_EX_LAYERED参数(用CreateWindowEx),或者在创建后设置该参数(用SetWindowLong),我选用后者。全部函数、常量声明如下:
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
   其中hwnd是透明窗体的句柄,crKey为颜色值,bAlpha是透明度,取值范围是[0,255],dwFlags是透明方式,可以取两个值:当取值为LWA_ALPHA时,crKey参数无效,bAlpha参数有效;当取值为LWA_COLORKEY时,bAlpha参数有效而窗体中的所有颜色为crKey的地方将变为透明--这个功能很有用:我们不必再为建立不规则形状的窗体而调用一大堆区域分析、创建、合并函数了,只需指定透明处的颜色值即可,哈哈哈哈!请看具体代码。
Private Const WS_EX_LAYERED = &H80000
Private Const GWL_EXSTYLE = (-20)
Private Const LWA_ALPHA = &H2
Private Const LWA_COLORKEY = &H1

代码一:一个半透明窗体
Private Sub Form_Load()
  Dim rtn As Long
  rtn = GetWindowLong(hwnd, GWL_EXSTYLE)
  rtn = rtn Or WS_EX_LAYERED
  SetWindowLong hwnd, GWL_EXSTYLE, rtn
  SetLayeredWindowAttributes hwnd, 0, 200, LWA_ALPHA
End Sub

代码二:形状不规则的窗体
Private Sub Form_Load()
  Dim rtn As Long
  BorderStyler=0
  rtn = GetWindowLong(hwnd, GWL_EXSTYLE)
  rtn = rtn Or WS_EX_LAYERED
  SetWindowLong hwnd, GWL_EXSTYLE, rtn
  SetLayeredWindowAttributes hwnd, &HFF0000, 0, LWA_COLORKEY '将扣去窗口中的蓝色
End Sub
ztchen 2002-10-27
  • 打赏
  • 举报
回复
为什么98不可能?只不过98下没有支持的库罢了。但如果对windows图形绘制熟悉的话,那又有何不可以呢?

7,763

社区成员

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧