[原]PictureBox也玩容器透明
上次TGA的项目要增加功能，在图片上再贴图片，当然需要能方便的调整新加入的图片的位置，比如可以移动后贴上的图片位置，决定了要贴在哪个位置再确定是否贴上，简单的说就是PictureBox 内再加一层象photoShop中的那种图层，图层可以移动。这样就带来了一个问题“透明”！因为后加入的图像需要透明背景不能成方形的覆盖在底图像上。想了几个办法，如透明Form或Image 控件，但是用form控件透明
上次TGA的项目要增加功能，在图片上再贴图片，当然需要能方便的调整新加入的图片的位置，比如可以移动后贴上的图片位置，决定了要贴在哪个位置再确定是否贴上，简单的说就是PictureBox 内再加一层象photoShop中的那种图层，图层可以移动。这样就带来了一个问题“透明”！因为后加入的图像需要透明背景不能成方形的覆盖在底图像上。想了几个办法，如透明Form或Image 控件，但是用form控件透明的话，不好定位坐标；而用Image 控件的话，太多方法不支持。于是查了一下资料，查到http://www.cnblogs.com/Tangf/archive/2006/04/05/367885.html刚好有实现这个功能的代码，于是仔细看了一下这个代码，发现居然和我以前制作透明窗体的代码有些类似，就想到了SetWindowRgn函数调用时用到的hWnd变量，以前是用Form控件的hWnd属性作变量，这回改成PictureBox 的hWnd属性做变量试了一下，居然也实现了http://www.cnblogs.com/Tangf/archive/2006/04/05/367885.html中给出的类模块同样的效果，有所感悟，便用我原来制作透明窗体的代码稍作调整实现了相同的功能：
代码如下:
Option
Explicit
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
Const
HWND_TOPMOST
=
-
1
Private
Const
SWP_SHOWWINDOWS
=
&
H40
Private
Const
SWP_NOZORDER
=
&
H40
Private
Sub
Form_Load()
Dim
retValue
As
Long
Me.CurrentX
=
Me.Left
/
15
: Me.CurrentY
=
Me.Top
/
15
'
retValue = SetWindowPos(Me.hWnd, HWND_TOPMOST, Me.CurrentX, Me.CurrentY, 500, 400, SWP_NOZORDER)
Call
initwin(Picture1)
'
Me.Top = 0: Me.Left = 0
End Sub
Private
Sub
initwin(Pobj
As
PictureBox)
Dim
WindowRegion
As
Long
Pobj.ScaleMode
=
vbPixels
'
图片框设置为像素
Pobj.AutoRedraw
=
True
Pobj.AutoSize
=
True
'
尺寸自动更改
Pobj.BorderStyle
=
vbBSNone WindowRegion
=
PicProc(Pobj) SetWindowRgn Pobj.hWnd, WindowRegion,
True
End Sub
Public
Function
PicProc(picSkin
As
PictureBox)
As
Long
Dim
i
As
Long
, j
As
Long
, StartLineX
As
Long
Dim
Fullr
As
Long
, Liner
As
Long
Dim
TransparentColor
As
Long
Dim
Firstr
As
Boolean
Dim
Linei
As
Boolean
Dim
hDC
As
Long
Dim
PicWidth
As
Long
Dim
PicHeight
As
Long
hDC
=
picSkin.hDC Firstr
=
True
Linei
=
False
i
=
0
j
=
0
PicWidth
=
picSkin.ScaleWidth PicHeight
=
picSkin.ScaleHeight StartLineX
=
0
TransparentColor
=
GetPixel(hDC,
0
,
0
)
For
j
=
0
To
PicHeight
-
1
For
i
=
0
To
PicWidth
-
1
If
GetPixel(hDC, i, j)
=
TransparentColor
Or
i
=
PicWidth
Then
'
透明像素
If
Linei
Then
Linei
=
False
Liner
=
CreateRectRgn(StartLineX, j, i, j
+
1
)
If
Firstr
Then
Fullr
=
Liner Firstr
=
False
Else
CombineRgn Fullr, Fullr, Liner, RGN_OR
'
刷新
DeleteObject Liner
End
If
End
If
Else
'
非透明像素
If
Not
Linei
Then
Linei
=
True
StartLineX
=
i
End
If
End
If
Next
Next
PicProc
=
Fullr
End Function
Private
Sub
Picture1_DblClick()
End
End Sub
Private
Sub
Picture1_MouseDown(Button
As
Integer
, Shift
As
Integer
, i
As
Single
, j
As
Single
) ReleaseCapture SendMessage Me.hWnd, WM_NCLBUTTONDOWN, HTCAPTION,
0
&
End Sub
其中的API定义如下：
Option
Explicit
Public
Declare
Function
GetPixel Lib
"
gdi32
"
(ByVal hDC
As
Long
, ByVal X
As
Long
, ByVal Y
As
Long
)
As
Long
Public
Declare
Function
SetWindowRgn Lib
"
user32
"
(ByVal hWnd
As
Long
, ByVal hRgn
As
Long
, ByVal bRedraw
As
Boolean
)
As
Long
Public
Declare
Function
CreateRectRgn Lib
"
gdi32
"
(ByVal X1
As
Long
, ByVal Y1
As
Long
, ByVal X2
As
Long
, ByVal Y2
As
Long
)
As
Long
Public
Declare
Function
CombineRgn Lib
"
gdi32
"
(ByVal hDestRgn
As
Long
, ByVal hSrcRgn1
As
Long
, ByVal hSrcRgn2
As
Long
, ByVal nCombineMode
As
Long
)
As
Long
Public
Declare
Function
SendMessage Lib
"
user32
"
Alias
"
SendMessageA
"
(ByVal hWnd
As
Long
, ByVal wMsg
As
Long
, ByVal wParam
As
Long
, lParam
As
Any)
As
Long
Public
Declare
Function
ReleaseCapture Lib
"
user32
"
()
As
Long
Public
Declare
Function
DeleteObject Lib
"
gdi32
"
(ByVal hObject
As
Long
)
As
Long
Public
Const
RGN_OR
=
2
Public
Const
WM_NCLBUTTONDOWN
=
&
HA1
Public
Const
HTCAPTION
=
2
在http://www.cnblogs.com/Tangf/archive/2006/04/05/367885.html中的控件使用的透明色是RGB函数给出，而上面的代码中默认的透明色是由TransparentColor = GetPixel(hDC, 0, 0)取Picture1控件那图像左上角第一点象素的颜色做透明色，当然你也可以根据自己的需要改成用参数传递进处理过程中。
这个方法同样可以完成http://topic.csdn.net/t/20010201/18/63561.html问题中的要求。
在此向提供相关资料的各位同仁表示感谢！希望大家多多交流共同进步。
权威｜前沿｜技术｜干货｜国内首个API全生命周期开发者社区
更多推荐
1
0- 0
已为社区贡献1条内容
所有评论(0)