OLE DRAG & DROP in VISUAL FOXPRO

Published on by Yousfi Benameur


i published a post relative to oledrag & drop in visual foxpro - 6 november 2014 in this Foxite link:
https://www.foxite.com/archives/drag-images-from-explorer-firefox-0000414145.htm

infortunatly this was worked on windows8.1 if i remember.When upgraded to windows 10 professional this code have any longer and i wondered if microsoft go to correct this bug.
these last days i re try the code and by luck it worked.Ms corrected this bug through its updates.
the code make drag & drop operations from restricted tested sources  as
-firefox (works with images and text.protected images as google dont work)
-windows explorer: work (files)
-chrome( work for text only)
-IE dont work on images nor on text !
....

Select any image and drag&drop into the relative form(Firefox,explorer)
Select a text (ex from vfp command window or firefox or explorer txt file) and drag& drop into the form

the images captured are saved in captures folder as BMP and converted by APIS to light jpg ones.
notes:
-i choose the JPG light format for captures.can choose another format (PNG,GIF,BMP,...in code)
-the ANSI text can be saved as txt file from the relative form.
if you drag unicode text towards the vfp editbox you get "???"(must use rtfbox instead or ms textbox activeX  its unicode).
-the temp images used by Firefox are deleted automatically by system after some time.cannot clean them from vfp.

-Can build a project, add a config.fpw and compile an exe as utility (20 ko).

Added on Thursday 28 april 2016: 
-the oledrag & drop of unicode texts (tested here on arabic).
-corected contextuel menu (replaced by flat code - mpr not shipped previously).

note:  to make Firefox.exe (or iexplore.exe, chrome.exe.....), launched automatically without specifing the location path can use this command line(type in windows start):
setx path "%path%;C:\Program Files\Mozilla Firefox" 

 

 

Click on code to select [then copy] -click outside to deselect


*1*
*oledrag & drop images or ANSI text (2 options on 2 forms)

If !_vfp.StartMode=0
    On Shutdown Quit
Endi
Set Safe Off
Clea All

Publi m.yrep
m.yrep=Addbs(Justpath(Sys(16,1)))
Set Defa To (yrep)
If !Directory(m.yrep+"captures")   &&create a folder captures if not exist
	Md (m.yrep+"captures")
Endi

*download a fox image from my blog
Declare Integer Sleep In kernel32 Integer
Declare Integer URLDownloadToFile In urlmon.Dll Integer pCaller, String szURL, String szFileName, Integer dwReserved, Integer lpfnCB
Declare Integer DeleteUrlCacheEntry In wininet String lpszUrlName

lcDownloadURL = "http://img.over-blog-kiwi.com/1/43/54/07/20160422/ob_6577e4_yfennec.png"
lcDownloadLoc ="yfennec.png"
lnResult = DeleteUrlCacheEntry(lcDownloadURL)
lnResult = URLDownloadToFile(0, lcDownloadURL, lcDownloadLoc , 0,0)
If lnResult = 0
	Wait Window "Download "+lcDownloadLoc +"  Complete" Nowait
*Else
*!*  Messagebox("Download fails")
Endi

Local m.x
m.x=Inputbox("oledrag image(1)-oledragText(2)","","1")
If !Inlist(m.x,"1","2")
	Return .F.
Endi

Publi yform
Do Case
Case m.x="1"
*do form ydragDrop_Img
	yform=Newobject("yoledrag_drop_img")
Case m.x="2"
	yform=Newobject("yOledrag_drop_text")
*do form yoledragdrop_texts
Otherwise
	Return .F.
Endcase
yform.Show
Read Events

Define Class yoledrag_drop_img As Form
	Top = 0
	Left = 12
	Height = 392
	Width = 456
	ShowWindow = 2
	BackColor=Rgb(212,208,200)
	ShowTips = .T.
	Picture = ""
	Caption = "Visual Fox Dragdrop images from anywhere !"
	MaxButton = .F.
	Icon = Home(1)+"graphics\icons\misc\misc15.ico"
	WindowState = 0
	AlwaysOnTop = .T.
	xpict = .F.
	ycl = 0
	xleft = .F.
	xtop = .F.
	xwidth = .F.
	xheight = .F.
	Name = "Form1"

	Add Object image1 As Image With ;
		OLEDragMode = 1, ;
		OLEDropMode = 1, ;
		Anchor = 15, ;
		Picture = "yfennec.png", ;
		Stretch = 2, ;
		Height = 348, ;
		Left = 2, ;
		MousePointer = 15, ;
		Top = 0, ;
		Width = 450, ;
		ToolTipText = "", ;
		Name = "Image1"

	Add Object image2 As Image With ;
		Anchor = 768, ;
		backstyle=0, ;
		Picture = Home(1)+ "graphics\icons\win95\explorer.ico", ;
		Stretch = 2, ;
		Height = 36, ;
		Left = 162, ;
		MousePointer = 15, ;
		Top = 357, ;
		Width = 54, ;
		ToolTipText = "See captured images", ;
		Name = "Image2"

	Add Object label1 As Label With ;
		AutoSize = .T., ;
		FontBold = .T., ;
		FontSize = 20, ;
		Anchor = 768, ;
		BackStyle = 0, ;
		Caption = "?", ;
		Height = 35, ;
		Left = 230, ;
		MousePointer = 15, ;
		Top = 354, ;
		Width = 19, ;
		ForeColor = Rgb(128,0,64), ;
		ToolTipText = "Summary help", ;
		Name = "Label1"

	Procedure Load
	Declare Integer OpenClipboard In User32 Integer
	Declare Integer CloseClipboard In User32
	Declare Integer EmptyClipboard In User32
	Declare Integer SetClipboardData In User32 Integer,Integer
	Declare Integer GetClipboardData In User32 Integer
	Declare Integer GdipSaveImageToFile In GDIPlus.Dll Integer,String,String @,String @
	Declare Long GdipCreateHBITMAPFromBitmap In GDIPlus.Dll Long nativeImage, Long @, Long
	Declare Long CopyImage In WIN32API Long hImage, Long, Long, Long , Long
	Declare Long    GdipCreateBitmapFromFile    In GDIPlus.Dll String FileName, Long @nBitmap
	Declare Integer GdipCreateBitmapFromHBITMAP In GDIPlus.Dll Integer, Integer, Integer @
	Endproc

	Procedure zsave
	Lparameters yimage
	#Define CF_BITMAP 2
	#Define IMAGE_BITMAP 0
	#Define  LR_DEFAULTSIZE 0x00000040

	Local m.ext
	m.ext="JPG"   &&can choose any image format :PNG,BMP,JPG,GIF,TIFF ....
	Do Case
	Case m.ext="PNG"
		lqEncoderClsID_PNG=0h06F47C55041AD3119A730000F81EF32E &&PNGFormat
	Case m.ext="JPG"
		lqEncoderClsID_JPG=0h01F47C55041AD3119A730000F81EF32E &&JPGFormat
	Case m.ext="BMP"
		lqEncoderClsID_BMP=0h00F47C55041AD3119A730000F81EF32E &&BMPFormat
	Case m.ext="GIF"
		lqEncoderClsID_GIF=0h02F47C55041AD3119A730000F81EF32E &&GIFFormat
	Case m.ext="TIF"
		lqEncoderClsID_TIF=0h05F47C55041AD3119A730000F81EF32E &&TIFFormat
	Endcase

*Save the graphic file to the clipboard
	nBitmap=0
	hbm=0
	GdipCreateBitmapFromFile(Strconv(Allt(yimage)+0h00,5),@nBitmap)
	GdipCreateHBITMAPFromBitmap(nBitmap,@hbm,0)
	lhbmp=CopyImage(hbm,0, 0,0, LR_DEFAULTSIZE)    &&no resize  preserve dimensions as it
	If OpenClipboard(0)!= 0
		EmptyClipboard()
		SetClipboardData(CF_BITMAP, lhbmp)
		CloseClipboard()
	Endif

*get the graphics from the local clipboard
	OpenClipboard(0)
	hBitmap = GetClipboardData(CF_BITMAP)
	CloseClipboard()

*export as image file with any image extension on disc
	Local lcoutputfile,lcoutputfile0,ubitmap
	lcoutputfile0=m.yrep+"captures\"+Juststem(yimage)+"."+m.ext &&
	ubitmap=0
	GdipCreateBitmapFromHBITMAP(hBitmap,2,@ubitmap)
	lcoutputfile=Strconv(m.lcoutputfile0+Chr(0),5)
	GdipSaveImageToFile(ubitmap,lcoutputfile,Eval("lqEncoderClsID_"+m.ext),Null)

	Thisform.image1.PictureVal=Filetostr(lcoutputfile0)
	hBitmap=Null
	Endproc

	Procedure QueryUnload()
	Clea Resources
	Local gnbre
	gnbre=Adir(gabase,Addbs(Sys(2023))+"*.bmp")
	Wait Window (Trans(gnbre)+" BMPs in temp") Nowait
	For i=1 To gnbre
		Try
			Dele File Addbs(Sys(2023))+gabase(i,1)
		Catch
		Endtry
	Endfor
	Clea Events
	Endproc

	Procedure Init
	Declare Integer Sleep In kernel32 Integer
	_Screen.WindowState=1

	Thisform.xpict=""
	With Thisform
		.ycl=0
		.Left=0
		.Top=0
		.xleft=.Left
		.xtop=.Top
		.xwidth=.Width
		.xheight=.Height
	Endwith
	Endproc

	Procedure image1.MouseEnter
	Lparameters nButton, nShift, nXCoord, nYCoord

	This.ToolTipText="Drag any picture from explorer or FireFox navigator here-"+Chr(13)+"-Click=fullscreen"+Chr(13)+Thisform.xpict
*Contrary on Firefox,IE and Chrome dont accept oleDrag event
	Endproc

	Procedure image1.MouseDown
	Lparameters nButton, nShift, nXCoord, nYCoord
	Endproc

	Procedure image1.OLEDragDrop
	Lparameters oDataObject, nEffect, nButton, nShift, nXCoord, nYCoord
**********************************
*Foxhelp
*CF_TEXT  1  Text format.
*CF_OEMTEXT  7  Text format containing characters in the OEM character set.
*CF_UNICODETEXT  13  Unicode text format.

*NoteNote
*Available only for versions of Visual FoxPro running on Windows NT 4.0 or later.

*CF_FILES or CF_HDROP  15  A handle that identifies a list of files, such as a set of files dragged from the Windows Explorer.
*CFSTR_OLEVARIANTARRAY  "OLE Variant Array"  An array. Multiple values can be transferred in a single drag and drop operation with this format.
*For example, this format can be used to drag a set of items in a list box to another list box.
*
*CFSTR_OLEVARIANT  "OLE Variant"  A variant. All data types in Visual FoxPro are represented as variants. This format can be used to drag and drop Visual FoxPro data without losing the data type.
*CFSTR_VFPSOURCEOBJECT  "VFP Source Object"  A reference to the Visual FoxPro drag source object.
* Defined in FOXPRO.H.

	TEXT to _cliptext textmerge noshow
		1-<<oDataObject.GetFormat(1)>>-Text format
		7-<<oDataObject.GetFormat(7)>>-Text format containing characters in the OEM character se
		13-<<oDataObject.GetFormat(13)>>-Unicode text format
		15-<<oDataObject.GetFormat(15)>>-a list of files,
		-ole variant array : <<oDataObject.GetFormat("ole variant array")>>
		-"ole variant : <<oDataObject.GetFormat("olevariant")>>
		-vfp source object:<<oDataObject.GetFormat("vfp source object")>>
	ENDTEXT
	x=_Cliptext
	Messagebox(x,0+32+4096,"odataObject",1500)


	Local cfilename, afiles[ 1 ]
	If oDataObject.GetFormat( 15 )   &&files
		oDataObject.GetData( 15, @afiles )
		For Each cfilename In afiles
			Do Case
			Case Lower(Justpath(m.cfilename))==Lower(Sys(2023))  &&temp folder (Firefox)
				Thisform.zsave(cfilename)
			Otherwise  &&explorer

				Copy File  (cfilename) To (m.yrep+"captures")
				Thisform.xpict=m.yrep+"captures\"+Justfname(cfilename)
				Thisform.image1.PictureVal=Filetostr(Thisform.xpict)
			Endcase
			Inkey( .5 )
		Next
	Endif
	Endproc

	Procedure image1.OLEDragOver
	Lparameters oDataObject, nEffect, nButton, nShift, nXCoord, nYCoord, nState
	Do Case
	Case nState = 0 && Drag Enter
		If oDataObject.GetFormat(15)
			This.OLEDropHasData = 1
			This.OLEDropEffects = 4
			nEffect = 4
		Endif
	Case nState = 1 && DRAG_LEAVE
	Case nState = 2 && DRAG_OVER
	Endcase
	Thisform.Refresh
	Endproc

	Procedure image1.MouseEnter
	Lparameters nButton, nShift, nXCoord, nYCoord
	This.ToolTipText="Drag any picture from explorer or FireFox navigator here-"+Chr(13)+"-Click=fullscreen"+Chr(13)+Thisform.xpict
*Contrary on Firefox,IE and Chrome dont accept oleDrag event
	Endproc

	Procedure image2.Click
	Local oo
	m.oo=m.yrep+"captures"
	Thisform.WindowState=1
	Run /N explorer &oo
	Endproc

	Procedure label1.Click
	Local m.myvar
	TEXT to m.myvar noshow

this application uses the VFP oleDrag event to capture any image from
-the windows explorer (image saved as it)
-the Firefox browser (IE and Chrome dont accept oleDrag...another
 dont tried.): image intercepted and  saved as bmp and converted to JPG
 with APIs.

-Drag any image from explorer or Firefox into the image control
and its saved in the "captures" folder of this application.
-Can see  all captures produced
-Can make the image on fullscren( first click) and restaure the
 form (seconf click).

Author Yousfi Benameur ElBayadh Algeria
Thursday 6 november 2014
	ENDTEXT

	Messagebox(m.myvar,0+32+4096,"Summary help")
	Endproc
	Procedure Destroy
	Clea Events
	Endproc
Enddefine
*
*-- EndDefine: yoledrag_drop_img

*
Define Class yOledrag_drop_text As Form
	Top = 0
	Left = 0
	Height = 396
	Width = 732
	ShowWindow = 2
	Caption = "yOledradrop_texts"
	AlwaysOnTop = .T.
	BackColor = Rgb(72,72,72)
	Icon=Home(1)+"graphics\icons\misc\misc15.ico"
	Name = "Form1"

	Add Object edit1 As EditBox With ;
		OLEDragMode = 1, ;
		OLEDropMode = 1, ;
		Anchor = 15, ;
		Height = 324, ;
		Left = 7, ;
		Top = 36, ;
		Width = 713, ;
		Name = "Edit1"

	Add Object label1 As Label With ;
		AutoSize = .T., ;
		FontBold = .T., ;
		FontSize = 11, ;
		Anchor = 768, ;
		BackStyle = 0, ;
		Caption = "Dragdrop texts from anywhere if  client operation  supported", ;
		Height = 20, ;
		Left = 36, ;
		Top = 0, ;
		Width = 429, ;
		ForeColor = Rgb(255,0,0), ;
		Name = "Label1"

	Add Object label2 As Label With ;
		AutoSize = .T., ;
		FontBold = .T., ;
		FontSize = 11, ;
		BackStyle = 0, ;
		Caption = "", ;
		Height = 20, ;
		Left = 480, ;
		Top = 1, ;
		Width = 2, ;
		ForeColor = Rgb(0,255,0), ;
		Name = "Label2"

	Add Object command1 As CommandButton With ;
		Top = 370, ;
		Left = 299, ;
		Height = 25, ;
		Width = 133, ;
		Anchor = 768, ;
		Caption = "Save as txt file", ;
		MousePointer = 15, ;
		Name = "Command1"

	Procedure Destroy

	Clea Events
	Endproc

	Procedure edit1.OLEDragDrop
	Lparameters oDataObject, nEffect, nButton, nShift, nXCoord, nYCoord
	Local i, cText, cNewStr

	Do Case
***************
*case oDataObject.Getformat(15)	&&files from explorer
*This.Value =oDataObject.GetData(15)
**CF_FILES or CF_HDROP  15 A handle that identifies a list of files, such as a set of files dragged from the Windows Explorer.
********************
	Case oDataObject.GetFormat(1)	&&1-CF_TEXT
		This.Value =oDataObject.GetData(1)
		Thisform.label2.Caption="-1-CF_TEXT"

	Case oDataObject.GetFormat(7)	&&7 CF_OEMTEXT Text format containing characters in the OEM character set.
		This.Value =oDataObject.GetData(7)
		Thisform.label2.Caption="-7 CF_OEMTEXT"

	Case oDataObject.GetFormat(13)	&&13-CF_UNICODETEXT Unicode text format.

		Local m.cFontName,m.cFontCharset,m.cfilename,m.cfilename1,m.nRegionalIDType
		m.cFontName = 'Tahoma'           && unicode font
		m.cFontCharset = 178             && see getfont() in foxHelp (178=arabic)
		m.nRegionalIDType=2              && Specifies that nRegionalIdentifier is a FontCharSet value.
		Thisform.setfontcharset(Thisform.edit1,m.cFontName ,oDataObject.GetData(13) , m.cFontCharset,m.nRegionalIDType)
		Thisform.edit1.Value= Strconv(Substr(oDataObject.GetData(13),3), 11, nCharSet, nRegionalIDType)
		Thisform.label2.Caption="-13-CF_UNICODETEXT" 
	Endcase
	Nodefault
	Endproc

	Procedure edit1.RightClick
	Define Popup raccourci SHORTCUT Relative From Mrow(),Mcol()
	Define Bar _Med_cut Of raccourci Prompt "\<Couper" ;
		KEY CTRL+x, "Ctrl+X" ;
		MESSAGE "Enlève la sélection et la place dans le Presse-papiers"
	Define Bar _Med_copy Of raccourci Prompt "Co\<pier" ;
		KEY CTRL+C, "Ctrl+C" ;
		MESSAGE "Copie la sélection et la place dans le Presse-papiers"
	Define Bar _Med_paste Of raccourci Prompt "C\<oller" ;
		KEY CTRL+V, "Ctrl+V" ;
		MESSAGE "Place le contenu du Presse-papiers au point d'insertion"
	Define Bar _Med_find Of raccourci Prompt "Rec\<hercher..." ;
		KEY CTRL+F, "Ctrl+F" ;
		MESSAGE "Recherche le texte spécifié"
	Define Bar _Med_slcta Of raccourci Prompt "Sélec\<tionner tout" ;
		KEY CTRL+A, "Ctrl+A" ;
		MESSAGE "Sélectionne tout le texte ou tous les éléments de la fenêtre active"
	Define Bar _Med_redo Of raccourci Prompt "\<Rétablir" ;
		KEY CTRL+R, "Ctrl+R" ;
		MESSAGE "Rétablit la dernière opération annulée"
	Define Bar _Med_undo Of raccourci Prompt "\<Annuler" ;
		KEY CTRL+Z, "Ctrl+Z" ;
		MESSAGE "Annule la dernière modification"

	Activate Popup raccourci
	Endproc

	Procedure command1.Click
	Set Defa To (m.yrep+"captures")
	Strtofile(Thisform.edit1.Value,Forceext(Putfile('txt'),'txt')  )
	Set Defa To (m.yrep)
	Endproc

Enddefine
*
*-- EndDefine: yOledradrop_text



OLE DRAG &amp; DROP in VISUAL FOXPRO
OLE DRAG &amp; DROP in VISUAL FOXPRO
OLE DRAG &amp; DROP in VISUAL FOXPRO
OLE DRAG &amp; DROP in VISUAL FOXPRO

