Piechart.bas eat resources

[Eddy Larsson Member Find all posts View Profile Close Eddy Larsson]

HI

I am beginner on powerbasic and I found a loot of good information in this forum, but in
this case I don't know what is wrong.

I use PieChart.Bas posted by Bernad Chapman

http://www.powerbasic.com/support/pb...ad.php?p=17157



Evrytime I update the chartpie windows whith a timer (every ten seconds)can I se in the taskmanager,
that GDI-Object increase by 6, and after some hour the color in the pie is disappering (getting white)
and eating up resource from OS(xp).

The same happens if I use the orginal code and move a annother window many times over the piechart to force a updating.

I only guess that it has something to do whith the 'GDI-OBJECT' and the problem are in SUB PieChart.


Code extract from PieChart.Bas
'****************************************
SUB PieChart(hDC AS LONG,nosectors AS LONG,sectorname() AS STRING,sectorsize() AS SINGLE,XCentre AS LONG,YCentre AS LONG,radius AS LONG)
DIM DA(10) AS SINGLE
DIM gText(10) AS ASCIIZ * 200
LOCAL gTex AS ASCIIZ * 200
LOCAL I AS LONG
LOCAL TOTAL AS SINGLE
LOCAL CUMUL AS SINGLE
LOCAL pi2 AS SINGLE
LOCAL pct AS LONG
LOCAL recstart AS LONG
LOCAL hpenpie AS LONG
LOCAL hbrushpie AS LONG
LOCAL hFontPie AS LONG
LOCAL xStart AS LONG, yStart AS LONG, xEnd AS LONG, yEnd AS LONG
LOCAL xText AS LONG, yText AS LONG, korr AS LONG
LOCAL xLeft AS LONG, yTop AS LONG, xRight AS LONG, yBottom AS LONG

FOR I=1 TO nosectors
gText(I)=sectorname(I)
NEXT

TOTAL=0

FOR I=1 TO nosectors
DA(I) = sectorsize(i)
TOTAL = TOTAL + DA(I)
NEXT

xLeft = Xcentre - Radius : xRight = Xcentre + Radius
yTop = Ycentre - Radius : yBottom = Ycentre + Radius

hFontPie = MakeFont(FontName,FontSize)
SelectObject hDC, hFontPie

pi2=8*ATN(1)
CUMUL=0
korr=-11 ' empiric correction for height of characters. This may be improved.
FOR I=1 TO nosectors
CUMUL = CUMUL + DA(I)
pct=INT(100*DA(I)/TOTAL+0.5)
xText = INT(Xcentre+(Radius-korr)*COS(pi2 * (CUMUL - DA(I)/2) / TOTAL)+0.5)
yText = INT(Ycentre-(Radius-korr)*SIN(pi2 * (CUMUL - DA(I)/2) / TOTAL)+0.5)
IF COS(pi2 * (CUMUL - DA(I)/2) / TOTAL) >= 0 THEN
SetTextAlign hDC,%TA_LEFT ' text on right side of diagram
ELSE
SetTextAlign hDC,%TA_RIGHT ' text on left side of diagram
END IF
gTex=gText(I)+" ("+LTRIM$(STR$(pct))+"%)"
TextOut hDC, xText, yText+korr, gTex, BYVAL LEN(gTex)
NEXT

xStart=Xcentre+Radius: yStart=Ycentre ' select starting point for pie pieces
CUMUL=0

FOR I=1 TO nosectors
CUMUL = CUMUL + DA(I)
xEnd = INT(Xcentre+Radius*COS(pi2 * CUMUL / TOTAL)+0.5)
yEnd = INT(Ycentre-Radius*SIN(pi2 * CUMUL / TOTAL)+0.5)

hPenPie = SelectObject(hDC, CreatePen(%PS_SOLID, 0, gColor(10)))

hBrushPie = SelectObject(hDC, CreateSolidBrush (gColor(I)))

