- Код: Выделить всё
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC 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 dwRop As Long) As Long
Private Const SRCCOPY = &HCC0020
Private Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private bwDC As Long
Private bwBmp As Long
Private bwBmpOld As Long
Private TransparentColor As Long
Private W As Integer
Private H As Integer
Private Sub Command1_Click()
W = 500 * 15
H = 200 * 15
TransparentColor = 16777215 'мне нужен белый
' Varian 2 - by hwnd----------------------------------------------------------
' deskHWND = FindWindow(vbNullString, "Roulette - Mozilla Firefox")
' deskDC = GetWindowDC(deskDC)
'--------------------------------------------------------------------------------
' Varian 1 - desktop DC------------------------------------------------------
deskDC = GetDC(0)
BitBlt Picture1Picture1.hdc, 0, 0, W, H, deskDC, 0, 0, SRCCOPY 'десктоп в Picture1
Picture1.Refresh
'
' Create a monochrome DC & Bitmap of the same size as the source picture:
bwDC = CreateCompatibleDC(0)
bwBmp = CreateCompatibleBitmap(bwDC, W, H)
bwBmpOld = SelectObject(bwDC, bwBmp)
'
' Set the back 'colour' of the monochrome DC to the colour we wish to be transparent:
SetBkColor bwDC, TransparentColor
'
' Copy from the from picture to the monochrome DC to create the mask:
BitBlt bwDC, 0, 0, W, H, Picture1.hdc, 0, 0, SRCCOPY
'
' Now put the mask into Picture2:
BitBlt Picture2.hdc, 0, 0, W, H, bwDC, 0, 0, SRCCOPY
Picture2.Refresh
'
' Clear up the bitmap we used to create the mask:
SelectObject bwDC, bwBmpOld
DeleteObject bwBmp
'
' Clear up the monochrome DC:
DeleteObject bwDC
'
End Sub
1й вопрос - что я не догоняю? в чём мой косяк?
2й вопрос - как избавиться от промежуточного BitBlt в Picture1, то есть как прямо передать сграбленную картинку в монохромный bwDC?
Заранее благодарен!