I do some custom paint stuff to create some colors on the screen. Most of this code has come from this forum and modified. It appears that I have a GDI leak some where. Can somebody take a quick look for any major problems in this code?
Thanks.
CUSTOM EVENT ON THE FORM HOLDING THE TAB CONTROL
This paints the active tab with a color and changes the font to bold.
SELECT CASE wMsg
CASE %WM_DRAWITEM
lDisPtr = lParam
lZStrN = FF_TABCONTROL_GETTEXT (HWND_FORMMAIN_TABMAIN, @lDisPtr.ItemId)
lZStrB = TRIM$(FF_TABCONTROL_GETTEXT (HWND_FORMMAIN_TABMAIN, @lDisPtr.ItemId))
TABCTRL_GETITEMRECT HWND_FORMMAIN_TABMAIN, @lDisPtr.ItemId, lRect
IF @lDisPtr.ItemState = %ODS_SELECTED THEN
rc = lRect
rc.nBottom = rc.nBottom + 4
'Paint a background color of your choice
hBrush = CREATESOLIDBRUSH(%tabtoplevel) :'Top Level Tab Color
FILLRECT @lDisPtr.hDC, rc, hBrush
SETBKMODE @lDisPtr.hDC, %TRANSPARENT
'*Use a bold font if selected
hFont = CREATEFONT(-8,0,0,0,%FW_HEAVY,0,0,0,0,0,0,0,0,"MS Sans Serif")
ELSE
'*Or a normal one if not selected
hFont = CREATEFONT(-8,0,0,0,%FW_NORMAL,0,0,0,0,0,0,0,0,"MS Sans Serif")
END IF
hFont = SELECTOBJECT(@lDisPtr.hDC, hFont)
IF @lDisPtr.ItemState = %ODS_SELECTED THEN
SETTEXTCOLOR @lDisPtr.hDc, %fonttabtoplevel :'Text color for highlighted top level tab
TEXTOUT @lDisptr.hDc, lRect.nLeft + 5, lRect.nTop + 3, lZStrB, LEN (lZStrB)
ELSE
SETTEXTCOLOR @lDisPtr.hDc, %BLACK :'Black text on normal background
TEXTOUT @lDisptr.hDc, lRect.nLeft + 5, lRect.nTop + 3, lZStrN, LEN (lZStrN)
END IF
DELETEOBJECT SELECTOBJECT( @lDisPtr.hDC, hFont )
DELETEOBJECT hBrush
PAINT EVENT
This is in the paint event of a form to paint colored rectangles
hDC = BeginPaint(hWndForm,ps1)
hDC_Save = SaveDC( hDC )
'Left,Top,Right,Bottom
'PAT ID
hBrush = CreateSolidBrush( RGB(166,166,255) ) 'periwinkle
hBrush = SelectObject( hDC, hBrush )
ROUNDRECT hDC, 19, 30, 638, 200, 10, 10
' Delete the brush. Must put the old brush back into the hDC
' because you can not delete a brush if it is already in selected.
DeleteObject SelectObject( hDC, hBrush )
' 'PAT MISC
hBrush = CREATESOLIDBRUSH( RGB(142,230,173) ) 'light green
hBrush = SELECTOBJECT( hDC, hBrush )
ROUNDRECT hDC, 655, 30, 970, 200, 10, 10
DELETEOBJECT SELECTOBJECT( hDC, hBrush )
' 'PAT PRIME INS
hBrush = CREATESOLIDBRUSH( RGB(254,169,182) ) 'buff pink
hBrush = SELECTOBJECT( hDC, hBrush )
ROUNDRECT hDC, 19, 228, 970, 314, 10, 10
DELETEOBJECT SELECTOBJECT( hDC, hBrush )
'
'PAT SEC INS
hBrush = CREATESOLIDBRUSH( RGB(251,247,174) ) 'buff yellow
hBrush = SELECTOBJECT( hDC, hBrush )
ROUNDRECT hDC, 19, 335, 970, 418, 10, 10
DELETEOBJECT SELECTOBJECT( hDC, hBrush )
EndPaint hWndForm, ps1
RESTOREDC hWndForm, hDC_Save
CUSTOM EVENT OF A FORM WITH A LISTVIEW CONTROL
This paints the lines in ListView control with alternating stripes.
It has logic to paint groups in color not just odd and even.
LOCAL lpNmh AS NMHDR PTR
LOCAL lpLvNm AS NM_LISTVIEW PTR
LOCAL lpLvCd AS NMLVCUSTOMDRAW PTR
LOCAL ColFlg AS LONG
SELECT CASE wMsg
CASE %WM_NOTIFY
lpNmh = lParam
IF @lpNmh.idFrom = IDC_FORMPATPROFILE_LVSCRIPTLIST THEN
lpLvNm = lParam
SELECT CASE @LpLvNm.hdr.code
CASE %NM_CUSTOMDRAW
lpLvCd = lParam
SELECT CASE @lplvcd.nmcd.dwDrawStage
CASE %CDDS_PREPAINT, %CDDS_ITEMPREPAINT
FUNCTION = %CDRF_NOTIFYSUBITEMDRAW
CASE %CDDS_ITEMPREPAINT OR %CDDS_SUBITEM
ColFlg = FF_LISTVIEW_GETITEMLPARAM (HWND_FORMPATPROFILE_LVSCRIPTLIST, @lpLvCd.nmcd.dwItemSpec, 0)
IF (ColFlg MOD 2) = 0 THEN
@lpLvCd.clrTextBk = %WHITE
@lpLvCd.clrText = %BLACK
ELSE
@lpLvCd.clrTextBk = RGB(180,247,250)
@lpLvCd.clrText = %BLACK
END IF
FUNCTION = %CDRF_NEWFONT
END SELECT
END SELECT
END IF
END SELECT
There are no GDI leaks in your code. I loaded it all into a test project and running it only consumes between 10 and 12 GDI objects.
The problem must be elsewhere.........
You said previously that your app using a custom control to handle masked edit input. Is there any GDI resources consumed in there ????
This is a very important and interesting subject. While I do understand the fundamentals of how leaks occur and what GDI resources are and how they are used, I do not know how to measure their usage in my programs.
Paul mentioned how he put the code into a test program and measured the GDI resource usage.
Has anyone any code or utilities that can be used to test ones programs to determine if there are leakages or can help pin point areas of leakages if they exist
Regards
Gian Young (Australia)
Resource leaks are common when handles do not get released/deleted. In Win9x systems like Win95, Win98, WinME, the effect of resource leaks can be very devastating because those systems have a much smaller tolerance for handles and once the number of handles reaches the maximum then you will see applications slow down, display weird things, and generally crash. WinNT based systems like Win2K and WinXP have a much larger handle pool.
You can check a program's GDI object usage by looking at the "Windows Task Manager" under the "Processes" tab (look at the GDI Objects column). If that column is not visible then use the top menu "View", "Select Columns".
Here is some code that will display the GDI usage... maybe try placing it in a Timer event to display the count in a caption bar or a debug window.
function GetGDIcount() as long
local hProcess as dword
getwindowthreadprocessid HWND_FRMMAIN, hProcess
hProcess = openprocess(%PROCESS_QUERY_INFORMATION or %PROCESS_VM_READ, 0, hProcess)
function = getguiresources(hProcess, %GR_GDIOBJECTS)
end function
Double check all parameters to API calls to verify there are no bad
parameters.
I found one already:
RESTOREDC hWndForm, hDC_Save
The first parameter to restoreDC is suppose to be a DC handle, not
a window (or form) handle.
If I found one error there may be more.
Ah yes, Chris is right on this one. The RestoreDC should be changed.
... I must have been thinking of ReleaseDC when I wrote that code :oops:
Thank for your response and help on this guys.
Very instructive, hope it also helps others.
Regards
Gian Young Australia :D
I found the problem :D and :cry:
I used the code from this post by Roger to implement ToolTips.
http://www.planetsquires.com/forums/viewtopic.php?t=1087
I put it in the FORM CREATE of each form. In one form alone there are 37 ToolTips.
This probably explains why the GDI's did not climb after all of the forms loaded.
The other STRANGE problem is the error found by Chris Boss does NOT cause any GDI leak. I commented out the whole chunk of code that does the painting of colored rectangles and the GDI count did NOT change.
It appears each tool tip generates about 14 GDI objects. Based on this math it and over 200 tool tips this accounts for most of the 3100 GDI objects that this program creates.
It may be I need a "Tutorial" on ToolTips. The ToolTips in this program need to be redone anyway. I have a concept of generating them from my field help file so they don't have to be hand coded.
The GetGDIcount function posted by Paul helped find the problem. I just kept putting in various places showing the "before" and "after" count.
Can somebody give me the basics?
Thanks for all of the help to this point and anything else you can provide on ToolTips.
Old code...try this one out-
'------------------------------------------------------------------------------------------------------------------------
' Major Versions
'3= WinNT 3.51
'4= WinNT 4.0/Win9x-ME
'5= Windows2K/XP/2003
'6= WinLonghorn/Vista
' Minor Versions
'0= Win95/NT 4.0/2K
'1= WinXP
'2= Win2003/WinXP64
'10= Win98
'51= WinNT 3.51
'90= WinME
Function ToolTipSet(ByVal prevTip As Dword, ByVal hWnd As Dword, ByVal hCtrl As Dword, ByVal sText As Asciiz * 80, Optional ByVal BalloonStyle As Dword, Optional ByVal Title As Asciiz * 100, Optional ByVal IconPic As Dword) As Long
Static osi As OSVERSIONINFOEX
Static allowBalloons As Dword ' 1= Balloons Allowed, 2= XP SP2+ (hIcons allowed)
Local hWnd_ToolTip As Dword
Local TI As TOOLINFO
Local classname As Asciiz * 17
' prevTip= 0 to create a new tooltip Parent Window, else use prev hWnd from function return
' BalloonStyle= 1 for Balloon, 2 for Balloon that Tracks/Stays and is activated by app.
' Icons= 1 for Info, 2 for Warning, 3 for Error, SP2 can also be HICON handle...but docs are weird saying you have to clean up the copy it makes???
If IsWindow(prevTip) Then ' If really a tooltip then use it.
GetClassName(prevTip, classname, 17)
If classname= "tooltips_class32" Then hWnd_ToolTip= prevTip
End If
If BalloonStyle Then
If hWnd_ToolTip= 0 Then ' If no Previous Tooltip Window.
If osi.dwOSVersionInfoSize= 0 Then ' If haven't checked Version already.
osi.dwOSVersionInfoSize= SizeOf(OSVERSIONINFO) ' OSVERSIONINFOEX not supported Pre Win2K
GetVersionEx(osi)
Select Case osi.dwMajorVersion
Case 4
If osi.dwMinorVersion= 90 Then allowBalloons= 1 ' WinME
Case 5
Select Case osi.dwMinorVersion
Case 0 ' Win2K
allowBalloons= 1
Case 1 ' WinXP
osi.dwOSVersionInfoSize= SizeOf(OSVERSIONINFOEX) ' OSVERSIONINFOEX not supported Pre Win2K
GetVersionEx(osi)
If osi.wServicePackMajor > 1 Then allowBalloons= 2 Else allowBalloons= 1
Case > 1
allowBalloons= 2
End Select
Case > 5
allowBalloons= 2
End Select
End If
If allowBalloons Then ' Balloon Version Available.
hWnd_ToolTip= CreateWindowEx(%WS_EX_TOPMOST, "tooltips_class32", "", %TTS_BALLOON Or %TTS_NOPREFIX Or %TTS_ALWAYSTIP Or %WS_EX_TOOLWINDOW, 0,0,0,0,0, ByVal 0, GetModuleHandle(ByVal %Null), ByVal 0)
If IsWindow(hWnd_ToolTip) Then
SendMessage(hWnd_ToolTip, %TTM_SETMAXTIPWIDTH, 0, 300)
If (allowBalloons= 1) And IconPic > 3 Then IconPic= 1 ' If hIcon given and PreXP SP2 then make it Info Icon
SendMessage(hWnd_ToolTip, %TTM_SETTITLE, IconPic, ByVal VarPtr(Title))
End If
End If
End If
End If
If hWnd_ToolTip= 0 Then ' No Selected Tooltip Window yet or error making Ballon Style Tooltip.
hWnd_ToolTip= CreateWindowEx(%WS_EX_TOPMOST, "tooltips_class32", "", %TTS_NOPREFIX Or %TTS_ALWAYSTIP, 0,0,0,0,0, ByVal 0, GetModuleHandle(ByVal %Null), ByVal 0)
If IsWindow(hWnd_ToolTip) Then SendMessage(hWnd_ToolTip, %TTM_SETMAXTIPWIDTH, 0, 300)
End If
If hWnd_ToolTip= 0 Then Exit Function
TI.cbSize= SizeOf(TI)
TI.hWnd= hWnd
If hCtrl= 0 Then TI.uId= hWnd Else TI.uId = hCtrl ' If 0 set to Window else set to Control. hCtrl is Handle, not ID of control.
Function= SendMessage(hWnd_ToolTip, %TTM_DELTOOL, 0, ByVal VarPtr(TI))
If Len(sText) > 0 Then
If BalloonStyle= 2 Then TI.uFlags= %TTF_IDISHWND Or %TTF_TRACK or %TTF_ABSOLUTE Or %TTF_TRANSPARENT Else TI.uFlags= %TTF_SUBCLASS Or %TTF_IDISHWND
TI.lpszText= VarPtr(sText)
If SendMessage(hWnd_ToolTip, %TTM_ADDTOOL, 0, ByVal VarPtr(TI)) Then Function= hWnd_ToolTip Else Function= 0
End If
End Function
Mark,
Why do you need so many Tooltips ?
I use one ToolTip per Dialog for all controls that need a tooltip, unless
the control needs to create the tooltip itself (ie. common controls).
By processing the %TTN_NEEDTEXT notification message (WM_NOTIFY)
you can set the text for each controls display of a tooltip, as needed.
To have 200 tooltips seems a bit overkill, IMO !
Well --- as I said in my earlier post maybe I need a "tutorial". When I did this the first time I did not know any better.
Because of the way I now have help working by looking up some help content on the fly from a database when pressing F1 I will likely just delete nearly all of the tool tips anyway.
Thanks for all of the help from everybody.