Click on code to select [then copy] -click outside to deselect

                  
*2* this code works with unicode texts.the oleDrag&drop operation is tested  from an arabic web page on Firefox and chrome (no IE11).this works well and the text in editbox is arabic.it can be saved to an utf-8 txt file (using strconv(string,9,178,2).
Note : i cut the clipboard data relative to ansi text (seems to take superiority on unicode text) and all works well in code


publi yform
yform=newObject("yoledd")
yform.show
read events
retu
*
DEFINE CLASS yoleDD AS form
    Top = 0
	Left = 0
	Height = 396
	Width = 732
	ShowWindow = 2
	borderstyle=2
	Caption = "yOledradrop_texts unicodes"
	AlwaysOnTop = .T.
	BackColor = RGB(72,72,72)
	Name = "Form1"

	ADD OBJECT edit1 AS editbox WITH ;
		OLEDragMode = 1, ;
		OLEDropMode = 1, ;
		FontBold = .T., ;
		FontName = "Tahoma", ;
		FontSize = 11, ;
		FontCharSet = 178, ;
		Anchor = 15, ;
		Alignment = 1, ;
		Height = 324, ;
		Left = 7, ;
		Top = 36, ;
		Width = 713, ;
		RightToLeft = .T., ;
		Name = "Edit1"

	ADD OBJECT label1 AS label WITH ;
	    anchor=768, ;
		AutoSize = .T., ;
		FontBold = .T., ;
		FontSize = 11, ;
		Anchor = 768, ;
		BackStyle = 0, ;
		Caption = "Dragdrop texts from anywhere if  client operation  supported", ;
		Height = 20, ;
		Left = 36, ;
		Top = 0, ;
		Width = 429, ;
		ForeColor = RGB(255,0,0), ;
		Name = "Label1"

	ADD OBJECT label2 AS label WITH ;
	    anchor=768, ;
		AutoSize = .T., ;
		FontBold = .T., ;
		FontSize = 11, ;
		BackStyle = 0, ;
		Caption = "", ;
		Height = 20, ;
		Left = 480, ;
		Top = 1, ;
		Width = 2, ;
		ForeColor = RGB(0,255,0), ;
		Name = "Label2"

	ADD OBJECT command2 AS commandbutton WITH ;
	    anchor=768, ;
		Top = 367+5, ;
		Left = 290, ;
		Height = 25, ;
		Width = 204, ;
		FontBold = .T., ;
		Caption = "Save as  UTF-8 txt file", ;
		MousePointer = 15, ;
		BackColor = RGB(128,255,0), ;
		Name = "Command2"

	ADD OBJECT label3 AS label WITH ;
	    anchor=768, ;
		BackStyle = 0, ;
		Caption = "Rightclick editbox for contextuel  menu", ;
		Height = 25, ;
		Left = 14, ;
		Top = 368+3, ;
		Width = 226, ;
		ForeColor = RGB(255,255,0), ;
		Name = "Label3"

	PROCEDURE Init
		if !vartype(m.yrep)=="C"
		publi m.yrep
		m.yrep=addbs(justpath(sys(1271,this)))
		set defa to (yrep)
		endi
		set safe off
		_screen.windowstate=1
	ENDPROC

	PROCEDURE Destroy
		clea events
	ENDPROC

	PROCEDURE edit1.Init
		Local m.cFontName,m.cFontCharset,m.cFileName,m.cfilename1,m.nRegionalIDType
			m.cFontName = 'Tahoma'           && unicode font
			m.cFontCharset = 178             && see getfont() in foxHelp (here test on 178=arabic)
			m.nRegionalIDType=2
			this.fontCharset=m.cFontCharset
			this.fontname=m.cfontname
	ENDPROC

	PROCEDURE edit1.RightClick
		DEFINE POPUP raccourci SHORTCUT RELATIVE FROM MROW(),MCOL()
		DEFINE BAR _med_cut OF raccourci PROMPT "\<Couper" ;
			KEY CTRL+X, "Ctrl+X" ;
			MESSAGE "Enlève la sélection et la place dans le Presse-papiers"
		DEFINE BAR _med_copy OF raccourci PROMPT "Co\<pier" ;
			KEY CTRL+C, "Ctrl+C" ;
			MESSAGE "Copie la sélection et la place dans le Presse-papiers"
		DEFINE BAR _med_paste OF raccourci PROMPT "C\<oller" ;
			KEY CTRL+V, "Ctrl+V" ;
			MESSAGE "Place le contenu du Presse-papiers au point d'insertion"
		DEFINE BAR _med_find OF raccourci PROMPT "Rec\<hercher..." ;
			KEY CTRL+F, "Ctrl+F" ;
			MESSAGE "Recherche le texte spécifié"
		DEFINE BAR _med_slcta OF raccourci PROMPT "Sélec\<tionner tout" ;
			KEY CTRL+A, "Ctrl+A" ;
			MESSAGE "Sélectionne tout le texte ou tous les éléments de la fenêtre active"
		DEFINE BAR _med_redo OF raccourci PROMPT "\<Rétablir" ;
			KEY CTRL+R, "Ctrl+R" ;
			MESSAGE "Rétablit la dernière opération annulée"
		DEFINE BAR _med_undo OF raccourci PROMPT "\<Annuler" ;
			KEY CTRL+Z, "Ctrl+Z" ;
			MESSAGE "Annule la dernière modification"

		ACTIVATE POPUP raccourci
	ENDPROC

	PROCEDURE edit1.OLEDragDrop
		LPARAMETERS oDataObject, nEffect, nButton, nShift, nXCoord, nYCoord
		LOCAL i, cText, cNewStr
		do case
		***************
		*case oDataObject.Getformat(15)	&&files from explorer  &&this takes priority on unicode ?? uncommented.
		*This.Value =oDataObject.GetData(15)
		**CF_FILES or CF_HDROP  15 A handle that identifies a list of files, such as a set of files dragged from the Windows Explorer.
		********************

		case oDataObject.Getformat(7)	&&7 CF_OEMTEXT Text format containing characters in the OEM character set.
			This.Value =oDataObject.GetData(7)
		thisform.label2.caption="-7 CF_OEMTEXT"

		case oDataObject.Getformat(13)	&&13-CF_UNICODETEXT Unicode text format.
		   This.Value =oDataObject.GetData(13)
		
		Local m.cFontName,m.cFontCharset,m.cFileName,m.cfilename1,m.nRegionalIDType
			m.cFontName = 'Tahoma'           && unicode font
			m.cFontCharset = 178             && see getfont() in foxHelp (178=arabic)
			m.nRegionalIDType=2              && Specifies that nRegionalIdentifier is a FontCharSet value.
			*Thisform.setfontcharset(Thisform.edit1,m.cFontName ,oDataObject.GetData(13) , m.cFontCharset,m.nRegionalIDType)
		    thisform.edit1.value= Strconv(Substr(oDataObject.GetData(13),3), 6, cFontCharSet, nRegionalIDType)  &&unicode to double bits
		
		thisform.label2.caption="-13-CF_UNICODETEXT" 

		case oDataObject.Getformat(1)	&&1-CF_TEXT
			This.Value =oDataObject.GetData(1)
		thisform.label2.caption="-1-CF_TEXT"

		endcase

		NODEFAULT
	ENDPROC

	PROCEDURE command2.Click
		set defa to (m.yrep+"captures")
		local m.x,m.oo,m.uu
		m.x=strconv(thisform.edit1.value,9,178,2)
		m.oo=m.yrep+"captures\blank.txt"

		m.uu=int(val(inputbox("Overwrite txt(0)-Append txt (1)","","0")))
		if !between (m.uu,0,1)
		m.uu=0
		endi

		if m.uu=0
		=strtofile(m.x,m.oo)
		else
		=strtofile(m.x,m.oo,.t.)
		endi

		thisform.windowstate=1
		set defa to (m.yrep)
		run/n notepad &oo
	ENDPROC

ENDDEFINE
*
*-- EndDefine: yoleDD

 

Note:run MSpaint and position it side with firefox window. if you drag manually image directly from Firefox into MSPAINT this success in my FF50.1.0. its not the case with iexplore.
Note:run MSpaint and position it side with firefox window. if you drag manually image directly from Firefox into MSPAINT this success in my FF50.1.0. its not the case with iexplore.

Note:run MSpaint and position it side with firefox window. if you drag manually image directly from Firefox into MSPAINT this success in my FF50.1.0. its not the case with iexplore.

Click on code to select [then copy] -click outside to deselect

*3*
*created on 25 of february 2017
*!*this is a better replacement for the code *1* above.it works on modern navigators unless some prealable settings in IE11.
*!*	can execute ie (complet interface), ie application,firefox, chrome  (if exits on system) or windows explorer
*!*	from these windows can oledragdeop text (editbox,textbox) or pictures(warning there is some links whose are not  picture but mask a navigation to a picture)
*!*	 if picture:
*!*	   - on textbox  or editbox (retrieve the link picture as text)
*!*	   -on the image it retrieves the real image (if link is real picture or blob picture)
*!*	 if text oledragged from the fired application , its copied in textbox (one line) or in editbox (multiline).
*!*	 added a contextuel menu to this editbox.
*!*	 for IE11,must in internet options uncheck the protected mode otherwise no oledragdrop
*!*	 (ie11/menu/tools/internet options/security tab: unchecjk protectd mode).
*!*	 or run separatly IE11 as administrator
*!*	 for firefox,chrome,explorer: no problem.
*!*	 Right click on the image control to save the picture in images folder created in code (save pictureVal blob as picture  or picture converted to pictureval from explorer).

publi yform
yform=newObject("yoleDD5")
yform.show
read events
retu
*
DEFINE CLASS yoleDD5 AS form
Height = 553
Width = 479
ShowWindow = 2
ShowTips = .T.
AutoCenter = .T.
Caption = "oleDragDrop from navigators and explorer demo"
MinHeight = 400
MinWidth = 400
AlwaysOnTop = .T.
BackColor = RGB(212,210,208)
Name = "Form1"

ADD OBJECT optiongroup1 AS optiongroup WITH ;
AutoSize = .T., ;
ButtonCount = 5, ;
Anchor = 768, ;
Value = 1, ;
Height = 27, ;
Left = 45, ;
Top = 12, ;
Width = 391, ;
Name = "Optiongroup1", ;
Option1.Caption = "IE11", ;
Option1.Value = 1, ;
Option1.Height = 17, ;
Option1.Left = 5, ;
Option1.Style = 0, ;
Option1.Top = 5, ;
Option1.Width = 43, ;
Option1.AutoSize = .T., ;
Option1.Name = "Option1", ;
Option2.Caption = "IE Application", ;
Option2.Height = 17, ;
Option2.Left = 61, ;
Option2.Style = 0, ;
Option2.Top = 5, ;
Option2.Width = 92, ;
Option2.AutoSize = .T., ;
Option2.Name = "Option2", ;
Option3.Caption = "Firefox", ;
Option3.Height = 17, ;
Option3.Left = 168, ;
Option3.Style = 0, ;
Option3.Top = 5, ;
Option3.Width = 54, ;
Option3.AutoSize = .T., ;
Option3.Name = "Option3", ;
Option4.Caption = "Chrome", ;
Option4.Height = 17, ;
Option4.Left = 241, ;
Option4.Style = 0, ;
Option4.Top = 5, ;
Option4.Width = 63, ;
Option4.AutoSize = .T., ;
Option4.Name = "Option4", ;
Option5.Caption = "Explorer", ;
Option5.Height = 17, ;
Option5.Left = 323, ;
Option5.Style = 0, ;
Option5.Top = 5, ;
Option5.Width = 63, ;
Option5.AutoSize = .T., ;
Option5.Name = "Option5"

ADD OBJECT image1 AS image WITH ;
OLEDragMode = 1, ;
OLEDropMode = 1, ;
Anchor = 15, ;
Stretch = 2, ;
Height = 363, ;
Left = 17, ;
Top = 136, ;
Width = 456, ;
Name = "Image1"

ADD OBJECT text1 AS textbox WITH ;
OLEDragMode = 1, ;
OLEDropMode = 1, ;
FontName = "MS Sans Serif", ;
FontSize = 8, ;
Anchor = 768, ;
Height = 32, ;
Left = 43, ;
Top = 516, ;
Width = 396, ;
BackColor = RGB(128,255,255), ;
Name = "Text1"

ADD OBJECT edit1 AS editbox WITH ;
OLEDragMode = 1, ;
OLEDropMode = 1, ;
Anchor = 0, ;
Height = 85, ;
Left = 8, ;
Top = 43, ;
Width = 469, ;
BackColor = RGB(255,221,204), ;
Name = "Edit1"

ADD OBJECT image2 AS image WITH ;
Anchor = 768, ;
Picture = home(1)+"graphics\bitmaps\tlbr_w95\help.bmp", ;
Stretch = 2, ;
BackStyle = 1, ;
BorderStyle = 1, ;
Height = 32, ;
Left = 443, ;
MousePointer = 15, ;
Top = 6, ;
Width = 32, ;
Name = "Image2"


ADD OBJECT yex  AS image with ;
Picture = home(1)+"graphics\icons\win95\explorer.ico",;
BackStyle = 0,;
Height = 32,;
Left = 444,;
MousePointer = 15,;
Top = 516,;
Width = 32,;
ToolTipText = "Explore captures",;
Name = "yex"

PROCEDURE yex.Click
local m.oo
m.oo=m.yrep+"images"
run/n explorer &oo
ENDPROC


PROCEDURE Destroy
m.yrep=null
release m.yrep
clea events
ENDPROC

PROCEDURE Load
&&shellexecute
DECLARE INTEGER ShellExecute IN SHELL32.DLL INTEGER nWinHandle,;
	STRING cOperation,;
	STRING cFileName,;
	STRING cParameters,;
	STRING cDirectory,;
	INTEGER nShowWindow
_screen.windowstate=1
ENDPROC

PROCEDURE Init
with this
.left=1
.top=1
.SetAll('Fontname', 'Tahoma')
.SetAll('Fontsize',8)
endwith

publi m.yrep
IF VARTYPE(SYS(1271, THISFORM)) = "L"
	m.yrep = ADDBS(JUSTPATH(SYS(16, 1)))   &&code runs as prg
ELSE
	m.yrep = ADDBS(JUSTPATH(SYS(1271, THISFORM))) &&code runs as form
ENDIF

if !directory( m.yrep+"images")
md (m.yrep+"images")
endi
ENDPROC

PROCEDURE Resize
with thisform.edit1
.left=10
.width=thisform.width-20
endwith
ENDPROC

PROCEDURE optiongroup1.Init
with this
.setall("mousepointer",15,"optionbutton")
.setall("autosize",.t.,"optionbutton")
.setall("backstyle",0,"optionbutton")
.backstyle=0
.autosize=.t.
endwith
ENDPROC

PROCEDURE optiongroup1.Click
try
do case
case this.value=1
ShellExecute(0, "open", 'iexplore.exe',"http://yousfi.over-blog.com/2015/01/glass-images-effect-with-gdiplusx.html","",1)

case this.value=2
publi apie
apie=newObject("internetexplorer.application")
with apie
.navigate("http://yousfi.over-blog.com/2015/01/glass-images-effect-with-gdiplusx.html")
.visible=.t.
endwith

case this.value=3
ShellExecute(0, "open", 'Firefox.exe',"http://yousfi.over-blog.com/2015/01/glass-images-effect-with-gdiplusx.html","",1)

case this.value=4
ShellExecute(0, "open", 'chrome.exe',"http://yousfi.over-blog.com/2015/01/glass-images-effect-with-gdiplusx.html","",1)

case this.value=5
run/n explorer
endcase
catch
messagebox("not installed",16+4096,"Error")
endtry
ENDPROC

PROCEDURE image1.OLEDragOver
LPARAMETERS oDataObject, nEffect, nButton, nShift, nXCoord, nYCoord, nState
DO CASE
CASE nState == 0		&&DRAG_ENTER
	DO CASE
	CASE oDataObject.GetFormat("OLE Variant Array")	&& Array
		This.OLEDropHasData = 1		&&DROPHASDATA_USEFUL
		This.OLEDropEffects = 1+2	&&DROPEFFECT_COPY + DROPEFFECT_MOVE

	CASE oDataObject.GetFormat(1)				&& Text
		This.OLEDropHasData = 1		&&DROPHASDATA_USEFUL
		This.OLEDropEffects = 1+2	&&DROPEFFECT_COPY + DROPEFFECT_MOVE

	CASE oDataObject.GetFormat(15)				&& Files CF_HDROP
		This.OLEDropHasData = 1		&&DROPHASDATA_USEFUL
		This.OLEDropEffects = 4		&&DROPEFFECT_LINK
	OTHERWISE
		This.OLEDropHasData = 0		&&DROPHASDATA_NOTUSEFUL
	ENDCASE

CASE nState == 1	&& Drag Leave
CASE nState == 2	&& Drag Over
ENDCASE
ENDPROC

PROCEDURE image1.OLEDragDrop
LPARAMETERS oDataObject, nEffect, nButton, nShift, nXCoord, nYCoord
*-- Check to see whether the user wants to copy or move
IF nShift == 1
nOperation = 1	&&DROPEFFECT_COPY
ELSE
nOperation = 2	&&DROPEFFECT_MOVE
ENDIF

thisform.lockscreen=.t.
do case
case  oDataObject.Getformat(1)	&&CF_TEXT
	cText = oDataObject.GetData(1)

	********************
	*using the pictureval property from web with MsXml2.XmlHttp responsebody
	Local loRequest,lcUrl
	m.lcUrl=allt(m.ctext)
	try
	m.loRequest = Createobject('MsXml2.XmlHttp')
	m.loRequest.Open("GET",lcUrl,.F.)
	m.loRequest.Send()
	This.pictureVal=m.loRequest.ResponseBody
	m.loRequest=Null
	catch
	endtry
	*********************************
case odataobject.GETFORMAT( 15 )  &&one file is oledragdopped in image only (from explorer here)
		 LOCAL cfilename, afiles[ 1 ]
		 odataobject.GETDATA( 15, @afiles )
			  For Each cfilename In afiles
			   THIS.PICTURE = cfilename
			   this.pictureval=filetostr(cfilename)
			   INKEY( .5 )
			NEXT
	endcase
thisform.lockscreen=.f.
*-- Set the nEffect parameter for communication back to the source object
nEffect = nOperation
retu
ENDPROC

PROCEDURE image1.Init
Local loRequest,lcUrl
lcUrl="http://img.over-blog-kiwi.com/1/43/54/07/20160422/ob_6577e4_yfennec.png"
try
	m.loRequest = Createobject('MsXml2.XmlHttp')
	m.loRequest.Open("GET",lcUrl,.F.)
	m.loRequest.Send()
	This.pictureVal=m.loRequest.ResponseBody
	m.loRequest=Null
catch
endtry
ENDPROC

PROCEDURE image1.RightClick
*nodefault  &&context menu?
if empty(this.pictureval)
return .f.
endi
local m.lcdest
m.lcdest=m.yrep+"images\img_"+sys(2015)+'.jpg'

strtofile(this.pictureVal ,m.lcdest)
messagebox(m.lcdest+"    saved",0+32+4096,'',1200)
ENDPROC

PROCEDURE text1.OLEDragOver

LPARAMETERS oDataObject, nEffect, nButton, nShift, nXCoord, nYCoord, nState
DO CASE
CASE nState == 0		&&DRAG_ENTER
	DO CASE
	CASE oDataObject.GetFormat("OLE Variant Array")	&& Array
		This.OLEDropHasData = 1		&&DROPHASDATA_USEFUL
		This.OLEDropEffects = 1+2	&&DROPEFFECT_COPY + DROPEFFECT_MOVE

	CASE oDataObject.GetFormat(1)				&& Text
		This.OLEDropHasData = 1		&&DROPHASDATA_USEFUL
		This.OLEDropEffects = 1+2	&&DROPEFFECT_COPY + DROPEFFECT_MOVE

	CASE oDataObject.GetFormat(15)				&& Files CF_HDROP
		This.OLEDropHasData = 1		&&DROPHASDATA_USEFUL
		This.OLEDropEffects = 4		&&DROPEFFECT_LINK
	OTHERWISE
		This.OLEDropHasData = 0		&&DROPHASDATA_NOTUSEFUL
	ENDCASE

CASE nState == 1	&& Drag Leave
CASE nState == 2	&& Drag Over
ENDCASE
ENDPROC

PROCEDURE text1.OLEDragDrop
LPARAMETERS oDataObject, nEffect, nButton, nShift, nXCoord, nYCoord
LOCAL i, cText, cNewStr
If oDataObject.Getformat(1)	&&CF_TEXT
	cText = oDataObject.GetData(1)
	This.Value =cText
endif

if oDataObject.GetFormat(15)	&& Files CF_DROP  (from explorer here)
	DIMENSION aValues[1]
	oDataObject.GetData(15, @aValues )
	*-- Add each filename as a new item in the list
	FOR i = 1 to 1    &&alen(aValues)  if listbox
		This.value=(aValues[m.i])
	NEXT
ENDi
NODEFAULT
ENDPROC

PROCEDURE text1.Click
this.setfocus
keyboard "{CTRL+A}"
ENDPROC

PROCEDURE edit1.OLEDragOver
LPARAMETERS oDataObject, nEffect, nButton, nShift, nXCoord, nYCoord, nState

DO CASE
CASE nState == 0		&&DRAG_ENTER
	DO CASE
	CASE oDataObject.GetFormat("OLE Variant Array")	&& Array
		This.OLEDropHasData = 1		&&DROPHASDATA_USEFUL
		This.OLEDropEffects = 1+2	&&DROPEFFECT_COPY + DROPEFFECT_MOVE

	CASE oDataObject.GetFormat(1)				&& Text
		This.OLEDropHasData = 1		&&DROPHASDATA_USEFUL
		This.OLEDropEffects = 1+2	&&DROPEFFECT_COPY + DROPEFFECT_MOVE

	CASE oDataObject.GetFormat(15)				&& Files CF_HDROP
		This.OLEDropHasData = 1		&&DROPHASDATA_USEFUL
		This.OLEDropEffects = 4		&&DROPEFFECT_LINK
	OTHERWISE
		This.OLEDropHasData = 0		&&DROPHASDATA_NOTUSEFUL
	ENDCASE
CASE nState == 1	&& Drag Leave
CASE nState == 2	&& Drag Over
ENDCASE
ENDPROC

PROCEDURE edit1.OLEDragDrop
LPARAMETERS oDataObject, nEffect, nButton, nShift, nXCoord, nYCoord
LOCAL i, cText, cNewStr

If oDataObject.Getformat(1)	&&CF_TEXT
	cText = oDataObject.GetData(1)
	This.Value =cText
endif
if oDataObject.GetFormat(15)	&& Files CF_DROP  one file dropped only (all if listbox) (from explorer here)
	DIMENSION aValues[1]
	oDataObject.GetData(15, @aValues )
	*-- Add each filename as a new item in the list
	FOR i = 1 to 1    &&alen(aValues)  if listbox
		This.value=(aValues[m.i])
	NEXT
ENDi
NODEFAULT
ENDPROC

PROCEDURE edit1.RightClick

	Define Popup raccourci SHORTCUT Relative From Mrow(),Mcol()
	Define Bar _Med_cut Of raccourci Prompt "\<Couper" ;
		KEY CTRL+x, "Ctrl+X" ;
		MESSAGE "Enlève la sélection et la place dans le Presse-papiers"
	Define Bar _Med_copy Of raccourci Prompt "Co\<pier" ;
		KEY CTRL+C, "Ctrl+C" ;
		MESSAGE "Copie la sélection et la place dans le Presse-papiers"
	Define Bar _Med_paste Of raccourci Prompt "C\<oller" ;
		KEY CTRL+V, "Ctrl+V" ;
		MESSAGE "Place le contenu du Presse-papiers au point d'insertion"
	Define Bar _Med_find Of raccourci Prompt "Rec\<hercher..." ;
		KEY CTRL+F, "Ctrl+F" ;
		MESSAGE "Recherche le texte spécifié"
	Define Bar _Med_slcta Of raccourci Prompt "Sélec\<tionner tout" ;
		KEY CTRL+A, "Ctrl+A" ;
		MESSAGE "Sélectionne tout le texte ou tous les éléments de la fenêtre active"
	Define Bar _Med_redo Of raccourci Prompt "\<Rétablir" ;
		KEY CTRL+R, "Ctrl+R" ;
		MESSAGE "Rétablit la dernière opération annulée"
	Define Bar _Med_undo Of raccourci Prompt "\<Annuler" ;
		KEY CTRL+Z, "Ctrl+Z" ;
		MESSAGE "Annule la dernière modification"
	Activate Popup raccourci
ENDPROC

PROCEDURE image2.Click
local m.myvar
text to m.myvar pretext 7 noshow
can execute ie (complet interface), ie application,firefox, chrome  (if exits on system) or windows explorer
form these windows can oledragdeop text (editbox,textbox) or pictures(warning thre is some links whose are not
 picture but mask a navigation to a picture)
 if picture:
   - on textbox  or editbox (retrieve the link picture as text)
   -on the image it retrive the real image (if link is real picture or blob picture)
 if text oledragged from the fired application , its copied in textbox (one line) or in editbox (multiline).
 added a contextuel menu to ths editbox.
 for IE11,must in internet options uncheck the protected mode otyherwise no oledragdrop
 (ie11/menu/tools/internet options/security tab: unchecjk protectd mode).
 or run separatly IE11 as administrator
 for firefox,chrome,explorer: no problem.
 Right click on the image control to save the picture in images folder created in code (save pictureVAl blob as picture
 or picture converted to pictureval from explorer).
 endtext
messagebox(m.myvar,0+32+4096,"Summary help")
ENDPROC

ENDDEFINE
*
*-- EndDefine: yoleDD5


OLE DRAG &amp; DROP in VISUAL FOXPRO
OLE DRAG &amp; DROP in VISUAL FOXPRO

Important:All Codes above are tested on VFP9SP2 & windows 10 pro.

Please come back with any bug.correcting code is usefull to all readers.

Published on oledrag&drop, Visual foxpro

To be informed of the latest articles, subscribe:
Comment on this post