Tweet
Code:
#COMPILE EXE
#DIM ALL
'This is an example of using drag images to drag cell to cell and not row to row.
'The default behavior for listView drag images is to use the entire row.
'The data in the resulting location will be overwritten with the data in the starting location.
'Most code is not originally mine and I owe about 99.999% of it to others on this helpful forum
'------------------------------------------------------------------------------
' ** Includes **
'------------------------------------------------------------------------------
#IF NOT %DEF(%WINAPI)
#INCLUDE "WIN32API.INC"
#ENDIF
#IF NOT %DEF(%COMMCTRL_INC)
#INCLUDE "COMMCTRL.INC"
#ENDIF
GLOBAL HLV AS DWORD
GLOBAL OLDLVPROC AS DWORD
'GLOBAL HBMP AS DWORD
GLOBAL himg AS DWORD
GLOBAL fDrag AS LONG
GLOBAL gNormalCursor AS LONG
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
' ** Constants **
'------------------------------------------------------------------------------
%IDD_DIALOG1 = 101
%IDC_LV = 1002
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
' ** Declarations **
'------------------------------------------------------------------------------
DECLARE CALLBACK FUNCTION ShowDIALOG1Proc()
DECLARE FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
DECLARE FUNCTION createCustDragImage(hldg AS DWORD, _
Himg AS DWORD, theStartLVITEM AS LONG, theLVSUBITEM AS LONG) AS LONG
#PBFORMS DECLARATIONS
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
' ** Main Application Entry Point **
'------------------------------------------------------------------------------
FUNCTION PBMAIN()
ShowDIALOG1 %HWND_DESKTOP
END FUNCTION
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
' ** CallBacks **
'------------------------------------------------------------------------------
FUNCTION LV_SubclassProc _
( _
BYVAL hWnd AS DWORD, _ ' control handle
BYVAL uMsg AS DWORD, _ ' type of message
BYVAL wParam AS DWORD, _ ' first message parameter
BYVAL lParam AS LONG _ ' second message parameter
) EXPORT AS LONG
LOCAL OrigdWndProc&
LOCAL LVHitTest AS LVHITTESTINFO
STATIC theStartLVITEM AS LONG
STATIC theStartLVSUBITEM AS LONG
LOCAL pt AS POINTAPI
LOCAL dx, x AS LONG
LOCAL dy, y AS LONG
LOCAL colwidth, thecol AS LONG
LOCAL tLVC AS LV_COLUMN
LOCAL hHdrCtrl AS DWORD
LOCAL nCount AS LONG
LOCAL szBuf AS ASCIIZ * 50
STATIC fDrag AS LONG
LOCAL nocursor AS LONG
SELECT CASE uMsg
CASE %WM_LBUTTONDOWN
'// determine the current mouse position
'// evaluate if we clicked on the icon
LVHitTest.pt.x = LOWRD(LPARAM)
LVHitTest.pt.y = HIWRD(LPARAM)
SendMessage HLV, %LVM_SUBITEMHITTEST, 0, VARPTR(LVHitTest)
theStartLVITEM = LVHitTest.iItem
theStartLVSUBITEM = LVHitTest.isubItem
createCustDragImage(getparent(hwnd), Himg, theStartLVITEM, theStartLVSUBITEM)
'// convert the cursor position in screen coordinates
pt.x = LOWRD(LPARAM)
pt.y = HIWRD(LPARAM)
CALL ClientToScreen( HLV, pt)
'// define the icon attributes
CALL ImageList_BeginDrag( himg, 0, 0, 0)
'// enter dragging mode
CALL ImageList_DragEnter( %NULL,pt.x, pt.y)
'// set the drag flag to TRUE
fDrag = 1
'// capture the mouse to drag the icon everywhere on the screen
CALL SetCapture( hwnd)
CASE %WM_LBUTTONUP
'// release the mouse
CALL ReleaseCapture()
ImageList_EndDrag()
'//Drop the text
'Figure out which cell is under the cursor
LVHitTest.pt.x = LOWRD(LPARAM)
LVHitTest.pt.y = HIWRD(LPARAM)
SendMessage HLV, %LVM_SUBITEMHITTEST, 0, VARPTR(LVHitTest)
'make sure they are dropping in a possible place
IF (LVHitTest.iItem > -1 AND LVHitTest.isubItem > -1) AND _
(LVHitTest.iItem <> theStartLVITEM OR _
LVHitTest.isubItem <> theStartLVsubITEM) THEN
'get the text to drop
listview_getItemText(hlv,theStartLVITEM ,theStartLVSUBITEM , szBuf, SIZEOF(szbuf))
IF TRIM$(szbuf) <> "" THEN
'drop the text
listview_setItemText(hlv,LVHitTest.iItem ,LVHitTest.isubItem , szBuf)
'clear old text
listview_setItemText(hlv,theStartLVITEM ,theStartLVSUBITEM , "")
END IF
ELSE
MSGBOX "You cannot drop it here"
END IF
CASE %WM_MOUSEMOVE
'// skip if we are not dragging the icon
IF fDrag = 1 THEN
pt.x = LOINT(LPARAM)
pt.y = HIINT(LPARAM)
'// convert the cursor position in screen coordinates
CALL ClientToScreen( HLV, pt)
'// drag the icon
CALL ImageList_DragMove( pt.x, pt.y)
END IF
CASE %WM_DESTROY
' Remove control subclassing
OrigdWndProc& = SetWindowLong (hWnd, %GWL_WNDPROC, OLDLVPROC)
END SELECT
FUNCTION = CallWindowProc(OLDLVPROC, hWnd, uMsg, wParam, lParam)
END FUNCTION
CALLBACK FUNCTION ShowDIALOG1Proc()
LOCAL ps AS PAINTSTRUCT
LOCAL pt AS POINTAPI
LOCAL hDC AS DWORD
LOCAL hMemDC AS DWORD
LOCAL hOldBmp AS DWORD
LOCAL hOldBrush AS DWORD
LOCAL hBmpCopy AS DWORD
LOCAL lOldBkMode AS LONG
LOCAL cxIcon AS LONG
LOCAL cyIcon AS LONG
LOCAL dx AS LONG
LOCAL dy AS LONG
LOCAL hCursor AS DWORD
LOCAL iImage AS LONG
LOCAL LVHitTest AS LVHITTESTINFO
SELECT CASE AS LONG CBMSG
CASE %WM_INITDIALOG
gNormalCursor = GetCUrsor
CASE %WM_DESTROY
IF himg THEN ImageList_Destroy himg
CASE %WM_NCACTIVATE
STATIC hWndSaveFocus AS DWORD
IF ISFALSE CBWPARAM THEN
' Save control focus
hWndSaveFocus = GetFocus()
ELSEIF hWndSaveFocus THEN
' Restore control focus
SetFocus(hWndSaveFocus)
hWndSaveFocus = 0
END IF
CASE %WM_LBUTTONUP
CALL ReleaseCapture()
ImageList_EndDrag()
END SELECT
END FUNCTION
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
' ** Dialogs **
'------------------------------------------------------------------------------
FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
LOCAL lRslt, lstyle, x,xx AS LONG
LOCAL tLVC AS LV_COLUMN
LOCAL tLVI AS LV_ITEM
LOCAL szBuf AS ASCIIZ * 32
LOCAL hDlg AS DWORD
DIALOG NEW hParent, "Dialog1", 239, 270, 300, 220, %WS_POPUP OR _
%WS_BORDER OR %WS_DLGFRAME OR %WS_SYSMENU OR %WS_CLIPSIBLINGS OR _
%WS_VISIBLE OR %DS_MODALFRAME OR %DS_3DLOOK OR %DS_NOFAILCREATE OR _
%DS_SETFONT, %WS_EX_CONTROLPARENT OR %WS_EX_LEFT OR _
%WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR, TO hDlg
''add listview
CONTROL ADD "SysListView32", hDlg, %IDC_LV, "SysListView32_2", _
70, 30, 175, 170, %WS_CHILD OR %WS_VISIBLE OR _
%LVS_REPORT OR %LVS_SHOWSELALWAYS OR %LVS_SINGLESEL, %WS_EX_CLIENTEDGE OR _
%WS_EX_LEFT OR %WS_EX_RIGHTSCROLLBAR
CONTROL HANDLE hDlg, %IDC_LV TO hlv
lStyle = ListView_GetExtendedListViewStyle(hlv)
ListView_SetExtendedListViewStyle(hlv, lStyle OR %LVS_EX_GRIDLINES)
' Load column headers.
FOR x = 0 TO 10
tLVC.mask = %LVCF_FMT OR %LVCF_TEXT OR %LVCF_SUBITEM
tLVC.fmt = %LVCFMT_LEFT
tLVC.pszText = VARPTR(szBuf)
szBuf = "column " + STR$(x)
tLVC.iOrder = x
x=ListView_InsertColumn(hlv, x, tLVC)
ListView_SetColumnWidth(hlv, x, 75)
NEXT x
'add items to listview
tLVI.stateMask = %LVIS_FOCUSED
tLVI.pszText = VARPTR(szBuf)
FOR x = 0 TO 50
tLVI.iSubItem = 0
tLVI.lParam = 0
tLVI.mask = %LVIF_TEXT OR %LVIF_PARAM OR %LVIF_STATE
szBuf = "line " + STR$(x)
tLVI.iItem = x
ListView_InsertItem(hlv, tLVI)
FOR xx = 0 TO 10
szBuf = "ln" + STR$(x) + "col" + STR$(xx)
ListView_SetItemText(hlv, x, xx, szbuf)
NEXT xx
NEXT x
OLDLVPROC = SetWindowLong(hLV, %GWL_WNDPROC, CODEPTR(LV_SubclassProc))
DIALOG SHOW MODAL hDlg, CALL ShowDIALOG1Proc TO lRslt
FUNCTION = lRslt
END FUNCTION
FUNCTION createCustDragImage(hdlg AS DWORD, _
Himg AS DWORD, _
theStartLVITEM AS LONG, theStartLVSUBITEM AS LONG) AS LONG
LOCAL ps AS PAINTSTRUCT
LOCAL pt AS POINTAPI
LOCAL hDC AS DWORD
LOCAL hMemDC AS DWORD
LOCAL hOldBmp AS DWORD
LOCAL hOldBrush AS DWORD
LOCAL hBmpCopy AS DWORD
LOCAL lOldBkMode AS LONG
LOCAL cxIcon AS LONG
LOCAL cyIcon AS LONG
LOCAL iImage AS LONG
LOCAL szText AS ASCIIZ * 50
LOCAL hBmp AS DWORD
' Create the drag image
' ---------------------
cxIcon = 100
cyIcon = 15
hDC = GetDC(hdlg)
hMemDC = CreateCompatibleDC(hDC)
hBmp = CreateCompatibleBitmap(hDC, cxIcon, cyIcon)
ReleaseDC hdlg, hDC
hOldBmp = SelectObject(hMemDC, hBmp)
lOldBkMode = SetBkMode(hMemDC, %TRANSPARENT)
hOldBrush = SelectObject(hMemDC, CreateSolidBrush(%WHITE))
PatBlt hMemDC, 0, 0, cxIcon, cyIcon, %PATCOPY
DeleteObject SelectObject(hMemDC, hOldBrush)
SetTextColor hMemDC, GetSysColor(%COLOR_WINDOWTEXT)
'get the text
ListView_GetItemText(hLV, theStartLVITEM, theStartLVSUBITEM, szText, SIZEOF(szText))
TextOut hMemDC, 1, 1, szText, LEN(szText)
SetBkMode hMemDC, lOldBkMode
SelectObject hMemDC, hOldBmp
DeleteDC hMemDC
himg = ImageList_Create(cxIcon, cyIcon, %ILC_COLOR32 OR %ILC_MASK, 2, 1)
ImageList_SetBkColor himg, %CLR_NONE
' ImageList_AddMasked modifies the original bitmap, therefore, a
' copy of the bitmap is added since the original is used for the
' image on the dialog.
hBmpCopy = CopyImage(hBmp, %IMAGE_BITMAP, 0, 0, %LR_COPYRETURNORG)
iImage = ImageList_AddMasked(himg, hBmpCopy, %WHITE)
DeleteObject hBmpCopy
' -------------------------- End Create drag image
END FUNCTION
Comment