VFP OLEDRAGDROP with treeview,textbox,listbox ,editbox,grid,image from windows explorer & navigators

Published on by Yousfi Benameur


All Oledragdrop operation consists to prepare the control with 2 properties oledragmode and oleDropMode(=1  activated).
then prepare 2 methods oledragOver and oleDragDrop to receive what its possible and what you want to receive.coding must affect parameters as effect one.the nature of data can be tested in getdataformat and performed with getdata. 

this is a code for Oledragdrop operation with a treeview (from a textbox,a listbox and windows explorer)
note1: vfp9 must run as level priveleges to permit the operation oledrgdrop.its forbidden (barred icon) if vfp run as administrator priveleges.(explorer can run at administrator privelege here [tested]).
Read this link :  https://blogs.msdn.microsoft.com/patricka/2010/01/28/q-why-doesnt-drag-and-drop-work-when-my-application-is-running-elevated-a-mandatory-integrity-control-and-uipi/
Note2:if dont want to see the complet path issue in code justfname (cfilename).

this code runs a treeview and windows explorer for oledragdrop operation.
adjust position of explorer and select a file,or select a list of files.
-dragdrop to the textbox (1 element retained-preferably works with one file at once for textbox (one line))
-dragdrop to the lisbox: this is fill by the selected list of files.
if click on below button then fill treeview with this list (this is external method not oledragDrop one).this populates the tree as root arborescence only.the hitTest method dont applied.

-dragdrop from textbox to treeview: text is added as tree child (if click on on node area) or as tree main(if click outside the node).

-the treeview works now directly from the windows explorer.select any file,any files selection and oledragdrop to the treeview. 
problem solved successfully.
yhe controls must have the property control.oleDropMode=1 to permit the oledragDrop operation.

Note3 :oDataObject.Getformat(15,@files) returns always error for the treeview.replaced by an OOP collection files syntax.the error maybe fires because the treeview have not properties as :OLEDropHasData...(available in textbox & listbox)...to confirm.

updates:created below new sections with oledragdrop
-editbox,grid,textbox from windows explorer
-image control,listbow,textbox from windows explorer
-VFP webbrowser as explorer and oledragdrop to textbox+listbox.

[poste 222]


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

       
*1*
*created on 21 of february 2017
*oledradrop operation with a treeview (from a textbox,a listbox and windows explorer)
*note: vfp9 must run as level priveleges to permit the operation oledrgdrop.its forbidden (barred icon) if administrator
*priveleges.(explorer can run at administrator privelege here [tested]).
*  https://blogs.msdn.microsoft.com/patricka/2010/01/28/q-why-doesnt-drag-and-drop-work-when-my-application-is-running-elevated-a-mandatory-integrity-control-and-uipi/
*if dont want to see the complet path issue in code justfname(cfilename).

Publi yform
yform=Newobject("yoledd")
yform.Show
Read Events
Retu
*
Define Class yoledd As Form
Top = 0
Left = 0
Height = 562
Width = 288
ShowWindow = 2
OLEDragMode = 1
Caption = "OLE Drag And Drop from explorer to vfp textbox,listbox,treeview"
Name = "Form1"

Add Object olecontrol1 As OleControl With ;
oleclass="MSComctlLib.TreeCtrl.2" , ;
anchor=15, ;
Top = 60, ;
Left = 0, ;
Height = 348, ;
Width = 288, ;
Name = "Olecontrol1"

Add Object text1 As TextBox With ;
anchor=768,;
OLEDragMode = 1, ;
OLEDropMode = 1, ;
FontName = "MS Sans Serif", ;
FontSize = 8, ;
Value = "Drag drop me to treeview", ;
Height = 33, ;
Left = 7, ;
Top = 5, ;
Width = 277, ;
Name = "Text1"

Add Object lstfiles As ListBox With ;
Anchor=768,;
OLEDragMode = 1, ;
OLEDropMode = 1, ;
FontName = "MS Sans Serif", ;
FontSize = 8, ;
Height = 108, ;
Left = 1, ;
TabIndex = 2, ;
Top = 415, ;
Width = 283, ;
ItemTips = .T., ;
Name = "lstFiles"

Add Object command1 As CommandButton With ;
anchor=768,;
Top = 531, ;
Left = 12, ;
Height = 25, ;
Width = 204, ;
FontBold = .T., ;
Caption = "Add listbox contents  to treeview", ;
BackColor = Rgb(128,255,0), ;
Name = "Command1"

Add Object label1 As Label With ;
Anchor=768,;
AutoSize = .T., ;
FontBold = .T., ;
FontSize = 16, ;
Caption = "?", ;
Height = 27, ;
Left = 240, ;
MousePointer = 15, ;
Top = 528, ;
Width = 15, ;
ForeColor = Rgb(255,0,0), ;
Name = "Label1"

Procedure Destroy
Clea Events
Endproc

Procedure Load
_Screen.WindowState=1
Local m.o
m.o=Home(1)
Run/N explorer  &o
Endproc

Procedure olecontrol1.OLEDragOver
Lparameters oDataObject, effect, Button, Shift, x, Y, state
Local loNode
Do Case
Case  oDataObject.GetFormat(1) Or oDataObject.GetFormat(15) && 1=text  variant  15 list of files
loNode = This.HitTest( 15*x, 15*Y )
effect = 1
This.DropHighlight = loNode
Otherwise
effect=0
Endcase
Endproc

Procedure olecontrol1.OLEDragDrop
*** ActiveX Control Event ***
Lparameters oDataObject, effect, Button, Shift, x, Y
#Define CF_FILES              15     && A list of files
#Define CF_HDROP              15     && A list of files
Local lcData, loNode
Thisform.LockScreen = .T.
Do Case
Case  oDataObject.GetFormat(1) && text-format
Wait Window "text"  Nowait
This.DropHighlight = .Null.
effect =1
lcData = oDataObject.GetData(1) && text-format
loNode = This.HitTest( 15*x,15*Y )
If Vartype(loNode)='O'
This.nodes.Add( loNode, 4, "A" + Sys(3), lcData )
loNode.expanded = .T.
Else
This.nodes.Add( .Null., 0, "A" + Sys(3), lcData )
Endi

