Da einige gerne den Desktop aufräumen wollen, hier ein Grundgerüst -auf's minimieren mußte ich verzichten- als Toolbar, dass *.exe und *.lnk übernimmt . Ich hoffe drag&drob gehen unter WIN7 auch noch.
[Blockierte Grafik: http://s15.postimg.org/ix3mwbd3b/Screen_22_03_2013_20_Uhr_59_21_Sek.jpg]
Code
$H windows.ph
$H messages.ph
$H commctrl.ph
Def w32_ExtractAssociatedIcon(3) !"SHELL32","ExtractAssociatedIconA"
Def DragAcceptFiles(2) !"SHELL32","DragAcceptFiles"
Def DragFinish(1) !"SHELL32","DragFinish"
Def DragQueryFile(4) !"SHELL32","DragQueryFileA"
Declare PF#
Dim PF#,461
Declare Integer Hx,Hy,Az,xx,yy
Declare LONG H,Dy,dlg,IL,Tb,Lv,x,y,Q,Z,Cu,DM,Bk
Declare STRING a,b,c,cfg,Zi[]
a=$AppDataDir
b="\\icobar"
cfg=a+b+b+".cfg"
casenot FileExists(a+b) : MkDir a+b
casenot FileExists(cfg):WRITEINI cfg,"BAR","N"="0"
Hx=0
Hy=0
Az=val(ReadIni$(cfg,"BAR","N"))
Windowstyle 1112
window 0,0
H=%hwnd
UseFont "Arial",16,0,0,0,0
SetDialogFont 1
Bk=Create("Button", H ,">",0,0,20,38)
Create("Tooltip",H,Bk,"Menü")
dlg=@Create("Dialog",H,"Sort per Drag",0,0,700,300)
ShowWindow(dlg,0)
Lv=Create("ListBox",dlg,0,16,0,660,260)
WhileLoop Az
Zi[&loop]=ReadIni$(cfg,"BAR",str$(&loop))
Case FileExists(Zi[&loop]):AddString(Lv,Zi[&loop])
EndWhile
BAR
Messagebox("Zufügen mit Drag&Drop\n\nSchieben mit Strg+Maus","Tip",32)
DragAcceptFiles(H,1)
UserMessages 16,~WM_DROPFILES
While 1
Az=GetCount(Lv)
Waitinput
case %UMessage =~WM_DROPFILES:DROP
yy=%MenuItem
If IsKey(17) | (%MousePressed=1)
UseCursor 5
SendMessage(H,$112,$F012,0)
UseCursor 0
HX=%WinLeft
HY=%WinTop
ElseIf Getfocus(Bk) | (%MousePressed=2)
CreateMenu
SubPopUp "Löschen"
xx=201
WhileLoop Az
AppendMenu xx, GetString$(Lv,&loop-1)
inc xx
EndWhile
EndSub
AppendMenu 108,"Sortieren"
AppendMenu 107,"min"
AppendMenu 106,"max"
Separator
AppendMenu 109,"Ende"
TrackMenu %MouseX,%MouseY
yy=%MenuItem
If yy>200
DeleteString(Lv,yy-201)
dec Az
BAR
EndIf
case MenuItem(106):SetWindowPos H=Hx,Hy -(Az*47)+22,38;0
case MenuItem(107):SetWindowPos H=Hx,Hy - 21,38;0
case MenuItem(108):SORT
case MenuItem(109):BREAK
ElseIf (yy>2000)
ShellExec(Zi[yy-2000],"OPEN",1)
Endif
EndWhile
Dispose PF#
WRITEINI cfg,"BAR","N"=str$(Az)
WhileLoop Az
WRITEINI cfg,"BAR",Str$(&loop)=GetString$(Lv,&loop-1)
Endwhile
DeleteObject IL
End
Proc DROP
Declare Bild&,shfi#
x=&WParam
DragQueryFile(x,$FFFFFFFF,PF#,461);
DragQueryFile(x,0,PF#,261)
a=String$(PF#,0)
DragFinish(x)
Case substr$(upper$(a),-1,".")="LNK": a=Link(a)
AddString(Lv,a)
inc Az
BAR
EndProc
Proc BAR
DeleteObject IL
DestroyWindow(Tb)
DestroyWindow(Dy)
Clear Zi[]
IL=Create("ImageList", 32, 32)
SetWindowPos H=Hx,Hy - (Az*47)+22,38;0
Dy=Control("DIALOG","",$54000000,22,0,Width(H),38,H,0,%hinstance)
Tb=Create("TOOLBAR", Dy, IL, 0, 32, 2000, 1)
xx=1
Declare x#
Dim x#,255
WhileLoop Az
Zi[&loop]=GetString$(Lv,&loop-1)
If substr$(upper$(Zi[&loop]),-1,".")<>"EXE"
String x#,0=Zi[&loop]
y=1
x=w32_ExtractAssociatedIcon(%hinstance,x#,Addr(y))
Else
x=Create("hIcon",Zi[&loop],0)
EndIf
ImageList("AddIcon", IL,x)
Toolbar("AddButton",Tb,&loop-1,2000+xx,substr$(Zi[&loop],-1,"\"))
Toolbar("Separator",Tb)
inc xx
EndWhile
Dispose x#
EndProc
Proc LINK
Parameters Pa$
Declare Po&,Si&
Assign #15,Pa$
Openrw #15
Si&=GetFileSize(#15)+256
Declare x#
Dim x#,Si&
BlockRead(#15,x#,0,Si&)
Closerw #15
Po&=MemPos(x#,MemPos(x#,0,":\\")+1,":\\") + MemPos(x#,0,":\\")
Pa$=String$(x#,Po&)
Dispose x#
Return Pa$
EndProc
Proc SORT
subclass Dlg,1
subclass H,1
ShowWindow(dlg,1)
Cu=~LoadCursorA(~GetModuleHandle("Shell32"),1003)
DM=~RegisterWindowMessage("commctrl_DragListMsg")
~MakeDragList(Lv)
WhileNot %umessage=16
waitinput
endwhile
subclass Dlg,0
subclass H,0
ShowWindow(dlg,0)
BAR
EndProc
subclassproc
if subclassmessage(H,~WM_KEYDOWN)
x=&swparam
if (x>32)*((x<41))
setfocus(Lv)
sendkey(Lv,x)
endif
elseif subclassmessage(Dlg,DM)
Z=~LBItemFromPt(Lv,long(&slparam,8),long(&slparam,12),1)
if long(&slparam,0)=~DL_BEGINDRAG
Q=Z
set("winproc",0)
return 1
elseif long(&slparam,0)=~DL_DRAGGING
~SetCursor(Cu)
~DrawInsert(Dlg,Lv,Z+1)
elseif long(&slparam,0)=~DL_DROPPED
if Z>-1
a=getstring$(Lv,Q)
deletestring(Lv,Q)
case Q>Z:Z=Z+1
insertstring(Lv,Z,a)
setcursel Lv,Z
endif
~DrawInsert(Dlg,Lv,-1)
endif
elseif subclassmessage(Dlg,~WM_COMMAND)
endif
endproc
Alles anzeigen
Gruß Thomas