VB制作透明控件。
来源:互联网 发布:在哪里能购买淘宝号 编辑:程序博客网 时间:2024/06/08 01:25
Option ExplicitPrivate Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As LongPrivate Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As LongPrivate Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As LongPrivate Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As LongPrivate Declare Function OffsetRect Lib "user32" (lpRect As RECT, ByVal X As Long, ByVal Y As Long) As LongPrivate Type POINTAPI X As Long Y As LongEnd TypePrivate Type RECT Left As Long Top As Long Right As Long Bottom As LongEnd TypePrivate Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As LongPrivate Const DT_SINGLELINE = &H20Private Const DT_CENTER = &H1Private Const DT_VCENTER = &H4Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As LongPrivate Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As LongPrivate Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As LongPrivate Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As LongPrivate Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As LongPrivate Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As LongPrivate Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As LongPrivate Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As LongPrivate Const SW_SHOW = 5Private Const SW_HIDE = 0Private 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 LongPrivate Declare Function AlphaBlend Lib "msimg32" (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 widthSrc As Long, ByVal heightSrc As Long, ByVal blendFunct As Long) As BooleanDim m_hMemDC As LongDim m_hMemBmp As Long, m_hMemBmpPrev As LongDim m_rcControl As RECTPrivate Sub UserControl_Initialize() UserControl.AutoRedraw = True UserControl.BackColor = vbRed m_hMemDC = CreateCompatibleDC(UserControl.hdc)End SubPrivate Sub UserControl_Terminate() If m_hMemBmp <> 0 Then DeleteObject SelectObject(m_hMemDC, m_hMemBmpPrev) End If DeleteDC m_hMemDCEnd SubPublic Sub Translucence() Dim hdc As Long Dim tPt As POINTAPI '获得控件当前位置和大小 ClientToScreen UserControl.hwnd, tPt ScreenToClient UserControl.ContainerHwnd, tPt Call GetClientRect(UserControl.hwnd, m_rcControl) OffsetRect m_rcControl, tPt.X, tPt.Y '创建一幅内存位图 If m_hMemBmp <> 0 Then DeleteObject (SelectObject(m_hMemDC, m_hMemBmpPrev)) End If m_hMemBmp = CreateCompatibleBitmap(UserControl.hdc, m_rcControl.Right, m_rcControl.Bottom) m_hMemBmpPrev = SelectObject(m_hMemDC, m_hMemBmp) '隐藏控件 ShowWindow UserControl.hwnd, SW_HIDE DoEvents '保存控件容器的图像到内存位图中 Dim hDesktopDC As Long hDesktopDC = GetDC(UserControl.hwnd) BitBlt m_hMemDC, 0, 0, m_rcControl.Right, m_rcControl.Bottom, hDesktopDC, 0, 0, vbSrcCopy ReleaseDC 0, hDesktopDC '通过alpha效果进行半透明渲染 UserControl.AutoRedraw = True AlphaBlend m_hMemDC, 0, 0, m_rcControl.Right, m_rcControl.Bottom, UserControl.hdc, 0, 0, m_rcControl.Right, m_rcControl.Bottom, 5242880 UserControl.AutoRedraw = False '显示控件 ShowWindow UserControl.hwnd, SW_SHOW '将渲染后的结果复制到控件中 BitBlt UserControl.hdc, 0, 0, m_rcControl.Right, m_rcControl.Bottom, m_hMemDC, 0, 0, vbSrcCopyEnd SubPrivate Sub UserControl_Paint() BitBlt UserControl.hdc, 0, 0, m_rcControl.Right, m_rcControl.Bottom, m_hMemDC, 0, 0, vbSrcCopyEnd Sub
然后 ,在FORM中调用即可实现!
private sub form_load()UserControl11.TranslucenceEnd sub
- VB制作透明控件。
- 透明控件的制作
- vb透明控件窗体不透明函数
- vb 窗体透明效果(控件不透明)
- 【VB】窗体透明一:窗体透明,控件不透明(穿过)
- 【VB】窗体透明三:窗体、控件变透明
- [原创][VB.NET] 用LayeredWindow制作PNG透明窗体心得
- VB无所不能之四:制作透明和半透明窗体
- VB中用第三方控件制作资源管理器
- VB中用第三方控件制作资源管理器
- VB自定义控件的制作,ACTIVEX,.OCX
- 如何使用VB制作OCX控件
- [VB.NET].net 下窗体透明,窗体上控件不透明
- VB.NET 实现自定义控件的透明背景
- vb 让PictureBox控件透明 可加载gif 图片
- VB中如何让text控件设置成透明
- Vb.net 控件背景色透明设置BackColor 和Parent
- 【VB】窗体透明二:窗体逐渐变透明(包括控件)
- java 关于split函数
- Hibernate工作机制
- 《大数据》笔记 相似项发现
- Struts2原理
- 学而知之
- VB制作透明控件。
- php实战第三天
- UItableview自适应高度
- Spring工作机制及为什么要用?
- vim 编译器的配置
- 国外程序员是如何准备面试的
- struts2用户界面之标注标签
- 《程序员的思维修炼》——别鄙视方法论
- Xcode代码格式化利器——XEP