Announcement

Collapse
No announcement yet.

Piechart.bas eat resources

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Piechart.bas eat resources

    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

  • #2
    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,

    Code:
    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
    Dominic Mitchell
    Phoenix Visual Designer
    http://www.phnxthunder.com

    Comment


    • #3
      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

      Comment


      • #4
        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.
        Dominic Mitchell
        Phoenix Visual Designer
        http://www.phnxthunder.com

        Comment


        • #5
          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

          Code:
          '===================================================================================
          '   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

          Comment


          • #6
            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...
            Regards,
            Peter

            Comment


            • #7
              The correct(ed) version of PieChart Sub:

              Code:
              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
                  Local hTemp As Dword
               
                  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)
                  hTemp = 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 = CreatePen(%PS_SOLID, 0, gColor(10))
                    SelectObject hDC, hPenPie
               
                    hBrushPie = CreateSolidBrush (gColor(I))
                    SelectObject hDC, hBrushPie
              
                    Pie hDC, xLeft,yTop,xRight,yBottom, xStart, yStart, xEnd, yEnd
                    xStart=xEnd: yStart=yEnd
               
                    DeleteObject hPenpie
                    DeleteObject hBrushpie
                   Next
                   SelectObject hDc, hTemp
                   DeleteObject hFontpie
              End Sub
              Regards,
              Peter

              Comment


              • #8
                My mistake, I am a bit distracted at the moment.
                Peter, a more correct vesion would be this
                Code:
                    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.
                Dominic Mitchell
                Phoenix Visual Designer
                http://www.phnxthunder.com

                Comment


                • #9
                  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().
                  Michael Mattias
                  Tal Systems Inc. (retired)
                  Racine WI USA
                  [email protected]
                  http://www.talsystems.com

                  Comment


                  • #10
                    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

                    Comment


                    • #11
                      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...

                      Comment

                      Working...
                      X