- Код: Выделить всё
Dim R As Long
Dim WidthSrc As Long, HeightSrc As Long
WidthSrc = frmSmiles.picSmile(k).ScaleWidth
HeightSrc = frmSmiles.picSmile(k).ScaleHeight
hDCMemory = CreateCompatibleDC(frmSmiles.picSmile(k).hDC)
hBmp = CreateCompatibleBitmap(frmSmiles.picSmile(k).hDC, WidthSrc, HeightSrc)
SelectObject hDCMemory, hBmp
frmSmiles.pics.BackColor = BackColor
BitBlt hDCMemory, 0, 0, WidthSrc, HeightSrc, frmSmiles.pics.hDC, 0, 0, vbSrcCopy
TransparentBlt hDCMemory, 0, 0, WidthSrc, HeightSrc, frmSmiles.picSmile(k).hDC, 0, 0, WidthSrc, HeightSrc, lngTransColor
R = DeleteDC(hDCMemory)
Set hDCToPicture = CreateBitmapPicture(hBmp, 0)
думаю, что не очень корректно, как можно сделать получше? или без использования frmSmiles.pics (я его использую как буфер) ?