Суть кода ниже в том, что создается hbshBack_temp (Brush из большой картинки),
из него берется из заданного места кусок и пихается в новый bitmap hbmDst, из которого потом делается IPictureDisp, который как объяснял Бенедикт отвечает за битмат hbmDst и битмап удалять не надо. IPictureDisp потом подкладывается как фон Ребар, что делает ребар "прозрачным". Ну, Nothing для IPictureDisp я делаю.
Подвох скорее всего во "вложенных" SelectObject (я выделил) -в оригинальных кодах этого нет. В оригинальных градиент рисуется на hdcDst и есть только hbmDst, а здесь мне надо привязаться еще и к hbshBack_temp .
Но как извернуться не знаю. На авось когда-то проехало.
Счас играюсь со "слайдами" с высокой тестовой частотой (с этой же частотой работает код что ниже),
и этот код генерирует мне по +2 объекта GDI в процессах (при каждом срабатывании).
Аналогичный код с градиентами новых объектов не плодит (вроде).
При частоте 5 сек на XP нехватка ресурсов начинает ощущаться "по черному" довольно быстро, хотя на 8.1-ке вроде держится.
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
Public Function CreateTransparentBackGround( _
ByVal hwndRebar As Long) As IPictureDisp
Dim rc As RECT
Dim tPt As POINTAPI
Dim hdcRef As Long
Dim hdcDst As Long
Dim hbmDst As Long
Dim hbmOld As Long
'Dim the_hdc As Long
Dim hbmDstOld As Long
Dim RebarHeight As Long
Dim RebarWidth As Long
Dim hbmpBack_temp As Long
Dim hbshBack_temp As Long
hbmpBack_temp = FormMain.PictureDigits.Picture.Handle
If hbmpBack_temp <> 0 Then
hbshBack_temp = CreatePatternBrush(hbmpBack_temp)
Else
'затычка на случай отсутствия фоновой картинки
Dim the_ColorRef As Long
OleTranslateColor FormMain.PictureDigits.BackColor, 0, the_ColorRef
hbshBack_temp = CreateSolidBrush(the_ColorRef)
End If
GetWindowRect hwndRebar, rc
If ThemesEnabled(hwndRebar) Then
rc.Left = rc.Left + 2
End If
RebarWidth = rc.Right - rc.Left
RebarHeight = rc.Bottom - rc.Top
hdcRef = GetDC(hwndRebar)
hdcDst = CreateCompatibleDC(hdcRef)
hbmDst = CreateCompatibleBitmap(hdcRef, RebarWidth, RebarHeight)
ReleaseDC hwndRebar, hdcRef
hbmOld = SelectObject(hdcDst, hbmDst)
hbmDstOld = SelectObject(hdcDst, hbshBack_temp)
SetBkMode hdcDst, TRANSPARENT
tPt.x = rc.Left
tPt.y = rc.Top
MapWindowPoints 0, FormMain.PictureDigits.hwnd, tPt, 2
rc.Left = tPt.x
rc.Top = tPt.y
SetBrushOrgEx hdcDst, -rc.Left, -rc.Top, tPt
PatBlt hdcDst, 0, 0, RebarWidth, RebarHeight, PATCOPY
SelectObject hdcDst, hbmDstOld
SelectObject hdcDst, hbmOld: hbmOld = 0
DeleteDC hdcDst: hdcDst = 0
DeleteObject hbshBack_temp
Set CreateTransparentBackGround = CreateIPictureDispFromHBITMAP(hbmDst)
End Function