PIE hDC, xLeft,yTop,xRight,yBottom, xStart, yStart, xEnd, yEnd

xStart=xEnd: yStart=yEnd
NEXT


DeleteObject hPenpie
DeleteObject hBrushpie
DeleteObject hFontpie
END SUB
'****************************************************


Eddy Larsson

[Dominic Mitchell Member Find all posts View Profile Close Dominic Mitchell]

Because only the last pen and brush that are created within the loop are being destroyed. Move the deletion of the pen and brush to the inside of the loop.

For example,

hFontPie = MakeFont(FontName,FontSize)
SelectObject hDC, hFontPie
 
....

 
FOR I=1 TO nosectors
  CUMUL = CUMUL + DA(I)
  xEnd = INT(Xcentre+Radius*COS(pi2 * CUMUL / TOTAL)+0.5)
  yEnd = INT(Ycentre-Radius*SIN(pi2 * CUMUL / TOTAL)+0.5)
  
  hPenPie = SelectObject(hDC, CreatePen(%PS_SOLID, 0, gColor(10)))
  
  hBrushPie = SelectObject(hDC, CreateSolidBrush (gColor(I)))
  
  PIE hDC, xLeft,yTop,xRight,yBottom, xStart, yStart, xEnd, yEnd
  
  xStart=xEnd: yStart=yEnd
  
  DeleteObject hPenpie
  DeleteObject hBrushpie
NEXT

DeleteObject hFontpie

[Eddy Larsson Member Find all posts View Profile Close Eddy Larsson]

Hi and thanks for the answer.

It helps for 4 of 6 GDI-OBJECT .It still increase by 2....

I am trying to find the other two but whithout succes .

Eddy Larsson

[Dominic Mitchell Member Find all posts View Profile Close Dominic Mitchell]

Resource leaks are very easy to track down.
Any leaks that happen after the code is modified as shown is occurring elsewhere.
If possible, post the code in its entirety.

[Eddy Larsson Member Find all posts View Profile Close Eddy Larsson]

Here cames the code. Most of it are not changed from original.
I have only modified the code by two timers,three buttons and a sub who create random date.
InvalidateRect are used to force updating of window in two places.

Eddy Larsson

'===================================================================================
'   PIECHART.BAS for PBWin modified from Erik Christensen's original program
'   posted in 7 Nov 2000. The changes made have been fairly straightforward but it has
'   been converted to SDK and generalised so that it can be easily called for many
'   purposes from within the one application. Easily convertible to DDT if preferred.
'
'   Remove the PostQuitMessage(0) commands in callback procedure when running the
'   piechart window as a child window from a parent window.
'===================================================================================
#COMPILE EXE
#REGISTER NONE
#DIM ALL

#INCLUDE "win32api.inc"
%IDC_BUTTON1=1501
%IDC_BUTTON2=1502
%IDC_BUTTON3=1503
%ID_TIMER1   = 100
%ID_TIMER2   = 101

