New Sub-Forum

In an effort to help make sure there are appropriate categories for topics of discussion that are happening, there is now a sub-forum for databases and database programming under Special Interest groups. Please direct questions, etc., about this topic to that sub-forum moving forward. Thank you.
See more
See less

Resource Cursor

  • Filter
  • Time
  • Show
Clear All
new posts

  • Resource Cursor

    I'd like to include a cursor as a resource, then use the cursor at runtime. There's no "Cursor" resource type in PBWin10, so I use RcData instead.

    #Resource RcData, arrow, "arrow.cur"
    I've posted code where I save the resource as a file and then use the LoadImage API with %LR_LoadFromFile like this ...

    hCursorA  = LoadImage (ByVal 0, "arrow.cur", %IMAGE_CURSOR, 125, 125, %LR_LOADFROMFILE)
    But, I can't find an example of using a resource cursor file directly (no intermediate file). Is that possible?

    I tried this, but it did not work ...

    hCursorA  = LoadCursor(GetModuleHandle(ByVal 0), "arrow")

  • #2
    Hi Gary

    The parameter of GetModuleHandle is an LPCSTR so, in your case, NULL is a pointer to an empty string and not ByVal 0.

    hCursorA = LoadCursor(GetModuleHandle(""), "arrow")


    • #3
      Howdy, Dave!

      Thanks for the comment. But your suggestion, and my original line of code, return a zero value.

         hCursorA  = LoadCursor(GetModuleHandle(""), "arrow")
         hCursorA  = LoadCursor(GetModuleHandle(ByVal 0), "arrow")
      I've assumed that the RcData resource type is at the heart of the problem but I don't know enough about resource storage to be sure. Regardless, it seems like there ought to be a work around that doesn't require the use of a file.


      • #4
        ... results pending (something that worked, now seems to fail)...


        • #5
          Never really liked the improved #RESOURCE metastatements, both because of limitations like this and the fact they add a bit to compile time. Easy enough to put all resources into an .RC file, compile to .PBR file once and then have everything working from start.
          In Stuff.rc:
          #include "resource.h"
          arrow  CURSOR  "arrow.cur"      // custom cursor
          In program code:
          #RESOURCE "Stuff.PBR"
            STATIC CurArrow AS DWORD
                CurArrow = LoadCursor(GetModuleHandle(""), "arrow")
            CASE %WM_SETCURSOR
                IF CurArrow THEN
                   IF GetCursor <> CurArrow THEN SetCursor CurArrow
                   FUNCTION = 1
                END IF


          • #6
            This is OK.
            #include "resource.h"
            arrow CURSOR arrow.cur
            We don't need the quotes for the filename, unless it has a space within it.


            • #7
              If you want to avoid .res or .pbr, you can include the cursor as an Icon resource. The hotspot gets shifted to the middle of the image but that can be redressed..
              #Compile Exe
              #Dim All
              #Include ""
              #Resource Icon, arrow, "Arrow128.cur"      ' "Green Pin.cur"
              CallBack Function DlgProc() As Long
               Static CurArrow As Dword
                Select Case As Long Cb.Msg
                  Case %WM_InitDialog
                    Local hIcon As Dword
                      hIcon = LoadImage(GetModuleHandle(""),"arrow", %Image_Icon, 0, 0, %LR_DEFAULTCOLOR)
                      If hIcon Then
                       Local pIconInfo As IconInfo
                        GetIconInfo(hIcon, pIconInfo)
               '          ? Using$("Hotspot # # ", pIconInfo.xHotspot, pIconInfo.yHotspot)  ' Mid point from Res
                        pIconInfo.fIcon = 0                                               ' Type > cursor (1 = Icon)
                        pIconInfo.xHotspot = 2 : pIconInfo.yHotspot = 2                   ' Adjust Hotspot
                        CurArrow = CreateIconIndirect(pIconInfo)                          ' Recreate as CurArrow
                        DestroyIcon hIcon
                      End If
                  Case %WM_SetCursor
                      If CurArrow Then
                         If GetCursor <> CurArrow Then SetCursor CurArrow
                         Function = 1
                      End If
                  Case %WM_Destroy
                End Select
              End Function
              Function PBMain()
               Local hDlg  As Dword
                Dialog New 0, "Test", , , 200, 120, %WS_Caption Or %WS_SysMenu, To hDlg
                Dialog Show Modal hDlg, Call DlgProc
              End Function
              Rgds, Dave


              • #8
                use #RESOURCE BITMAP. Then create your cursor on the fly. You can use the following for that. I found it on this bb several years ago. Don't remember who wrote it:

                FUNCTION FN_NewCursor(BYVAL CurSize AS WORD, BYVAL xHotSpot AS WORD, BYVAL yHotSpot AS WORD, _
                                      CursName AS STRING) AS DWORD  'BYVAL ResNum AS DWORD) AS DWORD
                LOCAL hDC         AS DWORD
                LOCAL hMemDC      AS DWORD
                LOCAL hBrush      AS DWORD
                LOCAL hBrushOld   AS DWORD
                LOCAL IbmpHndl    AS DWORD
                LOCAL IbmpDc      AS DWORD
                LOCAL Bmp         AS STRING
                LOCAL hBitmap     AS DWORD
                LOCAL hOldBitmap  AS DWORD
                LOCAL X           AS DWORD
                LOCAL Y           AS DWORD
                LOCAL dwWidth     AS LONG
                LOCAL dwHeight    AS LONG
                LOCAL hMonoBitmap AS DWORD
                LOCAL rgbColor    AS DWORD
                LOCAL hAlphaCursor  AS DWORD
                LOCAL dwErr         AS DWORD
                LOCAL bi            AS BITMAPINFO
                LOCAL IcoInfo       AS ICONINFO
                LOCAL rgbPixel      AS RGBQUAD
                LOCAL bm            AS BITMAP
                LOCAL ClrPtr AS DWORD POINTER
                dwWidth  = CurSize
                dwHeight = CurSize
                bi.bmiHeader.bV5Size            = SIZEOF(BITMAPV5HEADER)
                bi.bmiHeader.bV5Width           = dwWidth
                bi.bmiHeader.bV5Height          = dwHeight
                bi.bmiHeader.bV5Planes          = 1
                bi.bmiHeader.bV5BitCount        = 32
                bi.bmiHeader.bV5Compression     = %BI_RGB
                bi.bmiHeader.bV5RedMask         = &hFF000000
                bi.bmiHeader.bV5GreenMask       = &h00FF0000
                bi.bmiHeader.bV5BlueMask        = &h0000FF00
                bi.bmiHeader.bV5AlphaMask       = &h000000FF
                hdc = GetDC(%NULL)
                hBitmap = CreateDIBSection(hdc, bi, %DIB_RGB_COLORS, 0, 0, 0)
                hMemDC = CreateCompatibleDC(hdc)
                hOldBitmap = SelectObject(hMemDC, hBitmap)
                CALL GetObject(hBitmap, SIZEOF(bm), bm)
                PatBlt(hMemDC, 0, 0, dwWidth, dwHeight, %BLACKNESS)
                CALL CreateBmp(CurSize, CurSize, IBmpHndl, IbmpDc)
                GRAPHIC ATTACH IbmpHndl, 0
                GRAPHIC CLEAR 0
                GRAPHIC GET DC TO IbmpDC
                GRAPHIC RENDER BITMAP CursName$, (0, 0) - (CurSize - 1, CurSize - 1)
                GRAPHIC GET BITS TO Bmp$
                ClrPtr = STRPTR(Bmp$) + 8
                FOR I = 0 TO CurSize - 1
                  FOR J = 0 TO CurSize - 1
                    Icolor = BGR(@ClrPtr)
                    IF (Icolor = %BLACK) OR (Icolor = %WHITE) THEN GOTO IncPtr
                    setpixelv(hMemDC, J, I, Icolor)
                    IncPtr: '
                    INCR ClrPtr
                  NEXT J
                NEXT I
                CALL DestroyBmp(IbmpHndl, IbmpDc)
                PatBlt(hMemDC, xHotSpot - 2, yHotSpot - 2, 4, 4, %BLACKNESS)
                SelectObject(hMemDC, hOldBitmap)
                hMonoBitmap = CreateBitmap(dwWidth&, dwHeight, 1, 24, BYVAL %NULL)
                hOldBitmap = SelectObject(hMemDC, hMonoBitmap)
                PatBlt(hMemDC, 0, 0, dwWidth, dwHeight, %BLACKNESS)
                SelectObject(hMemDC, hOldBitmap)
                '// SET the alpha value FOR each pixel so that the complete cursor
                '// is semi-transparent.
                REDIM rgbPixels(dwWidth * dwHeight - 1) AS RGBQUAD AT bm.bmBits
                FOR X = 0 TO dwWidth - 1
                   FOR Y = 0 TO dwHeight - 1
                       I = Y * dwHeight& + X
                       rgbColor = MAKDWD(MAKWRD(rgbPixels(I).rgbRed, rgbPixels(I).rgbGreen),_
                       IF rgbColor = %BLUE THEN
                          rgbPixels(I).rgbReserved = 255
                       ELSEIF rgbColor = %BLACK THEN
                          rgbPixels(I).rgbReserved = 0
                       ELSEIF rgbColor = %RED THEN
                          rgbPixels(I).rgbReserved = 255
                          rgbPixels(I).rgbReserved = rgbcolor
                       END IF
                icoInfo.fIcon = %FALSE
                icoInfo.xHotspot = xHotSpot
                icoInfo.yHotspot = yHotSpot
                icoInfo.hbmMask = hMonoBitmap
                icoInfo.hbmColor = hBitmap
                hAlphaCursor = CreateIconIndirect(IcoInfo)
                IF (hAlphaCursor)=0 THEN
                   'dwErr = GetLastError()
                    MSGBOX "error" + STR$(dwErr)
                END IF
                FN_NewCursor = hAlphaCursor
                END FUNCTION
                SUB CreateBmp(BYVAL BmpWide AS DWORD, BYVAL BmpHigh AS DWORD, BmpHndl AS DWORD, BmpDc AS DWORD)
                  GRAPHIC BITMAP NEW BmpWide, BmpHigh TO BmpHndl
                  GRAPHIC ATTACH BmpHndl, 0
                  GRAPHIC GET DC TO BmpDc
                  GRAPHIC DETACH
                END SUB
                SUB DestroyBmp(BmpHndl AS DWORD, BmpDc AS DWORD)
                  IF BmpHndl = 0 THEN EXIT SUB
                  GRAPHIC ATTACH BmpHndl, 0
                  GRAPHIC BITMAP END
                  BmpHndl = 0
                  BmpDc = 0
                END SUB

                Walt Decker


                • #9
                  Walt, thanks for the suggestion and code. That's a hefty piece of code, in that the app I'm playing with only has 300 lines of code itself. See my comments below.

                  Borje/Dave R,
                  Thanks! I almost forgot that we once used PBR and RES files. I've been extremely happy with the #Resource feature. I can't say as I've noticed any slowdown, but then I typically don't have very many resources. In my current app, however, I'm up to about 200 icon resources and now that you mention the slowdown, I'll try an experiment to seen when/if I see a slowdown.

                  Dave B.,
                  The hits the mark on what I wanted, no file involved. I have about 5 cursors to load, so I'd make a function out of your code to accommodate the load.

                  Here's what I've been using ...fairly minimal ... just create a .cur file, load it, then delete it.

                     Open "arrow.cur"     For Output As #1 : Print #1, Resource$(RcData,"arrow") : Close #1
                     hCursorA  = LoadImage (ByVal 0, "arrow.cur", %IMAGE_CURSOR, 125, 125, %LR_LOADFROMFILE)
                     Kill "arrow.cur"
                  I originally hoped there was a %LR_LoadFromResource, but that would have been too simple.

                  I'll give Dave B.'s a try, turned to a function and see how that works.


                  • #10
                    Mr. Beene:

                    This statement:
                     GRAPHIC RENDER BITMAP CursName$, (0, 0) - (CurSize - 1, CurSize - 1)
                    pulls the bitmap resource. The nice thing about the function that it can make cursors of different sizes. Since I have some vision issues, that is a plus for me.

                    PS: The function also makes parts of the cursor semi-transparent depending on the color values used.
                    Walt Decker


                    • #11
                      BTW If using the code in post #7 you probably should make this mod to avoid memory leaks:
                                DeleteObject(pIconInfo.hbmMask)                                   ' < Cleanup
                                DeleteObject(pIconInfo.hbmColor)                                  ' <
                                DestroyIcon hIcon                                                 ' <
                      ( see MSDN for GetIconInfo() Remarks)
                      Rgds, Dave