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"
Declarar PF#
Dim PF#,461
Declarar Integer Hx,Hy,Az,xx,yy
Declarar LONG H,Dy,dlg,IL,Tb,Lv,x,y,Q,Z,Cu,DM,Bk
Declarar 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=Crear("Button", H ,">",0,0,20,38)
Crear("Tooltip",H,Bk,"Menü")
dlg=@Crear("Dialog",H,"Sort por Drag",0,0,700,300)
ShowWindow(dlg,0)
Lv=Crear("ListBox",dlg,0,16,0,660,260)

WhileLoop Az

    Zi[&bucle]=ReadIni$(cfg,"BAR",str$(&bucle))
    Case FileExists(Zi[&bucle]):AddStrings(Lv,Zi[&bucle])

EndWhile

BAR
Messagebox("Zufügen con Drag&Drop\n\nSchieben con Strg+Maus","Tip",32)
DragAcceptFiles(H,1)
Mensajes del usuario 16,~WM_DROPFILES

Mientras que 1

    Az=GetCount(Lv)
    Waitinput
    caso %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,&bucle-1)
            inc xx

        EndWhile

        EndSub
        AppendMenu 108,"Sortieren"
        AppendMenu 107,"min"
        AppendMenu 106,"max"
        Separador
        AppendMenu 109,"Ende"
        TrackMenu %MouseX,%MouseY
        yy=%MenuItem

        If yy>200

            DeleteString(Lv,yy-201)
            dec Az
            BAR

        EndIf

        caso MenuItem(106):SetWindowPos H=Hx,Hy -(Az*47)+22,38;0
        caso MenuItem(107):SetWindowPos H=Hx,Hy - 21,38;0
        caso MenuItem(108):SORT
        caso MenuItem(109):BREAK

    ElseIf (yy>2000)

        ShellExec(Zi[yy-2000],"OPEN",1)

    Endif

EndWhile

Disponer PF#
WRITEINI cfg,"BAR","N"=str$(Az)

WhileLoop Az

    WRITEINI cfg,"BAR",Str$(&bucle)=GetString$(Lv,&bucle-1)

Endwhile

DeleteObject IL
End

Proc DROP

    Declarar 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)
    AddStrings(Lv,a)
    inc Az
    BAR

ENDPROC

Proc BAR

    DeleteObject IL
    DestroyWindow(Tb)
    DestroyWindow(Dy)
    Claro Zi[]
    IL=Crear("ImageList", 32, 32)
    SetWindowPos H=Hx,Hy - (Az*47)+22,38;0
    Dy=Control("DIÁLOGO","",$54000000,22,0,Width(H),38,H,0,%hInstance)
    Tb=Crear("TOOLBAR", Dy, IL, 0, 32, 2000, 1)
    xx=1
    Declarar x#
    Dim x#,255

    WhileLoop Az

        Zi[&bucle]=GetString$(Lv,&bucle-1)

        If substr$(upper$(Zi[&bucle]),-1,".")<>"EXE"

            String x#,0=Zi[&bucle]
            y=1
            x=w32_ExtractAssociatedIcon(%hInstance,x#,Addr(y))

        Más

            x=Crear("hIcon",Zi[&bucle],0)

        EndIf

        ImageList("AddIcon", IL,x)
        Toolbar("AddButton",Tb,&bucle-1,2000+xx,substr$(Zi[&bucle],-1,"\"))
        Toolbar("Separator",Tb)
        inc xx

    EndWhile

    Disponer x#

ENDPROC

Proc LINK

    Parámetros Pa$
    Declarar Po&,Si&
    Asignar #15,Pa$
    Openrw #15
    Si&=GetFileSize(#15)+256
    Declarar 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&)
    Disponer x#
    Volver Pa$

ENDPROC

Proc SORT

    subclass Dlg,1
    subclass H,1
    ShowWindow(dlg,1)
    Cu=~LoadCursorA(~GetModuleHandle("Shell32"),1003)
    DM=~RegisterWindowMessage("commctrl_DragListMsg")
    ~MakeDragList(Lv)

    Sinestar encargado %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)
            volver 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)
                caso 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