Case oDataObject.GetFormat(CF_FILES)	&& Files CF_DROP 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.
oo=Thisform.olecontrol1
*DIMENSION aValues[1]
*oDataObject.GetData(CF_FILES, @aValues )    && this is a problem !

*messagebox("count="+trans(oDataObject.Files.count))
Local cfilename
For Each cfilename In oDataObject.Files   FoxObject
This.DropHighlight = .Null.
effect =1
loNode = This.HitTest( 15*x,15*Y )
If Vartype(loNode)='O'
	This.nodes.Add( loNode, 4, "A" + Sys(3), cfilename )
	loNode.expanded = .T.
Else
	This.nodes.Add( .Null., 0, "A" + Sys(3), cfilename )
Endi
Inkey( .5 )
Next

Endcase
Thisform.LockScreen = .F.
Endproc

Procedure olecontrol1.Init
This.Object.OLEDropMode = 1
This.nodes.Add( .Null., 0, "A1", "Drop any text here" )
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     && cNewStr
Endif

If oDataObject.GetFormat(15)	&&CF_TEXT
Local aFiles[1]
oDataObject.GetData(15,@aFiles)  &&can be sorted here
effect =2  &&  copy
This.Value =aFiles(1)   &&retain only first file if selection
This.Refresh
Endif
Endproc

Procedure text1.Click
Keyboard "{CTRL+A}"  && select all
Endproc

Procedure lstfiles.OLEDragDrop
Lparameters oDataObject, nEffect, nButton, nShift, nXCoord, nYCoord
Local aValues, i, cText, nOperation

*-- 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("OLE Variant Array")
Dimension aValues[ 1 ]
oDataObject.GetData("OLE Variant Array", @aValues )

*-- Add each array element as
For i = 1 To Alen(aValues,1)	&& for each row in the array
If (Alen(aValues,2) > 1)
	This.AddItem( aValues[m.i,1])
Else
	This.AddItem( aValues[m.i])
Endif
Next

Case oDataObject.GetFormat(1)		&& Text
cText = oDataObject.GetData(1)

*-- Add the text as a new item in the list
This.AddItem( cText )


Case oDataObject.GetFormat(15)	&& Files CF_DROP
Dimension aValues[1]
oDataObject.GetData(15, @aValues )

*-- Add each filename as a new item in the list
For i = 1 To Alen(aValues)
This.AddItem(aValues[m.i])
Next
Endcase
Thisform.LockScreen = .F.

*-- Set the nEffect parameter for communication back to the source object
nEffect = nOperation
Endproc

Procedure lstfiles.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 command1.Click
With Thisform.olecontrol1
Messagebox( " files to add to treeview="+Trans(Thisform.lstfiles.ListCount),0+32+4096,'',1200)

For i=1 To Thisform.lstfiles.ListCount
m.x=Thisform.lstfiles.List(i)
.nodes.Add(Null,4, Sys(2015),m.x)
Endfor
Endwith
Endproc

Procedure label1.Click
Local m.myvar
TEXT to m.myvar pretext 7 noshow
this code runs a treeview and windows explorer for oledragdrop operation.
adjust position of explorer and select a file,list of files

-dragdrop to the textbox (1 element retained-preferably work with one file at once for textbox (one line))
-dragdrop to the lisbox: this is fill by the selected list of files.
if click on below button then fill treeview with this list (external method not oledragDrop one)
-dragdrop from textbox to treeview: text is added as tree child (if click on on node area) or as
tree main(if click outside the node).

-the treeview works now directly from the windows explorer.select anyfile,any files selection and oledragdrop
to the treeview. problem solved successfully.
Note :oDataObject.Getformat(15,@files) returns always error.replaced by an OOP collection files syntax
Yousfi Benameur 21 of february 2017.
ENDTEXT
Messagebox(m.myvar,"summary help")
Endproc

Enddefine
*
*-- EndDefine: yoledd


VFP OLEDRAGDROP with treeview,textbox,listbox ,editbox,grid,image from windows explorer & navigators
VFP OLEDRAGDROP with treeview,textbox,listbox ,editbox,grid,image from windows explorer & navigators
VFP OLEDRAGDROP with treeview,textbox,listbox ,editbox,grid,image from windows explorer & navigators

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

*2* created on 22 of february 2017
*OLE Drag And Drop Editbox-grid-textbox from explorer.
Publi yform
yform=Newobject("yodd1")
yform.Show
Read Events
Retu
*
Define Class yodd1 As Form
Top = 0
Left = 0
Height = 545
Width = 376
ShowWindow = 2
OLEDragMode = 1
Caption = "OLE Drag And Drop Editbox-grid-textbox" 
Name = "Form1"

Add Object text1 As TextBox With ;
OLEDragMode = 1, ;
OLEDropMode = 1, ;
FontName = "MS Sans Serif", ;
FontSize = 8, ;
Value = "Drag drop me to treeview", ;
Height = 33, ;
Left = 7, ;
Top = 5, ;
Width = 277, ;
Name = "Text1"

Add Object label1 As Label With ;
AutoSize = .T., ;
FontBold = .T., ;
FontSize = 16, ;
Caption = "?", ;
Height = 27, ;
Left = 336, ;
MousePointer = 15, ;
Top = 0, ;
Width = 15, ;
ForeColor = Rgb(255,0,0), ;
Name = "Label1"

Add Object edit1 As EditBox With ;
OLEDragMode = 1, ;
OLEDropMode = 1, ;
Height = 241, ;
Left = 0, ;
Top = 48, ;
Width = 372, ;
BackColor = Rgb(198,255,255), ;
Name = "Edit1"

Add Object grid1 As Grid With ;
OLEDropMode = 1, ;
Height = 240, ;
Left = 0, ;
Top = 300, ;
Width = 372, ;
Name = "Grid1"

Procedure Load
_Screen.WindowState=1
Close Data All
Local m.o
m.o=Home(1)
Run/N explorer  &o
Endproc

Procedure Destroy
Clea Events
Endproc


Procedure text1.Click
Keyboard "{CTRL+A}"
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     && cNewStr
Endif

