- Код: Выделить всё
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function GetWindowDC 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 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 Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Dim hwndTB As Long
Dim hWndSB As Long
Dim hDcSB As Long
Dim mRect As RECT
Dim hDcTmp As Long
Dim hBmpTmp As Long
Dim hBmpTmp2 As Long
Dim nWidth As Long
Dim nHeight As Long
Dim sPath As String
Private Sub Form_Load()
hwndTB = FindWindow("Shell_TrayWnd", "")
hWndSB = FindWindowEx(hwndTB, 0, "button", vbNullString)
hDcSB = GetWindowDC(hWndSB)
Call GetWindowRect(hWndSB, mRect)
nWidth = mRect.Right - mRect.Left
nHeight = mRect.Bottom - mRect.Top
hDcTmp = CreateCompatibleDC(hDcSB)
hBmpTmp = CreateCompatibleBitmap(hDcTmp, nWidth, nHeight)
sPath = App.Path & "\temp.bmp"
hBmpTmp2 = SelectObject(hDcTmp, LoadPicture(sPath))
End Sub
Private Sub Form_Unload(Cancel As Integer)
hBmpTmp = SelectObject(hDcTmp, hBmpTmp2)
DeleteObject hBmpTmp
DeleteDC hDcTmp
End Sub
Private Sub tmrPaint_Timer()
Call BitBlt(hDcSB, 0, 0, nWidth, nHeight, hDcTmp, 0, 0, SRCCOPY)
End Sub
Скажите, почему вместо рисунка вылетает просто черный прямоугольник вместо кнопки пуск?
Вот рисунок:
