Access to content while dragging...?

[Michael Vogel]

I am writing a crypto tool which allows to drag passwords and other things to a web page but also allows to drop text content from other sources onto the gadgets.
I made a callback procedure for DropEvents which allows to change the text content or to colorize the gadgets where the mouse cursor is placed while the dragging is done. But it would be fine to even show the expected result before finishing the drop action. Is there a chance to catch the dragged text? Important note, dragging will start from an external program window and the dropping takes place on the PB dialog.

[srod]

Only way I know on Windows is to handle the drops through OLE. You can retrieve the text whenever the cursor enters a registered drop target.

Let me know if this will help (Windows only) and I can dredge up an example.

Won't be until tonight though when I get home.

[Michael Vogel]

Hi srod, it will be a Windows tool, here's a code (which looks a little bit messy as I have removed the code parts for dragging)...

...also saw just now, that #PB_Drop_Leave will never be seen - but that's another story...

Code: Select all

; Define

	#Demo=0

	#Undefined=-#True

	#GridX=40
	#GridY=40

	#SizeX1=75
	#SizeX2=200
	#SizeY0=30

	#TabX1=10
	#TabX2=#TabX1+#SizeX1
	#TabY1=10
	#TabY2=#TabY1+#GridY
	#TabY3=#TabY2+#GridY
	#TabY4=#TabY3+#GridY
	#TabY5=#TabY4+#GridY


	#DelayEventDrag=	5
	#DelayEventShort=	10
	#DelayEventLong=	50
	#DelayTimerTicks=	50; 50

	#Timer=666
	#TrimCharacters=#CRLF$+#TAB$+" "

	Enumeration
		; Windows
		#WinMain
		#WinDrag
		#WinDemo
	EndEnumeration

	Enumeration
		; Gadgets in Main
		#MainTitle
		#MainId
		#MainInformation
		#MainUsername
		#MainPassword
		#MainIdX
		#MainInformationX
		#MainUsernameX
		#MainPasswordX
		#MainStatus
		#MainEnd

		; Gadgets in Demo
		#DemoText
		#DemoString
	EndEnumeration

	Enumeration
		; Images
		#ImageBackground
		#ImageUsername
		#ImageDrag
	EndEnumeration

	Enumeration
		#FontDefault
	EndEnumeration

	#DrawOpaque=	$e0000000

	LoadFont(#FontDefault,"Segoe UI",10,#PB_Font_HighQuality)

	#GadgetTab=4
	#GadgetAdd=#GadgetTab+1;	horizontaler Versatz des Textes zwischen Image und Gadget

	Global GadgetCx,GadgetCy,GadgetCz

	Global DragMode;		0:off, 1:on (Mausknopf gedrückt)
	Global DragState;		0: scanning, 1: Dragging active
	Global DragGadget;		Gadget ID
	Global DragHandle;		Handle des "aktiven" Gadgets
	Global DragCounter;		Time
	Global DragCursor;		Handle
	Global DragMemory.s;	zwischengespeicherter Text des Gadgets
	Global DragText.s;		aktueller Text während des Verschiebens
	Global DragClipboard.s

	Enumeration
		#DragStateNil
		#DragStateActive
	EndEnumeration


	#GadgetFirst=#MainId
	#GadgetLast=#MainPassword

	Global Dim GadgetHandle(#GadgetLast)

; EndDefine

Procedure.s StrTrim(String.s,Character.s=" ")

	Protected a,b

	a=1
	b=Len(String)

	While FindString(Character,Mid(String,b,1))
		b-1
		If b=0
			ProcedureReturn ""
		EndIf
	Wend

	While FindString(Character,Mid(String,a,1))
		a+1
	Wend

	ProcedureReturn Mid(String,a,b-a+1)

EndProcedure
Procedure GetGadgetID(Handle)

	Protected i

	If Handle
		i=#GadgetLast

		While i
			If Handle=GadgetHandle(i)
				ProcedureReturn i
			EndIf
			i-1
		Wend
	EndIf

	ProcedureReturn #Null

EndProcedure
Procedure GetHoverGadget()

	Protected Cursor.Point

	If GetCursorPos_(Cursor)
		ProcedureReturn GetGadgetID(WindowFromPoint_(PeekQ(@Cursor)))
	EndIf

	ProcedureReturn #Null

EndProcedure


Procedure DropEvents(Window,State,Format,Action,x,y)

	If Window
		Window=GetGadgetID(Window)
		If Format=#PB_Drop_Text And Window
			Select State
			Case #PB_Drag_Enter
				DragText="<Content>";EventDropText()
				DragMemory=GetGadgetText(Window)
				Debug "New "+DragMemory
				If Action=#PB_Drag_Copy
					SetGadgetText(Window,DragMemory+DragText)
				Else
					SetGadgetText(Window,DragText)
				EndIf
				SetGadgetColor(Window,#PB_Gadget_BackColor,#Yellow)
				
			Case #PB_Drag_Update
				Debug "Update"
				If Action=#PB_Drag_Copy
					SetGadgetText(Window,DragMemory+DragText)
				Else
					SetGadgetText(Window,DragText)
				EndIf

			Case #PB_Drag_Leave
				Debug "Leave"
				SetGadgetText(Window,DragMemory+"!")
				SetGadgetColor(Window,#PB_Gadget_BackColor,#White)

			Case #PB_Drag_Finish
				SetGadgetColor(Window,#PB_Gadget_BackColor,#Red)

			EndSelect
			;SetGadgetText(Window,Str(State)+":"+Str(Format))
			;Debug Str(State)+":"+Str(Format)+":"+Str(Action)
		EndIf
	EndIf

	ProcedureReturn #True

EndProcedure

Procedure Init()

	DragCursor=LoadCursor_(0,#IDC_HAND)

	CompilerIf #Demo
		OpenWindow(#WinDemo,10,10,#GridX*6,#GridY*3,"Non Purebasic App - Drag here...")
		TextGadget(#DemoText,10,10,60,#SizeY0,"Text:",#SS_NOTIFY)
		StringGadget(#DemoString,80,10,#SizeX2,#SizeY0,"<empty>",#SS_NOTIFY)
		;EnableGadgetDrop(#DemoString,#PB_Drop_Text,#PB_Drag_Copy)
	CompilerEndIf

	CreateImage(#ImageBackground,#GridX*10,#GridY*5)
	StartDrawing(ImageOutput(#ImageBackground))
	Box(0,0,#GridX*10,#GridY*5,#Blue)
	Box(1,1,#GridX*10-2,#GridY*5-2,#White)
	DrawText(10,10,"MyPass",#Red,#White)
	StopDrawing()

	OpenWindow(#WinMain,0,0,#GridX*10,#GridY*5,"",#PB_Window_BorderLess|#PB_Window_ScreenCentered)
	;SetWindowColor(#WinMain,#Black); bewirkt dunkles Erscheinungsbild von WinDrag
	SetGadgetFont(#PB_Default,FontID(#FontDefault))
	TextGadget(#MainIdX,#TabX1,#TabY1,#SizeX1,#SizeY0,"Name:",#SS_CENTERIMAGE)
	GadgetHandle(#MainId)=StringGadget(#MainId,#TabX2,#TabY1,#SizeX2,#SizeY0,"PURE",#ES_MULTILINE)
	TextGadget(#MainInformationX,#TabX1,#TabY2,#SizeX1,#SizeY0,"Information:",#SS_CENTERIMAGE)
	GadgetHandle(#MainInformation)=StringGadget(#MainInformation,#TabX2,#TabY2,#SizeX2,#SizeY0,"Information",#ES_MULTILINE)
	TextGadget(#MainUsernameX,#TabX1,#TabY3,#SizeX1,#SizeY0,"Benutzer:",#SS_CENTERIMAGE)
	GadgetHandle(#MainUsername)=StringGadget(#MainUsername,#TabX2,#TabY3,#SizeX2,#SizeY0,"Username",#ES_MULTILINE)
	TextGadget(#MainPasswordX,#TabX1,#TabY4,#SizeX1,#SizeY0,"Passwort:",#SS_CENTERIMAGE)
	GadgetHandle(#MainPassword)=StringGadget(#MainPassword,#TabX2,#TabY4,#SizeX2,#SizeY0,"Password",#ES_MULTILINE)

	TextGadget(#MainStatus,#TabX1,#TabY5,300,20,"")
	;HideGadget(#MainUsername,1)


	ImageGadget(#MainTitle,0,0,#GridX*10,#GridY*5,ImageID(#ImageBackground),#SS_NOTIFY)
	;DisableGadget(#MainTitle,1)
	AddWindowTimer(#WinMain,#Timer,#DelayTimerTicks)
	StickyWindow(#WinMain,1)


	OpenWindow(#WinDrag,0,200,#SizeX2,#SizeY0,"<Dragging>",#PB_Window_BorderLess|#PB_Window_ScreenCentered|#PB_Window_Invisible)
	SetClassLong_(WindowID(#WinDrag),#GCL_HCURSOR,0)
	AddWindowTimer(#WinDrag,#Timer,#DelayTimerTicks)
	StickyWindow(#WinDrag,1)

	EnableGadgetDrop(#MainId,#PB_Drop_Text,#PB_Drag_Move|#PB_Drag_Copy)
	EnableGadgetDrop(#MainInformation,#PB_Drop_Text,#PB_Drag_Move|#PB_Drag_Copy)
	EnableGadgetDrop(#MainUsername,#PB_Drop_Text,#PB_Drag_Move|#PB_Drag_Copy)
	EnableGadgetDrop(#MainPassword,#PB_Drop_Text,#PB_Drag_Move|#PB_Drag_Copy)

	SetDropCallback(@DropEvents())
	;SetDragCallback(@DragEvents())

	;SetWindowCallback(@MainEvents(),#WinMain)
	;SetWindowCallback(@MoreEvents(),#WinDrag)

EndProcedure
Procedure Main()

	Protected g

	Init()


	Repeat

		Select WaitWindowEvent()
		Case #PB_Event_GadgetDrop
			SetGadgetText(EventGadget(),EventDropText())

		Case #PB_Event_Gadget
			Select EventGadget()
			Case #MainTitle
				SendMessage_(WindowID(#WinMain),#WM_NCLBUTTONDOWN,#HTCAPTION,0)
			Default
				Debug "G: "+Str(EventGadget())+" ("+EventType()+")"
			EndSelect

		Case #PB_Event_Menu
			Debug "M: "+Str(EventMenu())+" ("+EventType()+")"

		Case #PB_Event_CloseWindow
			DestroyCursor_(DragCursor)

			End


		Case #WM_LBUTTONDOWN
			DragMode=1
			Debug "v"

		Case #WM_LBUTTONUP
			DragMode=0
			Debug "^"

		EndSelect

	ForEver

EndProcedure

Main()

[Michael Vogel]

Here's a code, which is more complete and includes dragging from and to the PB dialog.

I also did a workaround now for the #PB_Drag_Leave issue, so dragging content to the gadgets is working fine now (except there's no preview of the text, only '<content>' will be displayed). Here it would be fine to see the real text content instead of the placeholder.

BTW: dragging text from the PB dialog to other programs is still unstable, sometimes a longer click does not work, sometimes wrong text will be inserted into the target application. Especially when clicking around wildly will bring my program into a bad state where things go weird - be careful

Code: Select all

; Define


	#Undefined=-#True

	#GridX=40
	#GridY=40

	#SizeX1=75
	#SizeX2=200
	#SizeY0=30

	#TabX1=10
	#TabX2=#TabX1+#SizeX1
	#TabY1=10
	#TabY2=#TabY1+#GridY
	#TabY3=#TabY2+#GridY
	#TabY4=#TabY3+#GridY
	#TabY5=#TabY4+#GridY


	#DelayEventDrag=	5
	#DelayEventShort=	10
	#DelayEventLong=	50
	#DelayTimerTicks=	50; 50

	#Timer=666
	#TrimCharacters=#CRLF$+#TAB$+" "

	Enumeration
		; Windows
		#WinMain
		#WinDrag
		#WinDemo
	EndEnumeration

	Enumeration
		; Gadgets in Main
		#MainTitle
		#MainId
		#MainInformation
		#MainUsername
		#MainPassword
		#MainIdX
		#MainInformationX
		#MainUsernameX
		#MainPasswordX
		#MainStatus
		#MainEnd
	EndEnumeration

	Enumeration
		; Images
		#ImageBackground
		#ImageUsername
		#ImageDrag
	EndEnumeration

	Enumeration
		#FontDefault
	EndEnumeration

	#DrawOpaque=	$e0000000

	LoadFont(#FontDefault,"Segoe UI",10,#PB_Font_HighQuality)

	#GadgetTab=4
	#GadgetAdd=#GadgetTab+1;	horizontaler Versatz des Textes zwischen Image und Gadget

	Global GadgetCx,GadgetCy,GadgetCz

	Global DragMode;		0: off, 1: on (Mausknopf gedrückt)
	Global DragState;		0: scanning, 1: Dragging active
	Global DragGadget;		Gadget ID
	Global DragHandle;		Handle des "aktiven" Gadgets
	Global DragCounter;		Time
	Global DragCursor;		Handle
	Global DragFromOutside;	0: kein Dragging, 1-n: Dragging im Gange (Gadget-ID)
	Global DragMemory.s;	zwischengespeicherter Text des Gadgets
	Global DragText.s;		aktueller Text während des Verschiebens
	Global DragClipboard.s

	Enumeration
		#DragStateNil
		#DragStateActive
	EndEnumeration

	#GadgetFirst=#MainId
	#GadgetLast=#MainPassword

	Global Dim GadgetHandle(#GadgetLast)

	#ColorDefault=	#White
	#ColorHighlight=	$0CFFE3
	#Colorxx=		1

; EndDefine

Procedure.s StrTrim(String.s,Character.s=" ")

	Protected a,b

	a=1
	b=Len(String)

	While FindString(Character,Mid(String,b,1))
		b-1
		If b=0
			ProcedureReturn ""
		EndIf
	Wend

	While FindString(Character,Mid(String,a,1))
		a+1
	Wend

	ProcedureReturn Mid(String,a,b-a+1)

EndProcedure
Procedure.s StrDrag(Action,s.s,t.s)

	Select Action
	Case #PB_Drag_Copy
		ProcedureReturn s+t
	Case #PB_Drag_Move
		ProcedureReturn t
	Default
		ProcedureReturn s
	EndSelect

EndProcedure

Procedure GetGadgetID(Handle)

	Protected i

	If Handle
		i=#GadgetLast

		While i
			If Handle=GadgetHandle(i)
				ProcedureReturn i
			EndIf
			i-1
		Wend
	EndIf

	ProcedureReturn #Null

EndProcedure
Procedure GetGadgetHovered()

	Protected Cursor.Point

	If GetCursorPos_(Cursor)
		ProcedureReturn GetGadgetID(WindowFromPoint_(PeekQ(@Cursor)))
	EndIf

	ProcedureReturn #Null

EndProcedure
Procedure SetGadgetContent(Gadget,Color,Text.s)

	Debug "Set: "+Str(Gadget)+" = "+Text+" / "+Str(Color)

	If GetGadgetText(Gadget)<>Text
		SetGadgetText(Gadget,Text)
	EndIf

	If GetGadgetColor(Gadget,#PB_Gadget_BackColor)<>Color
		SetGadgetColor(Gadget,#PB_Gadget_BackColor,Color)
	EndIf

EndProcedure
Procedure StringGadgetInitialize(GadgetID)

	Protected hdc
	Protected fsz.Size
	Protected Rect.Rect

	GadgetID=GadgetID(GadgetID)

	hdc=GetDC_(GadgetID)
	SelectObject_(hdc,FontID(#FontDefault))
	GetTextExtentPoint32_(hdc,"|",1,fsz)
	ReleaseDC_(GadgetID,hdc)

	GetWindowRect_(GadgetID,Rect)
	GadgetCx=Rect\right-Rect\left
	GadgetCy=Rect\bottom-Rect\top
	GadgetCz=GadgetCy>>1-fsz\cy<<4/21;	cy*16/20 (Text eher weiter oben) bis cy*16/22 (eher weiter unten)
	GadgetCy=(GadgetCy-fsz\cy)>>1

	GetClientRect_(GadgetID,Rect)
	GadgetCx-Rect\right+Rect\left
	GadgetCx>>1

	;Debug GadgetCx
	;Debug GadgetCy

EndProcedure
Procedure StringGadgetAlignment(GadgetID)

	Protected hwndEdit
	Protected hdc
	Protected fsz.SIZE
	Protected erect.RECT
	Protected height

	hwndEdit=GadgetID(GadgetID)

	GetClientRect_(hwndEdit,eRect)
	erect\left=#GadgetTab
	eRect\top=GadgetCz
	eRect\bottom=30;height+fsz\cy>>1

	SendMessage_(hwndEdit,#EM_SETRECT,0,eRect)

EndProcedure

Procedure SetWindowClickThrough(window)

	If IsWindow(window)
		window=WindowID(window)
		SetWindowLong_(window,#GWL_EXSTYLE,GetWindowLong_(window,#GWL_EXSTYLE)|#WS_EX_LAYERED|#WS_EX_TRANSPARENT)
	EndIf

EndProcedure
Procedure AlphaImageWindow(WindowID,ImageID)

	Protected Image_HDC
	Protected Image_Bitmap.BITMAP,Image_BitmapInfo.BITMAPINFO
	Protected ContextOffset.POINT,Blend.BLENDFUNCTION
	Protected x,y,w,h,Alpha

	SetWindowLong_(WindowID,#GWL_EXSTYLE,GetWindowLong_(WindowID,#GWL_EXSTYLE)|#WS_EX_LAYERED)

	Image_HDC=CreateCompatibleDC_(#Null)
	Image_Ancienne=SelectObject_(Image_HDC,ImageID)

	GetObject_(ImageID,SizeOf(BITMAP),@Image_Bitmap)
	Image_BitmapInfo\bmiHeader\biSize=SizeOf(BITMAPINFOHEADER)
	Image_BitmapInfo\bmiHeader\biWidth=Image_Bitmap\bmWidth
	Image_BitmapInfo\bmiHeader\biHeight=Image_Bitmap\bmHeight
	Image_BitmapInfo\bmiHeader\biPlanes=1
	Image_BitmapInfo\bmiHeader\biBitCount=32

	w=Image_Bitmap\bmWidth-1
	h=Image_Bitmap\bmHeight-1
	Protected Dim Image.l(w,h)

	GetDIBits_(Image_HDC,ImageID,0,Image_Bitmap\bmHeight,@Image(),@Image_BitmapInfo,#DIB_RGB_COLORS)

	For x=0 To w
		For y=0 To h
			Couleur=Image(x,y)
			Alpha=Couleur>>24&$FF
			If Alpha<$FF
				Image(x,y)=Alpha<<24|MulDiv_(Couleur&$FF,Alpha,255)|(MulDiv_(Couleur&$FF00,Alpha,255)&$FF00)|(MulDiv_(Couleur&$FF0000,Alpha,255)&$FF0000)
			EndIf
		Next
	Next

	SetDIBits_(Image_HDC,ImageID,0,Image_Bitmap\bmHeight,@Image(),@Image_BitmapInfo,#DIB_RGB_COLORS)

	Blend\SourceConstantAlpha=255
	Blend\AlphaFormat=1
	Blend\BlendOp=0
	Blend\BlendFlags=0
	UpdateLayeredWindow_(WindowID,0,0,@Image_BitmapInfo+4,Image_HDC,@ContextOffset,0,@Blend,2)

	SelectObject_(Image_HDC,Image_Ancienne)
	DeleteDC_(Image_HDC)

EndProcedure
Procedure UpdateDragImage()

	Protected s.s

	CreateImage(#ImageDrag,#SizeX2,#SizeY0,32,#PB_Image_Transparent)
	StartDrawing(ImageOutput(#ImageDrag))
	DrawingMode(#PB_2DDrawing_AllChannels)
	Box(0,0,#SizeX2,#SizeY0,$60ff0000)

	Select DragState
	Case #DragStateActive
		s=GetGadgetText(DragGadget)
		Box(1,1,#SizeX2-2,#SizeY0-2,$4000ff00)
	EndSelect

	; Box(80,1,80,40,0)
	DrawingMode(#PB_2DDrawing_AlphaBlend)
	DrawingFont(FontID(#FontDefault))
	DrawText(#GadgetAdd+GadgetCx,GadgetCy,s,$ff000000,#White)
	StopDrawing()

	AlphaImageWindow(WindowID(#WinDrag),ImageID(#ImageDrag))

	StickyWindow(#WinDrag,1)

EndProcedure

Procedure StartDragging()

	Protected WinRect.Rect

	If DragGadget

		DragState=#DragStateActive
		DragHandle=GadgetID(DragGadget)

		UpdateDragImage()
		GetWindowRect_(GadgetID(DragGadget),WinRect)
		ResizeWindow(#WinDrag,WinRect\left,WinRect\top,#PB_Ignore,#PB_Ignore)

		SetCursor_(DragCursor)
		SetWindowClickThrough(#WinDrag)
		HideWindow(#WinDrag,0)
		StickyWindow(#WinDrag,1)

		SetActiveWindow(#WinDrag)
		DisableGadget(DragGadget,1)
		SendMessage_(WindowID(#WinDrag),#WM_NCLBUTTONDOWN,#HTCAPTION,0)
		DisableGadget(DragGadget,0)

	Else
		DragGadget=#Null
		DragCounter=#Null

	EndIf

EndProcedure
Procedure StopDragging()

	Debug "StopDragging"

	If DragState

		Debug "Off Standard Drag..."
		DragState=#Null
		DragCounter=#Null

		DisableGadget(DragGadget,0)
		HideWindow(#WinDrag,1)

		Message=#Null
		If GetCursorPos_(cursor.POINT)
			Message=#True
			wParam=WindowFromPoint_(PeekQ(@cursor))
			While wParam
				If wParam=WindowID(#WinMain)
					Message=#Null
				EndIf
				wParam=GetParent_(wParam)
			Wend
		EndIf

		If Message

			BlockInput_(#True);

			DragClipboard=GetClipboardText()
			SetClipboardText(GetGadgetText(DragGadget))
			Debug "Text = "+GetClipboardText()

			Message=GetKeyState_(#VK_SHIFT)&128
			mouse_event_(#MOUSEEVENTF_LEFTDOWN,0,0,0,0)
			Delay(1)
			mouse_event_(#MOUSEEVENTF_LEFTUP,0,0,0,0)
			Delay(#DelayEventLong)

			If Message; Or DragMode
				If Message
					keybd_event_(#VK_SHIFT,0,#KEYEVENTF_KEYUP,0)
				EndIf
				keybd_event_(#VK_CONTROL,0,0,0)
				keybd_event_ (#VK_A, 0, 0, 0)
				keybd_event_(#VK_CONTROL,0,#KEYEVENTF_KEYUP,0)
				If Message
					keybd_event_(#VK_SHIFT,0,0,0)
				EndIf
				Delay(#DelayEventShort)
			EndIf

			If Message
				keybd_event_(#VK_SHIFT,0,#KEYEVENTF_KEYUP,0)
			EndIf
			keybd_event_(#VK_CONTROL,0,0,0)
			keybd_event_ (#VK_V, 0, 0, 0)
			keybd_event_(#VK_CONTROL,0,#KEYEVENTF_KEYUP,0)
			If Message
				keybd_event_(#VK_SHIFT,0,0,0)
			EndIf

			Delay(#DelayEventLong)
			SetClipboardText(DragClipboard)
			Debug "Text = "+GetClipboardText()

			BlockInput_(#False);							Tastatur freigeben...

		EndIf


	Else
		Debug "Off..."

	EndIf

	DragMode=0

EndProcedure

Procedure MainEvents(Window,Message,wParam,lParam)

	Select Message
	Case #WM_TIMER
		If wParam=#Timer
			; Debug ">tick<"
			If DragMode;													Mouse button pressed
				Window=GetGadgetHovered()
				If DragState=#Null
					;If GetKeyState_(#VK_LBUTTON)&128
					If DragCounter And DragGadget And DragGadget=Window
						DragCounter+1
						If DragCounter>#DelayEventDrag
							Debug "Start dragging "+Str(DragGadget)
							StartDragging()
						EndIf
					Else
						Debug "*"+Str(window)
						DragGadget=Window
						DragCounter=1
					EndIf
					;Else
					;	Debug "Button off"
					;	DragGadget=#Null
					;	DragCounter=#Null
					;EndIf

				ElseIf DragCounter
					Debug "PANIK "+Str(DragState)+": "+Str(DragGadget)+" / "+Str(DragCounter)+" ("+Str(GetKeyState_(#VK_LBUTTON)&128)+")"
					If GetKeyState_(#VK_LBUTTON)&128=0
						Debug "PANIC BUTTON - laufende Aktionen abwürgen (disabled, active Gadget etc.)"
						DragGadget=#Null
						DragCounter=#Null
						DragState=#Null;	erst nach Aktion ???
					EndIf
				EndIf
				; Debug Str(DragState)+": "+Str(DragGadget)+" / "+Str(DragCounter)
				SetGadgetText(#MainStatus,Str(DragState)+": "+Str(DragGadget)+" / "+Str(DragCounter))

			Else
				;Debug "idle"
				If DragFromOutside And DragFromOutside<>GetGadgetHovered()
					SetGadgetContent(DragFromOutside,#ColorDefault,DragMemory)
					DragFromOutside=#Null
				EndIf
			EndIf

		EndIf


	Case 15,33,273
		SendMessage_(DragHandle,#WM_PAINT,0,0)
		;DisableGadget(DragGadget,0)

	Case 0,3,6,7,24,36,70,71,124,125,127,132,134,161,274533,534,561,641,642
	Case 20,32,256,297,307,312,512,792

	Default
		;Debug  -Message

	EndSelect

	ProcedureReturn #PB_ProcessPureBasicEvents

EndProcedure
Procedure MoreEvents(Window,Message,wParam,lParam)

	Protected cursor.POINT

	Select Message
	Case 562;		Click-Through
		StopDragging()

	Case 49473;		Click-Through
		Debug "****"

	Case #WM_TIMER
	Case 0,3,6,7,24,36,70,71,124,125,127,132,134,161,274533,534,561,641,642
	Case 256,297,28

	Default
		Debug  "Event "+Str(Message)

	EndSelect

	ProcedureReturn #PB_ProcessPureBasicEvents

EndProcedure
Procedure DragEvents(Action)

	Debug Action
	If Action=#PB_Drag_Leave
		Debug "LEAVE"
	EndIf

EndProcedure
Procedure DropEvents(Window,State,Format,Action,x,y)

	If Window
		Window=GetGadgetID(Window)
		If Format=#PB_Drop_Text And Window
			Select State

			Case #PB_Drag_Leave
				Debug "NEVER SEEN!!!!"
				SetGadgetText(Window,DragMemory)
				SetGadgetColor(Window,#PB_Gadget_BackColor,#White)
				DragFromOutside=#Null

			Case #PB_Drag_Enter
				If DragFromOutside And DragFromOutside<>Window
					SetGadgetContent(DragFromOutside,#ColorDefault,DragMemory)
					DragFromOutside=#Null
				EndIf

				DragText="<Content>";EventDropText()
				DragMemory=GetGadgetText(Window)
				SetGadgetContent(Window,#ColorHighlight,StrDrag(Action,DragMemory,DragText))
				DragFromOutside=Window

			Case #PB_Drag_Update
				If Action=#PB_Drag_Copy
					SetGadgetText(Window,DragMemory+DragText)
				Else
					SetGadgetText(Window,DragText)
				EndIf

			Case #PB_Drag_Finish
				DragFromOutside=#Null
				SetGadgetColor(Window,#PB_Gadget_BackColor,#Red)

			EndSelect
			;SetGadgetText(Window,Str(State)+":"+Str(Format))
			;Debug Str(State)+":"+Str(Format)+":"+Str(Action)
		EndIf
	EndIf

	ProcedureReturn #True

EndProcedure

Procedure Init()

	DragCursor=LoadCursor_(0,#IDC_HAND)

	CreateImage(#ImageBackground,#GridX*10,#GridY*5)
	StartDrawing(ImageOutput(#ImageBackground))
	Box(0,0,#GridX*10,#GridY*5,#Blue)
	Box(1,1,#GridX*10-2,#GridY*5-2,#ColorDefault)
	DrawText(300,10,"MyPass",#Red,#ColorDefault)
	StopDrawing()

	OpenWindow(#WinMain,0,0,#GridX*10,#GridY*5,"",#PB_Window_BorderLess|#PB_Window_ScreenCentered)
	;SetWindowColor(#WinMain,#Black); bewirkt dunkles Erscheinungsbild von WinDrag
	SetGadgetFont(#PB_Default,FontID(#FontDefault))
	TextGadget(#MainIdX,#TabX1,#TabY1,#SizeX1,#SizeY0,"Name:",#SS_CENTERIMAGE)
	GadgetHandle(#MainId)=StringGadget(#MainId,#TabX2,#TabY1,#SizeX2,#SizeY0,"PURE",#ES_MULTILINE)
	TextGadget(#MainInformationX,#TabX1,#TabY2,#SizeX1,#SizeY0,"Information:",#SS_CENTERIMAGE)
	GadgetHandle(#MainInformation)=StringGadget(#MainInformation,#TabX2,#TabY2,#SizeX2,#SizeY0,"Information",#ES_MULTILINE)
	TextGadget(#MainUsernameX,#TabX1,#TabY3,#SizeX1,#SizeY0,"Benutzer:",#SS_CENTERIMAGE)
	GadgetHandle(#MainUsername)=StringGadget(#MainUsername,#TabX2,#TabY3,#SizeX2,#SizeY0,"Username",#ES_MULTILINE)
	TextGadget(#MainPasswordX,#TabX1,#TabY4,#SizeX1,#SizeY0,"Passwort:",#SS_CENTERIMAGE)
	GadgetHandle(#MainPassword)=StringGadget(#MainPassword,#TabX2,#TabY4,#SizeX2,#SizeY0,"Password",#ES_MULTILINE)

	SetGadgetColor(#MainIdX,#PB_Gadget_BackColor,#ColorDefault)
	SetGadgetColor(#MainInformationX,#PB_Gadget_BackColor,#ColorDefault)
	SetGadgetColor(#MainUsernameX,#PB_Gadget_BackColor,#ColorDefault)
	SetGadgetColor(#MainPasswordX,#PB_Gadget_BackColor,#ColorDefault)

	TextGadget(#MainStatus,#TabX1,#TabY5,300,20,"")
	;HideGadget(#MainUsername,1)

	StringGadgetInitialize(#MainId)
	StringGadgetAlignment(#MainId)
	StringGadgetAlignment(#MainInformation)
	StringGadgetAlignment(#MainUsername)
	StringGadgetAlignment(#MainPassword)

	ImageGadget(#MainTitle,0,0,#GridX*10,#GridY*5,ImageID(#ImageBackground),#SS_NOTIFY)
	;DisableGadget(#MainTitle,1)
	AddWindowTimer(#WinMain,#Timer,#DelayTimerTicks)
	StickyWindow(#WinMain,1)

	OpenWindow(#WinDrag,0,200,#SizeX2,#SizeY0,"<Dragging>",#PB_Window_BorderLess|#PB_Window_ScreenCentered|#PB_Window_Invisible)
	SetClassLong_(WindowID(#WinDrag),#GCL_HCURSOR,0)
	AddWindowTimer(#WinDrag,#Timer,#DelayTimerTicks)
	StickyWindow(#WinDrag,1)

	EnableGadgetDrop(#MainId,#PB_Drop_Text,#PB_Drag_Move|#PB_Drag_Copy)
	EnableGadgetDrop(#MainInformation,#PB_Drop_Text,#PB_Drag_Move|#PB_Drag_Copy)
	EnableGadgetDrop(#MainUsername,#PB_Drop_Text,#PB_Drag_Move|#PB_Drag_Copy)
	EnableGadgetDrop(#MainPassword,#PB_Drop_Text,#PB_Drag_Move|#PB_Drag_Copy)

	SetDropCallback(@DropEvents())
	;SetDragCallback(@DragEvents())

	SetWindowCallback(@MainEvents(),#WinMain)
	SetWindowCallback(@MoreEvents(),#WinDrag)

EndProcedure
Procedure Main()

	Init()

	Repeat

		Select WaitWindowEvent()
		Case #PB_Event_GadgetDrop
			;SetGadgetText(EventGadget(),EventDropText())
			SetGadgetContent(EventGadget(),#ColorDefault,StrDrag(EventDropAction(),DragMemory,EventDropText()))

		Case #PB_Event_Gadget
			Select EventGadget()
			Case #MainTitle
				SendMessage_(WindowID(#WinMain),#WM_NCLBUTTONDOWN,#HTCAPTION,0)
			Default
				Debug "G: "+Str(EventGadget())+" ("+EventType()+")"
			EndSelect

		Case #PB_Event_Menu
			Debug "M: "+Str(EventMenu())+" ("+EventType()+")"

		Case #PB_Event_CloseWindow
			DestroyCursor_(DragCursor)
			End

		Case #WM_LBUTTONDOWN
			DragMode=1
			Debug "v"

		Case #WM_LBUTTONUP
			DragMode=0
			Debug "^"

		EndSelect

	ForEver

EndProcedure

Main()

[srod]

I am unsure to what leave 'issue' you refer to? When working with OLE drops everything seems to be working fine. The debugger doesn't always respond to drop messages when dragging from outside the app, but the drag and drop otherwise seems to be working fine.

As I said, the only way I know of accessing the text during the drag is to implement the drop directly through OLE which I have now done.

This will unfortunately, require you to change your program quite a bit. On Windows at least it would be very straight forward for Fred or Freak to add this to the drag/drop lib. Consider a feature request perhaps, though I guess it depends on how easy it would be to implement on the other platforms as to whether it would be added or not?

Anyhow, you can access the text being dragged during the equivalent of a drop callback, but only during the #PB_Drag_Enter and #PB_Drag_Finish equivalents and then you must not attempt to retrieve the text after the #PB_Drag_Finish event has finished.

Personally, if I was using this then I would probably use PostEvent() with some custom events, but I do not know if you are already using some of the available custom constants etc. What I did therefore was implement a kind of 'Drop callback', similar to PB's one. You can easily modify it to suit your needs.

The function : OLEEventDropText() can be used to retrieve the text, but as stated, only in either the #PB_Drag_Enter or #PB_Drag_Finish callback messages.

Because of problems with the debugger when dragging from outside the app, keep an eye on the window status bar in the small demo program I give. This will show you the text at the appropriate times.

Main code.

Code: Select all

Global gOLEDROPFormat, gOLEDataObject.IDataobject

CompilerIf #PB_Compiler_Unicode
  gOLEDROPFormat = #CF_UNICODETEXT
CompilerElse
  gOLEDROPFormat = #CF_TEXT
CompilerEndIf

Prototype _iDropTarget_dropCallback(hWnd, state, action)

;Our iDropTarget class template.
;These will be accessible to our main app.
Structure _IDropTarget
  *vTable
  ID.i
  hWnd.i
  refCount.i
  blnAllowDrop.i
  dropCallback._iDropTarget_dropCallback
  actions.i
EndStructure


;-Drop enable function.

;/////////////////////////////////////////////////////////////////////////////////
Procedure OLEEnableGadgetDropText(id, dropCallback, actions)
  Protected *this._IDropTarget
  OleInitialize_(0) ;No harm in calling this multiple times.
  If IsGadget(id)
    *this = AllocateMemory(SizeOf(_IDropTarget))
    If *this    
      With *this
        \vTable = ?VTable_IDropTarget
        \ID = id
        \hWnd = GadgetID(id)      
        \refCount = 0 ;Why not!
        \dropCallback = dropCallback
        \actions = actions
      EndWith
      RegisterDragDrop_(*this\hWnd, *this) ; declare our gadget as a potential drop target
    EndIf
  EndIf
EndProcedure 
;/////////////////////////////////////////////////////////////////////////////////


;/////////////////////////////////////////////////////////////////////////////////
Procedure.s OLEEventDropText()
  Protected result$, thisFormatEtc.FORMATETC, thisStgMedium.STGMEDIUM, buffer, numBytes
  ;Retrieve the data. We have previously checked for valid data.
  ;Windows automatically converts between #CF_TEXT and #CF_UNICODETEXT as appropriate.
  With thisFormatEtc
    \cfFormat = gOLEDROPFormat
    \dwAspect = #DVASPECT_CONTENT
    \lindex = -1
    \tymed = #TYMED_HGLOBAL
  EndWith
  If gOLEDataObject\GetData(thisFormatEtc, thisStgMedium) = #S_OK
    If thisStgMedium\hGlobal ;Only prudent to be sure here!
      numBytes = GlobalSize_(thisStgMedium\hGlobal)
      If numBytes
        buffer = AllocateMemory(numBytes)
        If buffer
          *ptrChar = GlobalLock_(thisStgMedium\hGlobal)
          If *ptrChar
            CopyMemory(*ptrChar, buffer, numBytes)
            GlobalUnlock_(thisStgMedium\hGlobal)
            result$ = PeekS(buffer)
          EndIf
          FreeMemory(buffer)
        EndIf
      EndIf
      ReleaseStgMedium_(thisStgMedium)          
    EndIf
  EndIf
  ProcedureReturn result$
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////


;-Internal functions.

;/////////////////////////////////////////////////////////////////////////////////
;*pdwEffect guaranteed to be non-null.
Procedure DropTarget_SetEffects(*this._IDropTarget, grfKeyState, *pdwEffect.LONG)
  If grfKeyState&#MK_CONTROL
    If *pdwEffect\l & #DROPEFFECT_COPY And *this\actions & #PB_Drag_Copy
      *pdwEffect\l = #DROPEFFECT_COPY
    Else
      *pdwEffect\l = #DROPEFFECT_NONE
    EndIf
  ElseIf *pdwEffect\l & #DROPEFFECT_MOVE And *this\actions & #PB_Drag_Move
    *pdwEffect\l = #DROPEFFECT_MOVE
  Else
    *pdwEffect\l = #DROPEFFECT_NONE
  EndIf
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////


;-iDropTarget methods.

;/////////////////////////////////////////////////////////////////////////////////
Procedure.i DropTarget_QueryInterface(*this._IDropTarget, iid, *ppvObject.INTEGER)
  Protected result
  If CompareMemory(iid, ?IID_IUnknown, SizeOf(CLSID)) Or CompareMemory(iid, ?IID_IDropTarget, SizeOf(CLSID))
    *ppvObject\i = *this
    *this\refCount + 1
    result = #S_OK
  Else
    *ppvObject\i=0
    result = #E_NOINTERFACE
  EndIf
  ProcedureReturn result
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////


;/////////////////////////////////////////////////////////////////////////////////
Procedure.i DropTarget_AddRef(*this._IDropTarget)
  *this\refCount + 1
  ProcedureReturn 0
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////


;/////////////////////////////////////////////////////////////////////////////////
Procedure.i DropTarget_Release(*this._IDropTarget)
  Protected result
  *this\refCount - 1
  If *this\refCount > 0
    result = *this\refCount
  Else
    FreeMemory(*this)
  EndIf
  ProcedureReturn result
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////


;/////////////////////////////////////////////////////////////////////////////////
Procedure.i DropTarget_DragEnter(*this._IDropTarget, dataObject.IDataobject, grfKeyState, pt.q, *pdwEffect.LONG)
  Protected result=#S_OK, thisFormatEtc.FORMATETC
  *this\blnAllowDrop = #False
  If *pdwEffect = 0
    result = #E_INVALIDARG
  Else
    SetFocus_(*this\hWnd)
    ;Check to see if the data object supports our text format.
      With thisFormatEtc
        \cfFormat = gOLEDROPFormat
        \dwAspect = #DVASPECT_CONTENT
        \lindex = -1
        \tymed = #TYMED_HGLOBAL
      EndWith
      If dataObject\QueryGetData(thisFormatEtc) = #S_OK
        *this\blnAllowDrop = #True
        DropTarget_SetEffects(*this, grfKeyState, *pdwEffect)
        gOLEDataObject = Dataobject
        ;Call the callback.
          If *this\dropCallback
            *this\dropCallback(*this\hWnd, #PB_Drag_Enter, *pdwEffect\l)
          EndIf
      Else
        *pdwEffect\l = #DROPEFFECT_NONE
      EndIf
  EndIf
  ProcedureReturn result
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////


;/////////////////////////////////////////////////////////////////////////////////
Procedure.i DropTarget_DragOver(*this._IDropTarget, grfKeyState, pt.q, *pdwEffect.LONG)
  Protected result = #S_OK
  If *pdwEffect = 0
    result = #E_INVALIDARG
  Else
    If *this\blnAllowDrop
      DropTarget_SetEffects(*this, grfKeyState, *pdwEffect)
      ;Call the callback.
        If *this\dropCallback
          *this\dropCallback(*this\hWnd, #PB_Drag_Update, *pdwEffect\l)
        EndIf
    Else
      *pdwEffect\l = #DROPEFFECT_NONE
    EndIf
  EndIf
  ProcedureReturn result
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////


;/////////////////////////////////////////////////////////////////////////////////
Procedure.i DropTarget_DragLeave(*this._IDropTarget)
  ;Call the callback.
    If *this\dropCallback
      *this\dropCallback(*this\hWnd, #PB_Drag_Leave, 0)
    EndIf
  ProcedureReturn #S_OK
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////


;/////////////////////////////////////////////////////////////////////////////////
;*pdwEffect\l contains the original combination of effects.
Procedure.i DropTarget_Drop(*this._IDropTarget, Dataobject.IDataobject, grfKeyState, pt.q, *pdwEffect.LONG)
  Protected result = #S_OK, anchWnd, tempAnchWnd, thisFormatEtc.FORMATETC, thisStgMedium.STGMEDIUM, *ptrChar.CHARACTER
  If *pdwEffect = 0
    result = #E_INVALIDARG
  ElseIf *this\blnAllowDrop
    ;Set effects.
      DropTarget_SetEffects(*this, grfKeyState, *pdwEffect)
    ;Do we proceed?
      If *pdwEffect\l <> #DROPEFFECT_NONE
        If result = #S_OK
          gOLEDataObject = Dataobject
          ;Call the callback.
            If *this\dropCallback
              *this\dropCallback(*this\hWnd, #PB_Drag_Finish, *pdwEffect\l)
            EndIf
          ;Bring the ancestor window of the drop target into the fore. GetAncestor_() used to be buggy!
            anchWnd = *this\hWnd
            tempAnchWnd = GetParent_(anchWnd) 
            While tempAnchWnd 
              anchWnd=tempAnchWnd 
              tempAnchWnd = GetParent_(tempAnchWnd) 
            Wend 
            SetForegroundWindow_(anchWnd)
          Else
            result = #E_FAIL
          EndIf
      EndIf
  EndIf
  ProcedureReturn result
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////

DataSection 
  VTable_IDropTarget:
   Data.i @DropTarget_QueryInterface()
   Data.i @DropTarget_AddRef()
   Data.i @DropTarget_Release()
   Data.i @DropTarget_DragEnter()
   Data.i @DropTarget_DragOver()
   Data.i @DropTarget_DragLeave()
   Data.i @DropTarget_Drop()

  CompilerIf Defined(IID_IUnknown, #PB_Label) = 0
    IID_IUnknown:   ;"{00000000-0000-0000-C000-000000000046}"
      Data.l $00000000
      Data.w $0000,$0000
      Data.b $C0,$00,$00,$00,$00,$00,$00,$46 
  CompilerEndIf

  CompilerIf Defined(IID_IDropTarget, #PB_Label) = 0
    IID_IDropTarget:  ;{00000122-0000-0000-C000-000000000046}
      Data.l $00000122
      Data.w $0000,$0000
      Data.b $C0,$00,$00,$00,$00,$00,$00,$46
  CompilerEndIf
EndDataSection

Small demo.

Drag text from either the ListIcon on the left or from outside the program. Drop to the ListIcon on the right.

Code: Select all

Declare dropCallback(hWnd, state, action)

OpenWindow(0,0,0,480,400,"",#PB_Window_ScreenCentered|#PB_Window_SystemMenu) 
  CreateStatusBar(0, WindowID(0))
  AddStatusBarField(#PB_Ignore)
TextGadget(10, 20, 20, 200, 40, "Drag from...")
ListIconGadget(0,20,60,200,300, "Drag from...", 195, #PB_ListIcon_FullRowSelect) 
TextGadget(11, 250, 20, 200, 40, "Drag to...")
ListIconGadget(1, 250, 60, 200, 300, "Drop target", 150) 

For i = 0 To 50
  AddGadgetItem(0, -1, "Row "+Str(i)) 
Next

;Enable text drops to the second ListIcon.
  OLEEnableGadgetDropText(1, @dropCallback(), #PB_Drag_Move|#PB_Drag_Copy) 

Repeat 
  eventID = WaitWindowEvent() 
  Select eventID 
    Case #PB_Event_Gadget 
      If EventGadget() = 0 And EventType() = #PB_EventType_DragStart
        DragText(GetGadgetItemText(0, GetGadgetState(0)), #PB_Drag_Copy|#PB_Drag_Move) 
      EndIf 
 EndSelect 
Until eventID = #PB_Event_CloseWindow 


;Our OLE drop text callback.
Procedure dropCallback(hWnd, state, action)
  Select state
    Case #PB_Drag_Enter 
      StatusBarText(0, 0, "Entered drop gadget with drop text : " + OLEEventDropText())

    Case #PB_Drag_Update

    Case #PB_Drag_Leave

    Case #PB_Drag_Finish  
      text$ = OLEEventDropText()
      StatusBarText(0, 0, "Finished drop with drop text : " + text$)
      ;Let us add the dropped text to the ListIcon. We ignore EOL characters.
        AddGadgetItem(1, -1, text$)
  EndSelect
EndProcedure

[Michael Vogel]

Thanks for this code - works perfect.
I will do a complete redesign now because of the unpredictible results when dragging content to other apps. After doing so I will add your code so it seems that all will look fine at the end.