DECLARE FUNCTION MakeFont(BYVAL FontName AS STRING, BYVAL PointSize AS LONG) AS LONG
DECLARE FUNCTION gColor(BYVAL I AS LONG) AS LONG
DECLARE FUNCTION PieChartWindowProc (BYVAL hWnd AS LONG, BYVAL wMsg AS LONG, _
                  BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG

GLOBAL hInst        AS LONG

GLOBAL nosectors    AS LONG
GLOBAL sectorname() AS STRING
GLOBAL sectorsize() AS SINGLE

GLOBAL hght         AS LONG
GLOBAL wdth         AS LONG

GLOBAL Xcentre      AS LONG
GLOBAL Ycentre      AS LONG
GLOBAL radius       AS LONG
GLOBAL FontSize     AS LONG
GLOBAL FontName     AS STRING
GLOBAL ghInstance AS DWORD 'egen

'...........................................................................
FUNCTION PBMAIN

    LOCAL Msg AS tagMsg
    LOCAL pietitlez AS ASCIIZ*255
    LOCAL length AS LONG, breadth AS LONG
    LOCAL hWnd AS LONG,hparent AS LONG
    LOCAL Xleft AS LONG
    LOCAL Ytop AS LONG

'Get the instance handle

    hInst = GetModuleHandle(BYVAL %NULL)

'Register the window class
    CALL registerpiewindow



'CREATE SECOND WINDOW

'Set the sector properties

    nosectors=4

    REDIM sectorname(nosectors)
    REDIM sectorsize(nosectors)
    sectorname(1)="Sector 1"
    sectorname(2)="Sector 2"
    sectorname(3)="Sector 3"
    sectorname(4)="Sector 4"

    sectorsize(1)=1
    sectorsize(2)=2
    sectorsize(3)=3
    sectorsize(4)=4

'Create and position the window and set font


    length=600
    breadth=1100
    XLeft=300
    Ytop=100
    hParent=%NULL

    pietitlez="Pie Chart 2"

    FontSize=12
    FontName = "Times New Roman"

    CALL makepiewindow(hWnd,hparent,length,breadth,Xleft,YTop,pietitlez)

'Set the radius and position of centre of pie chart in window

    CALL getclientdimensions(hWnd,hght,wdth)
    Radius = 800/5.
    Xcentre=wdth/1.5
    Ycentre=hght/2.5

'Message loop

    DO WHILE GetMessage(Msg, %NULL, 0, 0)
        TranslateMessage Msg
        DispatchMessage Msg
    LOOP


    FUNCTION = msg.wParam

END FUNCTION

'...........................................................................
SUB PieChart(hDC AS LONG,nosectors AS LONG,sectorname() AS STRING,sectorsize() AS SINGLE,XCentre AS LONG,YCentre AS LONG,radius AS LONG)
    DIM DA(10) AS SINGLE
    DIM gText(10) AS ASCIIZ * 200
    LOCAL gTex AS ASCIIZ * 200
    LOCAL I AS LONG
    LOCAL TOTAL AS SINGLE
    LOCAL CUMUL AS SINGLE
    LOCAL pi2 AS SINGLE
    LOCAL pct AS LONG
    LOCAL recstart AS LONG
    LOCAL hpenpie AS LONG
    LOCAL hbrushpie AS LONG
    LOCAL hFontPie AS LONG
    LOCAL xStart AS LONG, yStart AS LONG, xEnd AS LONG, yEnd AS LONG
    LOCAL xText AS LONG, yText AS LONG, korr AS LONG
    LOCAL xLeft AS LONG, yTop AS LONG, xRight AS LONG, yBottom AS LONG

    FOR I=1 TO nosectors
       gText(I)=sectorname(I)
    NEXT

    TOTAL=0

    FOR I=1 TO nosectors
      DA(I) = sectorsize(i)
      TOTAL = TOTAL + DA(I)
    NEXT

    xLeft  = Xcentre - Radius : xRight =  Xcentre + Radius
    yTop   = Ycentre - Radius : yBottom = Ycentre + Radius

    hFontPie = MakeFont(FontName,FontSize)
    SelectObject hDC, hFontPie

    pi2=8*ATN(1)
    CUMUL=0
    korr=-11 ' empiric correction for height of characters. This may be improved.
    FOR I=1 TO nosectors
      CUMUL = CUMUL + DA(I)
      pct=INT(100*DA(I)/TOTAL+0.5)
      xText = INT(Xcentre+(Radius-korr)*COS(pi2 * (CUMUL - DA(I)/2) / TOTAL)+0.5)
      yText = INT(Ycentre-(Radius-korr)*SIN(pi2 * (CUMUL - DA(I)/2) / TOTAL)+0.5)
      IF COS(pi2 * (CUMUL - DA(I)/2) / TOTAL) >= 0 THEN
        SetTextAlign hDC,%TA_LEFT ' text on right side of diagram
      ELSE
        SetTextAlign hDC,%TA_RIGHT ' text on left side of diagram
      END IF
      gTex=gText(I)+" ("+LTRIM$(STR$(pct))+"%)"
      TextOut hDC, xText, yText+korr, gTex, BYVAL LEN(gTex)
        
    
    
    NEXT

    xStart=Xcentre+Radius: yStart=Ycentre ' select starting point for pie pieces
    CUMUL=0

    FOR I=1 TO nosectors
      CUMUL = CUMUL + DA(I)
      xEnd  = INT(Xcentre+Radius*COS(pi2 * CUMUL / TOTAL)+0.5)
      yEnd  = INT(Ycentre-Radius*SIN(pi2 * CUMUL / TOTAL)+0.5)

      hPenPie = SelectObject(hDC, CreatePen(%PS_SOLID, 0, gColor(10)))

      hBrushPie = SelectObject(hDC, CreateSolidBrush (gColor(I)))

      PIE hDC, xLeft,yTop,xRight,yBottom, xStart, yStart, xEnd, yEnd

      xStart=xEnd: yStart=yEnd
    
     DeleteObject hPenpie
    DeleteObject hBrushpie
     NEXT

    
     'DeleteObject hPenpie
    'DeleteObject hBrushpie
    
     DeleteObject hFontpie


END SUB
'...........................................................................
FUNCTION gColor(BYVAL I AS LONG) AS LONG
  SELECT CASE I
    ' Common RGB Colors:
    CASE 0 : FUNCTION = &H000000???  '%Black - same as RGB(0,0,0)
    CASE 1 : FUNCTION = &HFF0000???  '%Blue
    CASE 2 : FUNCTION = &H00FF00???  '%Green
    CASE 3 : FUNCTION = &HFFFF00???  '%Cyan
    CASE 4 : FUNCTION = &H0000FF???  '%Red
    CASE 5 : FUNCTION = &HFF00FF???  '%Magenta
    CASE 6 : FUNCTION = &H00FFFF???  '%Yellow
    CASE 7 : FUNCTION = &HFFFFFF???  '%White - same as RGB(255,255,255)
    CASE 8 : FUNCTION = &H808080???  '%Gray
    CASE 9 : FUNCTION = &HC0C0C0???  '%LtGray
    CASE ELSE : FUNCTION = &H000000???  '%Black
  END SELECT
END FUNCTION
'...........................................................................
FUNCTION MakeFont(BYVAL FontName AS STRING, BYVAL PointSize AS LONG) AS LONG
   LOCAL hDC AS LONG
   LOCAL CyPixels AS LONG

   hDC = GetDC(%HWND_DESKTOP)
   CyPixels  = GetDeviceCaps(hDC, %LOGPIXELSY)
   ReleaseDC %HWND_DESKTOP, hDC
   PointSize = (PointSize * CyPixels) \ 72

   ' ****************************************************************
   LOCAL Height AS LONG            ' logical height of font
   LOCAL Width1 AS LONG            ' logical average character width
   LOCAL Escapement AS LONG        ' angle of escapement
   LOCAL ORIENTATION AS LONG       ' base-line orientation angle
   LOCAL Weight AS LONG            ' font weight
   LOCAL Italic AS LONG            ' italic attribute flag
   LOCAL Underline AS LONG         ' underline attribute flag
   LOCAL StrikeOut AS LONG         ' strikeout attribute flag
   LOCAL CharSet AS LONG           ' character set identifier
   LOCAL OutputPrecision AS LONG   ' output precision
   LOCAL ClipPrecision AS LONG     ' clipping precision
   LOCAL QUALITY AS LONG           ' output quality
   LOCAL PitchAndFamily AS LONG    ' pitch and family
   LOCAL TypeFaceName AS ASCIIZ*50 ' typeface name string

   Height = 0 - PointSize            ' logical height of font
   Width1 = 0                        ' logical average character width
   Escapement = 0                    ' angle of escapement
   ORIENTATION = 0                   ' base-line orientation angle
   Weight = %FW_NORMAL               ' font weight (various degrees
                                     '     of thin or bold types
                                     '     can be defined)
   Italic = 0                        ' italic attribute flag (0,1)
   Underline = 0                     ' underline attribute flag (0,1)
   StrikeOut = 0                     ' strikeout attribute flag (0,1)
   CharSet = %ANSI_CHARSET           ' character set identifier
   OutputPrecision = %OUT_TT_PRECIS  ' output precision
   ClipPrecision = %CLIP_DEFAULT_PRECIS ' clipping precision
   QUALITY = %DEFAULT_QUALITY        ' output quality
   PitchAndFamily = %FF_DONTCARE     ' pitch and family
   TypeFaceName = FontName           ' typeface name string

   FUNCTION = CreateFont(Height,Width1,Escapement,ORIENTATION,Weight, _
                         Italic,Underline,StrikeOut,CharSet, _
                         OutputPrecision,ClipPrecision,QUALITY, _
                         PitchAndFamily,BYCOPY TypeFaceName)
END FUNCTION
'...........................................................................
SUB getclientdimensions(hWnd AS LONG,hght AS LONG,wdth AS LONG)
    LOCAL rc AS rect

    getclientrect(hWnd,rc)

    wdth=rc.nRight-rc.nLeft
    hght=rc.nBottom-rc.nTop
END SUB
'...........................................................................
SUB registerpiewindow

   LOCAL wndclasslocal    AS WndClassEx
   LOCAL szAppName   AS ASCIIZ * 80

   szAppName              = "piechartwindow"

   wndclasslocal.cbSize        = SIZEOF(wndclasslocal)
   wndclasslocal.style         = %CS_HREDRAW OR %CS_VREDRAW
   wndclasslocal.lpfnWndProc   = CODEPTR(PieChartWindowProc )
   wndclasslocal.cbClsExtra    = 0
   wndclasslocal.cbWndExtra    = 0
   wndclasslocal.hInstance     = hInst
   wndclasslocal.hIcon         = LoadIcon( hInst,"Hellowin.ico" )
   wndclasslocal.hCursor       = LoadCursor( %Null, BYVAL %IDC_ARROW )

   wndclasslocal.hbrBackground = GetSysColorBrush(%COLOR_BTNFACE)
   wndclasslocal.lpszMenuName  = %Null
   wndclasslocal.lpszClassName = VARPTR( szAppName )
   wndclasslocal.hIconSm       = LoadIcon( %NULL, BYVAL %IDI_APPLICATION )


    ghInstance=hInst 'egen
    
    
    
    
   RegisterClassEx wndclasslocal

END SUB
'...........................................................................
SUB makepiewindow(hWnd AS LONG,hParent AS LONG,length AS LONG,breadth AS LONG,X AS LONG,Y AS LONG,pietitlez AS ASCIIZ*255)
   LOCAL hDC AS LONG
LOCAL hWndChild   AS DWORD  'egen
      hWnd = CreateWindow("piechartwindow", _         ' window class name
                         pietitlez, _                 ' window caption
                         %WS_CAPTION OR %WS_SYSMENU or %WS_MINIMIZEBOX or %WS_MAXIMIZEBOX    , _' window style
                         X, _                         ' initial x position
                         Y, _                         ' initial y position
                         breadth, _                   ' initial x size
                         length, _                    ' initial y size
                         hParent, _                   ' parent window handle
                         %Null, _                     ' window menu handle
                         hInst, _                     ' program instance handle
                         BYVAL %Null)                 ' creation parameters

      
             hWndChild = CreateWindowEx(0, "BUTTON", "&Update from file ", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_FLAT, _
          100, 10, 150, 30,hWnd, %IDC_BUTTON1,ghInstance, BYVAL %NULL)
             
             hWndChild = CreateWindowEx(0, "BUTTON", "&Start timer", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_FLAT, _
          100, 40, 150, 30,hWnd, %IDC_BUTTON2,ghInstance, BYVAL %NULL)
             
             hWndChild = CreateWindowEx(0, "BUTTON", "&Stop timer", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_FLAT, _
          100, 70, 150, 30,hWnd, %IDC_BUTTON3,ghInstance, BYVAL %NULL)
        
        CALL showwindow(hWnd,%SW_SHOW)
        
         
        
END SUB
'...........................................................................
FUNCTION PieChartWindowProc (BYVAL hWnd AS LONG, BYVAL wMsg AS LONG, _
                  BYVAL wParam AS LONG, BYVAL lParam AS LONG) EXPORT AS LONG

   LOCAL hDC        AS LONG
   LOCAL LpPaint    AS PaintStruct
   LOCAL rc         AS Rect
     'LOCAL hWndChild   AS DWORD  'egen

   SELECT CASE wMsg

      CASE %WM_CREATE
                'hWndChild = CreateWindowEx(0, "BUTTON", "&Close", %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_FLAT, _
          '500, 10, 50, 30,hWnd, %IDC_BUTTON1,ghInstance, BYVAL %NULL)
        
      CASE %WM_SYSCOMMAND
         SELECT CASE LOWRD(wParam)
            CASE %SC_CLOSE
               CALL destroywindow(hWnd)
               CALL postquitmessage(0)  '<< REMOVE when run from main app window as parent
               FUNCTION = 0
               EXIT FUNCTION
         END SELECT
            
            CASE %WM_COMMAND
                    SELECT CASE LOWRD(wParam)
                      CASE %IDC_BUTTON1
                         IF HIWRD(wParam) = %BN_CLICKED THEN
                            'MSGBOX "you clicked me, I'm Button1"
                        'Test. Read from file    
'                            open "epieData.txt" for input as #1 
'                            reset sectorsize(1)
'                            reset sectorsize(2)
'                            reset sectorsize(3)
'                            reset sectorsize(4)
'                            input #1, sectorsize(1),sectorsize(2),sectorsize(3),sectorsize(4)
'                            close #1
                            
                        'No file is attached so use this    
                        call RandomValue (hWnd) '
                        '---------------------------------------------------    
                            
                        
                            
                            sectorname(1)="Name1"
                            sectorname(2)="Name2"
                            sectorname(3)="Name3"
                            sectorname(4)="Name4"
                            
                             nosectors=4
                            InvalidateRect hwnd,Byval %null,%True 'Update window . via WM_Paint I dont'know if it is correct but it works or ???
                   
                             END IF
                        CASE %IDC_BUTTON2
                             IF HIWRD(wParam) = %BN_CLICKED THEN
                             
                                     STATIC idEvent AS LONG                      ' Keep SetTimer's result in a static variable
                                idEvent = SetTimer(hwnd, %ID_TIMER1, _    ' Create WM_TIMER events with the SetTimer API
                         5000, BYVAL %NULL)   
                                 
                                         STATIC idEvent2 AS LONG                      ' Keep SetTimer's result in a static variable
                                idEvent2 = SetTimer(hwnd, %ID_TIMER2, _    ' Create WM_TIMER events with the SetTimer API
                         500, BYVAL %NULL) 
                            end if 
                        case %IDC_BUTTON3
                                 IF Hiwrd(wParam) = %BN_CLICKED THEN
                                 
                                 IF idEvent THEN                             ' If a timer identifier exists
                                  KillTimer hWnd, idEvent                      ' make sure to stop the timer events
                                 END IF  
                                            
                                            IF idEvent2 THEN                             ' If a timer identifier exists
                                  KillTimer hWnd, idEvent                      ' make sure to stop the timer events
                                 END IF    
                                 end if
                             
                        end select
            
        CASE %WM_TIMER    
                select case lowrd(wParam)
                    case %ID_Timer1
                        call RandomValue(hWnd)
                    end select
            
      CASE %WM_KEYDOWN
         IF LOWRD(wparam)=27 THEN
               CALL destroywindow(hWnd)
               CALL postquitmessage(0)  '<< REMOVE when run from main app window as parent
         END IF
        
            
      CASE %WM_PAINT
        
         hDC = BeginPaint(hWnd, LpPaint)
            CALL SetBkMode(hdc, %TRANSPARENT)
            CALL PieChart(hDC,nosectors,sectorname(),sectorsize(),XCentre,YCentre,radius)
            CALL ShowWindow(hwnd,%SW_SHOWNA)
         EndPaint hWnd, LpPaint
        FUNCTION = 0 
        EXIT FUNCTION
            
        CASE %WM_DESTROY                                                ' Sent when the dialog is being destroyed
                                 IF idEvent THEN                             ' If a timer identifier exists
                                  KillTimer hWnd, idEvent                      ' make sure to stop the timer events
                                 END IF  
                                            
                                            IF idEvent2 THEN                             ' If a timer identifier exists
                                  KillTimer hWnd, idEvent                      ' make sure to stop the timer events
                                 END IF            
            
            
            
   END SELECT

   FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam)

   EXIT FUNCTION

