Transparent user control (copy the control in the background of the parent window to achieve a transparent effect)
Two background pictures (001.jpg, 002.jpg), one larger and the other smaller. Please download it yourself and put it in the project directory
The biggest difficulty is that it supports DPI scaling. You can also specify only the background image of the copy window (parent object) without copying the control elements abo
In recent months, I have been researching various transparency technologies, turning existing text boxes into transparency, or adding background images. Self-developed transparent button control, PNG image control, etc. Some computers have DPI zoomed by 150%-200%. By intercepting the picture of the control's parent object (including other controls), it turns out that the size is wrong, so I wrote a DPI perception program, and the screenshot needs to be copied in equal proportions. This problem troubled me for 3 months and finally solved it. You can write it in the module, and you can use it in any form. PICTUREBOX becomes transparent, and usercontrol can also be transparent.
Two background pictures (001.jpg, 002.jpg), one larger and the other smaller. Please download it yourself and put it in the project directory
The biggest difficulty is that it supports DPI scaling. You can also specify only the background image of the copy window (parent object) without copying the control elements abo
In recent months, I have been researching various transparency technologies, turning existing text boxes into transparency, or adding background images. Self-developed transparent button control, PNG image control, etc. Some computers have DPI zoomed by 150%-200%. By intercepting the picture of the control's parent object (including other controls), it turns out that the size is wrong, so I wrote a DPI perception program, and the screenshot needs to be copied in equal proportions. This problem troubled me for 3 months and finally solved it. You can write it in the module, and you can use it in any form. PICTUREBOX becomes transparent, and usercontrol can also be transparent.
Code:
'code in form1.frm
Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function ReleaseCapture Lib "User32" () As Long
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = 2
'1, Add 001.jpg to Project Path
'2, Add Picturebox1 Control
'3, Copy This Code ,Run
Private Sub Form_Load()
Me.Picture = LoadPicture("001.jpg")
Picture1.AutoRedraw = True
Me.Caption = "drag the picture frame-transparent effect"
End Sub
Private Sub Form_Activate()
If Me.Tag = "" Then
Me.Tag = "a"
TransparentControl Picture1
End If
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
Call ReleaseCapture
Call SendMessage(Picture1.Hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)
TransparentControl Picture1
End If
End SubCode:
Option Explicit
'This Code Save To TransparentBas.bas
'100 Lines vb6 Code For TransparentControl(Picture1) 'Picturebox1
'============================
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function GetDesktopWindow Lib "User32" () As Long
Private Declare Function CreateDC& Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As Long) 'DEVMODE
Private Declare Function GetWindowDC Lib "User32" (ByVal Hwnd As Long) As Long
Private Declare Function BringWindowToTop Lib "User32" (ByVal Hwnd As Long) As Long
Private Declare Function GetParent Lib "User32" (ByVal Hwnd As Long) As Long
Private Declare Function GetWindowRect Lib "User32" (ByVal Hwnd As Long, lpRect As RECT) As Long
Private Declare Function ClientToScreen Lib "User32" (ByVal Hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function GetClientRect Lib "User32" (ByVal Hwnd As Long, lpRect As RECT) As Long
Private Declare Function ReleaseDC Lib "User32" (ByVal Hwnd As Long, ByVal hDC As Long) As Long
Private Declare Function ShowWindow Lib "User32" (ByVal Hwnd As Long, ByVal nCmdShow As Long) As Long
Private 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
Private Declare Function StretchBlt 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 nSrcWidth As Long, _
ByVal nSrcHeight As Long, _
ByVal dwRop As Long) As Long
Private Const SRCCOPY = &HCC0020 ' (DWORD) dest = source
Private Const SW_HIDE = 0
Declare Function GetDC Lib "User32" (ByVal Hwnd As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
Private Const DESKTOPHORZRES As Long = 118
Private Const HORZRES As Long = 8
Private Const LOGPIXELSX = 88
Public DpiRate As Single '本程序显示缩放倍数
Function GetDpiRate() As Single
Dim Hdc0 As Long, Pixelx As Long, PixelY As Long, MonitorW As Long, MonitorH As Long
If DpiRate = 0 Then
Hdc0 = GetDC(0)
MonitorW = GetDeviceCaps(Hdc0, DESKTOPHORZRES)
Pixelx = GetDeviceCaps(Hdc0, HORZRES) '//水平像素总数
DpiRate = MonitorW / Pixelx
If DpiRate = 0 Then DpiRate = 1
GetDpiRate = DpiRate
End If
End Function
Sub TransparentControl(Control1 As Control)
TransparentHwndHdc Control1.Hwnd, Control1.hDC
End Sub
Sub TransparentHwndHdc(MyHwnd As Long, MyHdc As Long, Optional ByVal ParentHwnd As Long)
Dim ParentDc As Long, CopyFromScreen As Boolean
If DpiRate = 0 Then GetDpiRate
ShowWindow MyHwnd, SW_HIDE
DoEvents
If ParentHwnd = -1 Then 'cut img from Screen
CopyFromScreen = True
ParentHwnd = GetDesktopWindow
ParentDc = CreateDC("DISPLAY", 0, 0, 0)
Else
If ParentHwnd = 0 Then ParentHwnd = GetParent(MyHwnd)
ParentDc = GetWindowDC(ParentHwnd)
End If
Dim AreaWidth As Long, AreaHeight As Long, WinRect1 As RECT, ClientWh2 As RECT, ClientXY2 As POINTAPI
GetWindowRect ParentHwnd, WinRect1
GetClientRect MyHwnd, ClientWh2
ClientToScreen MyHwnd, ClientXY2
AreaWidth = ClientWh2.Right
AreaHeight = ClientWh2.Bottom
BringWindowToTop ParentHwnd
If CopyFromScreen Then
StretchBlt MyHdc, 0, 0, AreaWidth, AreaHeight, ParentDc, _
DpiRate * (ClientXY2.X - WinRect1.Left), _
DpiRate * (ClientXY2.Y - WinRect1.Top) _
, AreaWidth * DpiRate, AreaHeight * DpiRate, vbSrcCopy
Else
BitBlt MyHdc, 0, 0, AreaWidth, AreaHeight, ParentDc, ClientXY2.X - WinRect1.Left, ClientXY2.Y - WinRect1.Top, vbSrcCopy '原来
End If
ReleaseDC ParentHwnd, ParentDc
ShowWindow MyHwnd, 5
End Sub