Results 1 to 14 of 14

Thread: GDIPlus + Windows Timer

  1. #1

    Thread Starter
    Addicted Member
    Join Date
    Jun 2022
    Posts
    234

    GDIPlus + Windows Timer

    Hi,

    This is related to my last question... I finally managed to make a smooth-edged circular shape based on a form thanks to the use of GDI+ memory drawing combined with the UpdateLayeredWindow api function.

    In fact, the circular shape I have drawn is for displaying an analog clock... Now, in order to update the clock, I have used a windows timer callback (SetTimer api) that runs every second.

    The clock displays nicely but, I noticed that if I leave it running for a longer time, the computer graphics display gradually becomes unstable\freezes and in one instance, I left the colck running for 30 mins, when I came back, the entire screen went black and I had to restart the computer... Sounds like some memory leak causing the issue.

    When I look in the Task Manager GDI Objects column, I see a moderate increase in activity (around 20%), but when stopping the clock, it goes back to almost where it was before.

    FYI, I am opening\declaring the GDI+ drawing objects inside the timer callback (ie: every second) but I am also making sure that all the opened GDI+ objects get properly deleted upon exiting the timer callback. So, in theory, there should be no memory leakage... Also, added lots of error checking as a further precaution.

    Do you have any ideas what might be causing the above issue ? and is it wise to open\close GDI+ objects inside a windows timer procedure every second ?

    Regards.


    Edit:This is just a small vba project for the purpose of learning how to use GDI+.
    Last edited by AngelV; Feb 6th, 2023 at 12:02 AM.

  2. #2
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,817

    Re: GDIPlus + Windows Timer

    Gotta see some code. And yeah, I'd keep as many GDI+ objects open as I could, rather than recreating everything every second.
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  3. #3

    Thread Starter
    Addicted Member
    Join Date
    Jun 2022
    Posts
    234

    Re: GDIPlus + Windows Timer

    Quote Originally Posted by Elroy View Post
    Gotta see some code. And yeah, I'd keep as many GDI+ objects open as I could, rather than recreating everything every second.
    Hi Elroy. Thanks for responding.

    The code is quite large but I can upload here an example workbook UPDATE as per post#10.



    Last edited by AngelV; Feb 7th, 2023 at 11:56 PM. Reason: Workbook Update Uploaded

  4. #4
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,817

    Re: GDIPlus + Windows Timer

    Ok, obviously, this is the VBA and not VB6. But you probably won't find people who know much about GDI+ over in the VBA forum.

    And, as you said, you're doing EVERYTHING in your timer event (aka, DrawClock) which gets raised once per second.

    For the benefit of others, I've posted that event procedure (timer callback) code here:


    Code:
    Private Sub DrawClock()
    
        Const HWND_TOPMOST = -1&:                       Const HWND_NOTOPMOST = -2&
        Const SWP_NOSIZE = &H1: Const SWP_NOMOVE = &H2: Const SWP_NOACTIVATE = &H10
        Const SmoothingModeAntiAlias = &H4:             Const DashStyleSolid = 0&
        Const StringFormatFlagsNoWrap = &H1000:         Const StringAlignmentCenter = &H1
        Const PixelFormat32bppPARGB = &H26200A:         Const UnitPixel = 2&
        Const PI = 3.14159265358979:                    Const Rads = PI / 180&
        Const ULW_ALPHA = 2&:                           Const AC_SRC_ALPHA = &H1000000
        Const WS_EX_LAYERED = &H80000:                  Const GWL_EXSTYLE = -20
        Const S_OK = 0&:                                Const SM_CYCAPTION = 4&
        
        Dim tRECTF As RECTF, ptSrc As POINTAPI, WinRect(0 To 1) As POINTAPI
        Dim hScreenDC As LongPtr, hMemDC As LongPtr, hBitmap As LongPtr, hPrevBmp As LongPtr
        Dim pBitmap As LongPtr, pFont As LongPtr, pPen As LongPtr, pBrush As LongPtr, pCap As LongPtr
        Dim pFontFamily As LongPtr, pFormat As LongPtr, lStyle As LongPtr
        Dim sngMinLinesLength As Single, sngYCaptionFactor As Single, sngFontHeight As Single
        Dim SngRadius1 As Single, SngRadius2 As Single, SngRadius3 As Single, SngRadius4 As Single, sngScaleRad As Single
        Dim sngSecond As Single, sngMinute As Single, sngHour As Single
        Dim X1 As Single, Y1 As Single
        Dim X2 As Single, Y2 As Single
        Dim Z1 As Single, Z2 As Single
        Dim W As Single, H As Single
        Dim lAngle As Long, lPenColor As Long, i As Long
        
            
        If hwnd = NULL_PTR Then GoTo GetOutAndCleanUp
        If IsIconic(hwnd) Then GoTo GetOutAndCleanUp
                     
        If bStopResume = False Then
            If bMute = False Then
                If bSkipPlayWav = False And bStopResume = False Then
                    Call PlayWav
                End If
            End If
            bSkipPlayWav = False
        
            Call GetWindowRect(hwnd, WinRect(0&))
            W = lRadius * 2&
            H = lRadius * 2&
            With WinRect(1&)
                .x = W: .y = H
            End With
            
            If GdipCreateBitmapFromScan0(W, H, 4& * W, PixelFormat32bppPARGB, NULL_PTR, pBitmap) <> S_OK Then
                GoTo GetOutAndCleanUp
            End If
            If GdipGetImageGraphicsContext(pBitmap, pGraphics) <> S_OK Then
                GoTo GetOutAndCleanUp
            End If
            If GdipSetSmoothingMode(pGraphics, SmoothingModeAntiAlias) <> S_OK Then
                GoTo GetOutAndCleanUp
            End If
            If GdipCreateSolidFill(RGBtoARGB(lBackColor, 255&), pBrush) <> S_OK Then
                GoTo GetOutAndCleanUp
            End If
            If lBackColor <> -1& Then
                If GdipFillEllipseI(pGraphics, pBrush, 0&, 0&, W - 1&, H - 1&) <> S_OK Then
                    GoTo GetOutAndCleanUp
                End If
            End If
        
            lPenColor = RGBtoARGB(lOutlineColor, 255&)
            If GdipCreatePen1(lPenColor, 4&, UnitPixel, pPen) <> S_OK Then
                GoTo GetOutAndCleanUp
            End If
            If GdipSetPenDashStyle(pPen, DashStyleSolid) <> S_OK Then
                GoTo GetOutAndCleanUp
            End If
            If GdipDrawEllipse(pGraphics, pPen, 2&, 2&, W - 5&, H - 5&) <> S_OK Then
                GoTo GetOutAndCleanUp
            End If
        
            Call GdipSetSolidFillColor(pBrush, RGBtoARGB(lNumbersFontColor, 255&))
            If GdipCreateFontFamilyFromName(StrPtr(sNumbersFontName), 0&, pFontFamily) <> S_OK Then
                GoTo GetOutAndCleanUp
            End If
            If GdipCreateFont(pFontFamily, lNumbersFontSize, 0&, UnitPixel, pFont) <> S_OK Then
                GoTo GetOutAndCleanUp
            End If
            If GdipGetFontHeight(pFont, pGraphics, sngFontHeight) <> S_OK Then
                GoTo GetOutAndCleanUp
            End If
            If GdipCreateStringFormat(0&, 0, pFormat) <> S_OK Then
                GoTo GetOutAndCleanUp
            End If
            If GdipSetStringFormatFlags(pFormat, StringFormatFlagsNoWrap) <> S_OK Then
                GoTo GetOutAndCleanUp
            End If
            If GdipSetStringFormatAlign(pFormat, StringAlignmentCenter) <> S_OK Then
                GoTo GetOutAndCleanUp
            End If
             
            sngYCaptionFactor = 1.3
            X1 = W / 2&
            Y1 = H / 2&
            SngRadius1 = W / 2& - (sngYCaptionFactor * GetSystemMetrics(SM_CYCAPTION))
            SngRadius2 = SngRadius1 * 8& / 10&
        
            For lAngle = 0& To 359&
                i = 15&
                If lAngle Mod 6& = 0& Then
                    X2 = (SngRadius1 + i) * (Sin(lAngle * Rads))
                    Y2 = (SngRadius1 + i) * (Cos(lAngle * Rads))
                    If lAngle Mod 5& = 0& Then
                        sngMinLinesLength = (SngRadius1 - SngRadius2) / 2&
                    Else
                        sngMinLinesLength = 4&
                    End If
                    Z1 = (X1 + X2) - (sngMinLinesLength * (Sin(lAngle * Rads)))
                    Z2 = (Y1 + Y2) - (sngMinLinesLength * (Cos(lAngle * Rads)))
                    lPenColor = RGBtoARGB(lMinLinesColor, 255&)
                    Call GdipSetPenColor(pPen, lPenColor)
                    Call GdipSetPenWidth(pPen, 5&)
                    Call GdipDrawLine(pGraphics, pPen, X1 + X2, Y1 + Y2, Z1, Z2)
                End If
                X2 = SngRadius2 * (Sin(lAngle * Rads))
                Y2 = SngRadius2 * (Cos(lAngle * Rads))
                tRECTF.Left = (X1 + X2):        tRECTF.Top = (Y1 + Y2 - sngFontHeight / 2&)
                If lAngle Mod 30& = 0& Then
                    Select Case lAngle
                        Case Is = 0&
                            Call GdipDrawString(pGraphics, StrPtr("6"), -1&, pFont, tRECTF, pFormat, pBrush)
                        Case Is = 30&
                            Call GdipDrawString(pGraphics, StrPtr("5"), -1&, pFont, tRECTF, pFormat, pBrush)
                        Case Is = 60&
                            Call GdipDrawString(pGraphics, StrPtr("4"), -1&, pFont, tRECTF, pFormat, pBrush)
                        Case Is = 90&
                            Call GdipDrawString(pGraphics, StrPtr("3"), -1&, pFont, tRECTF, pFormat, pBrush)
                        Case Is = 120&
                            Call GdipDrawString(pGraphics, StrPtr("2"), -1&, pFont, tRECTF, pFormat, pBrush)
                        Case Is = 150&
                            Call GdipDrawString(pGraphics, StrPtr("1"), -1&, pFont, tRECTF, pFormat, pBrush)
                        Case Is = 180&
                            Call GdipDrawString(pGraphics, StrPtr("12"), -1&, pFont, tRECTF, pFormat, pBrush)
                        Case Is = 210&
                            Call GdipDrawString(pGraphics, StrPtr("11"), -1&, pFont, tRECTF, pFormat, pBrush)
                        Case Is = 240&
                            Call GdipDrawString(pGraphics, StrPtr("10"), -1&, pFont, tRECTF, pFormat, pBrush)
                        Case Is = 270&
                            Call GdipDrawString(pGraphics, StrPtr("9"), -1&, pFont, tRECTF, pFormat, pBrush)
                        Case Is = 300&
                            Call GdipDrawString(pGraphics, StrPtr("8"), -1&, pFont, tRECTF, pFormat, pBrush)
                        Case Is = 330&
                            Call GdipDrawString(pGraphics, StrPtr("7"), -1&, pFont, tRECTF, pFormat, pBrush)
                    End Select
                End If
            Next lAngle
            Call GdipDeleteBrush(pBrush)
            Call GdipDeleteFontFamily(pFontFamily)
            Call GdipDeleteStringFormat(pFormat)
            pBrush = NULL_PTR
            pFont = NULL_PTR
            pFontFamily = NULL_PTR
            pFormat = NULL_PTR
        
            SngRadius3 = SngRadius1 * 7& / 10&
            SngRadius4 = SngRadius1 * 8& / 10&
    
            'Hours.
            If sngHourHandThickness = 0& Then sngHourHandThickness = 5&
            lPenColor = RGBtoARGB(lHourHandColor, 255&)
            Call GdipSetPenColor(pPen, lPenColor)
            Call GdipSetPenWidth(pPen, sngHourHandThickness)
            
            If bShowArrowCaps = True Then
                Call GdipCreateAdjustableArrowCap(5, 3, -1&, pCap)
                Call GdipSetPenCustomStartCap(pPen, pCap)
            End If
            
            sngHour = (Hour(Time) + (Minute(Time) / 60&)) * (2& * PI / 12&)
            If GdipDrawLine(pGraphics, pPen, X1 + SngRadius4 * Sin(sngHour) * 0.55, Y1 - SngRadius4 * Cos(sngHour) * 0.55, X1, Y1) <> S_OK Then
                GoTo GetOutAndCleanUp
            End If
    
            'Minutes.
            If sngMinHandThickness = 0& Then sngMinHandThickness = 3&
            lPenColor = RGBtoARGB(lMinHandColor, 255&)
            Call GdipSetPenColor(pPen, lPenColor)
            Call GdipSetPenWidth(pPen, sngMinHandThickness)
            sngMinute = (Minute(Time) + (Second(Time) / 60&)) * (2& * PI / 60&)
            If GdipDrawLine(pGraphics, pPen, X1 + SngRadius3 * Sin(sngMinute) * 0.8, Y1 - SngRadius3 * Cos(sngMinute) * 0.8, X1, Y1) <> S_OK Then
                GoTo GetOutAndCleanUp
            End If
        
            'Seconds.
            If sngSecHandThickness = 0& Then sngSecHandThickness = 2&
            lPenColor = RGBtoARGB(lSecHandColor, 255&)
            Call GdipSetPenColor(pPen, lPenColor)
            Call GdipSetPenWidth(pPen, sngSecHandThickness)
            sngSecond = Second(Time) * (2& * PI / 60&)
            If GdipDrawLine(pGraphics, pPen, X1 + SngRadius3 * Sin(sngSecond) * 0.9, Y1 - SngRadius3 * Cos(sngSecond) * 0.9, X1, Y1) <> S_OK Then
                GoTo GetOutAndCleanUp
            End If
     
            sngScaleRad = lRadius / 200
            lPenColor = RGBtoARGB(0, 255&)
            Call GdipSetPenColor(pPen, lPenColor)
            Call GdipSetPenWidth(pPen, 10&)
            If GdipDrawEllipse(pGraphics, pPen, X1, Y1, 1, 1) <> S_OK Then
                GoTo GetOutAndCleanUp
            End If
            
            lPenColor = RGBtoARGB(lNumbersFontColor, 255&)
            Call GdipSetPenColor(pPen, lPenColor)
            Call GdipSetPenWidth(pPen, 2&)
            If GdipDrawEllipse(pGraphics, pPen, X1 - sngHourHandThickness * 2.5 * sngScaleRad, Y1 - sngHourHandThickness * 2.5 * sngScaleRad, 5& * sngHourHandThickness * sngScaleRad, 5& * sngHourHandThickness * sngScaleRad) <> S_OK Then
                GoTo GetOutAndCleanUp
            End If
            If GdipDrawEllipse(pGraphics, pPen, X1 - sngHourHandThickness * 1.5 * sngScaleRad, Y1 - sngHourHandThickness * 1.5 * sngScaleRad, 3& * sngHourHandThickness * sngScaleRad, 3& * sngHourHandThickness * sngScaleRad) <> S_OK Then
                GoTo GetOutAndCleanUp
            End If
            Call GdipDeletePen(pPen)
            pPen = NULL_PTR
            pCap = NULL_PTR
        
            If GdipCreateHBITMAPFromBitmap(pBitmap, hBitmap, 0&) <> S_OK Then
                GoTo GetOutAndCleanUp
            End If
        
            hScreenDC = GetDC(NULL_PTR)
            If hScreenDC = NULL_PTR Then
                GoTo GetOutAndCleanUp
            End If
            hMemDC = CreateCompatibleDC(hScreenDC)
            If hMemDC = NULL_PTR Then
                GoTo GetOutAndCleanUp
            End If
            hPrevBmp = SelectObject(hMemDC, hBitmap)
            If hPrevBmp = NULL_PTR Then
                GoTo GetOutAndCleanUp
            End If
        
            lStyle = GetWindowLong(hwnd, GWL_EXSTYLE)
            If (lStyle And WS_EX_LAYERED) = 0& Then
            lStyle = lStyle Or WS_EX_LAYERED
                Call SetWindowLong(hwnd, GWL_EXSTYLE, lStyle)
            End If
    
            If UpdateLayeredWindow(hwnd, hScreenDC, WinRect(0&), WinRect(1&), hMemDC, ptSrc, 0&, AC_SRC_ALPHA Or CByte(255& * sngOpacity) * &H10000, ULW_ALPHA) = 0& Then
                GoTo GetOutAndCleanUp
            End If
    
            If oCanvas.Tag = "Init" Then
                oCanvas.Tag = ""
                Call SetFocus(Application.hwnd)
                Call SetFocus(hwnd)
                Call SetWindowPos(hwnd, IIf(bAlwaysOnTop, HWND_TOPMOST, HWND_NOTOPMOST), 0&, 0&, 0&, 0&, SWP_NOSIZE + SWP_NOMOVE + SWP_NOACTIVATE)
            End If
            
        End If
    
    GetOutAndCleanUp:
    
        If pBrush <> NULL_PTR Then
            Call GdipDeleteBrush(pBrush)
        End If
        If pPen <> NULL_PTR Then
            Call GdipDeletePen(pPen)
        End If
        If pFont <> NULL_PTR Then
            Call GdipDeleteFont(pFont)
        End If
        If pFormat <> NULL_PTR Then
            Call GdipDeleteStringFormat(pFormat)
        End If
        If pFontFamily <> NULL_PTR Then
            Call GdipDeleteFontFamily(pFontFamily)
        End If
        If hBitmap <> NULL_PTR Then
            Call GdipDisposeImage(pBitmap)
        End If
        If hBitmap <> NULL_PTR Then
            If hPrevBmp <> NULL_PTR Then
                Call SelectObject(hMemDC, hPrevBmp)
            End If
            Call DeleteObject(hBitmap)
        End If
        If hMemDC <> NULL_PTR Then
            Call DeleteDC(hMemDC)
        End If
        If hScreenDC <> NULL_PTR Then
            Call ReleaseDC(NULL_PTR, hScreenDC)
        End If
        
        'SetThreadExecutionState !!!
            'PreventSleepMode = True
    
    End Sub
    
    
    Private Function InitializesGDIPlus(ByVal Init As Boolean) As Boolean
    
        Const S_OK = 0&
        Static lGDIP As LongPtr
        Dim tSI As GdiplusStartupInput
        Dim lRet As Long
        
        If Init Then
            tSI.GdiplusVersion = 1&
            lRet = GdiplusStartup(lGDIP, tSI)
            If lRet = S_OK Then InitializesGDIPlus = True
        Else
            If lGDIP Then
                Call GdipDeleteGraphics(pGraphics)
                Call GdiplusShutdown(lGDIP)
                lGDIP = NULL_PTR
            End If
        End If
       
    End Function
    Ok, I've worked quite a bit with the GDI+ but I don't work with it everyday. However, I'd never do ALL of that every second.

    You're even initializing the GDI+ every second, and I don't see were you're ever un-initializing it. So you're just initializing it over and over and over. That in and of itself could probably crash the system.

    Beyond that, if it were me, I'd try very hard to do much of that work ONE TIME, rather than once-per-second. I mean, you know when one of your buttons is being clicked, so just get the one-time stuff done then.

    --------------

    ADDED: Actually, you're not initializing the GDI+ on every tick, but you aren't ever un-initializing it. That really should be a one-time thing. And all the other one-time stuff still holds.
    Last edited by Elroy; Feb 7th, 2023 at 02:30 AM.
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  5. #5

    Thread Starter
    Addicted Member
    Join Date
    Jun 2022
    Posts
    234

    Re: GDIPlus + Windows Timer

    ADDED: Actually, you're not initializing the GDI+ on every tick, but you aren't ever un-initializing it. That really should be a one-time thing. And all the other one-time stuff still holds.
    Thanks for looking.

    I am actually un-initializing the GDI+ once in the DeleteClock routine which is raised when closing the clock form.

    Code:
    Private Sub UserForm_Terminate()
    
        Dim i As Long, lCount As Long
    
        For i = 0& To VBA.UserForms.Count - 1&
            If GetProp(hwnd, "Clock_") = 1& Then
                lCount = lCount + 1&
            End If
        Next i
        If lCount > 1& Then
            Exit Sub
        End If
        bInit = False
        Call DeleteClock
    
    End Sub

    I'd try very hard to do much of that work ONE TIME
    ̶I̶ ̶h̶a̶v̶e̶n̶'̶t̶ ̶t̶r̶i̶e̶d̶ ̶t̶h̶a̶t̶ ̶b̶u̶t̶ ̶I̶ ̶w̶i̶l̶l̶ ̶t̶r̶y̶ ̶i̶t̶ ̶a̶n̶d̶ ̶s̶e̶e̶ ̶i̶f̶ ̶t̶h̶a̶t̶ ̶m̶a̶k̶e̶s̶ ̶a̶n̶y̶ ̶d̶i̶f̶f̶e̶r̶e̶n̶c̶e̶.̶
    Oops! I misunderstood what you meant by ONE TIME

    I don't know how I would draw an updating clock ONE TIME. The drawing operations (Specially, the moving Hour-Min-Sec Clock hands) will need to be re-drawn every second in order for the clock to display the correct current time.
    Last edited by AngelV; Feb 7th, 2023 at 03:26 AM.

  6. #6
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,625

    Re: GDIPlus + Windows Timer

    I do see quite a bit in there you could only do once. The hwnd won't change, so IsIconic(hwnd) won't change, =nullptr won't change, the RECT might change but you should be watching for a resize event, not recalculating sizes every tick. You can do the RBGtoARGB calculations once. Create the pens and set their properties once. GdipCreateFontFamilyFromName/GdipCreateFont those are heavy weight calls you only need once. GetSystemMetrics(SM_CYCAPTION) is very unlikely to change but if you wanted to account for that rarity you could listen for WM_THEMECHANGED.

  7. #7

    Thread Starter
    Addicted Member
    Join Date
    Jun 2022
    Posts
    234

    Re: GDIPlus + Windows Timer

    @fafalone

    IsIconic(hwnd) is needed as I have added a Taskbar icon (ITaskbarList extension) for the user to minimize the clock.

    I see what you are saying about creating the Pen, brush and Font objects once. Maybe storing them in a module level array at the start and releasing them at the end.

    I will give your suggestion a shot and see what happens.

    Thanks

  8. #8
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,625

    Re: GDIPlus + Windows Timer

    GetDC(null), setting the window style...also once.

    What is PlayWav doing (can't open it right now)? You should have wav loaded once into a byte array and use SND_MEMORY and SND_ASYNC.

  9. #9

    Thread Starter
    Addicted Member
    Join Date
    Jun 2022
    Posts
    234

    Re: GDIPlus + Windows Timer

    Quote Originally Posted by fafalone View Post
    GetDC(null), setting the window style...also once.

    What is PlayWav doing (can't open it right now)? You should have wav loaded once into a byte array and use SND_MEMORY and SND_ASYNC.
    That's what I am doing. I create the wav from memory bytes once ad then play it every second... I don't think this what is causing the issue.

    Code:
    Public Sub CreateTickTockWavSound(Optional ByVal bDummy As Boolean)
        Call BuildWAVSoundArrayFromBytes
    End Sub
    
    Public Sub PlayWav(Optional ByVal bDummy As Boolean)
        Const SND_ASYNC = &H1
        Const SND_NODEFAULT = &H2
        Const SND_MEMORY = &H4
        If SafeArrayGetDim(b) Then
            Call PlaySound(b(0&), SND_ASYNC Or SND_NODEFAULT Or SND_MEMORY)
        End If
    End Sub
    
    Public Sub UnloadWavBytes(Optional ByVal bDummy As Boolean)
        If SafeArrayGetDim(b) Then
            Call PlaySound(ByVal StrPtr(vbNullString), 0&)
            Erase b
        End If
    End Sub

  10. #10

    Thread Starter
    Addicted Member
    Join Date
    Jun 2022
    Posts
    234

    Re: GDIPlus + Windows Timer

    Ok- I seem to have finally managed to prevent the display freezing issue by making the timer callback lighter as suggested by you guys.

    I am now initializing the GDI+ objects once before running the windows timer callback and I am storing them in module level variables so they can be seen everywhere and then properly released upon closing the clock. The only exception is the pBitmap object (GdipCreateHBITMAPFromBitmap) which is still initialized inside the timer callback.

    This has made a huge difference in terms of performance and, based on the first couple of testings that I have carried out, the clock seems to run w/o problems even when left running for longer periods of time.

    By re-designing the project layout, I encountered a couple of new issues but I have corrected them by calling the GdipGraphicsClear api at the right spot.

    For the entire code, check out the following updated workbook:
    WORKBOOK UPDATE

    Thank you Elroy and fafalone for your advice on this.


    Timer Callbak Procedure:
    Code:
    Private Sub DrawClock()
    
        Const HWND_TOPMOST = -1&:  Const HWND_NOTOPMOST = -2&
        Const SWP_NOSIZE = &H1: Const SWP_NOMOVE = &H2: Const SWP_NOACTIVATE = &H10
        Const PI = 3.14159265358979: Const Rads = PI / 180&
        Const ULW_ALPHA = 2&: Const AC_SRC_ALPHA = &H1000000
        Const SM_CYCAPTION = 4&
        
        Dim tRECTF As RECTF, ptSrc As POINTAPI, WinRect(0 To 1) As POINTAPI
        Dim X1 As Single, Y1 As Single
        Dim X2 As Single, Y2 As Single
        Dim Z1 As Single, Z2 As Single
        Dim SngRadius1 As Single, SngRadius2 As Single, SngRadius3 As Single
        Dim SngRadius4 As Single, sngScaleRad As Single
        Dim sngSecond As Single, sngMinute As Single, sngHour As Single
        Dim sngMinLinesLength As Single, sngYCaptionFactor As Single
        Dim i As Long, lAngle As Long
        
            
        If hwnd = NULL_PTR Then Exit Sub
        If IsIconic(hwnd) Then Exit Sub
                     
        If bStopResume = False Then
            If bMute = False Then
                If bSkipPlayWav = False And bStopResume = False Then
                    Call PlayWav
                End If
            End If
            bSkipPlayWav = False
        
            Call GetWindowRect(hwnd, WinRect(0&))
            With WinRect(1&)
                .x = W: .y = H
            End With
             
            If lBackColor <> -1& Then
                Call GdipSetSolidFillColor(pBrush, RGBtoARGB(lBackColor, 255&))
                Call GdipFillEllipseI(pGraphics, pBrush, 0&, 0&, W - 1&, H - 1&)
            End If
       
            lPenColor = RGBtoARGB(lOutlineColor, 255&)
            Call GdipSetPenColor(pPen, lPenColor)
            Call GdipSetPenWidth(pPen, 4&)
            Call GdipDrawEllipse(pGraphics, pPen, 2&, 2&, W - 5&, H - 5&)
             
            sngYCaptionFactor = 1.3
            X1 = W / 2&
            Y1 = H / 2&
            SngRadius1 = W / 2& - (sngYCaptionFactor * GetSystemMetrics(SM_CYCAPTION))
            SngRadius2 = SngRadius1 * 8& / 10&
            
            For lAngle = 0& To 359&
                i = 15&
                If lAngle Mod 6& = 0& Then
                    X2 = (SngRadius1 + i) * (Sin(lAngle * Rads))
                    Y2 = (SngRadius1 + i) * (Cos(lAngle * Rads))
                    If lAngle Mod 5& = 0& Then
                        sngMinLinesLength = (SngRadius1 - SngRadius2) / 2&
                    Else
                        sngMinLinesLength = 4&
                    End If
                    Z1 = (X1 + X2) - (sngMinLinesLength * (Sin(lAngle * Rads)))
                    Z2 = (Y1 + Y2) - (sngMinLinesLength * (Cos(lAngle * Rads)))
                    lPenColor = RGBtoARGB(lMinLinesColor, 255&)
                    Call GdipSetPenColor(pPen, lPenColor)
                    Call GdipSetPenWidth(pPen, 5&)
                    Call GdipDrawLine(pGraphics, pPen, X1 + X2, Y1 + Y2, Z1, Z2)
                End If
                X2 = SngRadius2 * (Sin(lAngle * Rads))
                Y2 = SngRadius2 * (Cos(lAngle * Rads))
                tRECTF.Left = (X1 + X2):        tRECTF.Top = (Y1 + Y2 - sngFontHeight / 2&)
                
                 Call GdipSetSolidFillColor(pBrush, RGBtoARGB(lNumbersFontColor, 255&))
                If lAngle Mod 30& = 0& Then
                    Select Case lAngle
                        Case Is = 0&
                            Call GdipDrawString(pGraphics, StrPtr("6"), -1&, pFont, tRECTF, pFormat, pBrush)
                        Case Is = 30&
                            Call GdipDrawString(pGraphics, StrPtr("5"), -1&, pFont, tRECTF, pFormat, pBrush)
                        Case Is = 60&
                            Call GdipDrawString(pGraphics, StrPtr("4"), -1&, pFont, tRECTF, pFormat, pBrush)
                        Case Is = 90&
                            Call GdipDrawString(pGraphics, StrPtr("3"), -1&, pFont, tRECTF, pFormat, pBrush)
                        Case Is = 120&
                            Call GdipDrawString(pGraphics, StrPtr("2"), -1&, pFont, tRECTF, pFormat, pBrush)
                        Case Is = 150&
                            Call GdipDrawString(pGraphics, StrPtr("1"), -1&, pFont, tRECTF, pFormat, pBrush)
                        Case Is = 180&
                            Call GdipDrawString(pGraphics, StrPtr("12"), -1&, pFont, tRECTF, pFormat, pBrush)
                        Case Is = 210&
                            Call GdipDrawString(pGraphics, StrPtr("11"), -1&, pFont, tRECTF, pFormat, pBrush)
                        Case Is = 240&
                            Call GdipDrawString(pGraphics, StrPtr("10"), -1&, pFont, tRECTF, pFormat, pBrush)
                        Case Is = 270&
                            Call GdipDrawString(pGraphics, StrPtr("9"), -1&, pFont, tRECTF, pFormat, pBrush)
                        Case Is = 300&
                            Call GdipDrawString(pGraphics, StrPtr("8"), -1&, pFont, tRECTF, pFormat, pBrush)
                        Case Is = 330&
                            Call GdipDrawString(pGraphics, StrPtr("7"), -1&, pFont, tRECTF, pFormat, pBrush)
                    End Select
                End If
            Next lAngle
        
            SngRadius3 = SngRadius1 * 7& / 10&
            SngRadius4 = SngRadius1 * 8& / 10&
    
            'Hours.
            If sngHourHandThickness = 0& Then sngHourHandThickness = 5&
            lPenColor = RGBtoARGB(lHourHandColor, 255&)
            Call GdipSetPenColor(pPen2, lPenColor)
            Call GdipSetPenWidth(pPen2, sngHourHandThickness)
            sngHour = (Hour(Time) + (Minute(Time) / 60&)) * (2& * PI / 12&)
            Call GdipDrawLine(pGraphics, pPen2, X1 + SngRadius4 * Sin(sngHour) * 0.55, Y1 - SngRadius4 * Cos(sngHour) * 0.55, X1, Y1)
    
            'Minutes.
            If sngMinHandThickness = 0& Then sngMinHandThickness = 3&
            lPenColor = RGBtoARGB(lMinHandColor, 255&)
            Call GdipSetPenColor(pPen2, lPenColor)
            Call GdipSetPenWidth(pPen2, sngMinHandThickness)
            sngMinute = (Minute(Time) + (Second(Time) / 60&)) * (2& * PI / 60&)
           Call GdipDrawLine(pGraphics, pPen2, X1 + SngRadius3 * Sin(sngMinute) * 0.8, Y1 - SngRadius3 * Cos(sngMinute) * 0.8, X1, Y1)
        
            'Seconds.
            If sngSecHandThickness = 0& Then sngSecHandThickness = 2&
            lPenColor = RGBtoARGB(lSecHandColor, 255&)
            Call GdipSetPenColor(pPen2, lPenColor)
            Call GdipSetPenWidth(pPen2, sngSecHandThickness)
            sngSecond = Second(Time) * (2& * PI / 60&)
            Call GdipDrawLine(pGraphics, pPen2, X1 + SngRadius3 * Sin(sngSecond) * 0.9, Y1 - SngRadius3 * Cos(sngSecond) * 0.9, X1, Y1)
       
            sngScaleRad = lRadius / 200&
            lPenColor = RGBtoARGB(0&, 255&)
            Call GdipSetPenColor(pPen, lPenColor)
            Call GdipSetPenWidth(pPen, 10&)
            Call GdipDrawEllipse(pGraphics, pPen, X1, Y1, 1, 1)
            
            lPenColor = RGBtoARGB(lNumbersFontColor, 255&)
            Call GdipSetPenColor(pPen, lPenColor)
            Call GdipSetPenWidth(pPen, 2&)
            Call GdipDrawEllipse(pGraphics, pPen, X1 - sngHourHandThickness * 2.5 * sngScaleRad, Y1 - sngHourHandThickness * 2.5 * sngScaleRad, 5& * sngHourHandThickness * sngScaleRad, 5& * sngHourHandThickness * sngScaleRad)
            Call GdipDrawEllipse(pGraphics, pPen, X1 - sngHourHandThickness * 1.5 * sngScaleRad, Y1 - sngHourHandThickness * 1.5 * sngScaleRad, 3& * sngHourHandThickness * sngScaleRad, 3& * sngHourHandThickness * sngScaleRad)
    
            Call GdipCreateHBITMAPFromBitmap(pBitmap, hBitmap, 0&)
            Call GdipGraphicsClear(pGraphics, 0&)
    
            hScreenDC = GetDC(NULL_PTR)
            hMemDC = CreateCompatibleDC(hScreenDC)
            hPrevBmp = SelectObject(hMemDC, hBitmap)
    
            If UpdateLayeredWindow(hwnd, hScreenDC, WinRect(0&), WinRect(1&), hMemDC, ptSrc, 0&, AC_SRC_ALPHA Or CByte(255& * sngOpacity) * &H10000, ULW_ALPHA) = 0& Then
                Call DeleteClock(True)
                Exit Sub
            End If
            
            If hBitmap <> NULL_PTR Then
                If hPrevBmp <> NULL_PTR Then
                    Call SelectObject(hMemDC, hPrevBmp)
                End If
            Call DeleteObject(hBitmap)
            End If
            If hMemDC <> NULL_PTR Then
                Call DeleteDC(hMemDC)
            End If
            If hScreenDC <> NULL_PTR Then
                Call ReleaseDC(NULL_PTR, hScreenDC)
            End If
            hBitmap = NULL_PTR
            hMemDC = NULL_PTR
            hScreenDC = NULL_PTR
            hPrevBmp = NULL_PTR
    
            If oCanvas.Tag = "Init" Then
                oCanvas.Tag = ""
                Call SetFocus(Application.hwnd)
                Call SetFocus(hwnd)
                Call SetWindowPos(hwnd, IIf(bAlwaysOnTop, HWND_TOPMOST, HWND_NOTOPMOST), 0&, 0&, 0&, 0&, SWP_NOSIZE + SWP_NOMOVE + SWP_NOACTIVATE)
            End If
        
        End If
    
    End Sub
    Last edited by AngelV; Feb 7th, 2023 at 11:53 PM.

  11. #11
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,092

    Re: GDIPlus + Windows Timer

    This:

    Code:
                    Select Case lAngle
                        Case Is = 0&
                            Call GdipDrawString(pGraphics, StrPtr("6"), -1&, pFont, tRECTF, pFormat, pBrush)
                        Case Is = 30&
                            Call GdipDrawString(pGraphics, StrPtr("5"), -1&, pFont, tRECTF, pFormat, pBrush)
                        Case Is = 60&
                            Call GdipDrawString(pGraphics, StrPtr("4"), -1&, pFont, tRECTF, pFormat, pBrush)
                        Case Is = 90&
                            Call GdipDrawString(pGraphics, StrPtr("3"), -1&, pFont, tRECTF, pFormat, pBrush)
                        Case Is = 120&
                            Call GdipDrawString(pGraphics, StrPtr("2"), -1&, pFont, tRECTF, pFormat, pBrush)
                        Case Is = 150&
                            Call GdipDrawString(pGraphics, StrPtr("1"), -1&, pFont, tRECTF, pFormat, pBrush)
                        Case Is = 180&
                            Call GdipDrawString(pGraphics, StrPtr("12"), -1&, pFont, tRECTF, pFormat, pBrush)
                        Case Is = 210&
                            Call GdipDrawString(pGraphics, StrPtr("11"), -1&, pFont, tRECTF, pFormat, pBrush)
                        Case Is = 240&
                            Call GdipDrawString(pGraphics, StrPtr("10"), -1&, pFont, tRECTF, pFormat, pBrush)
                        Case Is = 270&
                            Call GdipDrawString(pGraphics, StrPtr("9"), -1&, pFont, tRECTF, pFormat, pBrush)
                        Case Is = 300&
                            Call GdipDrawString(pGraphics, StrPtr("8"), -1&, pFont, tRECTF, pFormat, pBrush)
                        Case Is = 330&
                            Call GdipDrawString(pGraphics, StrPtr("7"), -1&, pFont, tRECTF, pFormat, pBrush)
                    End Select
    . . . looks so wrong.

    Can you use a local string variable and call GdipDrawString once?

    Can you remove the Select Case at all and init this local string variable straight from lAngle with some basic math?

    cheers,
    </wqw>

  12. #12
    PowerPoster
    Join Date
    Nov 2017
    Posts
    3,106

    Re: GDIPlus + Windows Timer

    6 * (lAngle \ 180) + (180 - (lAngle Mod 180)) \ 30

  13. #13

  14. #14

    Thread Starter
    Addicted Member
    Join Date
    Jun 2022
    Posts
    234

    Re: GDIPlus + Windows Timer

    Quote Originally Posted by wqweto View Post
    This:
    Can you remove the Select Case at all and init this local string variable straight from lAngle with some basic math?</wqw>
    Yes. That was stupid of me... now corrected :

    Code:
    If lAngle Mod 30& = 0& Then
       Call GdipDrawString(pGraphics, StrPtr(CStr((530& - lAngle) \ 30& Mod 12& + 1&)), -1&, pFont, tRECTF, pFormat, pBrush)
    End If
    Also, thanks OptionBase1 and The trick.
    Last edited by AngelV; Feb 8th, 2023 at 04:39 PM.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width