Article ID: 186583
Article Last Modified on 7/13/2004
PUBLIC ox
ox=CREATEOBJECT("frmlist")
ox.SHOW
DEFINE CLASS frmlist AS FORM
AUTOCENTER=.T.
TOP = 0
LEFT = 0
HEIGHT = 200
WIDTH = 400
DOCREATE = .T.
OLEDRAGMODE = 1
OLEDROPMODE = 1
CAPTION = "OLE Drag And Drop Form"
NAME = "Form1"
ADD OBJECT list1 AS LISTBOX WITH ;
OLEDRAGMODE = 0, ;
OLEDROPMODE = 0, ;
HEIGHT = 156, ;
LEFT = 24, ;
MULTISELECT = .T., ;
TOP = 12, ;
WIDTH = 121, ;
NAME = "List1"
ADD OBJECT image1 AS IMAGE WITH ;
OLEDRAGMODE = 1, ;
OLEDROPMODE = 1, ;
HEIGHT = 180, ;
LEFT = 210, ;
TOP = 10, ;
WIDTH = 180, ;
NAME = "IMAGE1", ;
STRETCH=2
PROCEDURE INIT
THIS.getpicfiles()
ENDPROC
PROCEDURE LOAD
PUBLIC labmpfiles
DECLARE labmpfiles[1]
ENDPROC
PROCEDURE getpicfiles
=ADIR(labmpfiles,HOME(4)+'\BITMAPS\ASSORTED\*.BMP')
FOR i=1 TO ALEN(labmpfiles,1)
if UPPER(RIGHT(labmpfiles[i,1],3))="BMP"
THISFORM.list1.ADDITEM(labmpfiles[i,1])
ENDIF
NEXT
ENDPROC
PROCEDURE list1.MOUSEDOWN
LPARAMETERS nbutton, nshift, nxcoord, nycoord
THIS.OLEDRAG(.t.)
ENDPROC
PROCEDURE list1.OLESTARTDRAG
LPARAMETERS odataobject, neffect
odataobject.CLEARDATA
odataobject.SETFORMAT( 15 )
ENDPROC
PROCEDURE list1.OLESETDATA
LPARAMETERS odataobject, eformat
LOCAL afiles[ 1 ], nlen, ctext
nlen = 0
IF eformat == 15 && Files
FOR i = 1 TO THIS.LISTCOUNT
IF THIS.SELECTED(i)
nlen = nlen + 1
DIMENSION afiles[nLen]
afiles[nLen] = HOME(4)+'BITMAPS\ASSORTED\'+THIS.LIST(i)
ENDIF
NEXT
odataobject.SETDATA( @afiles, 15 )
ENDIF
ENDPROC
PROCEDURE image1.OLEDRAGDROP
LPARAMETERS odataobject, neffect, nbutton, nshift, nxcoord, ;
nycoord
LOCAL cfilename, afiles[ 1 ]
IF odataobject.GETFORMAT( 15 )
odataobject.GETDATA( 15, @afiles )
FOR EACH cfilename IN afiles
THIS.PICTURE = cfilename
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
ENDDEFINE
DO OLEDEMO
Additional query words: FxinteropAccess FxinteropExcel FxinteropWinword FxprgGeneral kbVFp600 kbUIDesign
Keywords: kbhowto KB186583