GDIPlus + Windows Timer

[AngelV]

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+.

[Elroy]

Gotta see some code. And yeah, I'd keep as many GDI+ objects open as I could, rather than recreating everything every second.

[AngelV]

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.

[Elroy]

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:

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.

[AngelV]

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.

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.

[fafalone]

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.

[AngelV]

@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

[fafalone]

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.

[AngelV]

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.

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

[AngelV]

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:

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

[wqweto]

This:

                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>

[OptionBase1]

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

[The trick]

(530 - lAngle) \ 30 Mod 12 + 1

[AngelV]

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 :

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.