END FUNCTION


sub RandomValue (BYVAL hWnd AS LONG)
'Create data to piechart

local i as integer
randomize timer
for i= 1 to 4
    sectorsize(i)= rnd(1,100)
next i    
InvalidateRect hwnd,Byval %null,%True 'via WM_Paint I dont'know if it is correct but it works or ???
end sub

[Peter Lameijn Member Find all posts View Profile Close Peter Lameijn]

You do not delete the pen and brush objects. This gives you 2 GDI leak points...
Also on exit you should restore the original object selection...

[Peter Lameijn Member Find all posts View Profile Close Peter Lameijn]

The correct(ed) version of PieChart Sub:

Sub PieChart(hDC As Long,nosectors As Long,sectorname() As String,sectorsize() As Single,XCentre As Long,YCentre As Long,radius As Long)
    Dim DA(10) As Single
    Dim gText(10) As Asciiz * 200
    Local gTex As Asciiz * 200
    Local I As Long
    Local TOTAL As Single
    Local CUMUL As Single
    Local pi2 As Single
    Local pct As Long
    Local recstart As Long
    Local hpenpie As Long
    Local hbrushpie As Long
    Local hFontPie As Long
    Local xStart As Long, yStart As Long, xEnd As Long, yEnd As Long
    Local xText As Long, yText As Long, korr As Long
    Local xLeft As Long, yTop As Long, xRight As Long, yBottom As Long
    [b]Local hTemp As Dword[/b]
 
    For I=1 To nosectors
       gText(I)=sectorname(I)
    Next
 
    TOTAL=0
 
    For I=1 To nosectors
      DA(I) = sectorsize(i)
      TOTAL = TOTAL + DA(I)
    Next
 
    xLeft  = Xcentre - Radius : xRight =  Xcentre + Radius
    yTop   = Ycentre - Radius : yBottom = Ycentre + Radius
 
    hFontPie = MakeFont(FontName,FontSize)
    [b]hTemp = [/b]SelectObject (hDC, hFontPie)
 
    pi2=8*Atn(1)
    CUMUL=0
    korr=-11 ' empiric correction for height of characters. This may be improved.
    For I=1 To nosectors
      CUMUL = CUMUL + DA(I)
      pct=Int(100*DA(I)/TOTAL+0.5)
      xText = Int(Xcentre+(Radius-korr)*Cos(pi2 * (CUMUL - DA(I)/2) / TOTAL)+0.5)
      yText = Int(Ycentre-(Radius-korr)*Sin(pi2 * (CUMUL - DA(I)/2) / TOTAL)+0.5)
      If Cos(pi2 * (CUMUL - DA(I)/2) / TOTAL) >= 0 Then
        SetTextAlign hDC,%TA_LEFT ' text on right side of diagram
      Else
        SetTextAlign hDC,%TA_RIGHT ' text on left side of diagram
      End If
      gTex=gText(I)+" ("+LTrim$(Str$(pct))+"%)"
      TextOut hDC, xText, yText+korr, gTex, ByVal Len(gTex)
     Next
 
    xStart=Xcentre+Radius: yStart=Ycentre ' select starting point for pie pieces
    CUMUL=0
 
    For I=1 To nosectors
      CUMUL = CUMUL + DA(I)
      xEnd  = Int(Xcentre+Radius*Cos(pi2 * CUMUL / TOTAL)+0.5)
      yEnd  = Int(Ycentre-Radius*Sin(pi2 * CUMUL / TOTAL)+0.5)
 
      [b]hPenPie = CreatePen(%PS_SOLID, 0, gColor(10))
      SelectObject hDC, hPenPie
 
      hBrushPie = CreateSolidBrush (gColor(I))
      SelectObject hDC, hBrushPie[/b]

      Pie hDC, xLeft,yTop,xRight,yBottom, xStart, yStart, xEnd, yEnd
      xStart=xEnd: yStart=yEnd
 
      DeleteObject hPenpie
      DeleteObject hBrushpie
     Next
     [b]SelectObject hDc, hTemp[/b]
     DeleteObject hFontpie
