先将图片绘制到hDC上
用光栅运算分离掩码图(http://expert.csdn.net/Expert/topic/1293/1293155.xml?temp=.4505274)
再将其转为区域(http://expert.csdn.net/Expert/topic/1296/1296655.xml?temp=9.252566E-02)
用SetWindowRgn设置窗口显示区域
SetWindowRgn VB声明
Declare Function SetWindowRgn Lib "user32" Alias "SetWindowRgn" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
说明
这是那些很难有人注意到的对编程者来说是个巨大的宝藏的隐含的API函数中的一个。本函数允许您改变窗口的区域。
通常所有窗口都是矩形的——窗口一旦存在就含有一个矩形区域。本函数允许您放弃该区域。这意味着您可以创建圆的、星形的窗口,也可以将它分为两个或许多部分——实际上可以是任何形状
返回值
Long,执行成功为非零值,失败为0
参数表
参数 类型及说明
hWnd Long,将设置其区域的窗口
hRgn Long,将设置的区域的句柄,一旦设置了该区域,就不能使用或修改该区域句柄,也不要删除它
bRedraw Boolean,若为TRUE,则立即重画窗口
注解
为区域指定的所有坐标都以窗口坐标(不是客户坐标)表示,它们以整个窗口(包括标题栏和边框)的左上角为起点
用光栅运算分离掩码图(http://expert.csdn.net/Expert/topic/1293/1293155.xml?temp=.4505274)
再将其转为区域(http://expert.csdn.net/Expert/topic/1296/1296655.xml?temp=9.252566E-02)
用SetWindowRgn设置窗口显示区域
SetWindowRgn VB声明
Declare Function SetWindowRgn Lib "user32" Alias "SetWindowRgn" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
说明
这是那些很难有人注意到的对编程者来说是个巨大的宝藏的隐含的API函数中的一个。本函数允许您改变窗口的区域。
通常所有窗口都是矩形的——窗口一旦存在就含有一个矩形区域。本函数允许您放弃该区域。这意味着您可以创建圆的、星形的窗口,也可以将它分为两个或许多部分——实际上可以是任何形状
返回值
Long,执行成功为非零值,失败为0
参数表
参数 类型及说明
hWnd Long,将设置其区域的窗口
hRgn Long,将设置的区域的句柄,一旦设置了该区域,就不能使用或修改该区域句柄,也不要删除它
bRedraw Boolean,若为TRUE,则立即重画窗口
注解
为区域指定的所有坐标都以窗口坐标(不是客户坐标)表示,它们以整个窗口(包括标题栏和边框)的左上角为起点
解决方案 »
- 求CRC16 vb版代码
- 请大家帮个忙,朋友儿子刚出生,急需取名,请各位大侠支招,大分赠送
- InstallShield里主程序安装前先安装某组件怎么做?
- 关于OCX控件你真的了解吗?????????????????????
- 利用CommonDialog控件如何实现打印和保存Picture控件中的图像?100分!
- VB6反编译工具
- ADO与Oracle的连接?
- 关于如何编写无插件数据库系统程序
- 不一般的access数据库备份?
- 小白请教VB
- VB基础问题--CommonDialog控件
- 关于msgbox的疑问,当需要返回值时,使用aa=msgbox(....)来体现,反之仅使用msgbox "aa",...来体现.请问
Private Sub Command1_Click()
Print "Hello"
End Sub
Private Sub Command2_Click()
End
End Sub
这 两 个 按 钮 一 个 用 于 终 止 程 序 运 行 , 一 个 用 于 显 示 文 字 。
然 后 , 将 Form的 Border设 为 None。
最 后 , 在 Form的 声 明 部 分 加 上 以 下 代 码 :
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 SetParent Lib "user32" (ByVal hWndChild _
As Long, ByVal hWndNewParent As Long) As Long
Const WS_EX_TRANSPARENT = &H20&
Const GWL_EXSTYLE = (-20)
最 后 , 在 Form中 加 上 如 下 代 码 。
Private Sub Form_Load()
SetWindowLong hwnd, GWL_EXSTYLE, WS_EX_TRANSPARENT
End Sub
这是一个很奇特的功能,首先要让Form变透明,接着,放一张背景透明的.gif图进来,如此,这变成一个透明的form,上面有许多Button,且图不会是一个方形,而会让图的背景透通。但有一点要注意,这种透明的Form不可以移动,否则一移就会发现它似乎不是透明的,这个很不好解释,建议您一开始设定Form的BorderStyle = 2 大小可变可移动,而去移动与更动小大,便可以知道。因此,在设计阶段时,一定要设BorderStyle = 0 没有框线,这样子您的Form才不会有问题。
首先我使用以下的程式码令Form变透明注:有适当的软体(如 MS PhotEditor)可以将图变成背景透通(引用 老怪之言)Me.AutoRedraw = True
hBitmap = CreateCompatibleBitmap(Me.hdc, 0, 0)
SelectObject Me.hdc, hBitmap
Me.Refresh
而透明的图形呢,那需要那一种背景透通性的.GIF档,在Form上放一个Image Control,将
图放到Image Control,那就OK了注释:需一个Image Control , 一个Command1
Option Explicit
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 CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private hBitmap As LongPrivate Sub Command1_Click()
Unload Me
End SubPrivate Sub Form_Load()
注释:事先请设form的BorderStyle = 0 没有框线
Me.AutoRedraw = True
Set Image1.Picture = LoadPicture("e:\bubbles.gif") 注释:请自行找一个背景透明的图
hBitmap = CreateCompatibleBitmap(Me.hdc, 0, 0)
SelectObject Me.hdc, hBitmap
Me.Refresh
End SubPrivate Sub Form_Unload(Cancel As Integer)
DeleteObject hBitmap
End Sub
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 Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function ExtCreateRegion Lib "gdi32" (lpXform As Long, ByVal nCount As Long, lpRgnData As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As LongPrivate Const WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = 2
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 Sub Command1_Click()
Dim x, y As Integer '当前象素坐标
Dim Red, Green, Blue As Integer '当前象素红,绿,篮组分
Dim Pixel As Long '当前象素点
Dim StarPos, EndPos As Integer '合并区域起点,终点坐标
Dim FirstPoint, AlSet As Integer
Dim FRgn As Integer '起始区域标记
Dim Rgn1, Rgn2, value As Long '显示区域缓冲区
Dim a As Integer
Dim CRed, CGreen, CBlue As Integer '不显示区域颜色标记
'获取不显示颜色
Pixel = Form1.Picture1.Point(1, 1)
CRed = Pixel Mod 256
CGreen = ((Pixel And &HFF00) / 256&) Mod 256&
CBlue = (Pixel And &HFF0000) / 65536FRgn = 0
FirstPoint = 0
AlSet = 0'注意:必须把Form和Picture的ScaleMode 属性设为3-Pixel
'你可改进以下算法使计算更快For y = 0 To Picture1.Height
For x = 0 To Picture1.Width
Pixel = Form1.Picture1.Point(x, y)
Red = Pixel Mod 256
Green = ((Pixel And &HFF00) / 256&) Mod 256&
Blue = (Pixel And &HFF0000) / 65536
If Not (Red = CRed And Green = CGreen And Blue = CBlue) Then '判断当前点是否为显示点
If FirstPoint = 0 Then '判断该点是否为显示区域起点,0为是起点
StarPos = x '区域起点为当前点
EndPos = x '设置结束点坐标
FirstPoint = 1 '
AlSet = 0
Else '不为起点
EndPos = x '设置终点坐标
AlSet = 1 '设置区域选定标志
End If
Else '该点为不显示点
If AlSet = 1 Then '已经标记区域
If FRgn = 0 Then '判断是否为起始区域,0为是
FRgn = 1 '设定已有区域标志
Rgn1 = CreateRectRgn(StarPos + 1, y, EndPos, y + 1) '建立显示区域
Else '已经存在显示区域
Rgn2 = CreateRectRgn(StarPos + 1, y, EndPos, y + 1) '建立要与Rgn1合并的区域
If Rgn2 <> 0 Then '建立区域2成功
value = CombineRgn(Rgn1, Rgn1, Rgn2, 2) '合并区域1和区域2
Form1.Picture1.Line (StarPos + 1, y)-(EndPos, y), RGB(2 * y, y * 3, y / 1.5) '显示已合并区域(可不要)
End If
DeleteObject (Rgn2) '删除区域2
End If
End If
FirstPoint = 0 '初始化新区域起点
End If
Next x
Next yIf Rgn1 <> 0 Then
Picture1.Visible = False
SetWindowRgn hwnd, Rgn1, True '显示上面建立的区域
Dim ReginData As Byte
Dim RgnSize As Long
'由于VB数据类型的现在我无法用API函数获得Rgn1里的数据,并将这些数据存盘。
'如有如果真的使用以上代码来实现一个不规则窗体,那真是一场噩梦,每次都等上一两分钟窗体才显示完。
'你可以通过由我提供的"ReginDll.dll",来完成以上计算过程,并把计算得到数据存盘
'以后每次运行只要读入区域数据,并显示这个区域即可,而且速度快得感觉不到!!
'由于“ReginDll.dll” 由C++编写,速度极快,计算时间比VB至少快3倍。
End If
DeleteObject (Rgn1) '删除区域1
End Sub