vb6 Transparent Control by BitBlt,Transparent Picturebox
in form1
in bas file:
in form1
Code:
TransparentWithHdc Picture1.hwnd, Picture1.HdcCode:
Public Declare Function ReleaseCapture Lib "user32" () 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 Const WM_NCLBUTTONDOWN = &HA1
Public Const HTCAPTION = 2
Public Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
'将客户区坐标系中的点转换为屏幕坐标
Public Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Public Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function BringWindowToTop Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal Hdc As Long) As Long
Public 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
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Type POINTAPI
x As Long
y As Long
End Type
Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Public Const SW_HIDE = 0
Sub TransparentWithHdc(MyHwnd As Long, MyHdc As Long)
Dim Wnd As Long
Wnd = GetParent(MyHwnd)
ShowWindow MyHwnd, SW_HIDE
'目标图片框有边框，要计算这些数据
Dim ParentDc As Long
'MyHdc = GetWindowDC(MyHwnd) '得到dc
ParentDc = GetWindowDC(Wnd) '得到dc
Dim W As Long, H As Long, W2 As Long, H2 As Long
Dim WinRect1 As RECT, ClientWh1 As RECT, ClientXY1 As POINTAPI
Dim WinRect2 As RECT, ClientWh2 As RECT, ClientXY2 As POINTAPI
GetWindowRect Wnd, WinRect1
'获取【Form】的客户区坐标系(Right=宽度,Bottom=高度）,重要,ABCD
GetClientRect Wnd, ClientWh1
'将客户区坐标系中的点p(0,0)转换为屏幕坐标（左上角位置）,重要,ABCD
ClientToScreen Wnd, ClientXY1
GetWindowRect MyHwnd, WinRect2
'获取【Form】的客户区坐标系(Right=宽度,Bottom=高度）,重要,ABCD
GetClientRect MyHwnd, ClientWh2
'将客户区坐标系中的点p(0,0)转换为屏幕坐标（左上角位置）,重要,ABCD
ClientToScreen MyHwnd, ClientXY2
W = ClientWh1.Right
H = ClientWh1.Bottom
W2 = ClientWh2.Right
H2 = ClientWh2.Bottom
DoEvents
'重要
BringWindowToTop Wnd
BitBlt MyHdc, 0, 0, W2, H2, ParentDc, ClientXY1.x - WinRect1.Left + (ClientXY2.x - ClientXY1.x), ClientXY1.y - WinRect1.Top + (ClientXY2.y - ClientXY1.y), vbSrcCopy
ReleaseDC Wnd, ParentDc
ShowWindow MyHwnd, 5
End Sub