Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

listview drag-n-drop cell to cell

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Bill Scharf
    replied
    listview drag-n-drop cell to cell using highlighting

    Code:
    '______________________________________________________________________________
    '
    ' ListView cell-to-cell drag-N-Drop using cell highlighting
    ' This example also shows the "frozen" first column
    ' Once again most of this code is not originally mine and I owe about 99.999% of it to this helpful forum
    '______________________________________________________________________________
    
    #COMPILE EXE
    #DIM ALL
    #REGISTER ALL
    
    %USEMACROS = 1
    #INCLUDE "WIN32API.INC"
    #INCLUDE "COMMCTRL.INC"
    %ID_LVA_LV          = 100       ' Main listview identifier #1
    %ID_LVB_LV          = 200       ' Main listview identifier #2
    
    GLOBAL hDlg, hDlgLv AS DWORD
    GLOBAL ListViewBHNDL, ListViewAHNDL AS LONG
    GLOBAL HiLIghtSubItem, HiLIghtItem, startItem, StartSubItem AS LONG
    GLOBAL sbUpdating, dragging         AS BYTE
    GLOBAL dragText                     AS STRING
    '------------------------------------------------------------------------------
    ' Listview Subclass Procedure
    ' This subclass callback is for both listivews, despite the fact that they have
    '      two different parent dialogs.
    '------------------------------------------------------------------------------
    CALLBACK FUNCTION ListView_SubclassProc
      STATIC PrimaryID, secondaryID, PrimaryHdlg, SecondaryHDLG, PrimaryControlHndl, SecondaryControlHndl,_
             LVBHndl        AS LONG
      LOCAL i, x                          AS LONG
      LOCAL ms_lvi                        AS LV_ITEM
      LOCAL lvhit                         AS LVHITTESTINFO
      LOCAL lvi                           AS LV_ITEM
      LOCAL szBuf                         AS ASCIIZ * %MAX_PATH
      LOCAL PT                            AS POINTAPI
    
      SELECT CASE CBMSG
    
             CASE %WM_VSCROLL, %WM_KEYFIRST TO %WM_KEYLAST, %WM_MOUSEFIRST TO %WM_MOUSELAST'Note HSCROLL is not needed
                        'the left ListView should not be allowed to scroll right
                        IF CBMSG = %WM_KEYDOWN AND CBWPARAM = %VK_RIGHT AND GetDlgCtrlID(CBHNDL) = %ID_LVA_LV THEN'
                            EXIT FUNCTION
                        END IF
                        PrimaryID     = IIF&(GetDlgCtrlID(CBHNDL) = %ID_LVA_LV, %ID_LVA_LV, %ID_LVB_LV)
                        secondaryID   = IIF&(GetDlgCtrlID(CBHNDL) = %ID_LVA_LV, %ID_LVB_LV, %ID_LVA_LV)
                        PrimaryHdlg   = IIF&(GetDlgCtrlID(CBHNDL) = %ID_LVA_LV, hDlgLv, hdlg)
                        SecondaryHDLG = IIF&(GetDlgCtrlID(CBHNDL) = %ID_LVB_LV, hDlgLv, hdlg)
    
                        'post a custom message.  THis allows all the scrolling to complete
                        'without this, the scrolling will trigger before it is complete and you might be off by 1 row
                        PostMessage CBHNDL, %WM_USER + 401, 0, 0
                        IF CBMSG = %WM_LBUTTONUP AND  PrimaryID =  %ID_LVB_LV THEN
                          dragging = 0
                          debugprint("Dragged from row " + STR$(startItem) + " col " + STR$(startsubItem))
                          'now we get where it is dragged to
                          GetCursorPos lvhit.pt
                          ScreenToClient ListViewBHNDL, lvhit.pt
                          SendMessage ListViewBHNDL, %LVM_SUBITEMHITTEST, 0, VARPTR(lvhit)
                             IF lvhit.iItem > -1 AND lvhit.isubItem > -1 THEN
                                MSGBOX ("Dragged to row " + STR$(lvhit.iItem+1) + " col " + STR$(lvhit.isubItem+1) + $CRLF + _
                                        "Dragged from row " + STR$(startItem+1) + " col " + STR$(startsubItem+1))
    
                                 ListView_GetItemText(ListViewBHNDL,lvhit.iItem, lvhit.isubItem,szBuf,SIZEOF(szBuf))
                                InvalidateRect ListViewBHNDL, BYVAL %NULL, %True
                                HiLIghtItem   = -1
                                HiLIghtSubItem= -1
                                startItem   = -1
                                StartSubItem= -1
                                ReleaseCapture()
                                ImageList_EndDrag()
                          END IF
                        END IF
                        IF CBMSG = %WM_MOUSEMOVE  AND PrimaryID =  %ID_LVB_LV AND dragging = 1 THEN
                          GetCursorPos lvhit.pt
                          ScreenToClient ListViewBHNDL, lvhit.pt
                          SendMessage ListViewBHNDL, %LVM_SUBITEMHITTEST, 0, VARPTR(lvhit)
                           'highlightcell(hlistview, lvhit.iItem, lvhit.isubItem)
                             IF lvhit.iItem > -1 AND lvhit.isubItem > -1 THEN
                                SetCursor LoadCursor(0, BYVAL %IDC_ARROW)
                                lvi.state     = %LVIS_FOCUSED
                                lvi.stateMask = %LVIS_FOCUSED
                                SendMessage ListViewBHNDL, %LVM_SETITEMSTATE, lvhit.iItem, VARPTR(lvi)
                                IF HiLIghtItem <> lvhit.iItem OR HiLIghtSubItem <> lvhit.isubItem THEN
                                    HiLIghtItem = lvhit.iItem
                                    HiLIghtSubItem = lvhit.isubItem
                                    IF startItem = -1 OR StartSubItem = -1 THEN
                                            StartItem =     lvhit.iItem
                                            StartSubItem =  lvhit.isubItem
                                    END IF
                                    'this is needed to refresh dragging within the same row
                                    InvalidateRect ListViewBHNDL, BYVAL %NULL, %True
                                END IF
                                'move the image?
                             ELSE
                                'if this is the first time we are out of range, then refresh to get rid of highlighting
                                IF HiLIghtItem <> -1 OR HiLIghtSubItem <> -1 THEN
                                    InvalidateRect ListViewBHNDL, BYVAL %NULL, %True
                                END IF
                                SetCursor LoadCursor(0, BYVAL %IDC_NO)
                                HiLIghtItem = -1
                                HiLIghtSubItem = -1
                             END IF
                        END IF
    
             CASE %WM_USER + 401
                 LOCAL PrimaryRect AS RECT, secondaryRect AS RECT
                 PrimaryRect.nLeft = %LVIR_BOUNDS
                 CONTROL HANDLE PrimaryHdlg, PrimaryID TO PrimaryControlHndl
                 CONTROL HANDLE SecondaryHDLG, secondaryID TO SecondaryControlHndl
                 'find how far down the initiating control is scrolled
                 SendMessage PrimaryControlHndl, %LVM_GETITEMRECT, 0, VARPTR(PrimaryRect)
                 'find how far down the secondary control is
                 secondaryRect.nLeft = %LVIR_BOUNDS
                 i=SendDlgItemMessage (SecondaryHDLG,secondaryID,%LVM_GETITEMRECT, 0, VARPTR(secondaryRect))
                 'scrolling the secondary control to where the initiating control is
                 i=SendDlgItemMessage (SecondaryHDLG, secondaryID, %LVM_SCROLL, 0,secondaryRect.nTop - PrimaryRect.nTop)
                 'get the selected one from the initiating control and select the same one in the secondary control
                  i=ListView_GetNextItem(PrimaryControlHndl, -1, %LVNI_FOCUSED OR %LVNI_SELECTED)
                  IF i > -1 THEN'select the other one
                                ms_lvi.stateMask = %LVIS_FOCUSED OR %LVIS_SELECTED
                                ms_lvi.state = %LVIS_FOCUSED OR %LVIS_SELECTED
                                SendMessage SecondaryControlHndl, %LVM_SETITEMSTATE, -1, VARPTR(ms_lvi)
                                SendMessage SecondaryControlHndl, %LVM_SETITEMSTATE, i, VARPTR(ms_lvi)
                  END IF
    
             CASE %WM_DESTROY
                  FUNCTION = CallWindowProc(GetWindowLong(CBHNDL, %GWL_USERDATA), CBHNDL, CBMSG, CBWPARAM, CBLPARAM)
                  SetWindowLong CBHNDL, %GWL_WNDPROC, GetWindowLong(CBHNDL, %GWL_USERDATA)
                  EXIT FUNCTION
    
    
      END SELECT
    
      FUNCTION = CallWindowProc(GetWindowLong(CBHNDL, %GWL_USERDATA), CBHNDL, CBMSG, CBWPARAM, CBLPARAM)
    END FUNCTION
    
    '------------------------------------------------------------------------------
    ' Main dialog callback procedure
    '------------------------------------------------------------------------------
    CALLBACK FUNCTION dlgMain
      LOCAL i AS LONG, lvi AS LV_ITEM, lvc AS LV_COLUMN, zText AS ASCIIZ * 1024, rc AS RECT
      LOCAL dlgxx, dlgyy, extendLV, hLV AS LONG
    
      SELECT CASE CBMSG
    
             CASE %WM_INITDIALOG
                  ' Prepare example listview items...
                  lvi.mask    = %LVIF_TEXT
                  lvi.pszText = VARPTR(zText)
                  FOR i = 1 TO 24
                      lvi.iItem = i-1
                      zText     = STR$(i)+":00 " + "Appointment"
                      CONTROL SEND CBHNDL, %ID_LVB_LV, %LVM_INSERTITEM, 0, VARPTR(lvi)
                      zText     = STR$(i)+":00"
                      CONTROL SEND hDlgLv, %ID_LVA_LV, %LVM_INSERTITEM, 0, VARPTR(lvi)
                  NEXT i
                ' Set column info...
                  GetClientRect GetDlgItem(CBHNDL, %ID_LVb_LV), rc
                  zText       = "Employee2"
                  lvc.mask    = %LVCF_WIDTH OR %LVCF_TEXT
                  lvc.pszText = VARPTR(zText)
                  lvc.cx      = rc.nRight-2
                  CONTROL SEND CBHNDL, %ID_LVB_LV, %LVM_INSERTCOLUMN, 0, VARPTR(lvc)
                  zText       = "Employee1"
                  CONTROL SEND CBHNDL, %ID_LVB_LV, %LVM_INSERTCOLUMN, 0, VARPTR(lvc)
                  zText       = "Time"
                  CONTROL SEND hDlgLv, %ID_LVA_LV, %LVM_INSERTCOLUMN, 0, VARPTR(lvc)
                   FOR i = 0 TO 24
                         ztext = "Another appt at" + STR$(i+1) + ":00"
                         ListView_SetitemText(ListViewBHNDL, i, 1, ztext)
                   NEXT i
                  ' Subclass listviews
                  SetWindowLong GetDlgItem(hDlgLv, %ID_LVA_LV), %GWL_USERDATA, SetWindowLong(GetDlgItem(hDlgLv, %ID_LVA_LV), %GWL_WNDPROC, CODEPTR(ListView_SubclassProc))
                  SetWindowLong GetDlgItem(CBHNDL, %ID_LVB_LV), %GWL_USERDATA, SetWindowLong(GetDlgItem(CBHNDL, %ID_LVB_LV), %GWL_WNDPROC, CODEPTR(ListView_SubclassProc))
                  HiLIghtItem   = -1
                  HiLIghtSubItem= -1
    
             CASE %WM_COMMAND
                  ' Exit program...
                  IF (CBCTL = %IDOK) AND (CBCTLMSG = %BN_CLICKED) THEN DIALOG END CBHNDL
    
             CASE %WM_SIZE
                 IF CBLPARAM<>%SIZE_MINIMIZED THEN
                    DIALOG GET SIZE CBHNDL TO DlgXX, DlgYY
                    CONTROL HANDLE hdlg, %ID_LVB_LV TO hLV
                    CONTROL SET SIZE CBHNDL, %ID_LVB_LV  , dlgxx-70,129
                    'Now comes the hack...
                    doTheHack(CBHNDL)
    
                 END IF
             CASE %WM_NOTIFY
                  LOCAL theNMHDR AS NMHDR PTR
                  theNMHDR = CBLPARAM
                  SELECT CASE AS LONG @thenmhdr.code
                      CASE %HDN_ENDTRACK
                           PostMessage CBHNDL, %WM_USER + 402, 0, 0
                  END SELECT
                                LOCAL nmh AS NMHDR PTR
                  LOCAL lplvcd                        AS NMLVCUSTOMDRAW PTR
                  nmh = CBLPARAM
                  SELECT CASE CBCTL
                        CASE %ID_LVb_LV
                         SELECT CASE @nmh.code
                             CASE %LVN_BEGINDRAG
                             'NOTE to self!!!
                             'This beginDrag message is much better than trapping the mousebutton down
                             'If you trap the mousebutton down to turn on dragging, then it will not always get the mouseup message
                             'the beginDrag message does not fire as quick as the beginDrag
                             '--and only seems to fire when a mouseup message will fire when you let go
                                 dragging = 1
    
                            CASE %NM_CUSTOMDRAW
                              lplvcd = CBLPARAM
                              IF(@lplvcd.nmcd.dwDrawStage = %CDDS_PREPAINT) THEN  ' Prepare painting
                                   FUNCTION = %CDRF_NOTIFYITEMDRAW                 ' Prepare to draw each item
                                   EXIT FUNCTION
                              END IF
                              IF(@lplvcd.nmcd.dwDrawStage = %CDDS_ITEMPREPAINT) THEN
                                   FUNCTION = %CDRF_NOTIFYSUBITEMDRAW              ' Prepare to draw each subitem
                                   EXIT FUNCTION
                              END IF
                              IF (@lplvcd.nmcd.dwDrawStage = %CDDS_SUBITEM OR %CDDS_PREPAINT) THEN
                                 '---- Default Cell background Colors
                                 @lplvcd.clrTextBk = RGB(255, 255, 255)
                                 @lplvcd.clrText = %BLACK
                                 '---- set the time column
                              IF @lplvcd.iSubItem=HiLIghtSubItem AND @lplvcd.nmcd.dwItemSpec=HiLIghtItem THEN
                                 @lplvcd.clrTextBk = RGB(240,0,0)
                              END IF
                              END IF
                              FUNCTION =%CDRF_NOTIFYSUBITEMDRAW OR %CDRF_NEWFONT
                              EXIT FUNCTION
                         END SELECT
                  END SELECT
    
            CASE %WM_USER + 402
                 doTheHack(CBHNDL)
    
      END SELECT
    
    END FUNCTION
    '------------------------------------------------------------------------------
    ' Secondary callback procedure
    '------------------------------------------------------------------------------
    CALLBACK FUNCTION dlgMain2
          'subclassing this dialog's ListView could go here if you wanted...but why not put them in the same place
    END FUNCTION
    
    '------------------------------------------------------------------------------
    ' Program Start Point
    '------------------------------------------------------------------------------
    
    
    FUNCTION PBMAIN
      LOCAL lStyle AS LONG
      DIALOG NEW 0, "Parallel ListView Test", , , 250, 153+15, %DS_MODALFRAME OR %WS_CAPTION OR %WS_SYSMENU OR %WS_THICKFRAME OR %WS_POPUP TO hDlg
      DIALOG NEW hDlg, "", 0, 0, 63, 130, %WS_CHILD OR %WS_VISIBLE TO hDlgLv
    
      CONTROL ADD $WC_LISTVIEW, hDlgLv, %ID_LVA_LV, "", 0, 0, 75, 141,  %WS_CHILD OR %WS_VISIBLE OR _
                    %WS_TABSTOP OR %LVS_REPORT OR %LVS_SHOWSELALWAYS OR %LVS_SINGLESEL, %WS_EX_LEFT OR _
                    %WS_EX_CLIENTEDGE OR %WS_EX_RIGHTSCROLLBAR
      CONTROL ADD $WC_LISTVIEW, hDlg, %ID_LVB_LV, "", 64, 0, 125, 129,  %WS_CHILD OR %WS_VISIBLE OR _
                    %WS_TABSTOP OR %LVS_REPORT OR %LVS_SHOWSELALWAYS OR %LVS_SINGLESEL, %WS_EX_LEFT OR _
                    %WS_EX_CLIENTEDGE OR %WS_EX_RIGHTSCROLLBAR
      CONTROL HANDLE hDlgLv, %ID_LVa_LV TO ListViewAHNDL
      CONTROL HANDLE hDlg, %ID_LVb_LV TO ListViewBHNDL
      CONTROL ADD BUTTON, hDlg, %IDOK, "Exit", 100, 150, 50, 15
      'The listviews lack style...so let's add styles
      '  This is done separately and after all controls are added just so I could play around with various styles
        lStyle = ListView_GetExtendedListViewStyle(ListViewAHNDL)
        ListView_SetExtendedListViewStyle(ListViewAHNDL, lStyle OR %LVS_EX_FULLROWSELECT OR %LVS_EX_GRIDLINES)
        lStyle = ListView_GetExtendedListViewStyle(ListViewBHNDL)
        ListView_SetExtendedListViewStyle(ListViewBHNDL, lStyle OR %LVS_EX_FULLROWSELECT OR %LVS_EX_GRIDLINES)
    
      DIALOG SHOW MODELESS hDlgLv CALL dlgMain2
      DIALOG SHOW MODAL hDlg CALL dlgMain
    END FUNCTION
    
    FUNCTION doTheHack(hldg AS DWORD) AS LONG
          LOCAL tLVI   AS LV_ITEM
                     'It seems windows adds a line to the "B" (right-most) listView when a scrollbar is added
                    'therefore we need to add a line to the "A" (left-most) listview when the scrollbar is added
                    'we also need to take the last line away when the scrollbar is no longer present
    
                    IF (GetWindowLong(ListViewBHNDL, %GWL_STYLE) AND %WS_HSCROLL) AND _
                       (ListView_GetItemCount(ListViewAHNDL) = ListView_GetItemCount(ListViewBHNDL))THEN
                        tLVI.iItem = ListView_GetItemCount(ListViewBHNDL)+1
                        tLVI.mask = %LVIF_TEXT OR %LVIF_PARAM OR %LVIF_STATE
                        ListView_InsertItem(ListViewAHNDL,tLVI)
                    ELSE
                        IF  ((GetWindowLong(ListViewBHNDL, %GWL_STYLE) AND %WS_HSCROLL)=0) AND _
                           (ListView_GetItemCount(ListViewAHNDL) > ListView_GetItemCount(ListViewBHNDL)) THEN
                            ListView_DeleteItem(ListViewAHNDL, ListView_GetItemCount(ListViewAHNDL)-1)
                        END IF
                    END IF
    END FUNCTION

    Leave a comment:


  • Bill Scharf
    started a topic listview drag-n-drop cell to cell

    listview drag-n-drop cell to cell

    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
    Last edited by Bill Scharf; 16 Mar 2009, 02:52 PM. Reason: more comments
Working...
X