XProfan

 $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