If oDataObject.GetFormat(15)	&&CF_TEXT
Local aFiles[1]
oDataObject.GetData(15,@aFiles)  &&can be sorted here
effect =2  && copy
This.Value =aFiles(1)   &&retain only first file if selection
This.Refresh
Endif
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 label1.Click
Local m.myvar
TEXT to m.myvar pretext 7 noshow
this code runs a textbox,an editbox ,a grid and windows explorer.
adjust position of explorer and select a file, or a list of files

-oledragdrop to the textbox (1 element retained-preferably work with one file at once)
-oledragdrop to the editbox: this is fill by the selected file or the selected list of files.

-dragdrop from textbox to editbox: text is added  to the editbox value.textbox can receive also an
 oledragdrop for the editbox
-oledragdrop from explorer  ro grid: the selected file or list of files (even folders) are added as
 records  into the grid.
-oledragdrop from the grid: the property grid.oledragMode is natively disabled and then cannot do it !:
ENDTEXT
Messagebox(m.myvar,"summary help")
Endproc


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

*-- 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)		&& Text
m.cText = oDataObject.GetData(1)

*-- Add the text as a new item in the list
This.Value=This.Value+Chr(13)+m.cText

Case oDataObject.GetFormat(15)	&& Files CF_DROP
Dimension aValues[1]
oDataObject.GetData(15, @aValues )

*-- Add each filename as a new item in the list
For i = 1 To Alen(aValues)
	This.Value=This.Value+Chr(13)+aValues[m.i]
Next

Endcase
Thisform.LockScreen = .F.
*-- Set the nEffect parameter for communication back to the source object
nEffect = nOperation
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 grid1.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 grid1.OLEDragDrop

Lparameters oDataObject, nEffect, nButton, nShift, nXCoord, nYCoord
Local aValues, i, cText, nOperation

*-- 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)		&& Text
cText = oDataObject.GetData(1)
Sele This.recorsource

*-- Add the text as a new item in the list
Insert Into ycurs Values(m.cText )
Thisform.grid1.Refresh

Case oDataObject.GetFormat(15)	&& Files CF_DROP
Dimension aValues[1]
oDataObject.GetData(15, @aValues )

*-- Add each filename as a new item in the list
For i = 1 To Alen(aValues)
	Insert Into ycurs Values(aValues[m.i])
Next
Thisform.grid1.Refresh

Endcase

Thisform.LockScreen = .F.
*-- Set the nEffect parameter for communication back to the source object
nEffect = nOperation
Endproc

Procedure grid1.Init
*cursor with 1 column to identify the insertion as well in the test (otherwise list all fields insertion)
Sele address From Home(1)+"samples\data\customer" Where Recno()<6 Into Cursor ycurs Readwrite &&mandatory to oledragdrop
With This
.RecordSource="ycurs"
.GridLines=0
.column1.Width=450
.DeleteMark=.F.
.ScrollBars=3
.SetAll("DynamicBackColor","IIF(MOD(RECNO( ), 2)=0, RGB(212,210,208) , RGB(0,200,0))", "Column")
*.autofit()   &&this is incompatible with dynamicbackcolor !
Locate
.Refresh
Endwith
Endproc

Enddefine
*
*-- EndDefine: yodd1


VFP OLEDRAGDROP with treeview,textbox,listbox ,editbox,grid,image from windows explorer &amp; navigators

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

*3* created on 23 of february 2017
*OLE Drag And Drop image control-listbox-textbox from explorer.
Publi yform
yform=Newobject("yoddPict")
yform.Show
Read Events
Retu
*
DEFINE CLASS  yoddPict AS form
Top = 0
Left = 0
Height = 526
Width = 457
ShowWindow = 2
OLEDragMode = 1
Caption = "OLE Drag And Drop image control-listbox-textbox"
Name = "Form1"

ADD OBJECT text1 AS textbox WITH ;
OLEDragMode = 1, ;
OLEDropMode = 1, ;
FontBold = .T., ;
FontName = "MS Sans Serif", ;
FontSize = 8, ;
Value = "Drag drop me to treeview", ;
Height = 33, ;
Left = 60, ;
Top = 0, ;
Width = 277, ;
ForeColor = RGB(255,255,255), ;
BackColor = RGB(0,0,160), ;
Name = "Text1"

ADD OBJECT label1 AS label WITH ;
AutoSize = .T., ;
FontBold = .T., ;
FontSize = 16, ;
Caption = "?", ;
Height = 27, ;
Left = 408, ;
MousePointer = 15, ;
Top = 0, ;
Width = 15, ;
ForeColor = RGB(255,0,0), ;
Name = "Label1"

ADD OBJECT image1 AS image WITH ;
OLEDragMode = 1, ;
OLEDropMode = 1, ;
Stretch = 2, ;
Height = 313, ;
Left = 14, ;
Top = 192, ;
Width = 428, ;
Name = "Image1"

ADD OBJECT list1 AS listbox WITH ;
OLEDragMode = 1, ;
OLEDropMode = 1, ;
FontName = "MS Sans Serif", ;
FontSize = 8, ;
Height = 132, ;
Left = 12, ;
TabIndex = 2, ;
Top = 48, ;
Width = 432, ;
ItemTips = .T., ;
Name = "List1"

PROCEDURE Destroy
clea events
ENDPROC

PROCEDURE Load
_screen.windowstate=1
close data all
local m.o
m.o=home(1)
run/n explorer  &o
declare integer Sleep in kernel32 integer
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     && cNewStr
endif

If oDataObject.Getformat(15)	&&CF_TEXT
local aFiles[1]
oDataObject.GetData(15,@aFiles)  &&can be sorted here
effect =2  && copy
This.Value =aFiles(1)   &&retain only first file if selection
this.refresh

endif
ENDPROC

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

PROCEDURE label1.Click
local m.myvar
text to m.myvar pretext 7 noshow
this code runs a textbox,a listbox ,an image control and windows explorer.
adjust position of explorer and select a file,list of files

-oledragdrop to the textbox (1 element retained-preferably work with one file at once)
-oledragdrop to the listbox: this is fill by the selected file or the selected list of files.

