AlphaBlend 在一个软件的一台机器上失败

Question

我正在使用与如下声明相同的 AlphaBlend 函数：

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

在某些机器上，我的代码工作得非常好，并且完全按照它应该做的去做。

在一台机器上，相同的代码在应用程序 A 中运行良好，但相同的代码在应用程序 B 中使 AlphaBlend 失败。

想象一下：你有 2 个同卵双胞胎，他们都在吃一个苹果。两个苹果完全一样

一个双胞胎成功吞下了它，另一个双胞胎在尝试这样做时死了。

GetLastError returns 0.

我该如何调查问题所在？

一些机器，一切正常。

然而，在有问题的一台机器上，我在两个应用程序中编译了完全相同的代码运行：应用程序 A 和应用程序 B。

在应用程序A中，AlphaBlend失败，在应用程序B中，AlphaBlend成功。它总是在应用程序 A 中失败。

我什至怀疑 VB6 的理智并检查“Len”是否确实 returns 正确的长度。

我使用 VB6 已有 20 年了，但我从未经历过如此疯狂的事情。

有人知道为什么相同的代码可能会在那个应用程序中失败吗？

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

Answer 1

由于这是特定于机器的（假设它是准确的），因此两个程序 A 和 B 可能没有加载相同的副本 MSIMG32.dll。

我会检查：PC 上是否有该 DLL 的多个副本？特别是如果程序文件夹中有 A 或 B 的副本？

您还可以运行进程监视器并观察运行ning 程序以准确查看正在加载的 DLL。这至少可以确认它们都运行正在使用相同的 DLL 并将其作为潜在原因消除。

除此之外，我个人会加入一些调试日志记录并真正验证失败函数的输入是否相同。

Answer 2

当 OS 设置为高 DPI 设置（例如以 150% 显示所有内容）并且如果应用程序具有声明 dpiaware=true.

的清单时，就会出现问题

有 2 种可能的解决方案：

从清单中删除 dpiaware
也向其他进程添加一个清单，并在该清单中也声明 dpiaware=true。这样两个过程之间就没有差异了。这当然只适用于您的产品/流程，并且您可以使用清单对其进行编译。

AlphaBlend 在一个软件的一台机器上失败

AlphaBlend fails on one machine in one software

api

vb6