БенедиктДмитрий77,
COM-объект, поддерживающий интерфейс IPictureDisp, либо сам управляет временем жизни GDI-объекта (делает DeleteObject (для битмапа)), либо не управляет вовсе. Это определяется третьим параметром OleCreatePictureIndirect(), он же третий параметр CreateIPictureDispFromHBITMAP().
Вот это, да?
fOwn [in]
If TRUE, the picture object is to destroy its picture when the object is destroyed. If FALSE, the caller is responsible for destroying the picture.
А ведь я туда глядел, видимо по принципу смотрю в книгу, вижу фигу.
А вот ты разжуешь, и сразу вижу буквы, а за ними смысл.
БенедиктЕсли параметр не равен FALSE/False (нулю, короче), то такие фокусы как DeleteObject g_picRebarBackground не нужны (и даже вредны), но в данном конкретном случае ни к какому фатальному эффекту не приведут. Ресурсы будут освобождены при уменьшении счётчика использования COM-объекта до нуля. В явном виде уменьшение счётчика это Set g_picRebarBackground = Nothing. В неявном - Set g_picRebarBackground = <другой объект>.
И все-таки, четкий ответ?
Убрать вообще все эти конструкции?
Или все-таки налепить
1.
Set g_picRebarBackground = Nothing
Потому как у меня с этими конструкциями при определенных условиях возникает
Er.91 (object NOT set), хотя вроде делаю If Not g_picRebarBackground Is Nothing Then
Приведу целиком, чего навертел:
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.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
Public Function CreateTheReBar_txt(ByVal Parent As PictureBox, ByVal str_text As String, _
FontCtr As Control, lng_Img As Long, g_picRebarBackground_txt As IPictureDisp) As Long
'создание панели с текстом в стиле Rebar
'FontCtr -имя контрола, в кот. хранится нужный шрифт
Dim rcClient As RECT
GetClientRect Parent.hWnd, rcClient
Dim RebarStyle As Long
RebarStyle = WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or _
WS_BORDER Or RBS_FIXEDORDER Or CCS_NODIVIDER Or _
CCS_NOPARENTALIGN Or CCS_TOP '
Dim the_hwndRebar As Long
the_hwndRebar = CreateWindowEx(WS_EX_TOOLWINDOW, _
REBARCLASSNAME, _
vbNullString, _
RebarStyle, _
0, _
0, _
rcClient.Right, _
0, _
Parent.hWnd, _
0&, _
App.hInstance, _
0&)
If sys_WinVista And ThemesEnabled(the_hwndRebar) Then
Dim the_theme As String
the_theme = Form1.GetCurrentPanelsStyle
If the_theme = "Classic" Then
DeactivateWindowTheme the_hwndRebar
ElseIf the_theme = "Explorer" Then
SetWindowTheme the_hwndRebar, StrPtr("Communications"), 0 'стиль для Висты
Else
SetWindowTheme the_hwndRebar, StrPtr(the_theme), 0 'стиль для Висты
End If
ElseIf (IsWinXP Or IsWin2003) And ThemesEnabled(the_hwndRebar) Then
DeactivateWindowTheme the_hwndRebar
End If
Dim fnt As IFont
Set fnt = FontCtr.Font
SendMessage the_hwndRebar, WM_SETFONT, fnt.hFont, ByVal 0
Set fnt = Nothing
Dim rInfo As REBARINFO
With rInfo
.cbSize = LenB(rInfo)
.fMask = RBIM_IMAGELIST
.hIml = m_hImlRB_RND
End With
SendMessage the_hwndRebar, RB_SETBARINFO, 0, rInfo
Dim rbBand As REBARBANDINFO
With rbBand
.cbSize = LenB(rbBand)
.fMask = RBBIM_COLORS Or RBBIM_CHILDSIZE Or RBBIM_STYLE Or RBBIM_TEXT Or RBBIM_IMAGE
.fStyle = RBBS_NOVERT
OleTranslateColor vbWindowBackground, 0, .clrFore
OleTranslateColor vbButtonShadow, 0, .clrBack
.cxMinChild = 170
If IsWinVista And ThemesEnabled(the_hwndRebar) Then
.cyMinChild = 25
Else
.cyMinChild = 22
End If
.lpText = VarPtr(StringToMas(str_text).ByteStr(0))
.iImage = lng_Img 'картинка на панели
End With
' Insert band into rebar
SendMessage the_hwndRebar, RB_INSERTBAND, -1, rbBand
If (the_theme = "Explorer") And sys_WinVista And ThemesEnabled(the_hwndRebar) Then
Dim rcClientRB As RECT
GetClientRect the_hwndRebar, rcClientRB '!!! Надо придумать что-нибудь получше
MsgBox "before DeleteObject"
If Not g_picRebarBackground_txt Is Nothing Then DeleteObject g_picRebarBackground_txt.Handle
MsgBox "after DeleteObject"
Set g_picRebarBackground_txt = CreateGradientBackComplexPlus(g_picRebarBackground_txt, Parent.ScaleWidth, _
rcClientRB.Bottom)
With rbBand
.cbSize = LenB(rbBand)
.fMask = RBBIM_BACKGROUND
.hbmBack = g_picRebarBackground_txt.Handle
End With
SendMessage the_hwndRebar, RB_SETBANDINFOA, 0, rbBand
End If
CreateTheReBar_txt = the_hwndRebar
End Function
А ошибка выдается, если при загрузке формы прога считывает значение стиля "Explorer", что предполагает именно свою отрисовку битмапа поверх банда (как ты учил), а не стиль. Возникает где-то после MsgBox "after DeleteObject", пока не "додебажил".
Или я просто что-то навертел не то с передачей "объектов" в функцию?
У меня идет создание 3-х панелей подряд, + я использую перерисовку в Form_resize, где этот object переубивается (для "этого стиля"). Не уверен что там ничего не перекрещивается.
ДмитУ меня как-то к утечки приводило GetDC без ReleaseDC :)
О-о-о! Ето большая бяка. После знакомства с этой бякой я как раз и стал переживать "чтоб все убивать".
