Модуль:
- Код: Выделить всё
Option Explicit
Public Const AC_SRC_ALPHA As Long = &H1
Public Const AC_SRC_OVER As Long = &H0
Public Const DIB_RGB_COLORS As Long = 0
Public Const GWL_EXSTYLE As Long = -20
Public Const HWND_TOPMOST As Long = -1
Public Const SWP_NOMOVE As Long = &H2
Public Const SWP_NOSIZE As Long = &H1
Public Const ULW_ALPHA As Long = &H2
Public Const WS_EX_LAYERED As Long = &H80000
Public Type GdiplusStartupInput
GdiplusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
Public Type BLENDFUNCTION
BlendOp As Byte
BlendFlags As Byte
SourceConstantAlpha As Byte
AlphaFormat As Byte
End Type
Public Type Size
cx As Long
cy As Long
End Type
Public Type POINTAPI
x As Long
y As Long
End Type
Public Type RGBQUAD
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbReserved As Byte
End Type
Public Type BITMAPINFOHEADER
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type
Public Type BITMAPINFO
bmiHeader As BITMAPINFOHEADER
bmiColors As RGBQUAD
End Type
Public Declare Function GdipDrawImageRect Lib "gdiplus" (ByVal graphics As Long, ByVal image As Long, ByVal x As Single, ByVal y As Single, ByVal Width As Single, ByVal Height As Single) As Long
Public Declare Function GdipLoadImageFromFile Lib "gdiplus" (ByVal filename As String, ByRef image As Long) As Long
Public Declare Function GdipGetImageWidth Lib "gdiplus" (ByVal image As Long, ByRef Width As Long) As Long
Public Declare Function GdipGetImageHeight Lib "gdiplus" (ByVal image As Long, ByRef Height As Long) As Long
Public Declare Function GdipDisposeImage Lib "gdiplus" (ByVal image As Long) As Long
Public Declare Function GdiplusStartup Lib "gdiplus" (ByRef token As Long, ByRef inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
Public Declare Function GdipCreateFromHDC Lib "gdiplus" (ByVal hDC As Long, ByRef graphics As Long) As Long
Public Declare Function GdipDeleteGraphics Lib "gdiplus" (ByVal graphics As Long) As Long
Public Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function CreateDIBSection Lib "gdi32.dll" (ByVal hDC As Long, ByRef pBitmapInfo As BITMAPINFO, ByVal un As Long, ByVal lplpVoid As Long, ByVal handle As Long, ByVal dw As Long) As Long
Public Declare Function CreateCompatibleDC Lib "gdi32.dll" (ByVal hDC As Long) As Long
Public Declare Function SelectObject Lib "gdi32.dll" (ByVal hDC As Long, ByVal hObject As Long) As Long
Public Declare Function SetWindowPos Lib "user32.dll" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Public Declare Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Public Declare Function UpdateLayeredWindow Lib "user32.dll" (ByVal hWnd As Long, ByVal hdcDst As Long, ByRef pptDst As POINTAPI, ByRef psize As Size, ByVal hdcSrc As Long, ByRef pptSrc As POINTAPI, ByVal crKey As Long, ByRef pblend As BLENDFUNCTION, ByVal dwFlags As Long) As Long
Public Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Public Declare Function DeleteDC Lib "gdi32.dll" (ByVal hDC As Long) As Long
Форма:
- Код: Выделить всё
Rem ////////////////////////////////////////////////////////////
Rem © BV (Boris Vorontsov, borisbox@mail.ru)
Rem ////////////////////////////////////////////////////////////
Option Explicit
Private strPNGFile As String
Private hCDC As Long
Private hBitmap As Long
Private hOldObject As Long
Private Sub Form_Activate()
Call SetWindowPos(Me.hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
End Sub
Private Sub Form_DblClick()
Unload Me
End Sub
Private Sub Form_Load()
Dim lOldLong As Long
Dim H As Long
Dim W As Long
Dim hImage As Long
Dim hGraphics As Long
Dim lToken As Long
Dim BMI As BITMAPINFO
Dim BF As BLENDFUNCTION
Dim SZ As Size
Dim PAD As POINTAPI, PAS As POINTAPI
Dim GDIPSI As GdiplusStartupInput
strPNGFile = App.Path & "\widj.png" 'Путь к маске PNG
With BMI.bmiHeader
.biSize = Len(BMI.bmiHeader)
.biBitCount = 32
.biHeight = Me.ScaleHeight
.biWidth = Me.ScaleWidth
.biPlanes = 1
.biSizeImage = .biWidth * .biHeight * (.biBitCount / 8)
End With
hCDC = CreateCompatibleDC(Me.hDC)
hBitmap = CreateDIBSection(hCDC, BMI, DIB_RGB_COLORS, ByVal 0, 0, 0)
hOldObject = SelectObject(hCDC, hBitmap)
GDIPSI.GdiplusVersion = 1
If GdiplusStartup(lToken, GDIPSI) <> 0 Then
Unload Me
End If
Call GdipCreateFromHDC(hCDC, hGraphics)
Call GdipLoadImageFromFile(StrConv(strPNGFile, vbUnicode), hImage)
Call GdipGetImageHeight(hImage, H)
Call GdipGetImageWidth(hImage, W)
Call GdipDrawImageRect(hGraphics, hImage, 0, 0, W, H)
lOldLong = GetWindowLong(Me.hWnd, GWL_EXSTYLE)
Call SetWindowLong(Me.hWnd, GWL_EXSTYLE, lOldLong Or WS_EX_LAYERED)
PAD.x = 0: PAD.y = 0
PAS.x = 0: PAS.y = 0
SZ.cx = ScaleWidth
SZ.cy = ScaleHeight
With BF
.AlphaFormat = AC_SRC_ALPHA
.BlendFlags = 0
.BlendOp = AC_SRC_OVER
.SourceConstantAlpha = 255
End With
Call GdipDisposeImage(hImage)
Call GdipDeleteGraphics(hGraphics)
Call UpdateLayeredWindow(Me.hWnd, Me.hDC, PAD, SZ, hCDC, PAS, 0, BF, ULW_ALPHA)
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Call SelectObject(hCDC, hOldObject)
Call DeleteObject(hBitmap)
Call DeleteDC(hCDC)
End Sub
Как можно увидеть, в примере используется функция UpdateLayeredWindow.
Проблема вот в чем: контролы, которые до этого находились на форме при использовании этой функции не отображаются. Как сделать, чтобы они имели место быть на форме?
Что характерно, при использовании функции того же семейства SetLayeredWindowAttributes контролы на форме есть.
Ваши варианты решения, господа?
