ViOrb/LayerdWindowSupport.bas at master · lee-soft/ViOrb · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
Attribute VB_Name = "LayerdWindowSupport"
'--------------------------------------------------------------------------------
'    Component  : LayerdWindowSupport
'    Project    : ViOrb5
'
'    Description: Containts helper functions for layered windows
'
'    Modified   :
'--------------------------------------------------------------------------------
Option Explicit

Public Declare Function UpdateLayeredWindow _
               Lib "user32.dll" (ByVal hWnd As Long, _
                                 ByVal hdcDst As Long, _
                                 pptDst As Any, _
                                 psize As Any, _
                                 ByVal hdcSrc As Long, _
                                 pptSrc As Any, _
                                 ByVal crKey As Long, _
                                 ByRef pblend As BLENDFUNCTION, _
                                 ByVal dwFlags As Long) As Long

Private m_layeredAttrBank As Collection

Public Const ULW_ALPHA = &H2

Public Const WS_EX_LAYERED = &H80000

Public Const AC_SRC_ALPHA As Long = &H1

Public Const AC_SRC_OVER = &H0

Public Type BLENDFUNCTION

    BlendOp As Byte
    BlendFlags As Byte
    SourceConstantAlpha As Byte
    AlphaFormat As Byte

End Type

Public Enum AnchorPointConstants

    apTopLeft = 1
    apTop = 5
    apBottomLeft = 2
    apLeft = 6
    apBottomRight = 3
    apBottom = 7
    apTopRight = 4
    apRight = 8
    apMiddle = 9

End Enum

Public Function MakeLayerdWindow(ByRef sourceForm As Form, _
                                 Optional fromExistingLayeredWindow As Boolean = True, _
                                 Optional clickThrough As Boolean = False) As LayerdWindowHandles

    Dim KeyName As String

    KeyName = sourceForm.hWnd & "_hwnd"

    If m_layeredAttrBank Is Nothing Then
        Set m_layeredAttrBank = New Collection
    End If

    If ExistInCol(m_layeredAttrBank, KeyName) Then
        If fromExistingLayeredWindow Then
            m_layeredAttrBank(KeyName).Release
            m_layeredAttrBank.Remove KeyName
        Else
            Set MakeLayerdWindow = m_layeredAttrBank(KeyName)
            Call SetWindowLong(sourceForm.hWnd, GWL_EXSTYLE, GetWindowLong(sourceForm.hWnd, GWL_EXSTYLE) Or WS_EX_LAYERED)

            Exit Function

        End If
    End If

    Dim srcPoint   As win.POINTL

    Dim winSize    As win.SIZEL

    Dim mDC        As Long

    Dim tempBI     As BITMAPINFO

    Dim mainBitmap As Long

    Dim oldBitmap  As Long

    Dim theHandles As New LayerdWindowHandles

    Dim newStyle   As Long

    m_layeredAttrBank.Add theHandles, sourceForm.hWnd & "_hwnd"

    With tempBI.bmiHeader
        .biSize = Len(tempBI.bmiHeader)
        .biBitCount = 32    ' Each pixel is 32 bit's wide
        .biHeight = sourceForm.ScaleHeight  ' Height of the form
        .biWidth = sourceForm.ScaleWidth    ' Width of the form
        .biPlanes = 1   ' Always set to 1
        .biSizeImage = .biWidth * .biHeight * (.biBitCount / 8) ' This is the number of bytes that the bitmap takes up. It is equal to the Width*Height*ByteCount (bitCount/8)
    End With

    mDC = CreateCompatibleDC(sourceForm.hdc)
    mainBitmap = CreateDIBSection(mDC, tempBI, DIB_RGB_COLORS, ByVal 0, 0, 0)

    If mainBitmap = 0 Then
        MsgBox "CreateDIBSection Failed", vbCritical

        Exit Function

    End If

    oldBitmap = SelectObject(mDC, mainBitmap)   ' Select the new bitmap, track the old that was selected

    If oldBitmap = 0 Then

        'MsgBox "SelectObject Failed", vbCritical
        Exit Function

    End If

    newStyle = GetWindowLong(sourceForm.hWnd, GWL_EXSTYLE)
    newStyle = newStyle Or WS_EX_LAYERED

    If (clickThrough) Then
        newStyle = newStyle Or WS_EX_TRANSPARENT
    End If

    If SetWindowLong(sourceForm.hWnd, GWL_EXSTYLE, newStyle) = 0 Then
        'MsgBox "Failed to create layered window!"
        'Exit Function
    End If

    ' Needed for updateLayeredWindow call
    srcPoint.x = 0
    srcPoint.y = 0
    winSize.cx = sourceForm.ScaleWidth
    winSize.cy = sourceForm.ScaleHeight

    theHandles.mainBitmap = mainBitmap
    theHandles.oldBitmap = oldBitmap
    theHandles.theDC = mDC

    theHandles.SetSize winSize
    theHandles.SetPoint srcPoint
    'theHandles.
    Set MakeLayerdWindow = theHandles

Handler:
End Function