In a Listbox I can move the items up and down with two buttons.
Now I want to drag and drop the items like in FF Workspace - TabOrder.
Can anyone show me some code how to do that?
Klaas
Hi Klaas,
I used code from Edwin that produces a drag/drop ListBox. Here is the code:
'//////////////////////////////////////////////////////////////////////////////////////////
'// Draglistbox
'// This uses an ordinary listbox and makes it a draglistbox.
'// The only thing you need to do is to call DRAGLIST_MakeDragList() only once.
'// You can use WM_INITDIALOG for that.
'// A special windowmessage should be used to interact.
'// A small example:
'
'#If 0
'
' Select Case CbMsg
' Case %WM_INITDIALOG
'
' '(100 = listbox ID)
' DRAGLIST_MakeDragList GetDlgItem( CbHndl, 100 )
'
' Case WM_DL_NOTIFY
'
' '// Process draglist messages.
' '// If you are using a dialogbox (like DDT), set the bIsDialog to true
' Function = DRAGLIST_NOTIFY( CbHndl, CbMsg, CbWParam, CbLParam, 1 )
' Exit Function
'
'#EndIf
'
'//////////////////////////////////////////////////////////////////////////////////////////
'//////////////////////////////////////////////////////////////////////////////////////////
'// Internal use
'//////////////////////////////////////////////////////////////////////////////////////////
Global WM_DL_NOTIFY As Long
Global DL_HCURSOR As Long
Global DL_lpdi As DRAGLISTINFO Ptr
Global DL_nItem As Long
Global DL_nItemToMove As Long
Global DL_LBItemFromPt As Dword
Declare Function DRAGLIST_LoadCursor() As Long
Declare Function DRAGLIST_Initialize() As Long
Declare Function DRAGLIST_LBItemFromPt( ByVal hLB As Dword, ByVal x As Long, ByVal y As Long, ByVal bAutoScroll As Long ) As Long
'//////////////////////////////////////////////////////////////////////////////////////////
'// Public use
'//////////////////////////////////////////////////////////////////////////////////////////
'// Call this once to initialize your listbox.
'// This makes the listbox behave as a draglistbox.
Function DRAGLIST_MakeDragList( ByVal hWnd As Long ) As Long
stat& = DRAGLIST_Initialize()
If stat& = 0 Then Exit Function
Function = MakeDragList( hWnd )
DL_nItemToMove = -1
End Function
'//////////////////////////////////////////////////////////////////////////////////////////
'// Internal use
'//////////////////////////////////////////////////////////////////////////////////////////
Function DRAGLIST_Initialize() As Long
Dim hLib As Long
If WM_DL_NOTIFY = 0 Then WM_DL_NOTIFY = RegisterWindowMessage( $DRAGLISTMSGSTRING )
If DL_HCURSOR = 0 Then DL_HCURSOR = DRAGLIST_LoadCursor()
If CLng( DL_LBItemFromPt ) = 0 Then
InitCommonControls
'// Solve a problem with the declaration (LBItemFromPt)
hLib = LoadLibrary( "COMCTL32.DLL" )
If hLib = 0 Then Exit Function
DL_LBItemFromPt = GetProcAddress( hLib, "LBItemFromPt" )
FreeLibrary hLib
If CLng( DL_LBItemFromPt ) = 0 Then Exit Function
End If
Function = 1
End Function
Function DRAGLIST_NOTIFY( _
ByVal hWnd As Long _
, ByVal wMsg As Long _
, ByVal wParam As Long _
, ByVal lParam As Long _
, ByVal bIsDialog As Long _
) As Long
Dim a As Long
Dim T As String
If lParam = 0 Then Exit Function
DL_lpdi = lParam
Select Case @DL_lpdi.uNotification
Case %DL_BEGINDRAG
Call Dword DL_LBItemFromPt Using DRAGLIST_LBItemFromPt( @DL_lpdi.hWnd, @DL_lpdi.ptCursor.x, @DL_lpdi.ptCursor.y, 1 ) To DL_nItemToMove
If bIsDialog Then SetWindowLong hWnd, %DWL_MSGRESULT, 1
Function = 1
Case %DL_DRAGGING
Call Dword DL_LBItemFromPt Using DRAGLIST_LBItemFromPt( @DL_lpdi.hWnd, @DL_lpdi.ptCursor.x, @DL_lpdi.ptCursor.y, 1 ) To DL_nItem
DrawInsert hWnd, @DL_lpdi.hWnd, DL_nItem
If DL_nItem <> -1 Then
SetCursor DL_HCURSOR
Exit Function
End If
If bIsDialog Then
Function = 1: SetWindowLong hWnd, %DWL_MSGRESULT, %DL_STOPCURSOR
Else
Function = %DL_STOPCURSOR
End If
Case %DL_CANCELDRAG
DL_nItemToMove = -1
Case %DL_DROPPED
Call Dword DL_LBItemFromPt Using DRAGLIST_LBItemFromPt( @DL_lpdi.hWnd, @DL_lpdi.ptCursor.x, @DL_lpdi.ptCursor.y, 1 ) To DL_nItem
If DL_nItem <> -1 Then
a = SendMessage( @DL_lpdi.hWnd, %LB_GETTEXTLEN, DL_nItemToMove, ByVal 0& )
T = String$( Max( 1, a ), 0 )
a = SendMessage( @DL_lpdi.hWnd, %LB_GETITEMDATA, DL_nItemToMove, ByVal 0& )
SendMessage @DL_lpdi.hWnd, %LB_GETTEXT, DL_nItemToMove, ByVal StrPtr( T )
SendMessage @DL_lpdi.hWnd, %LB_DELETESTRING, DL_nItemToMove, ByVal 0&
DL_nItem = SendMessage( @DL_lpdi.hWnd, %LB_INSERTSTRING, DL_nItem, ByVal StrPtr( T ) )
SendMessage @DL_lpdi.hWnd, %LB_SETCURSEL, DL_nItem, ByVal 0&
If a Then SendMessage @DL_lpdi.hWnd, %LB_SETITEMDATA, DL_nItem, ByVal a
DrawInsert hWnd, @DL_lpdi.hWnd, -1
DL_nItemToMove = -1
End If
End Select
End Function
Sub DRAGLIST_HORIZONTALCURSOR( T As String )
Dim a&: For a& = 1 To DataCount: T = T & Read$( a& ): Next a&
Data 000002000100202000000F000F003001000016000000280000002000000040000000010001
Data 0000000000000100000000000000000000000000000000000000000000FFFFFF0000000000
Data 00000000000000000000000000000000000000000000000000000000000100000002800000
Data 044000000820000006C0000002800001FEFF00010001000100010001FEFF00000280000006
Data C0000008200000044000000280000001000000000000000000000000000000000000000000
Data 00000000000000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
Data FFFFFFFFFFFFFFFFFFFEFFFFFFFC7FFFFFF83FFFFFF01FFFFFF83FFFFFFC7FFFFE0000FFFE
Data 0000FFFE0000FFFE0000FFFFFC7FFFFFF83FFFFFF01FFFFFF83FFFFFFC7FFFFFFEFFFFFFFF
Data FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
End Sub
Type DRAGLIST_TAGICONDIR
idReserved As Word '// Reserved (must be 0)
idType As Word '// Resource Type (1 For icons)
idCount As Word '// How many images?
End Type
Type DRAGLIST_TAGICONDIRENTRY
bWidth As Byte '// Width, In Pixels, of the Image
bHeight As Byte '// Height, In Pixels, of the Image
bColorCount As Byte '// Number of colors In Image (0 If >=8bpp)
bReserved As Byte '// Reserved ( must be 0)
wPlanes As Word '// Color Planes
wBitCount As Word '// Bits per pixel
dwBytesInRes As Dword '// How many bytes In this resource?
dwImageOffset As Dword '// Where In the file is this image?
End Type
'// Internal use only, creates the cursor.
Function DRAGLIST_LoadCursor() As Long
Dim a As Long
Dim T1 As String
Dim T2 As String
Dim pIconDir As DRAGLIST_TAGICONDIR Ptr
Dim pIconDirEntry As DRAGLIST_TAGICONDIRENTRY Ptr
DRAGLIST_HORIZONTALCURSOR T1
For a = 1 To Len( T1 ) Step 2
T2 = T2 & Chr$( Val( "&H" & Mid$( T1, a , 2 ) ) )
Next a
pIconDir = StrPtr( T2 )
If @pIconDir.idCount < 1 Then Exit Function
pIconDirEntry = pIconDir + Len( @pIconDir )
Function = CreateIconFromResource( _
ByVal pIconDir + @pIconDirEntry.dwImageOffset _
, @pIconDirEntry.dwBytesInRes _
, @pIconDir.idType _
, &H30000& _
)
End Function
'------------------------------------------------------------------------------------------------------------------------
Function FRMTABORDER_CUSTOM ( _
hWndForm As Dword, _ ' handle of Form
wMsg As Long, _ ' type of message
wParam As Dword, _ ' first message parameter
lParam As Long _ ' second message parameter
) As Long
Select Case wMsg
Case WM_DL_NOTIFY
DL_lpdi = lParam ' needed in order to zero in on the %DL_DROPPED message
Function = DRAGLIST_NOTIFY( hWndForm, wMsg, wParam, lParam, 0 ) ' process all drag listbox messages
If @DL_lpdi.uNotification = %DL_DROPPED Then
SaveTabOrder
End If
Exit Function
...
...
...
Thanks Paul for the code.
I will try to understand it. (This will take me a while)
Do I have to place it in a separate Module?
Klaas.
For FireFly, I placed the code in a separate text file (I called it modDragList.inc). I then #INCLUDE'd it into the FireFly application in FF_AppStart.