XProfan

 $H Windows.ph
 $H Messages.ph
 $H commctrl.ph
usermessages 16
Def GetSysColor(1) !"USER32","GetSysColor"
Def WindowFromPoint(2)!"USER32","WindowFromPoint"
Def GetCursorPos(1) !"USER32","GetCursorPos"
Declare p#,h&
Dim p#,8
declare FORMATETC#:dim FORMATETC#,20
long FORMATETC#,4=0,1,-1,1
struct STGMEDIUM=tymed&,Value&,IUnknown&
declare STGMEDIUM#:dim STGMEDIUM#,STGMEDIUM

proc GetData'-------------------------------------------------GetData

    parameters IFace&
    var VTable&=long(IFace&,0)
    return call(long(VTable&,12),IFace&,FORMATETC#,STGMEDIUM#)

endproc'-------------------------------------------------------------

proc Dummy'-----------------------------------------------------Dummy

    return 0'--E_OK

endproc'-------------------------------------------------------------

proc Drop'-------------------------------------------------------Drop

    parameters This&,IDataObject&,KeyState&,X&,Y&
    long FORMATETC#,0=~CF_HDROP'----------------Format: DropFiles

    ifnot GetData(IDataObject&)

        var Mem&=~GlobalLock(STGMEDIUM#.Value&)
        INSERT stringw$(Mem&,20)
        '   print "Datei:",stringw$(Mem&,20)
        ~GlobalUnlock(STGMEDIUM#.Value&)
        ~GlobalFree(STGMEDIUM#.Value&)

    endif

    long FORMATETC#,0=~CF_TEXT'-----------------Format: Text

    ifnot GetData(IDataObject&)

        var Mem&=~GlobalLock(STGMEDIUM#.Value&)
        INSERT string$(Mem&,0)
        ~GlobalUnlock(STGMEDIUM#.Value&)
        ~GlobalFree(STGMEDIUM#.Value&)

    endif

    return 0'--E_OK

endproc'-------------------------------------------------------------

Proc INSERT

    Parameters Zeile$
    var a$=Chr$(13)+Chr$(10)'Zeilenumbruch
    GetCursorPos(p#)' Empfänger ist ?
    h&=WindowFromPoint(Long(p#,0),Long(p#,4))
    ~GetCursorPos(HIT#)
    ~ScreenToClient(Lb&,HIT#)
    sendmessage(Lb&,~LVM_HITTEST,0,HIT#)'---------------------Infos über Cursor in Bezug auf Lv
    sendmessage(Lb&,~LVM_SUBITEMHITTEST,0,HIT#)
    zielx&= HIT#.SubItem&
    ziely&= HIT#.Item&

    If h&=edi&

        SetText edi&,zeile$

    ElseIf h&=Lb&

        zeile$=Translate$(zeile$," ",";")'Feldtrenner= Leerzeichen > werden ';'
        zeile$=Translate$(zeile$,",",";")'Feldtrenner= Komma > werden ';'

        WhileLoop 100'alle vielfachen ';' auf einen reduzieren

            zeile$=Translate$(zeile$,";;",";")

        EndWhile

        zeile$=Translate$(zeile$,";","|")' ';' für Gridbox in '|'
        zeile$=Translate$(zeile$,a$," ")' Zeilenumbruch entfernen

        If (len(Zeile$,"|") > 1)' Anzahl der Felder > 1

            @InsertString(Lb&,0,Zeile$)

        Else

            If ziely&=-1

                @InsertString(Lb&,0,"|||")
                SetText Lb&,0, zielx&, trim$(zeile$)

            Else

                SetText Lb&,ziely&, zielx&, trim$(zeile$)

            EndIf

        EndIf

    EndIf

EndProc'-------------------------------------------------------------

'=========================================================================
window 670,250
Cls GetSysColor(15)
var Font&=Create("Font","MS Sans Serif",16,0,0,0,0)
SETDIALOGFONT Font&
CreateText(%hwnd,"Eingabe:",10,12,90,22)
var edi&= CreateEdit(%hwnd,"",100,10,300,22)
var text$ = "PassNummer;3;150;Vorname;0;180;Nachname;0;180;eMail;0;100"
var Lb& = Create("GridBox", %hwnd, Text$, 0, 10, 44, 640, 140)
declare IDropTarget#,IDropTarget&
dim IDropTarget#,32'-----------------------IDropTarget-Interface
long IDropTarget#, 0=procaddr("Dummy",2)'--QueryInterface
long IDropTarget#, 4=procaddr("Dummy",1)'--AddRef
long IDropTarget#, 8=procaddr("Dummy",1)'--Release
long IDropTarget#,12=procaddr("Dummy",5)'--DragEnter
long IDropTarget#,16=procaddr("Dummy",5)'--DragOver
long IDropTarget#,20=procaddr("Dummy",1)'--DragLeave
long IDropTarget#,24=procaddr("Drop",5)'---Drop
long IDropTarget#,28=IDropTarget#
IDropTarget&=IDropTarget#+28
external("ole32","OleInitialize",0)
external("ole32","RegisterDragDrop",%hwnd,IDropTarget&)
declare HIT#'------LVHITTESTINFO-Struktur
struct HIT=x&,y&,Flags&,Item&,SubItem&
dim Hit#,HIT
declare ziely&,zielx&

while 1

    waitinput
    case %umessage=16:break

endwhile

external("ole32","RevokeDragDrop",%hwnd)
external("ole32","OleUninitialize")
dispose IDropTarget#,FORMATETC#,STGMEDIUM#,p#,hit#
f='./../../funktionsreferenzen/XProfan/deleteobject/'>DeleteObject font&
end