-dragdrop from textbox to listbox: text is added  to the listbox as item.textbox can receive also an
oledragdrop for the editbox
-oledragdrop from explorer  to  image control: the selected file or list of files (even folders) are added as
1 first record i(for the first image meet)
-oledragdrop from image control to the listbox or textbox: not permitted.
endtext
messagebox(m.myvar,"summary help")
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
LOCAL aValues, i, cText, nOperation
*-- 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)		&& Text
cText = oDataObject.GetData(1)
if inlist(lower(justext(ctext)),"jpg","bmp","png","gif","emf")
this.picture=ctext
endi

CASE oDataObject.GetFormat(15)	&& Files CF_DROP
DIMENSION aValues[1]
oDataObject.GetData(15, @aValues )

*-- Add each filename as a new item in the list
FOR i = 1 to alen(aValues)
if inlist(lower(justext(aValues(i))),"jpg","bmp","png","gif","emf")
this.picture=aValues(i)
exit    &&permit one ficrst picture only here
endi
NEXT

ENDCASE
Thisform.LockScreen = .F.

*-- Set the nEffect parameter for communication back to the source object
nEffect = nOperation
ENDPROC


PROCEDURE list1.OLEDragDrop
LPARAMETERS oDataObject, nEffect, nButton, nShift, nXCoord, nYCoord
LOCAL aValues, i, cText, nOperation

*-- 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("OLE Variant Array")
DIMENSION aValues[ 1 ]
oDataObject.GetData("OLE Variant Array", @aValues )

*-- Add each array element as
FOR i = 1 to alen(aValues,1)	&& for each row in the array
	IF (alen(aValues,2) > 1)
		This.AddItem( aValues[m.i,1])
	ELSE
		This.AddItem( aValues[m.i])
	ENDIF
NEXT

CASE oDataObject.GetFormat(1)		&& Text
cText = oDataObject.GetData(1)

*-- Add the text as a new item in the list
This.AddItem( cText )

CASE oDataObject.GetFormat(15)	&& Files CF_DROP
DIMENSION aValues[1]
oDataObject.GetData(15, @aValues )

*-- Add each filename as a new item in the list
FOR i = 1 to alen(aValues)
	This.AddItem(aValues[m.i])
NEXT

ENDCASE

Thisform.LockScreen = .F.

*-- Set the nEffect parameter for communication back to the source object
nEffect = nOperation
ENDPROC

PROCEDURE list1.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

ENDDEFINE
*
*-- EndDefine: yoddPict


VFP OLEDRAGDROP with treeview,textbox,listbox ,editbox,grid,image from windows explorer &amp; navigators

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

                    
*4* created on 23 of february 2017
*!*	this code achieves an oledragdrop images operation from  windows explorer.
*!*	adjust position of explorer and select any image or a selection of images (can be more 130 images).
*!*	only the images (jpg,bmp,gif,png emf) are filtered to this operation.
*!*	All the images dropped on the form are re arranged to fill the form and stretched to  thumbs 80*80.
*!*	if the form resizes the images are even re arranged.
*!*	Click on any image dropped to zoom it-click on the viewer to release it.
*!*	To remove all images dropped on the form click the button at top left.

Publi oform
oform=Newobject("yOddPict")
oform.Show
Read Events
Retu
*
Define Class yOddPict As Form
Top = 0
Left = 0
Height = 526
Width = 506
ShowWindow = 2
ScrollBars = 3
OLEDragMode = 1
OLEDropMode = 1
ShowTips = .T.
Caption = "OLE Drag And Drop pictures from windows explorer"
BackColor = Rgb(0,0,0)
Name = "Form1"

Add Object label1 As Label With ;
AutoSize = .T., ;
FontBold = .T., ;
FontSize = 20, ;
BackStyle = 0, ;
Caption = "?", ;
Enabled = .T., ;
Height = 35, ;
Left = 468, ;
MousePointer = 15, ;
Top = 0, ;
Width = 19, ;
ForeColor = Rgb(255,0,0), ;
Name = "Label1"

Add Object line1 As Line With ;
Anchor = 0, ;
Height = 0, ;
Left = 0, ;
Top = 36, ;
Width = 504, ;
Name = "Line1"

Add Object command2 As CommandButton With ;
Top = 0, ;
Left = 24, ;
Height = 25, ;
Width = 132, ;
FontBold = .T., ;
Caption = "Remove all img", ;
MousePointer = 15, ;
SpecialEffect = 2, ;
BackColor = Rgb(128,255,0), ;
Name = "Command2"

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

Add Object optiongroup1 As OptionGroup With ;
AutoSize = .T., ;
ButtonCount = 1, ;
BackStyle = 0, ;
BorderStyle = 0, ;
Value = 1, ;
Height = 27, ;
Left = 192, ;
MousePointer = 15, ;
Top = 0, ;
Width = 28, ;
ToolTipText = "Form Backcolor", ;
Name = "Optiongroup1", ;
Option1.BackStyle = 0, ;
Option1.Caption = "", ;
Option1.Value = 1, ;
Option1.Height = 17, ;
Option1.Left = 5, ;
Option1.Top = 5, ;
Option1.Width = 18, ;
Option1.AutoSize = .T., ;
Option1.Name = "Option1"

Procedure my
Lparameters nButton, nShift, nXCoord, nYCoord
*--- aevent create an array laEvents
Aevents( myArray, 0)
*--- reference the calling object
loObject = myArray[1]
*Do Form yviewer With loObject.Picture
local yv  as form
yv=newObject("yViewer","","",loObject.Picture)
yv.show
read events
Endproc

Procedure yarrange
*rearrange pictures on form.
Try
Use In Select("ycurs")
Catch
Endtry

Create Cursor ycurs (yname c(50))
With Thisform
For i=1 To .ControlCount
	If Substr(Lower(.Controls(i).Name),1,6)=="ypict_"
		Insert Into ycurs Values (.Controls(i).Name)
	Endi
Endfor
Endwith
Sele ycurs
If Reccount()=0
Use In Select("ycurs")
Return .F.
Endi
Thisform.label2.Caption=Trans(Reccount())+" images"
*brow
Local aa,nmax,j,k,u,v,top0,rec,delta
aa=Thisform.line1.Top+Thisform.line1.Height
delta=5
nmax=Floor(Thisform.Width/80 -1)   &&images/line
k=0
j=1
Scan
k=k+1
rec=Recno()
u=Eval("thisform."+Allt(yname))
With u
	If  k=1
		.Left=20
		.Top =aa+10+(j-1)*((.Height)+m.delta)
		top0=.Top

	Else

		Go rec-1
		v=Eval("thisform."+Allt(yname))
		Go rec
		.Left=v.Left+v.Width+m.delta
		.Top=top0
	Endi

	If k>=nmax
		k=0
		j=j+1
	Endi

