'Desktop Shell Demo
'copyright 2007, Alyce Watson
'if you use parts of this code,
' please credit Alyce Watson, http://alycesrestaurant.com/
nomainwin
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
WindowWidth=DisplayWidth:WindowHeight=DisplayHeight
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
wait
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
next
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)
next
icons$(iconMax,)=""
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
next
call PaintDesktop
end sub
Sub WriteIniInfo
for i = 1 to iconMax
call WriteIniFile "My Desktop Shell", "iconName"+str$(i), icons$(i), "mydesktopshell.ini"
next
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"
next
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
next
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
[DoWait]
exit sub
[DoExit]
call Quit "#desk"
exit sub
[AddShortcut]
call AddIcon
exit sub
[help]
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
[controlPanel]
run "rundll32.exe shell32.dll Control_RunDLL"
exit sub
[systemProp]
run "rundll32.exe shell32.dll Control_RunDLL sysdm.cpl"
exit sub
[about]
call ShellAbout "Liberty BASIC Desktop",chr$(169) + " 2006, Alyce Watson",0
exit sub
[recent]
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
[myDocuments]
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
[myComputer]
CSIDL.DESKTOPDIRECTORY = 16
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
[programs]
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$)
fileindex=Len(f$)
filelength=Len(f$)
While Mid$(f$, fileindex,1)<>"\"
fileindex=fileindex-1
Wend
SeparateFile$=Right$(f$,filelength-fileindex)
End Function
Function SeparatePath$(f$)
fileindex=Len(f$)
filelength=Len(f$)
While Mid$(f$, fileindex,1)<>"\"
fileindex=fileindex-1
Wend
SeparatePath$=Left$(f$,fileindex)
End Function
function FileExist(fPath$,fFile$)
dim info$(10,10)
files fPath$,fFile$,info$(
FileExist=val(info$(0,0))
end function
'*************
' API WRAPPERS
' api wrappers are copied from
' http://alycesrestaurant.com/workshop.htm
'*************
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$)
sPath$=Space$(256):lenPath=Len(sPath$)
CallDLL #kernel32, "GetShortPathNameA",lPath$ As Ptr,_
sPath$ As Ptr,lenPath As Long,r As Long
GetShortPathName$=Left$(sPath$,r)
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$)
nSize=100
lpReturnedString$=Space$(nSize)+Chr$(0)
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
GetIniFile$=Left$(lpReturnedString$,result)
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$
lpszParams$=""
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
FindExecutable$=Trim$(lpResult$)
End Function
Function GetSpecialfolder$(CSIDL)
CSIDL.RECENT = 8
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)
id=IDL.cb.struct
calldll #shell32, "SHGetPathFromIDListA",id as long, Path$ as ptr, ret as long
GetSpecialfolder$ = Left$(Path$, InStr(Path$, Chr$(0)) - 1)
else
GetSpecialfolder$ = "Error"
end if
End Function