Results 1 to 4 of 4

Thread: vb6 Transparent Control by BitBlt,Transparent Picturebox

  1. #1

    Thread Starter
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    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
    Attached Images Attached Images   
    Attached Files Attached Files

  2. #2
    PowerPoster yereverluvinuncleber's Avatar
    Join Date
    Feb 2014
    Location
    Norfolk UK (inbred)
    Posts
    2,235

    Re: vb6 Transparent Control by BitBlt,Transparent Picturebox

    I think the comments in your code could be a little more clear...

  3. #3

    Thread Starter
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    Re: vb6 Transparent Control by BitBlt,Transparent Picturebox

    Really transparent controls

    Code:
    'set Command2.Style = 1
    Command2.BackColor = vbBlue
    SetAlphaColor Command2.hWnd, vbBlue
    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
    Attached Images Attached Images  

  4. #4

    Thread Starter
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    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.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width