Brent Site Admin
Joined: 01 Jul 2005 Posts: 800
|
Posted: Jul 7th, 2007, 3:33am Post subject: [BETA} Cursor Demo using WMLiberty |
|
|
This little program demonstrates how to use WMLiberty to trap the WM_SETCURSOR message in order to display different cursors for different situations. It's a bit "rough around the edges" but should be quite stable. I'm seeking your input on any aspects of the GUI that you think need improved.
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 |
_________________ Brent |
|