Desktop Shell Demo

'Desktop Shell Demo
'copyright 2007, Alyce Watson
'if you use parts of this code,
'    please credit Alyce Watson,

global hDC, hWin, hChild, hButton, hDesktop
global gridWidth, gridHeight, iconMax, maxWidth, orgX, orgY
global curDir$

curDir$ = DefaultDir$
gridWidth = 80 : gridHeight = 80
iconMax = int((DisplayWidth/gridWidth) * (DisplayHeight/gridHeight)) 'maximum number of icons on desktop
maxWidth = int(DisplayWidth/gridWidth)  'maximum number of icons in each row

dim icons$(50) 'arrays are global by default
redim icons$(iconMax) ' filename

graphicbox #desk.g, -1, -1, DisplayWidth+2, DisplayHeight+2
open "Liberty BASIC Desktop" for window_popup as #desk
    #desk "trapclose Quit"
    #desk.g "down; setfocus"
    #desk.g "when rightButtonUp RightClick"
    #desk.g "when leftButtonUp MenuClick"
    #desk.g "when leftButtonDouble RunIcon"
    #desk.g "font ms_sans_serif 8"

    hWin = hwnd(#desk)
    hChild = hwnd(#desk.g)
    hDC = GetDC(hChild)

    call GetIniInfo 'get and draw user icons, flush desktop

    'make graphicbox chld of the desktop, so it stays on bottom
    calldll #user32, "GetDesktopWindow", hDesktop as ulong
    calldll #user32, "SetParent", hChild as ulong, hDesktop as ulong, hOldWin as ulong

    'hide original parent window
    calldll #user32, "ShowWindow", hWin as ulong, _SW_HIDE as long, re as boolean

Sub RightClick handle$, mx, my
    'see if cursor is on an icon
    'if it is, ask if user wants to delete it
    index = IconIndex(mx,my)
    Deleted = 0
    if (icons$(index) <> "") and (icons$(index) <> "none") then
        confirm "Delete " +  icons$(index) + " ?" ;response$
        if response$ = "yes" then
            call DeleteIcon index
            Deleted = 1
        end if
    end if

    'if cursor isn't on an icon, see if user wants to add an icon
    if Deleted = 0 then
        confirm "Would you like to add a shortcut?";response$
        if response$ = "yes" then call AddIcon
    end if
    end sub

Sub AddIcon
    for i = 1 to iconMax
        if icons$(i) = "" then
            filedialog "Add File", curDir$ + "\*.*", file$
            if file$ <> "" then
                curDir$ = SeparatePath$(file$)
                icons$(i) = GetShortPathName$(file$)
            end if
            exit for
        end if
    call PaintDesktop
    if i = iconMax then  'all slots are filled
        notice "All slots are filled. Cannot add more icons."
    end if
    end sub

sub DeleteIcon num
    for i = num to iconMax-1
        icons$(i) = icons$(i+1)
    call PaintDesktop
    end sub

Sub RunIcon handle$, mx, my
    index = IconIndex(mx,my) 'see which icon is clicked, give mouse coords
    exists = FileExist(SeparatePath$(icons$(index)),SeparateFile$(icons$(index)))
    if exists then call ShellExecute hwnd(#desk), icons$(index)
    end sub

Sub GetIniInfo
    for i = 1 to iconMax
        file$ = GetIniFile$("My Desktop Shell", "iconName"+str$(i),"none","mydesktopshell.ini")
        if file$ = "none" then exit for
        if file$ = "" then exit for
        icons$(i) = file$   'full path to icon exe
    call PaintDesktop
    end sub

Sub WriteIniInfo
    for i = 1 to iconMax
        call WriteIniFile "My Desktop Shell", "iconName"+str$(i), icons$(i), "mydesktopshell.ini"
    end sub

Sub ClearIniInfo
    'can use this sub to clear all ini info and start over
    for i = 1 to iconMax
        call WriteIniFile "My Desktop Shell", "iconName"+str$(i), "", "mydesktopshell.ini"
    End Sub

Sub DoFlush
    #desk.g "delsegment flushMe"
    'draw pseudo start button
    #desk.g "down; color black; backcolor white; size 2"
    #desk.g "place 0 ";DisplayHeight - 36;" ;boxfilled 70 ";DisplayHeight
    #desk.g "place 4 ";DisplayHeight-10
    #desk.g "font ms_sans_serif 12;\Actions"
    #desk.g "getbmp desk 0 0 ";DisplayWidth;" ";DisplayHeight
    #desk.g "drawbmp desk 0 0; flush flushMe"
    calldll #gdi32, "SetBkMode", hDC as ulong, _TRANSPARENT as long, re as long
    #desk.g "font ms_sans_serif 8"   'reset font for icon label text
    end sub

sub PaintDesktop
    calldll #user32, "PaintDesktop", hDC as ulong, re as boolean
    for i = 1 to iconMax
        if icons$(i) = "" then exit for
        hIcon = ExtractIcon(hwnd(#desk.g), icons$(i))
        if not(hIcon) then  'see if there is an exe associate with file, extract icon from exe
            exe$ = FindExecutable$(icons$(i))
            hIcon = ExtractIcon(hwnd(#desk.g), exe$)
            if not(hIcon) then  'still no icon, use a default icon
                calldll #user32, "LoadIconA", 0 as ulong, _IDI_WINLOGO as long, hIcon as ulong
            end if
        end if
        'draw icon on desktop at designated location
        iconX = IconXPos(i) : iconY = IconYPos(i)
        result = DrawIcon(hDC, hIcon, iconX, iconY )
        calldll #gdi32, "SetBkMode", hDC as ulong, _TRANSPARENT as long, re as long
        #desk.g "place ";iconX;" ";iconY + 42
        #desk.g "\";lower$(left$(SeparateFile$(icons$(i)),12))
        #desk.g "\";lower$(mid$(SeparateFile$(icons$(i)),13))
        calldll #user32, "DestroyIcon", hIcon as ulong, re as boolean
    call DoFlush
    end sub

Function IconXPos(num)
    IconXPos = int((num - 1) mod maxWidth) * gridWidth
    end function

Function IconYPos(num)
    IconYPos = int((num - 1) / maxWidth) * gridHeight
    end function

Function IconIndex(x,y)
    gridX = int(x/gridWidth) + 1
    gridY = int(y/gridHeight) + 1
    IconIndex = gridX + (maxWidth * (gridY-1))
    end function

Sub Quit handle$
    'make graphicbox child of original parent window
    calldll #user32, "SetParent", hChild as ulong, hWin as ulong, hOldWin as ulong
    call ReleaseDC hChild, hDC
    call WriteIniInfo
    close #handle$:end
    end sub

Sub MenuClick handle$,mx,my
    'see if mouse is over pseudo start button and activate menu
    if (mx<70) and (my>(DisplayHeight-36)) then call DoMenu handle$
    end sub

Sub DoMenu handle$
    popupmenu "&Add Shortcut", [AddShortcut],"&Help",[help],"A&bout",[about],|,_
    "My &Documents", [myDocuments], "My &Computer", [myComputer], "&Programs", [programs],_
    "&Recent Documents", [recent],|, "&Control Panel", [controlPanel], "&System Properties",[systemProp],|,_
    "&Quit", [DoExit], "&Cancel", [DoWait]
    exit Sub
        exit sub
        call Quit "#desk"
        exit sub
        call AddIcon
        exit sub
        m$ = "To add a shortcut to the desktop, "
        m$ = m$ + "click the right mouse button on any "
        m$ = m$ + "empty spot. You'll be presented with a file dialog "
        m$ = m$ + "from which you can select any executable program or any "
        m$ = m$ + "file on disk. A shortcut icon and a label will appear on the desktop. "
        m$ = m$ + "If you cancel the filedialog, no shortcut will be created. " + chr$(13) + chr$(13)
        m$ = m$ + "To run an executable program or open a file from its shortcut, "
        m$ = m$ + "double-click the icon with the left mouse button. " + chr$(13) + chr$(13)
        m$ = m$ + "To remove a shortcut from the desktop, right-click on its icon. You'll be asked to confirm the deletion. " + chr$(13) + chr$(13)
        m$ = m$ + "Use the 'Actions' button to add shortcuts, open the control panel, access recent documents, "
        m$ = m$ + "minimize this desktop application, or exit this desktop application. " + chr$(13) + chr$(13)
        m$ = m$ + "At this time, you cannot rearrange the icons, or change the icon displayed as a shortcut on the desktop. "
        notice m$
        #desk.g "setfocus"
        exit sub
        run "rundll32.exe shell32.dll Control_RunDLL"
        exit sub
        run "rundll32.exe shell32.dll Control_RunDLL sysdm.cpl"
        exit sub
        call ShellAbout "Liberty BASIC Desktop",chr$(169) + " 2006, Alyce Watson",0
        exit sub
        CSIDL.RECENT = 8 : folder$ = GetSpecialfolder$(CSIDL.RECENT)
        CallDLL #shell32, "ShellExecuteA", 0 As long, "explore" As ptr,_
        "" As ptr, "" As ptr, folder$ As ptr, _SW_SHOWNA As long, result As long
        exit sub
        CSIDL.PERSONAL = 5 : folder$ = GetSpecialfolder$(CSIDL.PERSONAL)
        CallDLL #shell32, "ShellExecuteA", 0 As long, "explore" As ptr,_
        "" As ptr, "" As ptr, folder$ As ptr, _SW_SHOWNA As long, result As long
        exit sub
        folder$ = GetSpecialfolder$(CSIDL.DESKTOPDIRECTORY) + "\My Computer"
        CallDLL #shell32, "ShellExecuteA", 0 As long, "explore" As ptr,_
        "" As ptr, "" As ptr, folder$ As ptr, _SW_SHOWNA As long, result As long
        exit sub
        CSIDL.PROGRAMS = 2 : folder$ = GetSpecialfolder$(CSIDL.PROGRAMS)
        CallDLL #shell32, "ShellExecuteA", 0 As long, "explore" As ptr,_
        "" As ptr, "" As ptr, folder$ As ptr, _SW_SHOWNA As long, result As long
        exit sub
    end sub

Function SeparateFile$(f$)
      While Mid$(f$, fileindex,1)<>"\"
    End Function

Function SeparatePath$(f$)
      While Mid$(f$, fileindex,1)<>"\"
    End Function

function FileExist(fPath$,fFile$)
    dim info$(10,10)
    files fPath$,fFile$,info$(
    end function

' api wrappers are copied from
Sub ShellAbout caption$,msg$,iconHandle
    'iconHandle can be 0
    calldll #shell32, "ShellAboutA",0 as long,caption$ as ptr,_
    msg$ as ptr,iconHandle as uLong,ret as long
    End Sub

Function GetShortPathName$(lPath$)
    CallDLL #kernel32, "GetShortPathNameA",lPath$ As Ptr,_
    sPath$ As Ptr,lenPath As Long,r As Long
    End Function

Sub WriteIniFile lpAppName$, lpKeyName$, lpString$, lpFileName$
    CallDLL #kernel32, "WritePrivateProfileStringA", _
        lpAppName$ As ptr, _    'section name
        lpKeyName$ As ptr, _    'key name
        lpString$ As ptr, _     'key value
        lpFileName$ As ptr, _   'ini filename
        result As boolean       'nonzero = success
    end sub

Function GetIniFile$(lpAppName$, lpKeyName$,lpDefault$,lpFileName$)
    CallDLL #kernel32, "GetPrivateProfileStringA", _
        lpAppName$ As ptr, _'section name
        lpKeyName$ As ptr, _'key name
        lpDefault$ As ptr, _'default string returned if there is no entry
        lpReturnedString$ As ptr, _ 'destination buffer
        nSize As long, _            'size of destination buffer
        lpFileName$ As ptr, _       'ini filename
        result As ulong     'number of characters copied to buffer

    end function

Function ExtractIcon(hW, file$)
    hInst=GetWindowLong(hW, _GWL_HINSTANCE)
    CallDLL #shell32, "ExtractIconA",hInst as uLong,_
    file$ As Ptr, 0 As Long, ExtractIcon as uLong
    End Function

Function DrawIcon(hdc,hIcon,x,y)
    CallDLL #user32, "DrawIcon",hdc as uLong, x As Long,_
    y As Long, hIcon as uLong, DrawIcon As Long
    End Function

Function GetWindowLong(hW, type)
    CallDLL #user32, "GetWindowLongA",hW as uLong,_
    type As Long,GetWindowLong As Long
    End Function

Function GetDC(hWnd)
    CallDLL #user32, "GetDC",hWnd as uLong,GetDC as uLong
    End Function

Sub ReleaseDC hWnd, hDC
    CallDLL#user32,"ReleaseDC",hWnd as uLong,_
    hDC as uLong,result As Long
    End Sub

Sub ShellExecute hWnd, file$
    parameter = _SW_SHOWNORMAL 'set up for viewing
    lpszOp$ = "open"           '"open" or "print"
    lpszFile$ = file$ 
    lpszDir$ = DefaultDir$ 
    CallDLL #shell32, "ShellExecuteA", hWnd as uLong,_
    lpszOp$ As Ptr,lpszFile$ As Ptr,_
    lpszParams$ As Ptr,lpszDir$ As Ptr,_
    parameter As Long, result As Long
    End Sub

Function FindExecutable$(lpFile$)
    'file$ should be full path and filename
    'such as c:\mydir\readme.txt
    lpDirectory$ = Space$(255)
    lpResult$ = Space$(255) + Chr$(0)
    CallDLL #shell32,  "FindExecutableA", _
        lpFile$ As Ptr, lpDirectory$ As Ptr,_
        lpResult$ As Ptr, result As Long
    End Function

Function GetSpecialfolder$(CSIDL)
    struct IDL,cb As Long, abID As short
    calldll #shell32, "SHGetSpecialFolderLocation",_
        0 as long, CSIDL as long, IDL as struct, ret as long
    if ret=0 then
        Path$ = Space$(512)
        calldll #shell32, "SHGetPathFromIDListA",id as long, Path$ as ptr, ret as long
        GetSpecialfolder$ = Left$(Path$, InStr(Path$, Chr$(0)) - 1)
        GetSpecialfolder$ = "Error"
    end if
    End Function


Source Code





Media Demos



API Resources


LB 4 Companion

Mastering LB 3

LB Workshop

Game Workshop