'****************** Demo: Drag & Drop von Files aus Listbox per Message simulieren
'****************** Profan² 7.x
'****************** © by TCS (Uwe "Pascal" Niemeier) 03'2002

window 10,10-250,300
usermessages 16'---Beenden abfangen

def WindowFromPoint(2) !"USER32", "WindowFromPoint"
def SetCapture(1) !"USER32", "SetCapture"
def ReleaseCapture(0) !"USER32", "ReleaseCapture"
def GetCursorPos(1) !"USER32","GetCursorPos"
def GetParent(1) !"USER32","GetParent"
def GetModuleHandle(1) !"KERNEL32","GetModuleHandleA"

declare Shell$,Shell&,Liste%,Datei$
declare Pos#,Wnd&,Drop#,Temp&

dim Pos#,8
dim Drop#,200


proc Drop'----------------------------------------------------------------------------
parameters File$'----------Dateipfad (muss vollständig sein!)

GetCursorPos(Pos#)'--------Cursor-Position
wnd&=WindowFromPoint(long(Pos#,0),long(Pos#,4))'--Element-Handle unter Cursor
Temp&=GetParent(wnd&)
while Temp&'---------------Höchste Fensterebene des Zielprogrammes ermitteln
   wnd&=Temp&
   Temp&=GetParent(wnd&)'--Höchste Ebene, wenn Parent=0
endwhile

clear Drop#'---------------DROPFILES-Struktur siehe Win32.hlp
long Drop#,0=20
string Drop#,20=File$
setfocus(wnd&)'------------Zielfenster aktivieren für Drop-Empfang
postmessage(wnd&,563,Drop#,0)'--WM_DROPFILES
endproc'---------------------------------------------------------------------------------


Shell$="Shell32"'-----------------------Handle von Shell32 für Drop-Cursor
Shell&=GetModuleHandle(addr(Shell$))
winexec("notepad.exe",5)'---------------Beispielprogramm als Drop-Empfänger

Liste%=create("listbox",%hwnd,"",10,150,200,100)
addstring(Liste%,"C:\CONFIG.SYS")'------Dateipfad muss vollständig sein! (siehe oben)
addstring(Liste%,"C:\AUTOEXEC.bat")
setfocus(%hwnd)

while 1
   waitinput
   if %message=305'-----------------Markierten (!) Eintrag mit Links anklicken
      useextcursor Shell&,"#1003"'--Drop-Cursor
      SetCapture(%hwnd)'------------Ereignisse auch ausserhalb von %Hwnd empfangen
      whilenot %message=7'----------warten auf Loslassen der Maustaste
         getmessage'----------------Falls Message verpasst wird: Abfrage &Wparam
         case &wparam<>1:break'-----Zusatzliche Abfrage wg. möglicher Endlos-Schleife
      endwhile
      Datei$=getstring$(Liste%,getcursel(Liste%))'--Dateipfad aus Liste
      Drop Datei$'------------------File droppen
      ReleaseCapture()'-------------Ereignisse wieder normal innerhalb von %Hwnd empfangen
      usecursor 0'------------------Standart-Cursor
   endif
   case %umessage=16:break

endwhile

dispose Pos#
dispose Drop#