I am using the same AlphaBlend function as declared like this:
Public Declare Function AlphaBlend Lib "MSIMG32.dll" (ByVal hDCDest As Long, ByVal nXOriginDest As Long, ByVal nYOriginDest As Long, ByVal nWidthDest As Long, ByVal nHeightDest As Long, ByVal hDCSrc As Long, ByVal nXOriginSrc As Long, ByVal nYOriginSrc As Long, ByVal nWidthSrc As Long, ByVal nHeightSrc As Long, ByVal lBlendFunction As Long) As Long
There are some machines where my code works perfectly fine and does exactely what it should.
On one machine, the very same code works fine in application A, but the same code in application B makes AlphaBlend fail.
Imagine the following: You have 2 identical twins both eating an apple. Both apples are perfectly the same.
One twin swallows it successfully, the other twin dies trying to do so.
GetLastError returns 0.
How could I investigate what goes wrong?
One some machines, all is fine.
On the one machine in question however, I have compiled the very same code running in two applications: Application A and application B.
In application A, AlphaBlend fails, and in application B, AlphaBlend succeeds. And it's ALWAYS that it fails in application A.
I have even doubted VB6's sanity and checked if "Len" actually returns the correct length.
I use VB6 since 20 years, but I have never experienced something that crazy.
Does anybody have any idea why the same code might fail in that one application?
Option Explicit
Private Declare Function GetLastError Lib "kernel32" () As Long
Private Declare Function AlphaBlend Lib "MSIMG32.dll" (ByVal hDCDest As Long, ByVal nXOriginDest As Long, ByVal nYOriginDest As Long, ByVal nWidthDest As Long, ByVal nHeightDest As Long, ByVal hDCSrc As Long, ByVal nXOriginSrc As Long, ByVal nYOriginSrc As Long, ByVal nWidthSrc As Long, ByVal nHeightSrc As Long, ByVal lBlendFunction As Long) As Long
Private Declare Function FindWindow Lib "USER32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Sub MoveMemory Lib "Kernel32.dll" 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 Long
Private Declare Function GetDC Lib "USER32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseDC Lib "User32.dll" (ByVal hWnd As Long, ByVal hdc As Long) As Long
Private Type BLENDFUNCTION
BlendOp As Byte
BlendFlags As Byte
SourceConstantAlpha As Byte
AlphaFormat As Byte
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Const AC_SRC_OVER = &H0
Private Sub Timer1_Timer()
Dim lHwnd&
lHwnd = FindWindow(vbNullString, "twsseetechcamwin")
If lHwnd = 0 Then
Me.Caption = "is null!"
Exit Sub
End If
Me.Caption = "ok"
Dim LBF As Long
Dim bf As BLENDFUNCTION
With bf
.BlendOp = AC_SRC_OVER
.SourceConstantAlpha = 255
End With
Dim lLen&
lLen = Len(bf) 'just check for sanity... I wanted to make sure that it's 4, and it indeed is
Call MoveMemory(LBF, bf, Len(bf)) 'Copy struct into a Long var
Dim rOtherWin As RECT
GetClientRect lHwnd, rOtherWin
Dim lOtherDC&
lOtherDC = GetDC(lHwnd)
Dim r As RECT
GetClientRect Me.hWnd, r
Dim lret&
lret = AlphaBlend(Me.hdc, 0, 0, (r.Right - r.Left), (r.Bottom - r.Top), lOtherDC, 0, 0, (rOtherWin.Right - rOtherWin.Left), (rOtherWin.Bottom - rOtherWin.Top), LBF)
Dim lWinErr&
lWinErr = GetLastError()
Me.Caption = Time & " ret: " & lret & ", err: " & lWinErr&
ReleaseDC lHwnd, lOtherDC
End Sub
The problem occurs when the OS is set to high DPI settings (like display everything in 150%) AND if the application has a manifest that states dpiaware=true.
There are 2 possible solutions:
dpiaware from the manifestdpiaware=true in that manifest, too. This way there is no discrepancy between the 2 processes. This of course only works if it's your product / process, and you have the possibility to compile it with a manifest.