Endwith
Endscan
Use In Select("ycurs")
Thisform.Refresh
Endproc

Procedure Init
Thisform.Resize
Endproc

Procedure Resize
With Thisform
.line1.Width=.Width
.yarrange()
Endwith
Endproc

Procedure OLEDragDrop
Lparameters oDataObject, nEffect, nButton, nShift, nXCoord, nYCoord
Local aValues, i, cText, nOperation
*-- 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)		&& Text
cText = oDataObject.GetData(1)
If !Inlist( Lower(Justext(m.cText)),"jpg","bmp","png","gif","emf")   &&test isImage? to find!
	Return.F.
Endi

With Thisform
	Local x
	x="ypict_1"
	Try
		.AddObject(m.x,"image")
	Catch
	Endtry

	With Eval ('.'+m.x)
		.Stretch=2
		.Picture=cText
		.Width=80
		.Height=80
		.ToolTipText=.Name
		.OLEDragMode=1
		.OLEDropMode=1
		.MousePointer=15
		.BorderStyle=1
		.Visible=.T.
		.Left= 10
		.Top=Thisform.line1.Top+Thisform.line1.Height+5
	Endwith
	Bindevent(Eval("."+m.x),"mousedown",Thisform,"my")
Endwith

Case oDataObject.GetFormat(15)	&& Files CF_DROP
Dimension aValues[1]
oDataObject.GetData(15, @aValues )
With Thisform
	u=0
	For j=1 To Alen(aValues)
		If Inlist( Lower(Justext(aValues[m.j])),"jpg","bmp","png","gif","emf")
			u=u+1
			x="ypict_"+Sys(2015)    &&unique
			.AddObject(m.x,"image")
			With Eval ('.'+m.x)
				.Stretch=2
				.Picture=aValues[m.j]
				.Width=80
				.Height=80
				.BorderStyle=1
				.ToolTipText=.Name
				.OLEDragMode=1
				.OLEDropMode=1
				.MousePointer=15
				.Visible=.T.
				If j=1
					.Left= nXCoord
				Else
					.Left=nXCoord+(u-1)*.Width+10
				Endi
				.Top=nYCoord
			Endwith
		Bindevent(Eval("."+m.x),"mousedown",Thisform,"my")
    Endi
	Next
Endwith
Endcase

Thisform.LockScreen = .F.

*-- Set the nEffect parameter for communication back to the source object
nEffect = nOperation

Thisform.yarrange()
Endproc

Procedure OLEDragOver
Lparameters oDataObject, nEffect, nButton, nShift, nXCoord, nYCoord, nState
Do Case
Case nState == 0		&&DRAG_ENTER
Do Case
Case oDataObject.GetFormat('VFP Source Object')
	This.OLEDropHasData = 1
	This.OLEDropEffects = 2	&&DROPEFFECT_MOVE

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 Destroy
Clea Events
Endproc

Procedure Load
_Screen.WindowState=1
Close Data All
Local m.o
m.o=Home(1)
Run/N explorer  &o
Declare Integer Sleep In kernel32 Integer
Endproc

Procedure label1.Click
Local m.myvar
TEXT to m.myvar pretext 7 noshow
this code achieve an oledragdrop images operation from  windows explorer.
adjust position of explorer and select any image or a selection of images.
only the images (jpg,bmp,gif,png emf) are filtered to this operation.
All the images dropped on the form are re arranged to fill the form and fill thumbs 80*80.
if the form resizes the images are even re arranged.
Click on any image dropped to zoom it-click on the viewer to release it.
To remove all images dropped on the form click the button at top left.
ENDTEXT
Messagebox(m.myvar,"summary help")
Endproc

Procedure command2.Click
Try
Use In Select("ycurs")
Catch
Endtry

Create Cursor ycurs (yname c(50))
With Thisform
For i=1 To .ControlCount
	If Substr(Lower(.Controls(i).Name),1,6)=="ypict_"
		Insert Into ycurs Values (.Controls(i).Name)
	Endi
Endfor
Endwith
Sele ycurs
If Reccount()=0
Use In Select("ycurs")
Return .F.
Endi

Scan
Try
	Thisform.RemoveObject(Allt(yname))
Catch
Endtry
Endscan
Use In Select("ycurs")
Thisform.label2.Caption=""
Thisform.Refresh
Endproc

Procedure optiongroup1.InteractiveChange
Thisform.BackColor=Iif(This.Value=1,Rgb(255*Rand(),255*Rand(),255*Rand()),0)
Endproc

Enddefine
*
*-- EndDefine: yOddPict

*yViewer
DEFINE CLASS yViewer  AS form
BorderStyle = 0
Height = 500
Width = 600
ShowWindow = 2
AutoCenter = .T.
Caption = "Form1"
TitleBar = 1
WindowType = 0
AlwaysOnTop = .T.
Name = "Form1"

ADD OBJECT shape1 AS shape WITH ;
Top = 12, ;
Left = 24, ;
Height = 421, ;
Width = 517, ;
Anchor = 15, ;
BackColor = RGB(0,0,0), ;
Name = "Shape1"

ADD OBJECT image1 AS image WITH ;
Height = 396, ;
Left = 36, ;
Top = 24, ;
Width = 492, ;
Name = "Image1"

PROCEDURE Init
lparameters xpict
if !pcount()=1
return .f.
endi
with thisform
.titlebar=0
with .image1
.picture=xpict
.left=10
.top=10
endwith
.width=.image1.width+20
.height=.image1.height+20
.autocenter=.t.
endwith
ENDPROC

PROCEDURE image1.Click
thisform.release
ENDPROC
Procedure destroy
clea events
endproc

ENDDEFINE
*
*-- EndDefine: yViewer


