vb6 Transparent Control by BitBlt,Transparent Picturebox
vb6 Transparent Control by BitBlt,Transparent Picturebox
in form1
Code:
TransparentWithHdc Picture1.hwnd, Picture1.Hdc
in bas file:
Code:
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
transparent by WS_EX_LAYERED ,need "project1.exe.manifest",win8 up ,support
Code:
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 WS_EX_LAYERED = &H80000
Private Const GWL_EXSTYLE = (-20)
Private Const LWA_ALPHA = &H2
Private Const LWA_COLORKEY = &H1
Function SetAlphaColor(hWnd As Long, Optional AlphaColor As Long = vbBlue) As Long
Dim rtn As Long
rtn = GetWindowLong(hWnd, GWL_EXSTYLE)
rtn = rtn Or WS_EX_LAYERED
SetWindowLong hWnd, GWL_EXSTYLE, rtn
SetLayeredWindowAttributes hWnd, AlphaColor, 0, LWA_COLORKEY
SetAlphaColor = rtn
End Function
Re: vb6 Transparent Control by BitBlt,Transparent Picturebox
Perhaps each control handle has a brush, if the image or text of any element on the whole window changes, it can intercept its event, and then modify the brush of these controls superimposed on the control.