I'll repost this in WMLiberty Demos and remove the code at a later date.
Code: |
' NoMainWin
Global g.hCursor, g.bOverride, g.hcurLoaded g.hCursor = LoadCursorID(_NULL, _IDC_ARROW) Open "WMLiberty" For DLL As #wmlib WindowWidth = 240 WindowHeight = 210 StyleBits #demo, _DS_CENTER, 0, 0, 0 ListBox #demo.lstCursors, List$(), demo.lstCursors.Click, 10, 10, 130, 155 Button #demo.btnExit, "E&xit", demo.btnExit.Click, UL, 150, 10, 75, 25 StyleBits #demo.btnExit, _BS_DEFPUSHBUTTON, 0, 0, 0 Button #demo.btnLoadFile, "&Load File...", demo.btnLoadFile.Click, UL, 150, 40, 75, 25 CheckBox #demo.chkOverride, "&Override control cursors", _ demo.chkOverride.Click, demo.chkOverride.Click, _ 150, 75, 75, 40 StyleBits #demo.chkOverride, _BS_MULTILINE, 0, 0, 0 StaticText #demo, "Cursor ID:", 150, 120, 75, 15 TextBox #demo.txtIDC, 150, 135, 75, 20 StyleBits #demo.txtIDC, _ES_READONLY, 0, 0, 0 Open "Cursor Demo" For Dialog As #demo #demo "TrapClose demo.Close" #demo.lstCursors "SetFocus" Call demo.lstCursors.PostOpen Call demo.chkOverride.PostOpen Callback lpfn, demo.OnSetCursor( ULong, ULong, ULong, ULong ), Long r = SetWMHandler(HWnd(#demo), _WM_SETCURSOR, lpfn, 1) Call DoEvents Sub DoEvents 1 Scan CallDLL #kernel32, "Sleep", _ 100 As Long, ret As Void GoTo 1 End Sub Sub demo.Close wnd$ Close #wnd$ Close #wmlib If g.hcurLoaded Then Call DestroyCursor g.hcurLoaded End End Sub Function demo.OnSetCursor( hWnd, uMsg, wParam, lParam ) If Not (g.bOverride) Then If hWnd <> wParam Then Exit Function End If CallDLL #user32, "SetCursor", _ g.hCursor As ULong, ret As ULong demo.OnSetCursor = 1 End Function Sub demo.lstCursors.Click lst$ #demo.lstCursors "Selection? a$" idc = Val(Word$(a$, 2, Chr$(0))) #demo.txtIDC idc If idc Then g.hCursor = LoadCursorID(_NULL, idc) Else If g.hcurLoaded Then g.hCursor = g.hcurLoaded Else Notice "Please load a cursor file, then try again." #demo.lstCursors "SelectIndex 0" #demo.btnLoadFile "!SetFocus" g.hCursor = LoadCursorID(_NULL, _IDC_ARROW) End If End If End Sub Sub demo.lstCursors.PostOpen Read c ReDim List$(c) For i = 1 To c Read a$, b$ List$(i) = a$ + Chr$(0) + b$ Next #demo.lstCursors "Font Arial 9" #demo.lstCursors "Reload" ReDim List$(0) #demo.lstCursors "SingleClickSelect" #demo.lstCursors "SelectIndex 1" #demo.txtIDC _IDC_ARROW Data 15 Data "IDC_ARROW", 32512 Data "IDC_IBEAM", 32513 Data "IDC_WAIT", 32514 Data "IDC_CROSS", 32515 Data "IDC_UPARROW", 32516 Data "IDC_SIZENWSE", 32642 Data "IDC_SIZENESW", 32643 Data "IDC_SIZEWE", 32644 Data "IDC_SIZENS", 32645 Data "IDC_SIZEALL", 32646 Data "IDC_NO", 32648 Data "IDC_HAND", 32649 Data "IDC_APPSTARTING", 32650 Data "IDC_HELP", 32651 Data "Cursor file", 0 End Sub Sub demo.btnExit.Click btn$ Call demo.Close "#demo" End Sub Sub demo.btnLoadFile.Click btn$ dir$ = GetWindowsDir$() + "\Cursors\" FileDialog "Select Cursor", dir$ + "*.CUR;*.ANI", file$ If file$ = "" Then Exit Sub If g.hcurLoaded Then Call DestroyCursor g.hcurLoaded g.hcurLoaded = LoadCursorFromFile(file$) #demo.txtIDC "!Contents? a$" If a$ = "0" Then g.hCursor = g.hcurLoaded End Sub Sub demo.chkOverride.Click chk$ #demo.chkOverride "Value? value$" g.bOverride = (value$ = "set") End Sub Sub demo.chkOverride.PostOpen #demo.chkOverride "Set" g.bOverride = 1 End Sub Function SetWMHandler( hWnd, uMsg, lpfnCB, lSuccess ) CallDLL #wmlib, "SetWMHandler", _ hWnd As ULong, uMsg As ULong, _ lpfnCB As ULong, lSuccess As Long, _ SetWMHandler As Long End Function Function LoadCursorID( hInstance, IDC ) CallDLL #user32, "LoadCursorA", _ hInstance As ULong, IDC As ULong, _ LoadCursorID As ULong End Function Function LoadCursorFromFile( FileName$ ) CallDLL #user32, "LoadCursorFromFileA", _ FileName$ As Ptr, _ LoadCursorFromFile As ULong End Function Sub DestroyCursor hCursor CallDLL #user32, "DestroyCursor", _ hCursor As ULong, ret As Long End Sub Function GetWindowsDir$() GetWindowsDir$ = Space$(255) CallDLL #kernel32, "GetWindowsDirectoryA", _ GetWindowsDir$ As Ptr, 255 As Long, _ cch As Long GetWindowsDir$ = Left$(GetWindowsDir$, cch) End Function |