Code: Alles auswählen
Structure Menu
ID.l
imgID.l
Name.s
EndStructure
Structure File
MenuName.s
Name.s
EndStructure
Structure SHELLICONLIST
hLarge.l
hSmall.l
szTypeName.s
EndStructure
Structure ShellLinkInfo
;Longs
IconIndex.l
ShowCmd.l
Hotkey_VK.l
Hotkey_MOD.l
;Strings
Target.s
Description.s
WorkingDirectory.s
Arguments.s
IconLocation.s
EndStructure
Structure Filelink
Listindex.l
Fileindex.l
EndStructure
;EnableExplicit
Global shInfo.SHFILEINFO
Global NewList Filelink.Filelink()
Global NewList silist.SHELLICONLIST()
Global NewList Menu.Menu()
Global NewList File.File()
Global columheight.l
Global OldAktivMenu.l=1
Global AktivMenu.l=1
Global MaxMenu.l
Global WindowWidth=30
Global aktivate.b
Global MousePosition.POINT
Global refreshtime.l
Global GadEvent.l
Global Wheeled.b
Global Stay.l
Global OldWidth.l
Global BarHeight.l
Global Transparenty.c
Global img0.l
Global opentime.l
Global SettingOpenTime.l
Global SettingStayTime.l
Global SettingRefreshTime.l
Global Quit.b
Global Systempath.s
Global Iconheight.l
Global Iconweidth.l
Global Dim col.l(25,0)
#WM_MOUSEWHEEL = $20A
Systempath = Space(1000)
GetModuleFileName_(0,@Systempath,1000)
Systempath=GetPathPart(Systempath)
Procedure.l LowByte(Word.w)
ProcedureReturn PeekB(@Word )
EndProcedure
Procedure.l HighByte(Word.w)
ProcedureReturn PeekB(@Word+1)
EndProcedure
Procedure ExamineMousePosition()
GetCursorPos_(@MousePosition)
EndProcedure
Procedure.w MouseWheelDelta()
x.w = ((EventwParam()>>16)&$FFFF)
ProcedureReturn -(x / 120)
EndProcedure
Procedure.l GetMouseX()
ProcedureReturn MousePosition\x
EndProcedure
Procedure.l GetMouseY()
ProcedureReturn MousePosition\y
EndProcedure
Procedure SetWinOpacity (hwnd.l, Opacity.l) ; Opacity: Undurchsichtigkeit 0-255
SetWindowLong_(hwnd, #GWL_EXSTYLE, $00080000)
If OpenLibrary(1, "user32.dll")
CallFunction(1, "SetLayeredWindowAttributes", hwnd, 0, Opacity, 2)
CloseLibrary(1)
EndIf
;MakeToolWindow(hwnd, 1) ; activate this line, if you want to have a ToolWindow (need user-lib ToolBar Prof. from Danilo)
EndProcedure
Procedure GetShellLinkInfo(ShellLink.s, *p.ShellLinkInfo)
Dim LinkFile.w(Len(ShellLink))
MultiByteToWideChar_(#CP_ACP, 0, ShellLink, -1, LinkFile(), Len(ShellLink)) ;We need a WideChar version of the ShellLink.s
*Buf = AllocateMemory(1024)
Hotkey.w = 0
Result = 0
If *Buf <> 0
CoInitialize_(0)
If CoCreateInstance_(?CLSID_ShellLink,0,1,?IID_IShellLink,@psl.IShellLinkA) >= 0
If psl\QueryInterface(?IID_IPersistFile, @ppf.IPersistFile) >= 0
If ppf\Load(@LinkFile(), 1) >= 0 ;Icon loaded?
;Get the target
psl\GetPath(*Buf, 1024, 0, 0)
*p\Target = PeekS(*Buf)
RtlFillMemory_(*Buf, 1024, 0)
;Get the description
psl\GetDescription(*Buf, 1024)
*p\Description = PeekS(*Buf)
RtlFillMemory_(*Buf, 1024, 0)
;Get the working directory
psl\GetWorkingDirectory(*Buf, 1024)
*p\WorkingDirectory = PeekS(*Buf)
RtlFillMemory_(*Buf, 1024, 0)
;Get the arguments
psl\GetArguments(*Buf, 1024)
*p\Arguments = PeekS(*Buf)
RtlFillMemory_(*Buf, 1024, 0)
;Get the hotkey
psl\GetHotkey(@Hotkey)
*p\Hotkey_VK = LowByte (Hotkey)
*p\Hotkey_MOD = HighByte(Hotkey)
;Get the showcommand
addr = *p
psl\GetShowCmd(addr+4)
;Get the icon file and the icon index
psl\GetIconLocation(*Buf, 1024, *p)
*p\IconLocation = PeekS(*Buf)
;RtlFillMemory_(*Buf, 1024, 0) ;<- We don't need this here
;Result will be 1 because we have finished the processing
Result = 1
EndIf
ppf\Release()
EndIf
psl\Release()
EndIf
CoUninitialize_()
FreeMemory(*Buf)
EndIf
ProcedureReturn Result
DataSection
CLSID_ShellLink:
; 00021401-0000-0000-C000-000000000046
Data.l $00021401
Data.w $0000,$0000
Data.b $C0,$00,$00,$00,$00,$00,$00,$46
IID_IShellLink:
; DEFINE_SHLGUID(IID_IShellLinkA, 0x000214EEL, 0, 0)
; C000-000000000046
Data.l $000214EE
Data.w $0000,$0000
Data.b $C0,$00,$00,$00,$00,$00,$00,$46
IID_IPersistFile:
; 0000010b-0000-0000-C000-000000000046
Data.l $0000010b
Data.w $0000,$0000
Data.b $C0,$00,$00,$00,$00,$00,$00,$46
EndDataSection
EndProcedure
Procedure Load()
Directory$ = Systempath
If ExamineDirectory(0, Directory$, "*.*")
While NextDirectoryEntry(0)
SubDirectory$=DirectoryEntryName(0)
If FileSize(SubDirectory$)=-2
If SubDirectory$<>"." And SubDirectory$<>".." And SubDirectory$<>"Sidebar_System_Folder"
AddElement(Menu())
Menu()\Name=SubDirectory$
If ExamineDirectory(1, Directory$+SubDirectory$, "*.*")
While NextDirectoryEntry(1)
If DirectoryEntryName(1)<>"" And DirectoryEntryName(1)<>"." And DirectoryEntryName(1)<>".."
file$=Directory$+SubDirectory$+"\"+DirectoryEntryName(1)
AddElement(File())
File()\MenuName=SubDirectory$
File()\Name=file$
EndIf
Wend
FinishDirectory(1)
EndIf
EndIf
EndIf
Wend
FinishDirectory(0)
EndIf
EndProcedure
Procedure run(Listindex.l)
ForEach Filelink()
If Filelink()\Listindex=Listindex
SelectElement(File(),Filelink()\Fileindex)
Break
EndIf
Next
If GetExtensionPart(File()\Name)="lnk"
GetShellLinkInfo(File()\Name, @SLI.ShellLinkInfo)
file$=SLI\Target
Else
file$=File()\Name
EndIf
ergebniss=ShellExecute_(#Null, #Null, file$, #Null, #Null, #SW_SHOWNORMAL)
If ergebniss=#SE_ERR_NOASSOC
DateiName$ = OpenFileRequester("öffnen mit","","Anwendung | *.exe",0)
If DateiName$
RunProgram(DateiName$,file$,GetPathPart(file$))
EndIf
;MessageRequester("ERROR","Kein Standartprogramm zum öffnen ausgewählt")
ElseIf ergebniss=#ERROR_FILE_NOT_FOUND
MessageRequester("ERROR","Datei nicht gefunden")
ElseIf ergebniss=#ERROR_PATH_NOT_FOUND
MessageRequester("ERROR","Dateipfat nicht gefunden")
ElseIf ergebniss=#SE_ERR_ACCESSDENIED
MessageRequester("ERROR","Zugriff verweigert")
ElseIf ergebniss=#SE_ERR_FNF
MessageRequester("ERROR","Datei nicht gefunden")
ElseIf ergebniss=#SE_ERR_OOM
MessageRequester("ERROR","Nicht genug Speicher")
ElseIf ergebniss=#SE_ERR_PNF
MessageRequester("ERROR","Dateipfat nicht gefunden")
EndIf
opentime=ElapsedMilliseconds()
EndProcedure
Procedure LoadMenu()
CreateGadgetList(WindowID(0))
ListIconGadget(0,250,0,5,BarHeight, "", 200,#PB_ListIcon_GridLines)
ChangeListIconGadgetDisplay(0,0)
;BEGINN Bugfix 001
If CountList(Menu())=0
MessageRequester("ERROR","Folders forbidden")
End
EndIf
columheight=BarHeight/CountList(Menu())
;END
ReDim col.l(25,columheight)
count=1
ForEach Menu()
transimg=CreateImage(#PB_Any,columheight,25)
StartDrawing(ImageOutput(transimg))
Box(0,0,columheight,25,RGB(255,255,255))
DrawingMode(#PB_2DDrawing_Transparent)
FrontColor(RGB(0,0,0))
DrawingFont(FontID(0))
DrawText(5,3,Menu()\Name)
For x = 0 To columheight-1
For y = 0 To 24
col(y,x) = Point(x, y)
Next
Next
StopDrawing()
Menu()\imgID=CreateImage(#PB_Any,25,columheight)
StartDrawing(ImageOutput(Menu()\imgID))
For y = 0 To columheight-1
For x = 0 To 24
Plot(x,(y*-1)+columheight,col(x,y))
Next
Next
StopDrawing()
ButtonImageGadget(count,0,(count-1)*columheight,20,columheight,ImageID(Menu()\imgID))
Menu()\ID=count
count+1
Next
MaxMenu=CountList(Menu())
img0=CreateImage(#PB_Any,3,columheight-4)
StartDrawing(ImageOutput(img0))
Box(0,0,3,columheight-4,RGB(255,188,65))
StopDrawing()
EndProcedure
Procedure ViewIcons()
ForEach Menu()
If Menu()\ID=AktivMenu
Menuname$=Menu()\Name
Break
EndIf
Next
ClearGadgetItemList(0)
WindowWidth=25+Iconweidth
ResizeWindow(0,0,0,WindowWidth,BarHeight)
ResizeGadget(0,25,0,WindowWidth-25,BarHeight)
counter=1
ClearList(Filelink())
ForEach File()
If File()\MenuName=Menuname$
SHGetFileInfo_(File()\Name, 0, shInfo, SizeOf(SHFILEINFO), #SHGFI_ICON)
AddGadgetItem(0,-1, StringField(GetFilePart(File()\Name),1,"."), shInfo\hIcon)
AddElement(Filelink())
Filelink()\Listindex=CountGadgetItems(0)-1
Filelink()\Fileindex=ListIndex(File())
counter+1
If BarHeight<counter*Iconheight
WindowWidth+Iconweidth
ResizeWindow(0,0,0,WindowWidth,BarHeight)
ResizeGadget(0,25,0,WindowWidth-25,BarHeight)
counter=0
EndIf
EndIf
Next
EndProcedure
Procedure LoadPref()
OpenPreferences(Systempath+"Sidebar_System_Folder\Preferences.prefs")
PreferenceGroup("Window")
BarHeight=ReadPreferenceLong ("BarHeight", 930)
Transparenty=ReadPreferenceLong ("Transparenty", 255)
PreferenceGroup("Time")
SettingOpenTime=ReadPreferenceLong("SettingOpenTime",3000)
SettingStayTime=ReadPreferenceLong("SettingStayTime",1000)
SettingRefreshTime=ReadPreferenceLong("SettingRefreshTime",1000)
PreferenceGroup("Icon")
Iconheight=ReadPreferenceLong ("Iconheight", 70)
Iconweidth=ReadPreferenceLong ("Iconweidth", 90)
ClosePreferences()
EndProcedure
Procedure SavePref()
CreatePreferences(Systempath+"Sidebar_System_Folder\Preferences.prefs")
PreferenceGroup("Window")
WritePreferenceLong("BarHeight",BarHeight)
WritePreferenceLong("Transparenty",Transparenty)
PreferenceGroup("Time")
WritePreferenceLong ("SettingOpenTime",SettingOpenTime)
WritePreferenceLong ("SettingStayTime",SettingStayTime)
WritePreferenceLong("SettingRefreshTime",SettingRefreshTime)
PreferenceGroup("Icon")
WritePreferenceLong ("Iconheight",Iconheight)
WritePreferenceLong ("Iconweidth",Iconweidth)
ClosePreferences()
EndProcedure
Procedure Settings()
OpenWindow(2, 394, 529, 380, 250, "Einstellungen", #PB_Window_SystemMenu | #PB_Window_TitleBar )
SetWindowPos_(WindowID(2),#HWND_TOPMOST,0,0,0,0,#SWP_NOMOVE|#SWP_NOSIZE)
CreateGadgetList(WindowID(2))
TextGadget(#PB_Any, 10, 10, 70, 20, "Sidebar höhe:")
TextGadget(#PB_Any, 10, 40, 70, 20, "Transparenz:")
TextGadget(#PB_Any, 10, 70, 80, 20, "Neulade Zeit:")
TextGadget(#PB_Any, 10, 100, 80, 20, "Stay on top Zeit:")
TextGadget(#PB_Any, 10, 130, 90, 20, "Stay on run Zeit:")
TextGadget(#PB_Any, 10, 160, 80, 20, "Icon höhe:")
TextGadget(#PB_Any, 10, 190, 90, 20, "Icon breite:")
String0=StringGadget(#PB_Any, 100, 10, 90, 20, "", #PB_String_Numeric)
String1=StringGadget(#PB_Any, 100, 40, 90, 20, "", #PB_String_Numeric)
String2=StringGadget(#PB_Any, 100, 70, 90, 20, "", #PB_String_Numeric)
String3=StringGadget(#PB_Any, 100, 100, 90, 20, "", #PB_String_Numeric)
String4=StringGadget(#PB_Any, 100, 130, 90, 20, "", #PB_String_Numeric)
String5=StringGadget(#PB_Any, 100, 160, 90, 20, "", #PB_String_Numeric)
String6=StringGadget(#PB_Any, 100, 190, 90, 20, "", #PB_String_Numeric)
TextGadget(#PB_Any, 200, 10, 40, 20, "pixel")
TextGadget(#PB_Any, 200, 40, 180, 20, "255 ist normal 0 ist ganz durchsichtig")
TextGadget(#PB_Any, 200, 70, 90, 20, "millisekunden")
TextGadget(#PB_Any, 200, 100, 90, 20, "millisekunden")
TextGadget(#PB_Any, 200, 130, 90, 20, "millisekunden")
TextGadget(#PB_Any, 200, 160, 90, 20, "pixel")
TextGadget(#PB_Any, 200, 190, 90, 20, "pixel")
Button0=ButtonGadget(#PB_Any, 10, 220, 170, 20, "Abbruch")
Botton1=ButtonGadget(#PB_Any, 200, 220, 170, 20, "Übernehmen")
SetGadgetText(String0,Str(BarHeight))
SetGadgetText(String1,Str(Transparenty))
SetGadgetText(String2,Str(SettingRefreshTime))
SetGadgetText(String3,Str(SettingStayTime))
SetGadgetText(String4,Str(SettingOpenTime))
SetGadgetText(String5,Str(Iconheight))
SetGadgetText(String6,Str(Iconweidth))
new=0
Quit2=0
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow : Quit2=1
Case #PB_Event_Gadget
Select EventGadget()
Case Button0 : Quit2=1
Case Botton1
If GetGadgetText(String0)="" Or GetGadgetText(String1)="" Or GetGadgetText(String2)="" Or GetGadgetText(String3)="" Or GetGadgetText(String4)="" Or GetGadgetText(String5)="" Or GetGadgetText(String6)=""
MessageRequester("Fehler","Bitte alle felder ausfüllen")
Else
BarHeight=Val(GetGadgetText(String0))
Transparenty=Val(GetGadgetText(String1))
SettingOpenTime=Val(GetGadgetText(String4))
SettingStayTime=Val(GetGadgetText(String3))
SettingRefreshTime=Val(GetGadgetText(String2))
Iconheight=Val(GetGadgetText(String5))
Iconweidth=Val(GetGadgetText(String6))
new=1
Quit2=1
EndIf
EndSelect
EndSelect
Until Quit2=1
CloseWindow(2)
SetActiveWindow(0)
If new=1
SavePref()
SetWinOpacity(WindowID(0), Transparenty)
ResizeWindow(0,0,0,WindowWidth,BarHeight)
ClearList(File())
ClearList(Menu())
Load()
LoadMenu()
ViewIcons()
EndIf
EndProcedure
hwnd=OpenWindow(1,0,0,130,60, "",#PB_Window_BorderLess | #PB_Window_ScreenCentered)
LoadPref()
SetWinOpacity(hwnd, Transparenty)
SetWindowPos_(hwnd,#HWND_TOPMOST,0,0,0,0,#SWP_NOMOVE|#SWP_NOSIZE)
CreateGadgetList(hwnd)
TextGadget(999,10,10,120,40,"Lade Desktop Sidebar!"+Chr(10)+Chr(10)+"Bitte Warten ...")
LoadFont(0,"Arial",8)
Load()
CloseWindow(1)
hwnd=OpenWindow(0,0,0,WindowWidth,BarHeight, "Sidebar",#PB_Window_BorderLess)
SetWinOpacity(hwnd, Transparenty)
SetWindowPos_(hWnd,#HWND_TOPMOST,0,0,0,0,#SWP_NOMOVE|#SWP_NOSIZE)
CreatePopupMenu(0)
MenuItem(0,"Einstellungen")
MenuBar()
MenuItem(1,"Beenden")
CreateGadgetList(hwnd)
ClearList(File())
ClearList(Menu())
Load()
LoadMenu()
ViewIcons()
OldAktivMenu=AktivMenu
HideWindow(0,1)
refreshtime=ElapsedMilliseconds()
Repeat
WinEvent=WindowEvent()
ForEach Menu()
If AktivMenu=Menu()\ID
Break
EndIf
Next
ExamineMousePosition()
If WinEvent
StartDrawing(WindowOutput(0))
Box(20,0,2,BarHeight,RGB(255,255,255))
DrawImage(ImageID(img0),20,((AktivMenu-1)*columheight)+2)
StopDrawing()
If aktivate=1 And WinEvent=#WM_RBUTTONUP And (GetMouseX()<WindowWidth Or GetMouseY()>BarHeight)
DisplayPopupMenu(0,WindowID(0))
EndIf
Wheel=MouseWheelDelta()
If WinEvent=#WM_MOUSEWHEEL
If Wheel>0
AktivMenu+1
If AktivMenu > MaxMenu : AktivMenu = 1 : EndIf
Wheeled=1
OldWidth=WindowWidth
ElseIf Wheel<0
AktivMenu-1
If AktivMenu =< 0 : AktivMenu = MaxMenu : EndIf
Wheeled=1
OldWidth=WindowWidth
EndIf
ElseIf WinEvent=#PB_Event_Menu
Select EventMenu()
Case 0 : Settings()
Case 1 : Quit=1
EndSelect
EndIf
If AktivMenu<>OldAktivMenu
ViewIcons()
OldAktivMenu=AktivMenu
EndIf
If WinEvent=#PB_Event_Gadget
GadEvent=EventGadget()
If GadEvent>0 And GadEvent<100
AktivMenu=GadEvent
ViewIcons()
OldAktivMenu=AktivMenu
ElseIf GadEvent=0 And EventType()=#PB_EventType_LeftDoubleClick And GetGadgetState(0)<>-1
run(GetGadgetState(0))
EndIf
EndIf
Else
Delay(50)
Sleep_(1)
EndIf
If opentime
If ElapsedMilliseconds()-opentime>SettingOpenTime
opentime=0
EndIf
Else
If GetMouseX()=0 And GetMouseY()<BarHeight And aktivate=0
If ElapsedMilliseconds()-refreshtime > SettingRefreshTime And aktivate=0
ClearList(File())
ClearList(Menu())
Load()
LoadMenu()
ViewIcons()
OldAktivMenu=AktivMenu
refreshtime=ElapsedMilliseconds()
EndIf
HideWindow(0,0)
aktivate=1
EndIf
If (GetMouseX()>WindowWidth Or GetMouseY()>BarHeight) And aktivate=1 And Wheeled=0
HideWindow(0,1)
aktivate=0
EndIf
If aktivate=1 And Wheeled=1
Stay=ElapsedMilliseconds()
Wheeled=2
EndIf
If Wheeled=2 And (GetMouseX()<WindowWidth Or GetMouseY()>BarHeight)
OldWidth=0
Wheeled=0
EndIf
If Wheeled=2 And (GetMouseX()>OldWidth Or GetMouseY()>BarHeight)
OldWidth=0
Wheeled=0
EndIf
If Wheeled=2 And ElapsedMilliseconds()-Stay > SettingStayTime
Wheeled=0
EndIf
EndIf
Until Quit=1
könnt ma compeliren ist ein feines Tool wer zuviel aufm Desktop hat und nicht immer dahin switchen will.
