Помогите решить проблему с TransparentBlt в Win98 и т.п.!!!!

[MagicMan]

Добрый День!!!

Столкнулся с траблой - после длительной работы над проектом наткнулся на то что под 98 прога не запускается - пишет не найден msimg32.dll - хотя в системе он есть. Порылся в инете - в микрософте написано что под 98 и т.п. команда TransparentBlt может обрабатываться некорректно - а как решить не пишут!!!! Эта команда пристутствует в компоненте кнопки в стиле XP - файл .ctl я выложил на http://www.anti-spammer.ru/files/xpb.zip и прикрепил к этому посту.
Выход есть - это заменить все кнопки - но у меня их больше сотни!!! Думаю есть решение по гуманнее.....

Жду совета,
Юрий.

ICQ: 75006889
magicman@anti-spammer.ru

[GSerg]

Когда-то я тут набрасывал... Ага...

Код: Выделить всё

Public Sub TransparentBlt(ByVal hdc 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 crTransparent As Long, _
                          Optional ByVal tmpMaskDC As Long = 0, _
                          Optional ByVal tmpInterDC As Long = 0, _
                          Optional ByVal tmpResultDC As Long = 0)
                         
  'Если предполагаются интенсивные вызовы, то неэффективно каждый раз
  'создавать и удалять DC. Поэтому можно создать их один раз в
  'вызывающем модуле, а сюда передавать через параметры. Тогда здесь ничего
  'не будет создаваться/удаляться.
  'Ответственность за наличие битмапов нужных типов в этих DC несёт вызывающий.
 
  Dim tmpMaskBitmap As Long
  Dim tmpResultBitmap As Long
  Dim tmpInterBitmap As Long
  Dim prevBkColor As Long
 
  If tmpMaskDC = 0 Then
    tmpMaskDC = CreateCompatibleDC(hdc)
    tmpMaskBitmap = CreateBitmap(nWidth, nHeight, 1, 1, ByVal 0&)
    DeleteObject SelectObject(tmpMaskDC, tmpMaskBitmap)
  End If
 
  If tmpInterDC = 0 Then
    tmpInterDC = CreateCompatibleDC(hSrcDC)
    tmpInterBitmap = CreateCompatibleBitmap(hSrcDC, nWidth, nHeight)
    DeleteObject SelectObject(tmpInterDC, tmpInterBitmap)
  End If
 
  If tmpResultDC = 0 Then
    tmpResultDC = CreateCompatibleDC(hdc)
    tmpResultBitmap = CreateCompatibleBitmap(hdc, nWidth, nHeight)
    DeleteObject SelectObject(tmpResultDC, tmpResultBitmap)
  End If
 
  'Маска накладываемой картинки -> maskDC
  prevBkColor = SetBkColor(hSrcDC, crTransparent)
  BitBlt tmpMaskDC, 0, 0, nWidth, nHeight, hSrcDC, xSrc, ySrc, vbNotSrcCopy
  SetBkColor hSrcDC, prevBkColor
 
  'Копия накладываемой картинки -> interDC
  BitBlt tmpInterDC, 0, 0, nWidth, nHeight, hSrcDC, xSrc, ySrc, vbSrcCopy
 
  'Маскированная накладываемая картинка -> interDC
  BitBlt tmpInterDC, 0, 0, nWidth, nHeight, tmpMaskDC, 0, 0, vbSrcAnd
 
  'Копия фона -> resultDC
  BitBlt tmpResultDC, 0, 0, nWidth, nHeight, hdc, x, y, vbSrcCopy
 
  'Инвертируем маску
  BitBlt tmpMaskDC, 0, 0, nWidth, nHeight, 0, 0, 0, vbDstInvert
 
  'Маскированный обратной маской фон -> resultDC
  BitBlt tmpResultDC, 0, 0, nWidth, nHeight, tmpMaskDC, 0, 0, vbSrcAnd
 
  'Слияние двух маскированных картинок через XOR
  BitBlt tmpResultDC, 0, 0, nWidth, nHeight, tmpInterDC, 0, 0, vbSrcPaint
 
  'Вывод результата
  BitBlt hdc, x, y, nWidth, nHeight, tmpResultDC, 0, 0, vbSrcCopy
 
  If tmpMaskBitmap Then DeleteDC tmpMaskDC: DeleteObject tmpMaskBitmap
  If tmpInterBitmap Then DeleteDC tmpInterDC: DeleteObject tmpInterBitmap
  If tmpResultBitmap Then DeleteDC tmpResultDC: DeleteObject tmpResultBitmap