VFP OLEDRAGDROP with treeview,textbox,listbox ,editbox,grid,image from windows explorer &amp; navigators
VFP OLEDRAGDROP with treeview,textbox,listbox ,editbox,grid,image from windows explorer &amp; navigators

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

                    
*5* created on 24 of february 2017
*!*	the code builds a webBrowser and uses it with 2 methods:
*!*	-as windows explorer interface: this navigates on discs listed on the container combo1
*!*	-as a normal navigator to any file/web url.
*!*	i added the navigation buttons capabilities (go forward, go back,...)
*!*	-can navigate any folder or open it by dblclick on.
*!*	-the available discs are listed at code starting (1 once).
*!*	-can adjust the webBrowser view in the second combo (or by rightclick to fire the contextuel menu on the webbrowser).
*!*	-can use the oledragdrop form this webBrowse to the textbow and listbox below(one text for the text or listbox or a file selection for the listbox).

Publi yform
yform=Newobject("yexplorer_browser")
yform.Show
Read Events
*
Define Class yexplorer_browser As Form
Height = 664
Width = 775
ShowWindow = 2
ShowTips = .T.
AutoCenter = .T.
Caption = "WebBrowser  & explorer"
BackColor = Rgb(212,210,208)
Name = "Form1"

Add Object shape1 As Shape With ;
Top = 48, ;
Left = 24, ;
Height = 420, ;
Width = 696, ;
Anchor = 15, ;
BackColor = Rgb(128,0,64), ;
Name = "Shape1"

Add Object lbl1 As Label With ;
AutoSize = .T., ;
FontName = "MS Sans Serif", ;
FontSize = 8, ;
Anchor = 768, ;
BackStyle = 0, ;
Caption = "Drop text here ", ;
Height = 15, ;
Left = 36, ;
Top = 504, ;
Width = 72, ;
Name = "Lbl1"

Add Object txtdrop As TextBox With ;
OLEDragMode = 1, ;
OLEDropMode = 1, ;
FontName = "MS Sans Serif", ;
FontSize = 8, ;
Anchor = 768, ;
Height = 32, ;
Left = 168, ;
Top = 492, ;
Width = 408, ;
BackColor = Rgb(128,255,255), ;
Name = "txtDrop"

Add Object webbrowser As OleControl With ;
Oleclass="shell.explorer.2",;
Top = 56, ;
Left = 36, ;
Height = 402, ;
Width = 674, ;
Anchor = 15, ;
Name = "webbrowser"

Add Object container1 As ycont  With ;
Anchor = 768, ;
Top = 1, ;
Left = 53, ;
Width = 654, ;
Height = 35, ;
BackStyle = 1, ;
BackColor = Rgb(0,0,0), ;
Name = "Container1"


Add Object list1 As ListBox With ;
OLEDragMode = 1, ;
OLEDropMode = 1, ;
FontName = "MS Sans Serif", ;
FontSize = 8, ;
Anchor = 768, ;
Height = 108, ;
Left = 108, ;
TabIndex = 2, ;
Top = 552, ;
Width = 583, ;
ItemTips = .T., ;
Name = "List1"

Add Object lbltext As Label With ;
AutoSize = .T., ;
FontName = "MS Sans Serif", ;
FontSize = 8, ;
Anchor = 768, ;
WordWrap = .T., ;
BackStyle = 0, ;
Caption = "Drop files here from the Windows Explorer/WebBrowser", ;
Height = 15, ;
Left = 24, ;
Top = 531, ;
Width = 263, ;
TabIndex = 1, ;
Name = "lblText"

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

Procedure Load
_screen.windowstate=1
Endproc

Procedure Destroy
Clea Events
Endproc

Procedure txtdrop.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 txtdrop.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
Dimension aValues[1]
oDataObject.GetData(15, @aValues )
*-- Add each filename as a new item in the list
For i = 1 To 1    &&alen(aValues)
	This.Value=(aValues[m.i])
Next
Endi
Nodefault
Endproc

Procedure webbrowser.Init
This.Navigate (Home(1))
Endproc

Procedure container1.Init
With This
.SetAll("mousepointer",15,"commandbutton")
.SetAll("backcolor",Rgb(0,255,0),"commandbutton")
Endwith
Endproc

Procedure list1.OLEDragDrop
Lparameters oDataObject, nEffect, nButton, nShift, nXCoord, nYCoord
Local aValues, i, cText, nOperation
*-- 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("OLE Variant Array")
Dimension aValues[ 1 ]
oDataObject.GetData("OLE Variant Array", @aValues )

*-- Add each array element as
For i = 1 To Alen(aValues,1)	&& for each row in the array
	If (Alen(aValues,2) > 1)
		This.AddItem( aValues[m.i,1])
	Else
		This.AddItem( aValues[m.i])
	Endif
Next

Case oDataObject.GetFormat(1)		&& Text
cText = oDataObject.GetData(1)
*-- Add the text as a new item in the list
This.AddItem( cText )

Case oDataObject.GetFormat(15)	&& Files CF_DROP
Dimension aValues[1]
oDataObject.GetData(15, @aValues )
*-- Add each filename as a new item in the list
For i = 1 To Alen(aValues)
	This.AddItem(aValues[m.i])
Next
Endcase
Thisform.LockScreen = .F.
*-- Set the nEffect parameter for communication back to the source object
nEffect = nOperation
Endproc

Procedure list1.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 label1.Click
Local m.myvar
TEXT to m.myvar pretext 7 noshow
	the code builds a webBrowser and uses it with 2 methods:
	-as windows explorer interface: this navigates on discs listed on the container combo1
	-as a normal navigator to any file/web url.
	i added the navigation buttons capabilities (go forward, go back,...)
	-can navigate any folder or open it by dblckicj on.
	-the available discs are listed at code starting.
	-can adjust the webBrowser view in the second combo (or by rightclick to fire the contextuel menu on the webbrowser).
-can use the oledragdrop form this webBrowse to the textbow and listbox below(one text for the text or listbow or a file selection for the listbox).

ENDTEXT
Messagebox(m.myvar,0+32+4096,"Summary help")
Endproc


Enddefine
*
*-- EndDefine: yexplorer_browser
Define Class ycont As Container
Anchor = 768
Top = 1
Left = 53
Width = 654
Height = 35
BackStyle = 1
BackColor = Rgb(0,0,0)
Name = "Container1"

