Announcement

Collapse
No announcement yet.

Piechart.bas eat resources

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

  • Pierre Bellisle
    replied
    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...

    Leave a comment:


  • Eddy Larsson
    replied
    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

    Leave a comment:


  • Michael Mattias
    replied
    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().

    Leave a comment:


  • Dominic Mitchell
    replied
    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.

    Leave a comment:


  • Peter Lameijn
    replied
    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

    Leave a comment:


  • Peter Lameijn
    replied
    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...

    Leave a comment:


  • Eddy Larsson
    replied
    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

    Leave a comment:


  • Dominic Mitchell
    replied
    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.

    Leave a comment:


  • Eddy Larsson
    replied
    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

    Leave a comment:


  • Dominic Mitchell
    replied
    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

    Leave a comment:


  • Eddy Larsson
    started a topic Piechart.bas eat resources

    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
Working...
X