End Sub

[Dominic Mitchell Member Find all posts View Profile Close Dominic Mitchell]

My mistake, I am a bit distracted at the moment.
Peter, a more correct vesion would be this

    hFontPie = SelectObject(hDC, MakeFont(FontName,FontSize))

....

    xStart=Xcentre+Radius: yStart=Ycentre ' select starting point for pie pieces
    CUMUL=0

    FOR I=1 TO nosectors
      CUMUL = CUMUL + DA(I)
      xEnd  = INT(Xcentre+Radius*COS(pi2 * CUMUL / TOTAL)+0.5)
      yEnd  = INT(Ycentre-Radius*SIN(pi2 * CUMUL / TOTAL)+0.5)

      hPenPie = SelectObject(hDC, CreatePen(%PS_SOLID, 0, gColor(10)))

      hBrushPie = SelectObject(hDC, CreateSolidBrush (gColor(I)))

      PIE hDC, xLeft,yTop,xRight,yBottom, xStart, yStart, xEnd, yEnd

      xStart=xEnd: yStart=yEnd
    
      DeleteObject SelectObject(hDC, hPenpie)
      DeleteObject SelectObject(hDC, hBrushpie)
     NEXT

    
     DeleteObject SelectObject(hDC, hFontpie)

This leaves the orginal pen and brush in the DC on exit.

[Michael Mattias Member Find all posts View Profile Close Michael Mattias]

At least for the hPenPie, that's the same for each iteration of the loop (CreatePen ()using gColor(10)). It's plumb silly to create and delete that for each iteration.. instead create once before the loop, delete once at end of loop.

And how many different hBrushPie are there? Is there really a different gColor(I) for each iteration? If many of those are the same, you could do an extra loop OUTSIDE the current loop and select only the "I" values for a given gColor().

[Eddy Larsson Member Find all posts View Profile Close Eddy Larsson]

Piechart don't eat resources.

GDI-object don't increase anymore......It Works.

I used Dominic's code.

Thanks so much for your responses and code.

Eddy Larsson

[Pierre Bellisle Member Find all posts View Profile Close Pierre Bellisle]

Hey, Eddy,
Also, if you do a lot of piecharts then you may have a look at
Rainer Morgen's site http://www.rmchart.com/ a designer is included...