原tab控件，仿360开关控件版权归原作者! VB控件背景透明代码来自：新浪 “玄雨清风”的博客 感谢以上两位源代码作者 链接:http://pan.baidu.com/s/1hrAEXqG 密码:nfhc '-----------------------以下是转自博客的控件透明源代码(可透明至父窗体或桌面)------------- '添加一个用户控件UserControl,代如下： Option Explicit '实现用户控件UserControl的"伪透明" 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 GetDC Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC 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 GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Private Const WM_ERASEBKGND = &H14 Private Const WM_PAINT = &HF Private Const SRCCOPY = &HCC0020 ' (DWORD) dest = source Public Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Public Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Public Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Private m_BK As Boolean '复制控件在父窗口的背景 Private Sub CopyParentBackground(ByVal phWnd As Long, ByVal chWnd As Long, ByVal hDestDC As Long) Dim lpRect As RECT, lpPoint As POINTAPI, nWidth As Long, nHeight As Long Dim BitMap As Long, oldBitMap As Long, hDC As Long, memDC As Long Call GetWindowRect(phWnd, lpRect) 'Call GetClientRect(phWnd, lpRect) nWidth = lpRect.Right - lpRect.Left '获取控件的宽度 nHeight = lpRect.Bottom - lpRect.Top '获取控件的高度 hDC = GetDC(0) BitMap = CreateCompatibleBitmap(hDC, nWidth, nHeight) Call ReleaseDC(0, hDC) memDC = CreateCompatibleDC(0) oldBitMap = SelectObject(memDC, BitMap) Call SendMessage(phWnd, WM_ERASEBKGND, memDC, 0) Call SendMessage(phWnd, WM_PAINT, memDC, 0) '至此memDC上已经保存了父窗口的背景内容 '用户可以调用BitBlt(...)等函数拷贝memDC的内容到子窗口的某个区域， '这样就达到了透明效果; Call GetWindowRect(chWnd, lpRect) lpPoint.X = lpRect.Left lpPoint.Y = lpRect.Top Call ScreenToClient(phWnd, lpPoint) '获取控件在父窗口的左上角位置 Call BitBlt(hDestDC, 0, 0, nWidth, nHeight, memDC, lpPoint.X, lpPoint.Y, SRCCOPY) ''''''''''''''''''''''复制背景之后,在这里可以其他事情'''''''''''''''''''''''''''' UserControl.CurrentY = 10 UserControl.Print "透明用户控件" UserControl.Refresh ' Call SelectObject(memDC, oldBitMap) Call DeleteDC(memDC) Call DeleteObject(BitMap) End Sub '复制控件在屏幕的背景 Private Sub CopyScreenBackground(ByVal phWnd As Long, ByVal chWnd As Long, ByVal hDestDC As Long) Dim lpRect As RECT, nWidth As Long, nHeight As Long, hDC As Long Call GetWindowRect(chWnd, lpRect) nWidth = lpRect.Right - lpRect.Left '获取控件的宽度 nHeight = lpRect.Bottom - lpRect.Top '获取控件的高度 ShowWindow chWnd, 0 '隐藏 DoEvents hDC = GetDC(0) Call BitBlt(hDestDC, 0, 0, nWidth, nHeight, hDC, lpRect.Left, lpRect.Top, SRCCOPY) Call ReleaseDC(0, hDC) ShowWindow chWnd, 5 '显示 ''''''''''''''''''''''复制背景之后,在这里可以其他事情'''''''''''''''''''''''''''' UserControl.CurrentY = 10 UserControl.Print "透明用户控件" UserControl.Refresh End Sub Private Sub UserControl_Initialize() UserControl.ScaleMode = vbPixels End Sub Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) RaiseEvent MouseDown(Button, Shift, X, Y) End Sub Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) RaiseEvent MouseMove(Button, Shift, X, Y) End Sub Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) RaiseEvent MouseUp(Button, Shift, X, Y) CopyBKImage m_BK End Sub Private Sub UserControl_Resize() On Error Resume Next CopyBKImage m_BK End Sub Private Sub UserControl_Show() CopyBKImage m_BK End Sub Public Property Let CopyBKMode(ByVal bkm As Boolean) m_BK = bkm End Property Public Property Let BorderStyle(BStyle As Boolean) If BStyle = True Then UserControl.BorderStyle = 1 Else UserControl.BorderStyle = 0 End If End Property Public Sub Refresh() CopyBKImage m_BK UserControl.Refresh End Sub Private Sub CopyBKImage(Optional ByVal flag As Boolean = False) If flag = True Then CopyScreenBackground UserControl.Parent.hwnd, UserControl.hwnd, UserControl.hDC Else CopyParentBackground UserControl.Parent.hwnd, UserControl.hwnd, UserControl.hDC End If End Sub '''''''''''''''''''''''''''''''调用实例''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''Form1代码'''''''''''''''''''''''''''''' Option Explicit Dim LabX As Single, LabY As Single, IsMouseDownLab As Boolean Private Sub ctl1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) IsMouseDownLab = True LabX = X: LabY = Y End Sub Private Sub ctl1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) If IsMouseDownLab = True Then '移动ctl1的位置 If Button = 1 Then ctl1.Move ctl1.Left + Me.ScaleX(X - LabX, 3, 3), ctl1.Top + ScaleX(Y - LabY, 3, 3) End If End Sub Private Sub ctl1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) IsMouseDownLab = False End Sub Private Sub Form_Load() Me.ScaleMode = vbPixels ctl1.CopyBKMode = True '复制控件在屏幕的背景 ctl2.CopyBKMode = False '默认值,复制控件在父窗口的背景 ctl2.BorderStyle = True '有边框 ctl1.BorderStyle = False '无边框 End Sub

实现C# 透明控件的概念 解决多个窗体置顶问题 背景半透明 解决控件半透明问题

工程采用的VS2008开发实现了窗口透明而控件不透明。具体的代码中间包含了很多我在尝试的时候注释的代码。另外就是SetLayeredWindowAttributes这个函数在VC6.0中间使用需要链接其它的库，具体方法请参照网上说明。因为这里我使用的是VS2008所以不需要链接其它的库。 程序中的对话框的分层属性必须被选中（因为我没有使用代码在程序中自动设置分层属性，所以需要手动设置）。如果没有选择分层属性。函数SetLayeredWindowAttributes将无效。

可以很方便的开发类似日历的软件。有鼠标穿透功能。

winform窗体上叠加一些透明控件,基于DSkin框架实现。效果优美，无锯齿. （DSKIN属于商业版 而非开源框架）,开发需官网购买授权码 ,请考虑后下载..

Demo包含一些自定义控件(下拉列表，树形列表 ， 图片列表等)均可实现透明效果。主窗体是一个海康相机的监控视频。使用时可替换成其他视频。