Add Object command1 As CommandButton With ;
Top = 5, ;
Left = 6, ;
Height = 27, ;
Width = 85, ;
Caption = "Web URL", ;
SpecialEffect = 2, ;
Name = "Command1"

Add Object command2 As CommandButton With ;
Top = 5, ;
Left = 99, ;
Height = 27, ;
Width = 98, ;
Picture = Home(1)+"graphics\icons\arrows\arw06rt.ico", ;
Caption = "", ;
ToolTipText = "Go Forward", ;
SpecialEffect = 2, ;
BackColor = Rgb(255,255,255), ;
Name = "Command2"

Add Object command3 As CommandButton With ;
Top = 5, ;
Left = 203, ;
Height = 27, ;
Width = 98, ;
Picture = Home(1)+"graphics\icons\arrows\arw06lt.ico", ;
Caption = "", ;
ToolTipText = "Go Back", ;
SpecialEffect = 2, ;
BackColor = Rgb(255,255,255), ;
Name = "Command3"

Add Object combo1 As ComboBox With ;
Height = 27, ;
Left = 349, ;
SpecialEffect = 2, ;
ToolTipText = "All available discs ", ;
Top = 5, ;
Width = 100, ;
Name = "Combo1"

Add Object label1 As Label With ;
AutoSize = .T., ;
FontBold = .T., ;
BackStyle = 0, ;
Caption = "Discs", ;
Height = 17, ;
Left = 309, ;
Top = 8, ;
Width = 34, ;
ForeColor = Rgb(0,255,0), ;
Name = "Label1"

Add Object combo2 As ComboBox With ;
Height = 25, ;
Left = 583, ;
SpecialEffect = 2, ;
ToolTipText = "WebBrowser view", ;
Top = 4, ;
Width = 61, ;
Name = "Combo2"

Add Object label2 As Label With ;
AutoSize = .T., ;
FontBold = .T., ;
BackStyle = 0, ;
Caption = "View", ;
Height = 17, ;
Left = 462, ;
Top = 9, ;
Width = 30, ;
ForeColor = Rgb(0,255,0), ;
Name = "Label2"

Procedure Init
With This
.SetAll("mousepointer",15,"commandbutton")
.SetAll("backcolor",Rgb(0,255,0),"commandbutton")
Endwith
Endproc

Procedure command1.Click
Local url
url=Inputbox("Navigate to web  url","","http://www.yousfi.over-blog.com")
If ! Empty(url)
Try
	With Thisform.webbrowser
		.Navigate(m.url)
	Endwith
Catch
Endtry
Endi
Endproc

Procedure command2.Click
Try
Thisform.webbrowser.GoForward
Catch
Endtry
Endproc

Procedure command3.Click
Try
Thisform.webbrowser.GoBack()
Catch
Endtry
Endproc

Procedure combo1.Init
Local lnType, lcDrive, i
Declare Integer GetDriveType In kernel32 String cDriveLetter
Local result
m.result=""
For i = 0 To 25
lcDrive = Chr(65 + i) + ":"
lnType = GetDriveType(lcDrive)
If lnType <> 1
	m.result=m.result+ lcDrive + Space(5) + Icase( ;
		lnType = 2, "Removable", ;
		lnType = 3, "Fixed", ;
		lnType = 4, "Network", ;
		lnType = 5, "CD-ROM", ;
		lnType = 6, "RAM Disk", "Unknown")+Chr(13)
	This.AddItem(Addbs(lcDrive))
Endif
Endfor
With This
.ListIndex=1
.Style=2
Endwith
Endproc

Procedure combo1.Click
Thisform.webbrowser.Navigate(This.Value)
Endproc

Procedure combo2.Click
Try
Thisform.webbrowser.Document.currentViewMode=Int(Val(This.Value))

Do Case
Case This.Value="1"
	This.Parent.label2.Caption="1. View Icons"
Case This.Value="2"
	This.Parent.label2.Caption="2. Small icons"
Case This.Value="3"
	This.Parent.label2.Caption="3. List"
Case This.Value="4"
	This.Parent.label2.Caption="4. Details"
Case This.Value="5"
	This.Parent.label2.Caption="5. Thumbnails"
Case This.Value="6"
	This.Parent.label2.Caption="6. Tile"
Case This.Value="7"
	This.Parent.label2.Caption="7. Thumbnail strip"
Endcase
Catch
Endtry
Endproc

Procedure combo2.Init
With This
For i=1 To 7
	.AddItem(Trans(i))
Endfor
.ListIndex=2
.Style=2
.Click()
Endwith
*!*	1 = Icons
*!*	2 = Small icons
*!*	3 = List
*!*	4 = Details
*!*	5 = Thumbnails
*!*	6 = Tile
*!*	7 = Thumbnail strip
Endproc

Enddefine
*
*-- EndDefine: ycont


warning :with webBrowser as explorer you can modify files/folders...(as explorer)-the view very large and large icons (1-2) must be set with contextuel menu first.

warning :with webBrowser as explorer you can modify files/folders...(as explorer)-the view very large and large icons (1-2) must be set with contextuel menu first.

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

                           
*6*
*IE11 oledragdrop problem solved.

to allow oledragdrop from internet explorer (IE11) can use 2 methods:

