Load Cursor - From Resource

Category: Resources

Date: 03-28-2012

Return to Index


 
'Compiler Comments:
'This code is written to compile in PBWin10. To compile in PBWin9, the zoom.cur
'file needs to be supplied to the app in a PowerBASIC resource file (*.pbr).
 
'Compilable Example:
#Compiler PBWin 10
#Compile EXE
#Dim All
#Include "Win32API.inc"
#Resource RcData, xxzoom, "zoom.cur"
Global hDlg,hCursor As Dword
 
Function PBMain() As Long
   Dialog New Pixels, 0, "Test Code",300,300,200,200, %WS_OverlappedWindow To hDlg
   Control Add Button, hDlg, 100,"Push", 50,10,100,20
   Dialog Show Modal hDlg Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   Select Case Cb.Msg
      Case %WM_InitDialog
         MakeCursorFile "xxzoom", "xxzoom.cur"
      Case %WM_SetCursor
         hCursor = LoadImage(GetModuleHandle(""), "xxzoom.cur", %Image_Cursor, 0, 0, %LR_LoadFromFile)
         MousePtr hCursor
         Function = 1
   End Select
End Function
 
Function MakeCursorFile(ResName As String, NewFile As StringAs Long
   Local lRet1 As Long,lRet2 As Long, dRet1 As Dword,dRet2 As Dword
   Local sBuff As String, szName As AsciiZ * 40, lFile As Long, hProcess As Long
   hProcess = 0                     'use null for current process
   szName = ResName             'change string to asciiz for api calls
   lRet1 = FindResource(hProcess, szName, ByVal %RT_RCDATA)
   If IsFalse lRet1 Then Function = 0:Exit Function   'could not find the res so exit
   dRet1 = SizeofResource(hProcess,lRet1)
   lRet2 = LoadResource(hProcess,lRet1)
   If IsFalse lRet2 Then Function = 0:Exit Function   'could not load res to mem so exit
   dRet2 = LockResource(lRet2)
   sBuff = Peek$(dRet2, dRet1)    ' load sBuff with the info we just put in memory
   'now save the item from memory to a file
   lFile = FreeFile                            'find next open file number
   Open NewFile For Binary As #lFile           'create the new file
   Put$ #lFile, sBuff                      'write the buffer to the file
   Close #lFile                                'close the file
   Function = 1                                'worked so return a 1
End Function
 
'gbs_01059
'Date: 03-10-2012


created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm