I want to translate Aurora code to Ebasic using the build-in drag&drop functions, but I'm unable to change drop effect inside DragOver handler. The return value seems to be implemented in the default way - allow/disallow message forwarding to the "sub handler", and even returning FALSE from the old-style handler does not work for me.
Maybe is there a undocumented @LPARAM trick?
Here's my code for both build-in and custom drag&drop implementation. Compile, run and drop any anchor to Links menu. Drop should be allowed to this menu item only.
The USE_DRAGDROP_CLASS macro switches between build-in and custom drag-drop implementation.
'$define USE_DRAGDROP_CLASS
$include "windowssdk.inc"
$ifdef USE_DRAGDROP_CLASS
$include "shlwapi.inc"
$endif
DIALOG d1,d2
CREATEDIALOG d1,0,0,300,80,0x80CA0080,0,"Menu drag&Drop",&DlgProcDialog
SHOWDIALOG d1
$ifdef USE_DRAGDROP_CLASS
'region DRAGDROP_CLASS
class CDropTargetMenu
declare virtual QueryInterface(pointer riid, pointer ppvObject),HRESULT
declare virtual AddRef(),ULONG
declare virtual Release(),ULONG
declare virtual DragEnter(IDataObject pDataObj,DWORD grfKeyState,POINTL pt byval,DWORD dwEffect byref),HRESULT
declare virtual DragOver(DWORD grfKeyState,POINTL pt byval,DWORD dwEffect byref),HRESULT
declare virtual DragLeave(),HRESULT
declare virtual Drop(IDataObject pDataObj,DWORD grfKeyState,POINTL pt byval,DWORD dwEffect byref),HRESULT
declare Init(HWND hwnd, HMENU menu)
declare Uninit()
declare Unhilite()
HWND m_hwnd
HMENU m_menu
int m_index
IDataObject m_data
endclass
CDropTargetMenu g_dragdrop
g_dragdrop.Init(d1.hwnd, GetMenu(d1.hwnd))
'endregion
$else
'region default
OnMessage d1,@IDDRAGENTER,&DoDragEnter
OnMessage d1,@IDDRAGOVER,&DoDragOver
OnMessage d1,@IDDRAGLEAVE,&Unhilite
OnMessage d1,@IDDRAGDROP,&DoDrop
int g_index = -1
REGISTERDROPTARGET d1.hwnd
'endregion
$endif
Waituntil IsWindowClosed(d1)
SUB DlgProcDialog
SELECT @MESSAGE
CASE @IDINITDIALOG
CENTERWINDOW d1
BEGINMENU d1
MENUTITLE "File"
MENUTITLE "Edit"
MENUTITLE "View"
MENUTITLE "Links"
ENDMENU
const LINKS_INDEX = 3
' open browser
OpenWindow d2, 6,6,288,52, @NOCAPTION|@NOAUTODRAW,d1,"",&WndProcBrowser
CASE @IDCLOSEWINDOW
$ifdef USE_DRAGDROP_CLASS
g_dragdrop.Uninit()
$else
REMOVEDROPTARGET d1.hwnd
$endif
CLOSEDIALOG d1,@IDOK
ENDSELECT
RETURN
ENDSUB
$ifdef USE_DRAGDROP_CLASS
'region DRAGDROP_CLASS
declare qudroptarget()
_asm
segment .data
align 4
extern _IID_IDropTarget
qudroptarget: dd _IID_IDropTarget, 0, 0, 0
segment .text
_endasm
sub CDropTargetMenu::QueryInterface(pointer riid, pointer ppvObject),HRESULT
return QISearch(this, &qudroptarget,riid,ppvObject)
endsub
sub CDropTargetMenu::AddRef(),ULONG
return 1
endsub
sub CDropTargetMenu::Release(),ULONG
return 1
endsub
sub CDropTargetMenu::DragEnter(IDataObject pDataObj,DWORD grfKeyState,POINTL pt byval,DWORD dwEffect byref),HRESULT
'IUnknown_Set(&m_data, pDataObj)
pDataObj->QueryInterface(_IID_IDataObject, &m_data)
m_index = -1
return S_OK
endsub
sub CDropTargetMenu::DragOver(DWORD grfKeyState,POINTL pt byval,DWORD dwEffect byref),HRESULT
if (_SendMessage(m_hwnd, WM_NCHITTEST, 0, POINTTOPOINTS(pt)) <> HTMENU)
dwEffect = DROPEFFECT_NONE
return S_OK
endif
int index = MenuItemFromPoint(m_hwnd, m_menu, pt)
setcaption *<WINDOW>&m_hwnd, str$(index)
if (m_index <> index) then Unhilite()
if (index >= 0)
HiliteMenuItem(m_hwnd, m_menu, m_index, MF_BYPOSITION | MF_HILITE)
m_index = index
endif
int format[5] ' FORMATETC
format = RegisterClipboardFormat("UniformResourceLocator"), 0, DVASPECT_CONTENT, -1, TYMED_HGLOBAL
if ((index <> LINKS_INDEX) or (m_data->QueryGetData(&format))) then dwEffect = DROPEFFECT_NONE
return S_OK
endsub
sub CDropTargetMenu::DragLeave(),HRESULT
'IUnknown_AtomicRelease(&m_data)
m_data->Release()
return S_OK
endsub
sub CDropTargetMenu::Drop(IDataObject pDataObj,DWORD grfKeyState,POINTL pt byval,DWORD dwEffect byref),HRESULT
Unhilite()
MessageBeep(MB_ICONINFORMATION)
'IUnknown_AtomicRelease(&m_data)
m_data->Release()
return S_OK
endsub
sub CDropTargetMenu::Unhilite()
if (m_index >= 0)
HiliteMenuItem(m_hwnd, m_menu, m_index, MF_BYPOSITION | MF_UNHILITE)
m_index = -1
endif
return
endsub
sub CDropTargetMenu::Init(HWND hwnd, HMENU menu)
m_hwnd = hwnd
m_menu = menu
OleInitialize(0)
RegisterDragDrop(hwnd, this)
return
endsub
sub CDropTargetMenu::Uninit()
RevokeDragDrop(m_hwnd)
OleUninitialize()
return
endsub
'endregion
$else
'region default
sub DoDragEnter(),int
' accept URL's only
return CheckDropFormat(RegisterClipboardFormat("UniformResourceLocator"))
endsub
sub DoDragOver(),int
POINT pt = GETDRAGPOINT(d1.hwnd)
ClientToScreen(d1.hwnd, &pt)
HMENU menu = GetMenu(d1.hwnd)
if (_SendMessage(d1.hwnd, WM_NCHITTEST, 0, POINTTOPOINTS(pt)) <> HTMENU)
' not over window menu
return Unhilite()
endif
' menubar item index
int index = MenuItemFromPoint(d1.hwnd, menu, pt)
setcaption d1, str$(index)
' unhilite hilited, if any
if (g_index <> index) then Unhilite()
' hilite new, if any
if (index >= 0)
HiliteMenuItem(d1.hwnd, menu, g_index, MF_BYPOSITION | MF_HILITE)
g_index = index
endif
return (index = LINKS_INDEX)
endsub
sub DoDrop()
messagebeep(0)
Unhilite()
return
endsub
sub Unhilite(),int
if (g_index >= 0)
HiliteMenuItem(d1.hwnd, GetMenu(d1.hwnd), g_index, MF_BYPOSITION | MF_UNHILITE)
g_index = -1
endif
return FALSE
endsub
'endregion
$endif
sub WndProcBrowser
SELECT @MESSAGE
CASE @IDCREATE
AttachBrowser d2
BROWSECMD d2, @BROWSELOAD, "<a href='http://aa.bb.cc/'>drag me to Links menu</a>"
ENDSELECT
RETURN
ENDSUB
Sapero,
Have you looked at the example program included with Emergence? "dragdrop_example1.eba". You can change cursors in response to @IDDRAGFEEDBACK
Paul
@IDDRAGFEEDBACK is not even sent because I am not the drop source.
I see now that I'm unable to get the copy/move/link cursor while dragging a url from webbrowser or just plain text from scintilla editor.. Every time the slashed circle cursor is active.
Wait a second, with shift and control keys pressed it works, the cursor is changing to arraw-link, but in standard window only. In a dialog, in the DragEnter and DragOver subroutines I need to callSetWindowLong(d1.hwnd, DWL_MSGRESULT, allow)