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