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

WhileLoop Az

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

Endwhile

BAR
Messagebox("Zufügen avec Drag&Drop\n\nSchieben avec Strg+Maus","Tip",32)
DragAcceptFiles(H,1)
Utilisateur Messages 16,~WM_DROPFILES

Tandis que 1

    Az=GetCount(Lv)
    Waitinput
    cas %UMessage =~WM_DROPFILES:DROP
    yy=%MenuItem

    Si 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"
        Séparateur
        AppendMenu 109,"Ende"
        TrackMenu %MouseX,%MouseY
        yy=%MenuItem

        Si yy>200

            DeleteString(Lv,yy-201)
            dec Az
            BAR

        EndIf

        cas MenuItem(106):SetWindowPos H=Hx,Hy -(Az*47)+22,38;0
        cas MenuItem(107):SetWindowPos H=Hx,Hy - 21,38;0
        cas MenuItem(108):SORT
        cas 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
Fin

Proc DROP

    Déclarer Bild&,shfi#
    x=&WParam
    DragQueryFile(x,$FFFFFFFF,PF#,461);
    DragQueryFile(x,0,PF#,261)
    a=String$(PF#,0)
    DragFinish(x)
    Cas substr$(upper$(a),-1,".")="LNK": a=Link(a)
    AddStrings(Lv,a)
    inc Az
    BAR

ENDPROC

Proc BAR

    DeleteObject IL
    DestroyWindow(Tb)
    DestroyWindow(Dy)
    Claire Zi[]
    IL=Créer("ImageList", 32, 32)
    SetWindowPos H=Hx,Hy - (Az*47)+22,38;0
    Dy=Contrôle("Dialogue",»,$54000000,22,0,Width(H),38,H,0,%HINSTANCE)
    Tb=Créer("TOOLBAR", Dy, IL, 0, 32, 2000, 1)
    xx=1
    Déclarer x#
    Faible x#,255

    WhileLoop Az

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

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

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

        D'autre

            x=Créer("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

    Paramètres Pa$
    Déclarer Po&,Si&
    Assign #15,Pa$
    Openrw #15
    Si&=GetFileSize(#15)+256
    Déclarer x#
    Faible 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#
    Retour 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

    si subclassmessage(H,~WM_KEYDOWN)

        x=&swparam

        si (x>32)*((x<41))

            setfocus(Lv)
            sendkey(Lv,x)

        endif

    elseif subclassmessage(Dlg,DM)

        Z=~LBItemFromPt(Lv,long(&slparam,8),long(&slparam,12),1)

        si 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

            si Z>-1

                a=getstring$(Lv,Q)
                deletestring(Lv,Q)
                cas 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