1-run IE11 as administrator.
2.In the Internet Options Security tab, disable protected mode (indepedently of checking or no the oledDragdrop options from custom levels button

Notes 1:
oledragdrop is allowed for Firefox (to confirm for Chrome).
oleDragDrop is allowed from a vfp embed webbrowser ("shell.explorer.2" oleclass)

Note2: when you run actually com ie11 object (internetexplorer.application) if fires errors when vfp9 run as low level mode (non administrator).
it runs fine when applying one of these 2 methods:
-run vfp9 as administrator
-disable the protected mode on IE11 internet options as explained above.


VFP OLEDRAGDROP with treeview,textbox,listbox ,editbox,grid,image from windows explorer &amp; navigators
VFP OLEDRAGDROP with treeview,textbox,listbox ,editbox,grid,image from windows explorer &amp; navigators

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

*7*
*created on 25 of february 2017
*!*this is a better oledragdrop for explorer and modern navigators unless some prealable settings to make 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) (ex: google images)
*!*	 if picture:
*!*	   - on textbox  or editbox (retrieves 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 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).
*!* can explore the images saved (in images folder created)

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 
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 (ex: google images)
 if picture:
   - on textbox  or editbox (retrieves 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 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


VFP OLEDRAGDROP with treeview,textbox,listbox ,editbox,grid,image from windows explorer &amp; navigators
VFP OLEDRAGDROP with treeview,textbox,listbox ,editbox,grid,image from windows explorer &amp; navigators

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


*!*8* created on Wednesday 14 of mrch 2018 form a source idea of Antonio Lopez in UT.(https://www.levelextreme.com/ViewPageGenericLogin.aspx)
*!*	can drag & drop any extension file form explorer to this form.
*!*	-can specify an extension  and drag & drop
*!*	-can change currently this extension  and drag & drop
*!*	-can select *.* for all extensions files  and drag & drop (any file).its the default.
*!*	source can be window explorer, firefox( transformed in BMP!)...... for whose enable operation.
*!*	all files dragged are gathered in a temp foler "yfolder"
*!*	can explorer it to see the captured files.
		
PUBLIC oform
oform=NEWOBJECT("dragNdropper")
oform.Show
RETURN
*
DEFINE CLASS dragNdropper AS form
	BorderStyle = 0
	Top = 172
	Left = 151
	Height = 97
	Width = 540
	ShowWindow = 2
	Caption = "Drag & drop any  files to thisform. from the  windows explorer"
	AlwaysOnTop = .T.
	Name = "Form1"

	ADD OBJECT command1 AS commandbutton WITH ;
		Top = 48, ;
		Left = 345, ;
		Height = 37, ;
		Width = 169, ;
		Caption = "Explorer DragnDrop pdf files", ;
		Name = "Command1"

	ADD OBJECT label1 AS label WITH ;
		AutoSize = .T., ;
		WordWrap = .T., ;
		BackStyle = 0, ;
		Caption = "Type an Extension file or  *.* for all ext.", ;
		Height = 32, ;
		Left = 12, ;
		Top = 12, ;
		Width = 105, ;
		Name = "Label1"

	ADD OBJECT text1 AS textbox WITH ;
		FontBold = .T., ;
		Value = "*.*", ;
		Height = 25, ;
		Left = 127, ;
		Top = 13, ;
		Width = 72, ;
		Name = "Text1"

	ADD OBJECT label2 AS label WITH ;
		AutoSize = .T., ;
		FontBold = .T., ;
		FontSize = 20, ;
		BackStyle = 0, ;
		Caption = "?", ;
		Height = 35, ;
		Left = 516, ;
		MousePointer = 15, ;
		Top = 0, ;
		Width = 19, ;
		ForeColor = RGB(128,0,64), ;
		Name = "Label2"

	PROCEDURE OLEDragDrop
		LPARAMETERS oDataObject, nEffect, nButton, nShift, nXCoord, nYCoord
			LOCAL ARRAY DragFiles(1)
			LOCAL SourceFile AS String
			LOCAL DestinationFile AS String
				DIMENSION m.DragFiles(1)
				IF m.oDataObject.GetData(15, @m.DragFiles)
					WAIT WINDOW "Copying.." NOWAIT NOCLEAR
					FOR EACH m.SourceFile IN m.DragFiles
					do case
				    case UPPER(JUSTEXT(m.SourceFile)) ==upper(allt( thisform.text1.value))
							m.DestinationFile = ADDBS(This.yfold) + JUSTFNAME(m.SourceFile)
							STRTOFILE(FILETOSTR(m.SourceFile), m.DestinationFile, 0)
		            case allt( thisform.text1.value)=="*.*"
		                   m.DestinationFile = ADDBS(This.yfold) + JUSTFNAME(m.SourceFile)
							STRTOFILE(FILETOSTR(m.SourceFile), m.DestinationFile, 0)
					ENDCASE
					ENDFOR
					WAIT WINDOW "Done!" NOWAIT
					m.nEffect = 1
				ELSE
					m.nEffect = 0
				ENDIF
	ENDPROC

	PROCEDURE OLEDragOver
		LPARAMETERS oDataObject, nEffect, nButton, nShift, nXCoord, nYCoord, nState
			LOCAL ARRAY DragFiles(1)
				IF m.nState = 0
					IF m.oDataObject.GetData(15, @m.DragFiles) AND UPPER(JUSTEXT(m.DragFiles(1))) == upper(allt( thisform.text1.value))  or  allt( thisform.text1.value)='*.*'
						This.OLEDropHasData = 1
						This.OLEDropEffects = 1
					ENDIF

				ELSE
					IF m.nState = 1
						This.OLEDropHasData = -1
					ENDIF
				ENDIF
	ENDPROC


	PROCEDURE Init
		_screen.windowstate=1
		this.OLEDropMode = 1
			* create a folder to gather all dragNdrop files
		this.addproperty("yFold",	ADDBS(SYS(2023)) + "yfolder")
		IF !DIRECTORY(This.yFold)
			MKDIR (This.yfold)
		ENDIF
	ENDPROC

	PROCEDURE Destroy
		clea events
	ENDPROC

	PROCEDURE command1.Click
		try
		local m.x
		m.x=thisform.yfold
		run/n  explorer &x
		catch
		endtry
	ENDPROC

	PROCEDURE label2.Click
		local m.myvar
		text to m.myvar pretext  7 noshow
		can drag & drop any extension file form explorer to this form.
		-can specify an extension  and drag & drop
		-can change currently this extension  and drag & drop
		-can select *.* for all extensions files  and drag & drop (any file).its the default.
	    -source can be window explorer, firefox( images are transformed in BMP+renamed !)...... for apps enabling these operations.
		all files dragged are gathered in a temp folder "yfolder"
		can explorer it to see the captured files.
		endtext
		messagebox(m.myvar,0+32+4096)
	ENDPROC

ENDDEFINE
*
*-- EndDefine:dragNdropper


VFP OLEDRAGDROP with treeview,textbox,listbox ,editbox,grid,image from windows explorer &amp; navigators
 
Important:All Codes above are tested on VFP9SP2  & windows 10 pro.

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