End Sub

Public Sub TransparentStretchBlt(ByVal hdc 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 nSrcWidth As Long, ByVal nSrcHeight, _
                          ByVal crTransparent As Long, _
                          Optional ByVal tmpMaskDC As Long = 0, _
                          Optional ByVal tmpInterDC As Long = 0, _
                          Optional ByVal tmpResultDC As Long = 0)
 
  Dim tmpMaskBitmap As Long
  Dim tmpResultBitmap As Long
  Dim tmpInterBitmap As Long
  Dim prevBkColor As Long
 
  If tmpMaskDC = 0 Then
    tmpMaskDC = CreateCompatibleDC(hdc)
    tmpMaskBitmap = CreateBitmap(nWidth, nHeight, 1, 1, ByVal 0&)
    DeleteObject SelectObject(tmpMaskDC, tmpMaskBitmap)
  End If
 
  If tmpInterDC = 0 Then
    tmpInterDC = CreateCompatibleDC(hSrcDC)
    tmpInterBitmap = CreateCompatibleBitmap(hSrcDC, nWidth, nHeight)
    DeleteObject SelectObject(tmpInterDC, tmpInterBitmap)
  End If
 
  If tmpResultDC = 0 Then
    tmpResultDC = CreateCompatibleDC(hdc)
    tmpResultBitmap = CreateCompatibleBitmap(hdc, nWidth, nHeight)
    DeleteObject SelectObject(tmpResultDC, tmpResultBitmap)
  End If
 
  'Маска накладываемой картинки -> maskDC
  prevBkColor = SetBkColor(hSrcDC, crTransparent)
  StretchBlt tmpMaskDC, 0, 0, nWidth, nHeight, hSrcDC, xSrc, ySrc, nSrcWidth, nSrcHeight, vbNotSrcCopy
  SetBkColor hSrcDC, prevBkColor
 
  'Копия накладываемой картинки -> interDC
  StretchBlt tmpInterDC, 0, 0, nWidth, nHeight, hSrcDC, xSrc, ySrc, nSrcWidth, nSrcHeight, vbSrcCopy
 
  'Маскированная накладываемая картинка -> interDC
  BitBlt tmpInterDC, 0, 0, nWidth, nHeight, tmpMaskDC, 0, 0, vbSrcAnd
 
  'Копия фона -> resultDC
  BitBlt tmpResultDC, 0, 0, nWidth, nHeight, hdc, x, y, vbSrcCopy
 
  'Инвертируем маску
  BitBlt tmpMaskDC, 0, 0, nWidth, nHeight, 0, 0, 0, vbDstInvert
 
  'Маскированный обратной маской фон -> resultDC
  BitBlt tmpResultDC, 0, 0, nWidth, nHeight, tmpMaskDC, 0, 0, vbSrcAnd
 
  'Слияние двух маскированных картинок через XOR
  BitBlt tmpResultDC, 0, 0, nWidth, nHeight, tmpInterDC, 0, 0, vbSrcPaint
 
  'Вывод результата
  BitBlt hdc, x, y, nWidth, nHeight, tmpResultDC, 0, 0, vbSrcCopy
 
  If tmpMaskBitmap Then DeleteDC tmpMaskDC: DeleteObject tmpMaskBitmap
  If tmpInterBitmap Then DeleteDC tmpInterDC: DeleteObject tmpInterBitmap
  If tmpResultBitmap Then DeleteDC tmpResultDC: DeleteObject tmpResultBitmap
End Sub

[MagicMan]

Я заменил вызов из msimg32.dll на Вашу функцию, добавил недостающих API - но все равно картинку не показывает.

Жду ответа,
Юрий.

[GSerg]

Ну чё могу посоветовать - только искать баги в кнопке

[MagicMan]

херово

[Andrey Fedorov]

Держи пример - собрал на скорую руку из того что валялось...