Bay Six Software Forum Index Bay Six Software
Beyond the Basics
 FAQFAQ   SearchSearch   UsergroupsUsergroups   RegisterRegister 
 ProfileProfile   Log in to check your private messagesLog in to check your private messages   Log inLog in 

[BETA} Cursor Demo using WMLiberty

Post new topic   Reply to topic    Bay Six Software Forum Index -> Snippet Testing
View previous topic :: View next topic  
Author Message
Site Admin

Joined: 01 Jul 2005
Posts: 798

PostPosted: Jul 7th, 2007, 3:33am    Post subject: [BETA} Cursor Demo using WMLiberty Reply with quote

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.
'    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 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)
        If g.hcurLoaded Then
            g.hCursor = g.hcurLoaded
            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$

    #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

Back to top
View user's profile Send private message Send e-mail
Display posts from previous:   
Post new topic   Reply to topic    Bay Six Software Forum Index -> Snippet Testing All times are GMT
Page 1 of 1
Jump to:  
Quick Reply
   Shortcut keys: Alt+Q to activate, Alt+P to preview, Alt+S to submit
You cannot post new topics in this forum
You can reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum
You cannot attach files in this forum
You can download files in this forum

Lo-Fi Version
Powered by phpBB © 2001, 2005 phpBB Group