Visual Basic Foro
Programación => Visual Basic 6 => Mensaje iniciado por: raul338 en Febrero 25, 2011, 09:19:14 pm
-
Buenas, siguiendo modificando el ucListView de Carles P.V. logre hacer lo siguiente
(http://i56.tinypic.com/11jbxjb.jpg)
Active Column: Marca la columna Activa
(http://i54.tinypic.com/24yqy49.jpg)
(http://i52.tinypic.com/168swlx.jpg)
Icon Spacing: Pedido por mi amigo enterariel :P logre implementar esto :)
(http://i51.tinypic.com/2ex4t45.jpg)
Menu en los headers y FilterBar (IE5): Los que tengan windows 7 veran que en el explorador tiene un menu de filtro, bueno, buscando como simular eso, no encontre el filtro, sino la opcion de mostrar un boton como para mostrar un menu :P
Ademas de la FilterBar, un extra agregado a partir de Internet Explorer 5 y casi indocumentado, listo para usar (puede tener ciertos bugs, ej, cada vez que se cambia, se manda como que se cambio 4 veces seguidas xD)
(http://i51.tinypic.com/ulmja.jpg)
Seleccion estilo windows 7 mejorada
Ya no se muestra un recuadro gris (focusRect) cuando se selecciona un item :)
Ademas de una clase para cargar facilmente Iconos desde recursos o archivos externos, y asi usarlos en el ucListView y en mis proximos controles (ya tengo algunos avanzados que pronto liberaré :P),
Como se usa?
asi
Dim ilLarge As clsImageList ' ImageList for large icons
Set ilLarge = New clsImageList
' Iniciamos (con tamaño)
Call ilLarge.Initialize(48, 48)
' y cargamos los iconos (Pueden ser archivos o recursos, definiendolos en el segundo parametro opcional)
Call ilLarge.AddIcon(App.Path & "\Graphics\document.ico")
Call ilLarge.AddIcon(App.Path & "\Graphics\box.ico")
' Y lo enlazamos al listview
' Esta linea fue agregada al ucListView especialmente para esta clase, pero funciona con otras clases manejadoras como la de BlackZeroX
Call .DuplicateImageListLarge(ilLarge.Handle)
' Siempre liberar recursos :)
Set ilLarge = Nothing
La clase iba a manejar imagelist, pero ya que la mayoria de los controles pide iconos solamente, lo hice para esos controles xD
Actualizado!!
Agregadas las propiedades
ItemWidth, ItemHeight, ItemTop e ItemLeft y ademas, SubItemWidth, SubItemHeight, SubItemTop e SubItemLeft (Que ya uno sabe para que es :xD) Pero ojo, Tener encuenta que Left y Top toman como (0,0) el left y top del ucListView! (vean el codigo de ejemplo)
Agregado el Evento Scroll con 2 parametros, para la vista iconos, es la distancia X e Y que se movio. para todas las demas vistas es la cantidad de items/columnas/filas que se movieron (cuando es negativo es izquierda y positivo derecha, prueben jugando con Debug.Print)
(http://i52.tinypic.com/11vimtf.png)
En el proyecto tambien se incluye un formulario para hacer esto, Poner cualquier cosa con handle como un SubItem, tengan en cuenta que la forma en la que esta hecho puede explotar (o no) si se eliminan items. Esta diseñado solo para agregar items
Sin mas, el link de descarga
ucListView + clsIconList (http://www.mediafire.com/?43ou0pb850y1pnk)
Despues pongo algun tutorial rapido de como se usa, o algun manual de referencia (?)
-
0_0 +1 :D
-
y como hago para poner un boton o combo dentro la columna y en cada celda
-----------------------------------------------------------------
---------------|-------------------|---------------------------------
| | boton
| | boton
| | boton
| | boton
| | boton
-
O.o
-
como biene quedando esto che!!!, Felicitaciones.
-
Gracias Leandro!
franklizardo, se puede hacer mediante el evento OnPrepaintSubitem y obteniendo el Rect del subitem en cuestion. En 2 dias te hare un ejemplo, ya que estoy rindiendo estos dias y .... quieren que dedique tiempo al estudio xDD
-
ok raul tare esperando como poner un boton y que permanesca ahi
-
Ahora subo el proyecto con el codigo de 2 formularios, y agregadas las propiedades
ItemWidth, ItemHeigth, ItemLeft, ItemTop y sus respectivos SubItem (width, left, heigth y top :P) y el Evento Scroll :P
(http://i52.tinypic.com/11vimtf.png)
-
excelente raul solo falta el link solo me faltaria que las columnas sean multiline
---------------------------------------------------------------------
linea1 | fecha | fecha |
linea2 | | Nacimiento |
--------------------------------------------------------------------
-
@raul338: che me parece q tenes los botones mas arriba de lo que deberian!
de todas maneras, perfecto!
-
hola raul el control con los botones funciona perfectamente solo que cuando muevo la columna los botones permancen en su lugar y tambien cuando se reduce la columna los botones no se mueven con las columnas su´pongo que cuando le doy click para ordenar no va ordenar los botones naa masss hasta mañana
-
coco, es un detallito xD, es lo que me da el GetSubItemRect y se puede calibrar con +/-1 etc
y frank (no se tu nombre de usuario XD) emm... hay que usar los eventos!!! En cuanto al ordenamiento, si que se ordenan ya que tambien se actualizan las posicion de los items!!!
-
excelente raul solo falta el link solo me faltaria que las columnas sean multiline
---------------------------------------------------------------------
linea1 | fecha | fecha |
linea2 | | Nacimiento |
--------------------------------------------------------------------
Eso no se si sea posible ._. Prueba poniendo un vbCrLf al string del header....
-
puse asi y no me funciono tambien probe con ch(13) y naaaaa
-
Estuve buscando, y es imposible hacerlo D: o sea, el mismisimo control Header te lo limita, solucion? Owner Drawing (pesado xD) o usar otra cosa (Labels, etc)
-
Moutro hijo de quien sos "bill gate" o "linus torvald", jejeje espectacular el control man felicitaciones...
-
Hola! Gracias por esta fuente agradable, pero podría subir un sencillo con sólo un informe listview bien con pequeño icono y por favor todas las otras cosas?
¡Gracias!
EN:
Hi! Thank you for this nice source but could you upload a simple one with just a good listview report with small icon and every other things please?
Thank you!
-
I don't get what you call "simple good listview report" ::)
You just have to copy de ucListView.ctl, the mListViewEx.bas, the mIOleInPlaceActivate.bas (I'm trying to join it to the ctl, but it's difficult xD) and the OleGuids3.tlb (by removing mIOleInPlaceActivate.bas I want to remove this tlb too). And add those to your project. The tlb goes in the References section (Project -> References -> Add Reference)
And then add the listView to your form, and add this code in the form Load or whether you want to init de listview
With ucListView1
Call .Initialize
Call .InitializeImageListHeader ' You must Call this even if you won't use images on the headers, or you will get a Blank header
' Add Icons
Dim ilSmall As clsIconList ' My Class to load icons, or use .ImageListSmall_AddBitmap or .ImageListSmall_AddIcon to add by Handle
' My class only add icons, i didn't want to add bmp or jpg, but... it's not difficult to replace, and i'll add it in the next version
Set ilSmall = New clsIconList
Call ilSmall.Initialize(16, 16) ' Size of the icons
Call ilSmall.AddIcon(App.Path & "\Graphics\document.ico") ' Add a icon by file
Call ilSmall.AddIcon("document", true) ' Add a icon by resource
Call .DuplicateImageListSmall(ilSmall.Handle) ' Set the imagelist to the ucListView
Set ilSmall = Nothing ' Free resources :D
' Add Headers (id, Caption, Width, Align, Image)
' In id you can use .ColumnCount to make it "auto"
Call .ColumnAdd(0, "Header 1", 150, [caLeft], 0)
Call .ColumnAdd(1, "Header 2", 150, [caLeft], 0)
' Add Items (id, Caption, ident, iconId) ' With ident you can simulate a TreeListView x)
Call .ItemAdd(i, "Item " & i, 0, 1) ' Icon: document.ico
' Set SubItems ( itemId, column, caption, icon) ' For Icon you must Enable "SubItemIcons"
Call .SubItemSet(i, 1, CInt(Rnd * 10), 0)
' Set Properties
.ViewMode = vmDetails ' Report
End With
And that's the basics, if you want add other properties, you can copy&paste from the property's CheckBox and set in the code.
Example, if you want to add Multiselect, you'll see
Private Sub chkMultiselect_Click()
ucListView1.MultiSelect = CBool(chkMultiselect)
End Sub
you only have to add
.MultiSelect = True
to your "Set Properties" section :D
NOTE:
You must put this in your form to work well with de XP Styles manifest (by file or resource)
Private Declare Sub InitCommonControls Lib "COMCTL32" ()
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function LoadLibraryA Lib "kernel32" (ByVal lpLibFileName As String) As Long
' This goes to the first form show
Private Sub Form_Initialize()
hMod = LoadLibraryA("shell32.dll")
Call InitCommonControls
End Sub
' And this to the last form, the "are you sure to exit" form
Private Sub Form_Terminate()
Call FreeLibrary(hMod)
End Sub
-
Thank you man! Your listview looks so good you know that? Do we can Drag and Drop on it?
EDIT: Did what you said and see:
(http://img145.imageshack.us/img145/1020/16182415.png)
-
Do we can Drag and Drop on it?
Not Yet >:(
:| you didn't saw all my code. Check the ScrollBar in the code seccion
If you see, there is an "' Add Headers (id, Caption, Width, Align, Image)" and you cut it up rigth there xD
' Add Headers (id, Caption, Width, Align, Image)
' In id you can use .ColumnCount to make it "auto"
Call .ColumnAdd(0, "Header 1", 150, [caLeft], 0)
Call .ColumnAdd(1, "Header 2", 150, [caLeft], 0)
' Add Items (id, Caption, ident, iconId) ' With ident you can simulate a TreeListView x)
Call .ItemAdd(i, "Item " & i, 0, 1) ' Icon: document.ico
' Set SubItems ( itemId, column, caption, icon) ' For Icon you must Enable "SubItemIcons"
Call .SubItemSet(i, 1, CInt(Rnd * 10), 0)
' Set Properties
.ViewMode = vmDetails ' Report
End With
Rembember to put the Manifest resource to the EXE or the vb6.exe if you want things like Groups, FilterHeader, etc
Using the XN Resource Editor (follow link and look for it) (http://www.leandroascierto.com.ar/foro/index.php?topic=69.0)
You open it, look for vb6.exe in (Program Files)/Microsoft Visual Studio/VB98
(http://i54.tinypic.com/2r23net.png)
And then you save it! (REMENBER TO DO A BACK UP!)
-
I'm really stoned man. Could you simply just upload a simple project only using listview report with multiselect etc.
Thanks man
-
This is what I would like to have without the checkboxes etc. Only one listview. (Icons too)
(http://img233.imageshack.us/img233/6894/54848089.png)
Thanks :D
-
Listview may get repaint issue when groups are collapsing or expanding with scrollbar presenting or disappearing. Tested on Win7.
-
Confirmed if Listview always got vertical scrollbar before/after groups collapsed,repaint is always OK.
Confirmed if Listview always don't have vertical scrollbar before/after groups collapsed,repaint is always OK.
Edited:
I am trying to subclass WM_LBUTTONUP, WM_RBUTTONUP, WM_MBUTTONUP and NM_CLICK, NM_RCLICK and eat them to use our own codes. Still studying in.
-
The progress bar can't draw properly after groupheaders added.
The TopIndex is always 0 when Listview got groups according to MSDN. So
all calculation in WM_PAINT is not right.
Using WM_PAINT is not a good idea. We should draw by NMLVCUSTOMDRAW.
After using NMLVCUSTOMDRAW:
(http://hi.csdn.net/attachment/201105/27/1705918_1306469265eFrq.jpg)
-
raul338,
thank you very much for the updated ucListView control. This is exactly what I have needed.
one question, regarding the "Header Filter", this functionality seems like "Find <text> in the Column".
would it be possible to change this functionality to be "only show listview items that contain <text> in the Column"?
some ideas I had: change the font to White for all other not matching list results, thus hiding them.
otherwise, it looks like I will have to:
1. keep a 2nd data structure containing the ListView items.
2. .Clear the ListView
3. .Add back the ListView matching results
4. When finished with this Filter, then .Clear the ListView and .Add back the original ListView items.
My spanish is bad, but hopefully my question/issue makes sense to you?
-
Actually there a bunch of bugs that Jen and I are fixing :)
For "hiding" items, well, it cannot be done simply like the Common Controls OCX
But there's a trick. Enabling groups (without adding a group) doesn't show all items wich group is 0 or -1. So, the trick is to set 1 to the "visible" items and -1 to "not visible" items :) and voila! (I didnt tried this, but it should work)
-
Thanks for the suggestion, I will try that when I get home tonight.
Should that work on WinXP too or is that ListView "group feature" only available in Windows 7 (or Vista)?
-
Yes :) I shouldnt be a problem. I'll Try that later :)
-
Thanks for the suggestion, I will try that when I get home tonight.
Should that work on WinXP too or is that ListView "group feature" only available in Windows 7 (or Vista)?
WinXP only shows Group without Substitle,Footer and collapse button. That means you can't collapse the groups. In Vista/Win7,the looking is better than ever.
-
WinXP only shows Group without Substitle,Footer and collapse button. That means you can't collapse the groups. In Vista/Win7,the looking is better than ever.
Thanks Jen. So if I only want to use the groups to filter/hide list items as raul338 has suggested, "set 1 to the "visible" items and -1 to "not visible" items", would that require collapsing? I wouldnt be home for a couple more hours to try this out. :)
-
To answer my question above...
Using "Groups" to hide items works beautifully on Windows 7, but does not work on WinXP.
-
Sorting of Columns when in Group Mode on Windows XP does not work.
EDIT: this does not work on Windows XP Service Pack 2, but it does work for Service Pack 3.
-
greetings again.
Here is the work I have done to modify this ucListview to fit my needs (basic theme-aware ListView with Sort and Filter)
new:
FilterItems (works both WinXP + Vista/7)
FilterEnabled (bool property)
FreezePaint (use before/after large updates to ListView)
DoubleBuffer style (reduces flicker when resizing, moving, adding, etc: http://www.codeproject.com/KB/list/listviewxp.aspx)
minor:
removed 'force admin' from the manifest file for the compiled .exe
fixed backgroundimage bugs (clears BackGroundImage and also proper loading of images in the example)
http://www.convivea.com/download/ucListView2.5.chip.rar
let me know.
thanks,
chip
-
Muy buenos cambios!! ;)
Otra funcionalidad para window 7 y vista
Private Const HDS_CHECKBOXES As Long = &H400
Public Property Get ColumnCheckValue(ByVal Column As Long) As Boolean
Dim uLVC As LVCOLUMN
If (m_hListView And m_hHeader) Then
With uLVC
.mask = LVCF_FMT
Call SendMessage(m_hListView, LVM_GETCOLUMN, Column, uLVC)
ColumnCheckValue = uLVC.fmt And HDF_CHECKED
End With
End If
End Property
Public Property Let ColumnCheckValue(ByVal Column As Long, ByVal value As Boolean)
Dim uLVC As LVCOLUMN
If (m_hListView And m_hHeader) Then
With uLVC
.mask = LVCF_FMT
Call SendMessage(m_hListView, LVM_GETCOLUMN, Column, uLVC)
uLVC.fmt = (uLVC.fmt And Not HDF_CHECKED) Or (value And HDF_CHECKED)
Call SendMessage(m_hListView, LVM_SETCOLUMN, Column, uLVC)
End With
End If
End Property
Public Property Get ColumnCheckStyle(ByVal Column As Long) As Boolean
Dim uLVC As LVCOLUMN
If (m_hListView And m_hHeader) Then
With uLVC
.mask = LVCF_FMT
Call SendMessage(m_hListView, LVM_GETCOLUMN, Column, uLVC)
ColumnCheckStyle = uLVC.fmt And HDF_CHECKBOX
End With
End If
End Property
Public Property Let ColumnCheckStyle(ByVal Column As Long, ByVal value As Boolean)
Dim uLVC As LVCOLUMN
If (m_hListView And m_hHeader) Then
With uLVC
.mask = LVCF_FMT
Call SendMessage(m_hListView, LVM_GETCOLUMN, Column, uLVC)
uLVC.fmt = (uLVC.fmt And Not HDF_CHECKBOX) Or (value And HDF_CHECKBOX)
Call SendMessage(m_hListView, LVM_SETCOLUMN, Column, uLVC)
End With
End If
End Property
Public Property Get ColumnCheckBoxes() As Boolean
If m_hListView And m_hHeader Then ColumnCheckBoxes = GetWindowLong(m_hHeader, GWL_STYLE) And HDS_CHECKBOXES
End Property
Public Property Let ColumnCheckBoxes(ByVal value As Boolean)
If m_hListView And m_hHeader Then
Call SetWindowLong(m_hHeader, GWL_STYLE, GetWindowLong(m_hHeader, GWL_STYLE) And Not HDS_CHECKBOXES Or (value And HDS_CHECKBOXES))
End If
End Property
ucListView1.ColumnCheckBoxes = True
ucListView1.ColumnCheckStyle(0) = True
ucListView1.ColumnCheckValue(0) = True
para los eventos
Private Const HDN_ITEMCHECK As Long = (HDN_FIRST - 16) 'The name is invented, not found his real name
Public Event ColumnCheck(Column As Long, Value As Boolean)
Case HDN_ITEMCHECK
Call CopyMemory(uNMHE, ByVal lParam, Len(uNMHE))
RaiseEvent ColumnCheck(uNMHE.iItem, Not Me.ColumnCheckValue(uNMHE.iItem))
-
Actually there a bunch of bugs that Jen and I are fixing :)
For "hiding" items, well, it cannot be done simply like the Common Controls OCX
But there's a trick. Enabling groups (without adding a group) doesn't show all items wich group is 0 or -1. So, the trick is to set 1 to the "visible" items and -1 to "not visible" items :) and voila! (I didnt tried this, but it should work)
Hello, after a long (?) time, I found a way to do what I wanted to explain :)
Only show Items with certain Filter
Private Sub ucListView1_FilterTimeout(ByVal Column As Long)
With ucListView1
Dim i As Integer, s As String
If .ColumnFilterText(Column) <> "" Then
.GroupsEnable = False
.GroupClear
Call .GroupAdd(0, "Resultado de busqueda")
For i = 0 To .Count - 1
If Column = 0 Then
s = .ItemText(i)
Else
s = .SubItemText(i, Column)
End If
If s Like .ColumnFilterText(Column) Then
.ItemGroup(i) = 0
Else
.ItemGroup(i) = 1 ' Grupo inexistente, no se mostrará
' The group with ID 1 doesn't exists, so, the item will not be shown
End If
Next
.GroupsEnable = True
Else
.GroupsEnable = False
End If
End With
End Sub
When GroupsEnable is setted to False all items with no valid group ID isn't shown :)
Testing:
In the second Column, I filter by "6" :P and the others items just disappear until i set the field to blank. In the last else you have to back to normal your listview if you were using groups
(http://i51.tinypic.com/29c6lph.jpg)
I'm still working fixing several bugs and Adding features ;) Just Wait
-
hi guys.. I fixed the Public Property Get GroupHeaderText(ByVal GroupID As Long) As String
(previously crashed on Windows XP)
Declares
'ADDED BY CHIP!
Private Declare Function lstrcpyA Lib "Kernel32.dll" ( _
ByVal lpString1 As String, ByVal lpString2 As Long) As Long
Private Declare Function lstrlenA Lib "Kernel32.dll" (ByVal lpString As Long) As Long
Private Declare Function lstrcpyW Lib "Kernel32.dll" ( _
ByVal lpString1 As Long, ByVal lpString2 As Long) As Long
Private Declare Function lstrlenW Lib "Kernel32.dll" (ByVal lpString As Long) As Long
Private Type LVGROUP_lp
cbSize As Long
mask As Long
pszHeader As Long
cchHeader As Long
pszFooter As Long
cchFooter As Long
iGroupId As Long
stateMask As Long
State As Long
uAlign As Long
' IF >= WinVista
pszSubtitle As Long
cchSubtitle As Long
pszTask As Long
cchTask As Long
pszDescriptionTop As Long
cchDescriptionTop As Long
pszDescriptionBottom As Long
cchDescriptionBottom As Long
iTitleImage As Long
iExtendedImage As Long
iFirstItem As Long ' Read only
cItems As Long ' Read only
pszSubsetTitle As Long ' NULL if group is not subset
cchSubsetTitle As Long
End Type
Public Property Get GroupHeaderText(ByVal GroupID As Long) As String
'EDITED BY CHIP! - FIXED GET TEXT POINTERS - ADDED LVGROUP_LP DATA TYPE
If m_hListView Then
Dim tLVG As LVGROUP_lp
Dim sBuffer As String
sBuffer = Space$(260)
With tLVG
.cbSize = Len(tLVG)
.mask = LVGF_HEADER
.cchHeader = 260
.pszHeader = StrPtr(sBuffer)
End With
If SendMessage(m_hListView, LVM_GETGROUPINFO, GroupID, tLVG) <> -1 Then GroupHeaderText = CopyString(ByVal tLVG.pszHeader, True)
End If
End Property
Private Function CopyString(ByVal inPtr As Long, _
Optional ByVal inAsWide As Boolean = False) As String
Dim BufLen As Long
If (inAsWide) Then
BufLen = lstrlenW(inPtr)
If (BufLen > 0) Then
CopyString = Space$(BufLen)
Call lstrcpyW(ByVal StrPtr(CopyString), inPtr)
End If
Else
BufLen = lstrlenA(inPtr)
If (BufLen > 0) Then
CopyString = Space$(BufLen)
Call lstrcpyA(CopyString, inPtr)
End If
End If
End Function
Note, you do not need the CopyString function, but I have included it for reference. If you do not wish to include the function, then you can copy the Pointer to the String using: lstrcpyW (in cases that are not Unicode, then you would use lstrcpyA).
Here is a slightly optimized Let GroupHeaderText( that uses StrPtr() instead of the StrConv().
Public Property Let GroupHeaderText(ByVal GroupID As Long, newText As String)
If m_hListView Then
Dim group As LVGROUP_lp
With group
.cbSize = Len(group)
.mask = LVGF_HEADER
.pszHeader = StrPtr(newText)
.cchHeader = Len(.pszHeader)
End With
Call SendMessage(m_hListView, LVM_SETGROUPINFO, GroupID, group)
End If
End Property
Finally, I will have an updated version of my FilterItems() that includes support for filtering WHILE they groups are displayed (very cool), both Windows Vista/7 & Windows XP.
Thanks guys!
-
Gracefully :) resolve UNICODE for GroupHeader/GroupFooter/GroupSubtitle.
Public Enum eGroupInfo
[iGroupHeaderText] = 0
[iGroupFooterText] = 1
[iGroupSubtitle] = 2
End Enum
Private Type LVGROUPW
cbSize As Long
Mask As Long
pszHeader As Long
cchHeader As Long
pszFooter As Long
cchFooter As Long
iGroupId As Long
stateMask As Long
State As Long
uAlign As Long
' SO >= WinVista
pszSubtitle As Long
cchSubtitle As Long
pszTask As Long
cchTask As Long
pszDescriptionTop As Long
cchDescriptionTop As Long
pszDescriptionBottom As Long
cchDescriptionBottom As Long
iTitleImage As Long
iExtendedImage As Long
iFirstItem As Long ' Read only
cItems As Long ' Read only
pszSubsetTitle As Long ' NULL if group is not subset
cchSubsetTitle As Long
End Type
Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Private Declare Function SendMessageLongW Lib "user32" Alias "SendMessageW" (ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Private Declare Function SendMessageW Lib "user32" (ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
'//
'String manuplate (Unicode/ANSI)
Private Declare Function lstrcpyW Lib "kernel32" (lpString1 As Any, lpString2 As Any) As Long
Private Declare Function lstrlenW Lib "kernel32" (lpString As Any) As Long
Private Declare Function lstrcpyA Lib "kernel32" (lpString1 As Any, lpString2 As Any) As Long
Private Declare Function lstrlenA Lib "kernel32" (lpString As Any) As Long
Private Declare Function GetProcessHeap Lib "kernel32" () As Long
Private Declare Function HeapAlloc Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Long) As Long
Private Declare Function HeapSize Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Long) As Long
'// Heap constants
Private Const HEAP_NO_SERIALIZE As Long = &H1
Private Const HEAP_ZERO_MEMORY As Long = &H8
Private Const HEAP_GENERATE_EXCEPTIONS As Long = &H4
'// LocalAlloc flags
Private Const LMEM_FIXED As Long = &H0
Private Const LMEM_ZEROINIT As Long = &H40
Private Const LPTR As Long = (LMEM_FIXED Or LMEM_ZEROINIT)
Private Const GMEM_FIXED As Long = &H0
Private Const GMEM_ZEROINIT As Long = &H40
Private Const GPTR As Long = (GMEM_FIXED Or GMEM_ZEROINIT)
Private Declare Function LocalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal wBytes As Long) As Long
Private Declare Function LocalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function LocalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function LocalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Public Property Get GroupHeaderText(ByVal GroupID As Long) As String
Dim tGRP As LVGROUPW
tGRP.cbSize = Len(tGRP)
tGRP.Mask = LVGF_HEADER
GroupHeaderText = psGetGroupText(GroupID, tGRP, iGroupHeaderText)
End Property
Public Property Let GroupHeaderText(ByVal GroupID As Long, Text As String)
'//XP/SP3 doesn't support,For Vista/Win7 above
Dim tGRP As LVGROUPW
tGRP.cbSize = Len(tGRP)
tGRP.Mask = LVGF_HEADER
If Not pbSetGroupInfo(GroupID, tGRP, Text) Then
'MsgBox "Failed to set groupheader."
End If
End Property
Private Function psGetGroupText(ByVal GroupID As Long, _
tGRP As LVGROUPW, _
Optional ByVal iOption As eGroupInfo = iGroupHeaderText) As String
Dim lR As Long
Dim hMem As Long
Dim lPtrMem As Long
Dim b() As Byte
Dim sOut As String
Dim iPos As Long
With tGRP
Select Case iOption
Case iGroupHeaderText
.cchHeader = 260
.pszHeader = pHeapAlloc(.cchHeader * 2)
lR = SendMessage(m_hListView, LVM_GETGROUPINFO, GroupID, tGRP)
If Not lR = GroupID Then
Call pHeapFree(.pszHeader)
Exit Function
End If
sOut = pStringFromPointer(.pszHeader, m_bIsNT, True)
iPos = InStr(sOut, vbNullChar)
If (iPos > 1) Then
psGetGroupText = Left(sOut, iPos - 1)
Else
psGetGroupText = sOut
End If
Exit Function
Case iGroupFooterText
.cchFooter = 260
.pszFooter = pHeapAlloc(.cchFooter * 2)
lR = SendMessage(m_hListView, LVM_GETGROUPINFO, GroupID, tGRP)
If Not lR = GroupID Then
Call pHeapFree(.pszFooter)
Exit Function
End If
sOut = pStringFromPointer(.pszFooter, m_bIsNT, True)
iPos = InStr(sOut, vbNullChar)
If (iPos > 1) Then
psGetGroupText = Left(sOut, iPos - 1)
Else
psGetGroupText = sOut
End If
Exit Function
Case iGroupSubtitle
.cchSubtitle = 260
.pszSubtitle = pHeapAlloc(.cchSubtitle * 2)
lR = SendMessage(m_hListView, LVM_GETGROUPINFO, GroupID, tGRP)
If Not lR = GroupID Then
Call pHeapFree(.pszSubtitle)
Exit Function
End If
sOut = pStringFromPointer(.pszSubtitle, m_bIsNT, True)
iPos = InStr(sOut, vbNullChar)
If (iPos > 1) Then
psGetGroupText = Left(sOut, iPos - 1)
Else
psGetGroupText = sOut
End If
Exit Function
End Select
End With
End Function
Private Function pbSetGroupInfo(ByVal GroupID As Long, _
tGRP As LVGROUPW, _
ByVal sText As String) As Boolean
Dim lR As Long
Dim hMem As Long
Dim lPtrMem As Long
Dim b() As Byte
Dim sAllocText As String
With tGRP
If .Mask = LVGF_HEADER Then
If Len(sText) > 0 Then
b = sText
ReDim Preserve b(0 To UBound(b) + 2) As Byte
Else
ReDim b(0 To 1) As Byte
End If
.cchHeader = (UBound(b) + 1) / 2
hMem = pHeapAlloc(Len(sText) * 2 + 2)
CopyMemory ByVal hMem, b(0), .cchHeader * 2
.pszHeader = hMem
If Not GroupID = SendMessage(m_hListView, LVM_SETGROUPINFO, GroupID, tGRP) Then
Call pHeapFree(.pszHeader)
Exit Function
End If
Call pHeapFree(.pszHeader)
pbSetGroupInfo = True
Exit Function
End If
If .Mask = LVGF_FOOTER Then
If Len(sText) > 0 Then
b = sText
ReDim Preserve b(0 To UBound(b) + 2) As Byte
Else
ReDim b(0 To 1) As Byte
End If
.cchFooter = (UBound(b) + 1) / 2
hMem = pHeapAlloc(Len(sText) * 2 + 2)
CopyMemory ByVal hMem, b(0), .cchFooter * 2
.pszFooter = hMem
If Not GroupID = SendMessage(m_hListView, LVM_SETGROUPINFO, GroupID, tGRP) Then
Call pHeapFree(.pszFooter)
Exit Function
End If
Call pHeapFree(.pszFooter)
pbSetGroupInfo = True
Exit Function
End If
If .Mask = LVGF_SUBTITLE Then
If Len(sText) > 0 Then
b = sText
ReDim Preserve b(0 To UBound(b) + 2) As Byte
Else
ReDim b(0 To 1) As Byte
End If
.cchSubtitle = (UBound(b) + 1) / 2
hMem = pHeapAlloc(Len(sText) * 2 + 2)
CopyMemory ByVal hMem, b(0), .cchSubtitle * 2
.pszSubtitle = hMem
If Not GroupID = SendMessage(m_hListView, LVM_SETGROUPINFO, GroupID, tGRP) Then
Call pHeapFree(.pszSubtitle)
Exit Function
End If
Call pHeapFree(.pszSubtitle)
pbSetGroupInfo = True
Exit Function
End If
End With
End Function
' Allocates an empty heap buffer of the specified size. This
' function is used when receiving strings from APIs, for example.
Private Function pHeapAlloc(ByVal Length As Long) As Long
pHeapAlloc = HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY, Length)
End Function
' pStringFromPointer
' Dereferences a string buffer allocated by pHeapAlloc(),
' optionally freeing it afterwards. If you use this function to dereference
' pointers to strings not allocated by the framework, make sure you don't
' try to free them as well or you'll get a GPF.
Public Function pStringFromPointer(ByVal Pointer As Long, Optional bUnicode As Boolean = True, Optional ByVal bFreeMemory As Boolean = False) As String
Dim sOut As String
Dim lLen As Long
Dim b() As Byte
If bUnicode Then
If Pointer Then
lLen = lstrlenW(ByVal Pointer)
If lLen Then
' allocate string with nLen chars
pStringFromPointer = String$(lLen, 0)
' copy 2x nLen bytes for Unicode
CopyMemory ByVal StrPtr(pStringFromPointer), ByVal Pointer, 2 * lLen
'lstrcpyW ByVal StrPtr(pStringFromPointer), ByVal Pointer
End If
If bFreeMemory Then Call pHeapFree(Pointer)
End If
Else
If Pointer Then
lLen = lstrlenA(ByVal Pointer)
If lLen Then
' allocate buffer with nLen bytes
ReDim b(0 To lLen - 1) As Byte
' copy nLen bytes for ANSI
CopyMemory b(0), ByVal Pointer, lLen
pStringFromPointer = StrConv(b(), vbUnicode)
End If
If bFreeMemory Then Call pHeapFree(Pointer)
End If
End If
End Function
' Frees a string buffer allocated by cbxAllocStr() or
' pHeapAlloc(). You should not use the memory pointer
' to by Pointer after you call in here since the memory
' location itself will no longer exist and you'll just GPF.
Public Function pHeapFree(ByVal Pointer As Long) As Long
If Pointer Then
pHeapFree = HeapFree(GetProcessHeap(), 0, ByVal Pointer)
End If
End Function
-
Bugs report: ucListviewEx 2.5 can't return LVIS_FOCUSED. ( LVIS_FOCUSED is different with LVIS_SELECTED,of cource)
Edited: it may not be a bug. I think we need a workaround using subclass.
Dim i As Long
ucListView1.ItemFocused(2) = True
Debug.Print ucListView1.ItemFocused(2)
i = ucListView1.RowInFocus
Debug.Print "RowInFocus=";i
Public Property Get ItemFocused(ByVal Item As Long) As Boolean
If (m_hListView) Then
ItemFocused = CBool(SendMessageLong(m_hListView, LVM_GETITEMSTATE, Item, LVIS_FOCUSED))
End If
End Property
Public Property Let ItemFocused(ByVal Item As Long, ByVal Focused As Boolean)
Dim uLVI As LVITEM 'LVITEMW
If (m_hListView) Then
With uLVI
.stateMask = LVIS_FOCUSED
.State = -Focused * LVIS_FOCUSED
.Mask = LVIF_STATE
End With
Call SendMessage(m_hListView, LVM_SETITEMSTATE, Item, uLVI)
End If
End Property
Public Property Get RowInFocus() As Long
'*/ [get] focused item
Dim i As Long
Dim bFocus As Boolean
RowInFocus = -1
If (m_hListView) Then
For i = 0 To Me.ItemCount - 1
bFocus = CBool(SendMessageLongW(m_hListView, LVM_GETITEMSTATE, i, LVIS_FOCUSED))
If bFocus Then RowInFocus = i: Exit For
Next
End If
End Property
Challenge for everyone:
Obama said: "We can do new things,we do big things". ;)
How to fully simulate Win7 Explorer Listview's item & subitem Drag-Drop? I never saw someone did in VB6.
-
Thanks to all, It looks like I have a lot of work to do :)
Challenge for everyone:
Obama said: "We can do new things,we do big things". ;)
How to fully simulate Win7 Explorer Listview's Drag-Drop? I never saw someone did in VB6.
Leandro Ascierto did that in "Explorador Remoto 2 (http://www.leandroascierto.com.ar/categoria/Proyectos/articulo/Proyecto.php)" in the File Explorer, just Drag&Drop to download File :P
-
Thanks to all, It looks like I have a lot of work to do :)
Challenge for everyone:
Obama said: "We can do new things,we do big things". ;)
How to fully simulate Win7 Explorer Listview's Drag-Drop? I never saw someone did in VB6.
Leandro Ascierto did that in "Explorador Remoto 2 (http://www.leandroascierto.com.ar/categoria/Proyectos/articulo/Proyecto.php)" in the File Explorer, just Drag&Drop to download File :P
I means Items or SubItems drag-drop at internal control or two ucListviewex control.
-
I means Items or SubItems drag-drop at internal control or two ucListviewex control.
It just depends on how you handle de OLEDrop and OLEStartDrag by setting the datatype and what to drag (string/binary data, etc) :P
-
Gracefully :) resolve UNICODE for GroupHeader/GroupFooter/GroupSubtitle.
Public Property Get GroupHeaderText(ByVal GroupID As Long) As String
Dim tGRP As LVGROUPW
tGRP.cbSize = Len(tGRP)
tGRP.Mask = LVGF_HEADER
GroupHeaderText = psGetGroupText(GroupID, tGRP, iGroupHeaderText)
End Property
Public Property Let GroupHeaderText(ByVal GroupID As Long, Text As String)
'//XP/SP3 doesn't support,For Vista/Win7 above
Dim tGRP As LVGROUPW
tGRP.cbSize = Len(tGRP)
tGRP.Mask = LVGF_HEADER
If Not pbSetGroupInfo(GroupID, tGRP, Text) Then
'MsgBox "Failed to set groupheader."
End If
End Property
Hi Jen, thanks for the example. I am always looking to learn. Are you suggesting this is better than the solution I suggested? If so, would you mind sharing more? Does UNICODE chars not work with my solution? I see you have used HeapAlloc, LocalAlloc & CopyMemory which I had found to be a solution as well, but then I found it to work with the simpler StrPtr() and lstrlenW/lstrcpyW?
Also, I tested both Get GroupHeaderText and Let GroupHeaderText using my solution on both Win7 & Win XP and it worked. (however you had suggested Let GroupHeaderText '//XP/SP3 doesn't support,For Vista/Win7 above)
Please advise, and thank you.
Gracias ! :)
-
From what I tested on XP/SP3 and VB6/SP6, GroupHeaderText can't be changed on runtime. But Vista/Win7 is OK. (Test String: ChrW$(&H6B22) & ChrW$(&H8FCE))
The Code your provided might be OK though there's a mistake:
.cchHeader = Len(.pszHeader) 'Always is 4 because .pszHeader is defined in Long,Should be Len(newText)
Public Property Let GroupHeaderText(ByVal GroupID As Long, newText As String)
If m_hListView Then
Dim group As LVGROUP_lp
With group
.cbSize = Len(group)
.mask = LVGF_HEADER
.pszHeader = StrPtr(newText)
.cchHeader =Len(.pszHeader)
End With
Call SendMessage(m_hListView, LVM_SETGROUPINFO, GroupID, group)
End If
End Property
-
From what I tested on XP/SP3 and VB6/SP6, GroupHeaderText can't be changed on runtime. But Vista/Win7 is OK. (Test String: ChrW$(&H6B22) & ChrW$(&H8FCE))
I dont know why, but, sometimes the group header text can be changed, other times no. I still don't know why :P Im testing that too on WinXP (If works in winxp it should work in vista/7 too)
-
I means Items or SubItems drag-drop at internal control or two ucListviewex control.
It just depends on how you handle de OLEDrop and OLEStartDrag by setting the datatype and what to drag (string/binary data, etc) :P
Normal drag-drop is realizable,but if we partially simulate Win7 explorer Listview Drag-Drop & Selected/Focused,it is a bit complicated but possible. We need to consider:
a. MultiSelection mode
b. create drag-drop image (if items is more than 1,paint multi Thumbnails and print number on it)
c. items on focus and on selected
d. GetItemRect and GetSubItemRect,GetTextRECT,draw drag-drop mark
e. cross groups
f. Auto scroll on H/V direction
g.Subclassing Mouse Notifications to make item Focus/Selected State on/off:
Private Const WM_LBUTTONDBLCLK As Long = &H203
Private Const WM_RBUTTONDBLCLK As Long = &H206
Private Const WM_MBUTTONDBLCLK As Long = &H209
Private Const WM_KILLFOCUS As Long = &H8
Private Const WM_SETFOCUS As Long = &H7
Private Const WM_NOTIFY As Long = &H4E
Private Const WM_KEYDOWN As Long = &H100
Private Const WM_KEYUP As Long = &H101
Private Const WM_CHAR As Long = &H102
Private Const WM_MOUSEMOVE As Long = &H200
Private Const WM_LBUTTONUP As Long = &H202
Private Const WM_LBUTTONDOWN As Long = &H201
Private Const WM_RBUTTONDOWN As Long = &H204
Private Const WM_RBUTTONUP As Long = &H205
Private Const WM_MBUTTONDOWN As Long = &H207
Private Const WM_MBUTTONUP As Long = &H208
Please play Win7 EXPLORER.exe for a while then you understand what features we want to achieve.
(http://hi.csdn.net/attachment/201106/8/1705918_1307511657Ihu1.gif)
(http://hi.csdn.net/attachment/201106/8/1705918_1307511661PotL.jpg)
-
From what I tested on XP/SP3 and VB6/SP6, GroupHeaderText can't be changed on runtime. But Vista/Win7 is OK. (Test String: ChrW$(&H6B22) & ChrW$(&H8FCE))
The Code your provided might be OK though there's a mistake:
.cchHeader = Len(.pszHeader) 'Always is 4 because .pszHeader is defined in Long,Should be Len(newText)
Hi Jen, thanks for the comments. I looked at it further and actually cchHeader is ignored when using LVM_SETGROUPINFO, so that line should be commented out/removed: http://msdn.microsoft.com/en-us/library/bb774769(v=vs.85).aspx
UNICODE:
Using my code, the Chinese characters ChrW$(&H6B22) & ChrW$(&H8FCE) do work on Windows XP SP3, both the IDE and compiled (vb6.exe needs manifest added). However, you will not see the characters unless you have East Asia Character support installed: http://www.cyberactivex.com/UnicodeTutorialVb.htm#Wheres_the_Beef_(Unicode)
GROUPHEADERTEXT:
From what I tested on XP/SP3 and VB6/SP6, GroupHeaderText can't be changed on runtime. But Vista/Win7 is OK. (Test String: ChrW$(&H6B22) & ChrW$(&H8FCE))
I dont know why, but, sometimes the group header text can be changed, other times no. I still don't know why :P Im testing that too on WinXP (If works in winxp it should work in vista/7 too)
raul338, I have experienced this problem too, no matter what code is used (even tried the example at vbAccelerator). Here is what I have found for Windows XP SP3:
1. Get the GroupHeaderText works (unicode/ansi).
2. Set the GroupHeaderText works (unicode/ansi).
3. Get the GroupHeaderText AFTER you Set the GroupHeaderText fails, everytime. No matter if you Set the GroupHeaderText with Unicode, or the method used to change the GroupHeaderText. It seems the Get GroupHeaderText will return "-1" everytime after you have Set the GroupHeaderText.
Possible work around for Windows XP (unless you guys have found a way to do that):
On Set GroupHeader Text:
a. Get the GroupHeader complete info
b. Remove the Group
c. Add the Group back with the new GroupHeader Text
Not sure how "fast" that will be or if there are any side effects. I have not had a chance to test that theory yet.
SORTING:
Looks like the ListView sorting should be changed from "If var > var then" to use Unicode aware CompareStringW Lib "kernel32.dll": #52 @ http://www.cyberactivex.com/UnicodeTutorialVb.htm#Sorting
Thanks !
-
hi again, im back with a working proof of concept:
image: http://www.convivea.com/capture.jpg
Download: http://www.convivea.com/download/ucListView2.5.chip.2011.6.09.rar
New:
GroupHeaderText: Set Text and Get Text work on Win 7 / Vista / XP. Unicode works.
note: use the text box next to the "Set Group 1" button to set your own text as the Group 1 header. If it is blank, it will use "Testing 1: & Chinese Unicode".
FilterItems: Works in Group Mode or Single List mode (very cool! try it :) )
Also, GroupMode filter works on Win 7, Vista, XP both Service Pack 3 and Service Pack 2 (check for COM CNTRL 6.0, if not, it will default the old trick of changing the text to white/white. this Mode is for XP service pack 2 or less.)
.SelectedItem : To provide a similar feature as the VB6 ListView control, I added a .SelectedItem property (Long, returns Item Index, not a reference to a ListViewItem). Try double clicking a list item (or right clicking as well)
Few other tweaks here and there (like GroupAdd() allows Collapsible and IndexOrder parameters).
Known Issues:
Adding new items while the list is filtered does not properly auto-update the filtered listview. The ItemAdd function need to be updated.
FilterItems with Unicode probably does not work yet.
image2: http://www.convivea.com/capture2.jpg
here you can see both FilterItems modes (work the same on Win7/Vista/XP), Set Header Text on the left, .SelectedItem on the right.
EDIT: I have found another (and better) work around to the Windows XP Set GroupHeader Text bug:
Public Property Let GroupHeaderText(ByVal GroupID As Long, newText As String)
'ADDED BY CHIP!
If m_hListView Then
Dim group As LVGROUP_lp
Dim lR As Long
Me.FreezePaint True
If pIsXP = True Then ' WINDOWS XP WORK AROUND
'THIS WORKS BUT A NEWER WORK AROUND WAS FOUND
'Dim x As Long
'Dim aGroups() As Long
'ReDim aGroups(0 To Me.Count - 1) As Long
'For x = 0 To Me.Count - 1
' aGroups(x) = Me.ItemGroup(x)
'Next
'Me.GroupRemove GroupID
'
'Me.GroupAdd GroupID, newText, , , , , GroupID
'
'For x = 0 To Me.Count - 1
'
' If aGroups(x) = GroupID Then
'
' Me.ItemGroup(x) = GroupID
'
' End If
'Next
'NEW work around found: http://users.skynet.be/oleole/Listview_grouping_feature.htm
'Discusses the BUG with LVM_SETGROUPINFO
With group
.cbSize = Len(group)
.mask = LVGF_HEADER Or LVGF_GROUPID
.pszHeader = StrPtr(newText)
.iGroupId = -100
End With
lR = SendMessageLong(m_hListView, LVM_SETGROUPINFO, GroupID, VarPtr(group))
With group
.mask = LVGF_GROUPID
.iGroupId = GroupID
End With
lR = SendMessageLong(m_hListView, LVM_SETGROUPINFO, -100, VarPtr(group))
Else
With group
.cbSize = Len(group)
.mask = LVGF_HEADER
.pszHeader = StrPtr(newText)
End With
lR = SendMessageLong(m_hListView, LVM_SETGROUPINFO, GroupID, VarPtr(group))
End If
Me.FreezePaint False
End If
End Property
-
http://www.convivea.com/download/ucListView2.5.chip.rar
I think the file has not yet updated. When filtering,Groups are lost!
-
sorry, you are right. i forgot to update all of the files in the .rar.
EDIT: new file uploaded:
http://www.convivea.com/download/ucListView2.5.chip.2011.6.09.rar
-
sorry, you are right. i forgot to update all of the files in the .rar.
EDIT: new file uploaded:
http://www.convivea.com/download/ucListView2.5.chip.2011.6.09.rar
Thanks for sharing. Well done!
I feel frustrated a bit. Allan Nielsen has built a Listview in year 1999. We are still working for Listview in year 2011.
Allan Nielsen: SuperGrid - Yet Another listview control
http://www.codeproject.com/KB/list/supergrid.aspx
-
Muy buenos cambios!! ;)
Otra funcionalidad para window 7 y vista
1. Why Column Checkbox disappear after set MultiSelect =True or False on my Win7?
2. After disappear, I have to use command again to bring back Checkbox on header.
3. If we don't handle any of the notifications (HDN_ITEMCHECK and HDN_ITEMSTATEICONCLICK[/color), the default behavior is to select and unselect the items in the list view when clicking the checkbox. This isn't what I want. I want to Check on all items and keep items Selected state and Focused state.
Case HDN_ITEMCHECK
Call CopyMemory(uNMHE, ByVal lParam, Len(uNMHE))
RaiseEvent ColumnCheck(uNMHE.iItem, Not Me.ColumnCheckValue(uNMHE.iItem))
Edited:
Subclass HDN_ITEMSTATEICONCLICK to prevent the default behavior.
Private m_lColumnChecked As Long
Case HDN_ITEMSTATEICONCLICK
m_lColumnChecked = -1
If Me.ColumnCheckStyle(uNMHE.iItem) Then
If Not Me.ColumnCheckValue(uNMHE.iItem) Then
Call CheckAll(True)
Me.ColumnCheckValue(uNMHE.iItem) = True
bHandled = True
lReturn = 1
ElseIf Me.ColumnCheckStyle(uNMHE.iItem) = True Then
Call CheckAll(False)
Me.ColumnCheckValue(uNMHE.iItem) = False
bHandled = True
lReturn = 1
End If
Call SetHeaderCheckbox(uNMHE.iItem)
m_lColumnChecked = uNMHE.iItem
End If
'...
Case LVN_ITEMCHANGED
'...
If m_lColumnChecked <> -1 Then
Call SetHeaderCheckbox(m_lColumnChecked)
End If
Public Sub CheckAll(Optional ByVal bChecked As Boolean = True)
Dim uLVI As LVITEMW
If (m_hListView) Then
With uLVI
.stateMask = LVIS_STATEIMAGEMASK
.State = &H1000& * (1 - bChecked)
.Mask = LVIF_STATE
End With
Call SendMessage(m_hListView, LVM_SETITEMSTATE, -1, uLVI)
End If
End Sub
Private Sub SetHeaderCheckbox(ByVal lColumn As Long)
Dim fChecked As Boolean
Dim i As Long
Dim uHDI As HDITEMW
fChecked = True
For i = 0 To Me.ItemCount - 1
If Me.ItemChecked(i) = False Then fChecked = False: Exit For
Next
uHDI.Mask = HDI_FORMAT
Call SendMessage(m_hHeader, HDM_GETITEMW, lColumn, uHDI)
If fChecked Then uHDI.fmt = uHDI.fmt Or HDF_CHECKED Else uHDI.fmt = uHDI.fmt And Not HDF_CHECKED
Call SendMessage(m_hHeader, HDM_SETITEMW, lColumn, uHDI)
End Sub
-
Listview Drag-Drop MultiSelection
good example - http://winandfx.narod.ru/
Audica 0.6.0 source http://winandfx.narod.ru/data/project_audica_0.6.0_src.zip
'-------------------------
ucListViewEx = ok
-
Listview Drag-Drop MultiSelection
good example - http://winandfx.narod.ru/
Audica 0.6.0 source http://winandfx.narod.ru/data/project_audica_0.6.0_src.zip
'-------------------------
ucListViewEx = ok
Good application.
I like ITaskbarList3 which shows Play buttons on thumbnail window on top of Taskbar.
Ya,the drag-drop (Dropped Files & Internal Items) also works even though they are not Vista/win7 style. ;)
I am thinking how to MoveItem/InsertItem... audica use VBScript Dictionary to keep the index/Key which I don't like...
In .NET,it is very easy:
if (1 == listView1.SelectedItems.Count)
{
ListViewItem item = listView1.SelectedItems[0];
int index = item.Index;
index++;
if (index < listView1.Items.Count)
{
listView1.Items.Remove(item);
listView1.Items.Insert(index, item);
item.Selected = true;
//listView1.Focus();
}
}
-
.SelectedItem : To provide a similar feature as the VB6 ListView control, I added a .SelectedItem property (Long, returns Item Index, not a reference to a ListViewItem). Try double clicking a list item (or right clicking as well)
Be attention to use :
LVM_GETSELECTIONMARK and LVM_GETNEXTITEM,They might not be what you expect for MultiSelect.
Need further testing the following code:
Public Function GetSelectedItem() As Long
Dim lFlags As Long
If m_hListView Then
If MultiSelect Then
GetSelectedItem = SendMessage(m_hListView, LVM_GETSELECTIONMARK, 0&, 0&)
Else
lFlags = LVNI_SELECTED
If GetFocus() = m_hListView Then lFlags = lFlags Or LVNI_FOCUSED
GetSelectedItem = SendMessage(m_hListView, LVM_GETNEXTITEM, &HFFFF, ByVal lFlags)
End If
End If
End Function
-
Be attention to use :
LVM_GETSELECTIONMARK and LVM_GETNEXTITEM,They might not be what you expect for MultiSelect.
Thank you Jen. My mistake. I missed that existing function because it was called "GetSelectedItem" and I was looking for "SelectedItem". It looks like if you remove the MultiSelect part, that will mimic VB6 functionality exactly as I wanted. What I have done is merged that existing function, removed what I previously added (included the m_SelectedItem in the subcass routine), and ended up with:
Public Property Get SelectedItem() As Long
Dim lFlags As Long
If m_hListView Then
lFlags = LVNI_SELECTED
If GetFocus() = m_hListView Then lFlags = lFlags Or LVNI_FOCUSED
SelectedItem = SendMessage(m_hListView, LVM_GETNEXTITEM, &HFFFF, ByVal lFlags)
End If
End Property
I tested on WinXP and Windows 7 and both has the same functionality as VB6's ListView.SelectedItem
-
1. Why Column Checkbox disappear after set MultiSelect =True or False on my Win7?
2. After disappear, I have to use command again to bring back Checkbox on header.
3. If we don't handle any of the notifications (HDN_ITEMCHECK and HDN_ITEMSTATEICONCLICK[/color), the default behavior is to select and unselect the items in the list view when clicking the checkbox. This isn't what I want. I want to Check on all items and keep items Selected state and Focused state.
Edited:
Subclass HDN_ITEMSTATEICONCLICK to prevent the default behavior.
1 & 2: same for me. Not sure why. is there a window msg that we need to subclass and "eat" ?
3: Here is how I have implemented both the default windows behavior (Check All / Uncheck All) as seen in Windows Explorer and provided the option to only Toggle the Selected items:
note: this is not perfect example, but atleast allows for multiple options to be used from within the ColumnCheck raised event.
Events:
Public Event ColumnCheck(Column As Long, Value As Boolean, Cancel As Boolean)
Subclass:
Case HDN_ITEMSTATEICONCLICK
Dim bCancel As Boolean
Call CopyMemory(uNMHE, ByVal lParam, Len(uNMHE))
Me.ColumnCheckValue(uNMHE.iItem) = Not Me.ColumnCheckValue(uNMHE.iItem)
RaiseEvent ColumnCheck(uNMHE.iItem, Me.ColumnCheckValue(uNMHE.iItem), bCancel)
If bCancel = True Then
bHandled = True
lReturn = 1
End If
Form:
Private Sub ucListView1_ColumnCheck(Column As Long, Value As Boolean, Cancel As Boolean)
On Error Resume Next
Dim x As Long
With ucListView1
If .Count = 0 Then Exit Sub
.FreezePaint True
If (.SelectedCount < .Count) And (.SelectedCount > 0) Then
Cancel = True
For x = 0 To .Count - 1
If .ItemSelected(x) = True Then
.ItemChecked(x) = Value
End If
Next
Else
For x = 0 To .Count - 1
.ItemChecked(x) = Value
Next
End If
.FreezePaint False
End With
End Sub
-
1 & 2: same for me. Not sure why. is there a window msg that we need to subclass and "eat" ?
3: Here is how I have implemented both the default windows behavior (Check All / Uncheck All) as seen in Windows Explorer and provided the option to only Toggle the Selected items:
note: this is not perfect example, but atleast allows for multiple options to be used from within the ColumnCheck raised event.
Yes,That is another good way to control Header Checkbox behavior through Public Event. Well Done!
-
En español muchachos!!!
-
@Mike, no tiene porque ser en español, nosotros como programadores tenemos que conocer el ingles, y es mas fácil adaptarnos nosotros a ellos, se que puede resultar algo complicado pero es el idioma universal y tenemos que aceptarlo.
Es bueno saber que nos visitan de otros países
Además nadie exigió que el Nick se en español ;D
English yes ;)
-
mi espanol es muy mal, pero aqui es un otro update para todos.
screen shot: http://www.convivea.com/update.png
download: http://www.convivea.com/download/ucListView2.5.2011.6.22.chip.rar
2011.6.20: Added support for Unicode with ListItems and Columns Headers.
Optimized: .Sort routines (about 2x as fast, and works with Unicode, and fixed DEFAULT sort order, works now :) )
Updated FilterItems: added parameter to update the Filter after ItemAdd or new sub FilterReApply() to re-apply the filter after adding a large number of items (example: add a filter then hit the Fill button)
Renamed FreezePaint(sub) to AllowRedraw (boolean property)
Added: HeaderCheckBoxes style (thnx LeandroA & Jen)
gracias :)
-
2011.6.20: Added support for Unicode with ListItems and Columns Headers.
Optimized: .Sort routines (about 2x as fast, and works with Unicode, and fixed DEFAULT sort order, works now :) )
Since you are making effort into sorting,how about multisorting (holding Shift + clicking two column header)?Let's do something different ;)
-
I can take a look at it, but I might not be adding much more to the control. Can you modify the attached project to Fill the Data with an example of when MultiSort would be used? (I am guessing when you have lots of the same identical values in Column 1 and lots of identical values in Column 2)?
thanks,
chip
-
I saw iGrid got multisort functionality,but it's not Listview. www.10tec.com
"Sorting is multi-column with numerated sort icons using different sort criteria for each column (by raw cell data, as case-insensitive text, by icons, by colors, by fonts, etc - including custom sorting)."
(http://www.10tec.com/Products/ActiveX/iGrid/img/ss/iGrid_SortIco.gif)
-
Saludos a todos !!!
Con todo respeto Raul338... te está quedando bárbaro !!!
Y eso es lo que digo, aquí hay buenos maestros !!! y lo digo porque he aprendido bastante de uds !!!
Felicitaciones Raul338 y a los demás !!!
Saludos !!!
Manuel F. Borrego S.
Barcelona, Edo. Anzoátegui. Venezuela. 8)
-
New findings:
When ucListview1 Group is enabled, the scrollbar unit is pixels.
When ucListview1 Group is disabled, the scrollbar unit is number of items.
e.g. ucListview1 Group is enabled,click scrollbar scoll down button once,Value(efsVertical) =33 (pixels)
e.g. ucListview1 Group is disabled,click scrollbar scoll down button once,Value(efsVertical) =1 (item)
MsgBox CStr(Min(efsVertical) & ":" & Max(efsVertical) & ":" & LargeChange(efsVertical) & ":" & Value(efsVertical))
'/* Bars:
Private Enum EFSScrollBarConstants
efsHorizontal = 0
efsVertical = 1
End Enum
Private Type SCROLLINFO
cbSize As Long
fMask As Long
nMin As Long
nMax As Long
nPage As Long
nPos As Long
nTrackPos As Long
End Type
Private Declare Function GetScrollInfo Lib "user32" (ByVal hWnd As Long, _
ByVal n As Long, _
LPSCROLLINFO As SCROLLINFO) As Long
Private Declare Function SetScrollInfo Lib "user32" (ByVal hWnd As Long, _
ByVal n As Long, _
lpcScrollInfo As SCROLLINFO, _
ByVal BOOL As Boolean) As Long
Private Sub pGetSI(ByVal eBar As EFSScrollBarConstants, _
ByRef tSI As SCROLLINFO, _
ByVal fMask As Long)
Dim lO As Long
lO = eBar
tSI.fMask = fMask
tSI.cbSize = LenB(tSI)
GetScrollInfo ucListView1.hWnd, lO, tSI
End Sub
Private Property Get Min(ByVal eBar As EFSScrollBarConstants) As Long
Dim tSI As SCROLLINFO
pGetSI eBar, tSI, &H1
Min = tSI.nMin
End Property
Private Property Get Max(ByVal eBar As EFSScrollBarConstants) As Long
Dim tSI As SCROLLINFO
pGetSI eBar, tSI, &H1 Or &H2
Max = tSI.nMax - tSI.nPage
End Property
Private Property Get Value(ByVal eBar As EFSScrollBarConstants) As Long
Dim tSI As SCROLLINFO
pGetSI eBar, tSI, &H4
Value = tSI.nPos
End Property
Private Property Get LargeChange(ByVal eBar As EFSScrollBarConstants) As Long
Dim tSI As SCROLLINFO
If (eBar = efsHorizontal) Then
pGetSI eBar, tSI, &H2
LargeChange = tSI.nPage
Else
pGetSI eBar, tSI, &H2
LargeChange = tSI.nPage
End If
End Property
-
New findings:
When ucListview1 Group is enabled, the scrollbar unit is pixels.
When ucListview1 Group is disabled, the scrollbar unit is number of items.
e.g. ucListview1 Group is enabled,click scrollbar scoll down button once,Value(efsVertical) =33 (pixels)
e.g. ucListview1 Group is disabled,click scrollbar scoll down button once,Value(efsVertical) =1 (item)
The same when WM_SCROLL is handled, in icon view the units ard pixels and in others views the units are items
Con todo respeto Raul338... te está quedando bárbaro !!!
Y eso es lo que digo, aquí hay buenos maestros !!! y lo digo porque he aprendido bastante de uds !!!
Felicitaciones Raul338 y a los demás !!!
Gracias! Aunque sigo intenando mejorarlo! :)
Thanks chip for your updates, i'll include in the control!
Since you are making effort into sorting,how about multisorting (holding Shift + clicking two column header)?Let's do something different ;)
With that we have to implement custom sorting too :P
Good Luck! :P
PD: This is like the OFFICIAL ucListView thread ;D
-
Why GetFooterRECT & GetFooterItemRECT failed on Win7?
BOOL GetFooterRect(LPRECT lpRect) const
{
ATLASSERT(::IsWindow(m_hWnd));
return (BOOL)::SendMessage(m_hWnd, LVM_GETFOOTERRECT, 0, (LPARAM)lpRect);
}
BOOL GetFooterItemRect(int nItem, LPRECT lpRect) const
{
ATLASSERT(::IsWindow(m_hWnd));
return (BOOL)::SendMessage(m_hWnd, LVM_GETFOOTERITEMRECT, nItem, (LPARAM)lpRect);
}
Private Function GetFooterItemRECT(hWnd As Long, ByVal Index As Long) As RECT2
'/* Get GetFooterItemRECT RECT ,no need to assign top
Dim bOK As Boolean
bOK = SendMessage(hWnd, LVM_GETFOOTERITEMRECT, Index, GetFooterItemRECT)
End Function
Private Function GetFooterRECT(hWnd As Long) As RECT2
'/* Get GetFooterRECT RECT ,no need to assign top & index
Dim bOK As Boolean
bOK = SendMessage(hWnd, LVM_GETFOOTERRECT, 0, GetFooterRECT)
End Function
-
I don't know why, its looks microsoft will add the API in next version of windows :P For know i only saw it in Explorer :( (and MFC i think)
-
I don't know why, its looks microsoft will add the API in next version of windows :P For know i only saw it in Explorer :( (and MFC i think)
Have you tried the code on your computer?On my Win7, GetFooterRECT & GetFooterItemRECT failed.
-
Here is an easy way to implement Multi Column Sort (supports 2 columns) :)
download: http://www.convivea.com/download/ucListView2.5.2011.6.22.chip.rar
you can also change the Sort Order of each column at any time (independent of each other), and you can change what the 2nd Sort Column is, without re-sorting or losing your first "main" column. i think its cool :)
http://www.convivea.com/multi_sort.png
For example, Header 1 is main and sorted first. Then Header 2 is clicked (with shift/cntrl). If you hold cntrl/shift and click Header 2, you will change only that column sort order. If you hold shift/cntrl and click Header 3, then Header 1 and Header 3 will be sorted.
Form:
Private Sub ucListView1_ColumnClick(Column As Long)
On Error Resume Next
Dim ncol As Long
With ucListView1
.AllowRedraw = False
If (.Count > 1) Then
'ADDED BY CHIP! - Support for Multi Column Sort
If (m_CurrentColumn > -1) And CNTRLorSHIFT = True Then ' Multi Column Sort
For ncol = 0 To .ColumnCount - 1
If (ncol <> Column) And (ncol <> m_CurrentColumn) Then
.ColumnOrder(ncol) = soDefault
End If
Next ncol
'SORT THE NEW COLUMN AND THEN SORT THE MAIN COLUMN AGAIN AFTER
If .ColumnOrder(Column) = soAscending Then
.ColumnOrder(Column) = soDescending
ElseIf .ColumnOrder(Column) = soDescending Then
.ColumnOrder(Column) = soDefault
Else
.ColumnOrder(Column) = soAscending
End If
Select Case Column
Case 0: Call .Sort(Column, .ColumnOrder(Column), [stStringSensitive])
Case 1, 3: Call .Sort(Column, .ColumnOrder(Column), [stNumeric])
Case 2: Call .Sort(Column, .ColumnOrder(Column), [stDate])
End Select
'PREPARE SORT THE MAIN COLUMN AGAIN
Column = m_CurrentColumn
Else ' Single Column Sort
For ncol = 0 To .ColumnCount - 1
If (ncol <> Column) Then .ColumnOrder(ncol) = soDefault
Next ncol
If .ColumnOrder(Column) = soAscending Then
.ColumnOrder(Column) = soDescending
ElseIf .ColumnOrder(Column) = soDescending Then
.ColumnOrder(Column) = soDefault
Else
.ColumnOrder(Column) = soAscending
End If
End If
Select Case Column
Case 0: Call .Sort(Column, .ColumnOrder(Column), [stStringSensitive])
Case 1, 3: Call .Sort(Column, .ColumnOrder(Column), [stNumeric])
Case 2: Call .Sort(Column, .ColumnOrder(Column), [stDate])
End Select
End If
Call .ColumnFocused(Column)
m_CurrentColumn = Column
.AllowRedraw = True
End With
End Sub
Module.bas:
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Public Function CNTRLorSHIFT() As Boolean
On Error Resume Next
If (GetAsyncKeyState(160) And &H8000) Then ' SHIFT
CNTRLorSHIFT = True
ElseIf (GetAsyncKeyState(162) And &H8000) Then ' CTRL
CNTRLorSHIFT = True
End If
End Function
Also:
Why GetFooterRECT & GetFooterItemRECT failed on Win7?
"The creation of footers in list-view controls is currently not supported." @ http://msdn.microsoft.com/en-us/library/bb774748.aspx
There is no Footer in a list-view control (yet).
-
Still stuck in GetFooterRECT & GetFooterItemRECT. GetFooterRECT & GetFooterItemRECT always return empty RECT. But Footer RECT height is always 15 pixels (?). I am afraid MS will update the Footer RECT in future (e.g. Add ImageList/Set Font...) if I set a const.
(http://www.vbforums.com/attachment.php?attachmentid=84580&stc=1&d=1309515492)
Private Function GetFooterItemRECT(hwnd As Long, ByVal Index As Long) As RECT2
'/* Get GetFooterItemRECT RECT ,no need to assign top & index
'//Failed
GetFooterItemRECT.y1 = LVGGR_GROUP
Call SendMessage(hwnd, LVM_GETFOOTERITEMRECT, Index, GetFooterItemRECT)
End Function
Private Function GetFooterRECT(hwnd As Long) As RECT2
'/* Get GetFooterRECT RECT ,no need to assign top & index
'//Failed
Call SendMessage(hwnd, LVM_GETFOOTERRECT, 0, GetFooterRECT)
End Function
-
you're cofusing ListView Footer rect with GroupFooter :P
Listview Footer
(http://www.codeproject.com/KB/vista/listviewundoc/footer.png)
What you marked is Group Footer :D
-
you're cofusing ListView Footer rect with GroupFooter :P
Listview Footer
(http://www.codeproject.com/KB/vista/listviewundoc/footer.png)
What you marked is Group Footer :D
Yes,I want to get the Group Footer RECT or 'Gap'.
-
For Who has advanced Programming skills,take a look:
http://www.codeproject.com/script/Articles/ViewDownloads.aspx?aid=35197
QueryInterface (LVM_QUERYINTERFACE)
http://www.geoffchappell.com/viewer.htm?doc=studies/windows/shell/comctl32/controls/listview/messages/queryinterface.htm&tx=23,26
ISubItemCallback:
http://www.geoffchappell.com/viewer.htm?doc=studies/windows/shell/comctl32/controls/listview/interfaces/isubitemcallback.htm&tx=25,26
IOwnerDataCallback
http://www.geoffchappell.com/viewer.htm?doc=studies/windows/shell/comctl32/controls/listview/interfaces/iownerdatacallback.htm&tx=25,26
IListViewFooterCallback
http://www.geoffchappell.com/viewer.htm?doc=studies/windows/shell/comctl32/controls/listview/interfaces/ilistviewfootercallback.htm&tx=25,26
IListViewFooter
http://www.geoffchappell.com/viewer.htm?doc=studies/windows/shell/comctl32/controls/listview/interfaces/ilistviewfooter.htm&tx=25,26
-
Nice links, but they are almos for windows vista and beyond (poor XP :'()
-
'code snippets
Private Function CellFromPoint(ByVal xPixels As Long, ByVal yPixels As Long, ByRef Row As Long, ByRef Cell As Long)
'/* mouse pointer over item
Dim tLVHT As LVHITTESTINFO
'/* get target item index
Row = -1
Cell = -1
If Not (Me.ItemCount = 0) Then
tLVHT.pt.x = xPixels
tLVHT.pt.y = yPixels
SendMessage m_hListView, LVM_HITTEST, 0&, tLVHT
If (tLVHT.iItem <= 0) Then
If (tLVHT.flags And LVHT_NOWHERE) = LVHT_NOWHERE Then
Row = -1
Else
Row = tLVHT.iItem
End If
Else
Row = tLVHT.iItem
End If
End If
'/* cell hit test
If Not (Me.ItemCount = 0) And Not Row = -1 Then
With tLVHT
.pt.x = xPixels
.pt.y = yPixels
.flags = LVHT_ONITEM
End With
'/* hit test
SendMessage m_hListView, LVM_SUBITEMHITTEST, 0&, tLVHT
Cell = tLVHT.iSubItem
End If
End Function
Private Function LVScrollVertical(ByVal bDown As Boolean)
'/* scroll vertical
If bDown Then
SendMessageLong m_hListView, WM_VSCROLL, SB_LINEDOWN, 0 'LVM_SCROLL
Else
SendMessageLong m_hListView, WM_VSCROLL, SB_LINEUP, 0
End If
End Function
Private Function LVScrollHorizontal(ByVal bRight As Boolean)
'/* scroll horizontal
If bRight Then
SendMessageLong m_hListView, WM_HSCROLL, SB_LINERIGHT, 0
Else
SendMessageLong m_hListView, WM_HSCROLL, SB_LINELEFT, 0
End If
End Function
Private Function LVHasHorizontal() As Boolean
'/* vertical scrollbar test
Dim lStyle As Long
If m_bIsNt Then
lStyle = GetWindowLongW(m_hListView, GWL_STYLE)
Else
lStyle = GetWindowLong(m_hListView, GWL_STYLE)
End If
LVHasHorizontal = (lStyle And WS_HSCROLL) <> 0
End Function
Private Function LVHasVertical() As Boolean
'/* horizontal scrollbar test
Dim lStyle As Long
If m_bIsNt Then
lStyle = GetWindowLongW(m_hListView, GWL_STYLE)
Else
lStyle = GetWindowLong(m_hListView, GWL_STYLE)
End If
LVHasVertical = (lStyle And WS_VSCROLL) <> 0
End Function
-
Does anyone know how to move Multi selected Items to new position using Sort Method or other better methods ;)?
e.g. Move item 0,2,6,8 to behind item 4, after moved, the new arrangement is 1,3,4,0,2,6,8,5,7,9,10,11,12,13...
Something likes:
/*
* ListView_Move helper function.
*/
int CALLBACK LVMoveCompareFunc(LPARAM lParam1, LPARAM lParam2, LPARAM lParamSort)
{
struct CTX { int src, trg; } *pctx = (struct CTX*) lParamSort;
if (lParam1 == pctx->src)
return (lParam2 >= pctx->trg ? -1 : +1);
else if (lParam2 == pctx->src)
return (lParam1 >= pctx->trg ? +1 : -1);
else
return (lParam1 >= lParam2 ? +1 : -1);
}
/*
* Moves the selected list view item up or down.
* hwnd = list view
* change = -1 for up 1, 1 for down 1, -2 for up two, etc.
* Returns TRUE on success, FALSE on failure.
*/
BOOL ListView_Move(HWND hwnd, int change)
{
struct CTX { int src, trg; } ctx;
ctx.src = ListView_GetNextItem(hwnd, -1, LVNI_SELECTED);
ctx.trg = ctx.src + change + (change > 0 ? 1 : 0);
return ListView_SortItemsEx(hwnd, LVMoveCompareFunc, (LPARAM) &ctx);
}
Private Sub List_MouseUp(ByVal Button As MouseButtonConstants, ByVal x As Long, ByVal y As Long, ByVal Shift As Integer)
If dragging Then
dragging = False
If sendToTab <> -1 Then
sendSelectedTo Form1.tabs.getOne(sendToTab), ModKey(vbCtrlMask)
Form1.tabs.draw
Else
Dim item As Long, i As Long, n As Long, shiftpos As Boolean
If list.SelectedCount = 0 Then Exit Sub
item = IIf( _
y < 0, 0, _
IIf(y > list.Bottom, -1, _
list.HitTest(0, y)))
If item = -1 Then item = list.Count - 1
If list.ItemSelected(item) = True Then Exit Sub
MousePointer = vbHourglass
ReDim Keys(list.SelectedCount - 1) As Long
i = list.SelectedItem()
While i <> -1
Keys(incl(n)) = list.keyByIndex(i)
i = list.SelectedItem(i)
Wend
If list.indexByKey(Keys(0)) < item Then shiftpos = True
item = list.keyByIndex(item)
For i = 0 To n - 1
list.Sort Keys(i), item
If shiftpos Then _
item = Keys(i)
Next i
list.SelectedItem = -1
For i = 0 To n - 1
list.SelectedItem = list.indexByKey(Keys(i))
Next i
list.RedrawVisibleItems
MousePointer = vbDefault
End If
End If
End Sub
Please refer this:
1. http://cboard.cprogramming.com/windows-programming/74680-moving-items-listview.html
2. Audica 0.6.0 source http://winandfx.narod.ru/data/project_audica_0.6.0_src.zip
-
thank you refer
-
Contributed by Jonney:
I think it is the first implement to use Sort Callback to Move Listview Items in VB6 :).
Thanks go to the below links for inspiration:
1. http://cboard.cprogramming.com/windows-programming/74680-moving-items-listview.html
2. Audica 0.6.0 source http://winandfx.narod.ru/data/project_audica_0.6.0_src.zip
'in module mListviewEx
Private Type SORTEX_VARS
lSrc As Long
lDest As Long
End Type
Private m_SortEx As SORTEX_VARS
Public Function MoveItem(ByVal hListView As Long, ByVal lFromIndex As Long, ByVal lToIndex As Long) As Boolean
Dim lRet As Long
m_SortEx.lSrc = lFromIndex
m_SortEx.lDest = lToIndex
lRet = SendMessageLong(hListView, LVM_SORTITEMSEX, VarPtr(m_SortEx), AddressOf pvCompareSpecial)
End Function
Private Function pvCompareSpecial(ByVal lParam1 As Long, _
ByVal lParam2 As Long, _
ByVal lPointer As Long) As Long
If (lParam1 = m_SortEx.lSrc) Then
pvCompareSpecial = IIf(lParam2 >= m_SortEx.lDest, -1, 1)
ElseIf (lParam2 = m_SortEx.lSrc) Then
pvCompareSpecial = IIf(lParam1 >= m_SortEx.lDest, 1, -1)
Else
pvCompareSpecial = IIf(lParam1 >= lParam2, 1, -1)
End If
End Function
Usage:
MoveItem m_hListview,5,8
-
Hardcode to move items,Cheers! :)
Public Function MoveItem(ByVal lFromIndex As Long, ByVal lToIndex As Long, ByVal lNewGroupID As Long)
Dim lvi As LVITEMW
Dim lvi_clone As LVITEMW
Dim lOldFromIndex As Long
Dim a(260) As Byte
Dim iColumn As Long, nColumns As Long, ret As Long
If lToIndex < 0 Or lFromIndex = lToIndex Then Exit Function
With lvi_clone
.Mask = LVIF_TEXT Or LVIF_IMAGE Or LVIF_STATE Or LVIF_PARAM Or LVIF_INDENT
.iItem = lFromIndex
.pszText = VarPtr(a(0))
.cchTextMax = UBound(a) + 1
End With
'// Create the new item, with all the info of the old...
If SendMessage(m_hListView, LVM_GETITEMW, lFromIndex, lvi_clone) = 0 Then Exit Function
Call Me.ItemAdd(lToIndex, pStringFromPointer(lvi_clone.pszText), lvi_clone.iIndent, lvi_clone.iImage, lvi_clone.lParam, lvi_clone.iGroupId)
Me.ItemGroup(lToIndex) = lNewGroupID
'// If we create an item above the old one, then the old one moves down one...
If lFromIndex > lToIndex Then lOldFromIndex = lFromIndex + 1 Else lOldFromIndex = lFromIndex
nColumns = Me.ColumnCount
'// Copy all the subitems from the old to the new
For iColumn = 1 To nColumns - 1
With lvi
Call ZeroMemory(lvi, Len(lvi))
.Mask = LVIF_TEXT Or LVIF_IMAGE
.iItem = lOldFromIndex
.iSubItem = iColumn
.pszText = VarPtr(a(0))
.cchTextMax = UBound(a) + 1
If SendMessage(m_hListView, LVM_GETITEMW, lOldFromIndex, lvi) = 0 Then Exit Function
End With
Call Me.SubItemSet(lToIndex, iColumn, pStringFromPointer(lvi.pszText), lvi.iImage)
Next
Call ZeroMemory(lvi_clone, Len(lvi_clone))
Call ZeroMemory(lvi, Len(lvi))
If Me.ItemSelected(lOldFromIndex) Then Me.ItemSelected(lToIndex) = True
Call Me.ItemRemove(lOldFromIndex)
End Function
Public Function ItemAdd( _
ByVal Item As Long, _
ByVal Text As String, _
ByVal Indent As Long, _
ByVal Icon As Long, _
Optional ByVal ItemData As Long = -1, _
Optional ByVal GroupID As Long = 0, _
Optional ByVal bUpdateFilter As Boolean = False) As Boolean
Dim uLVW As LVITEMW
If (m_hListView) Then
With uLVW
.iItem = Item
.lParam = ItemData 'Item
.pszText = StrPtr(Text)
.cchTextMax = Len(Text) + 1
.iIndent = Indent
.iImage = Icon
.Mask = LVIF_TEXT Or LVIF_INDENT Or LVIF_IMAGE Or LVIF_PARAM
End With
ItemAdd = (SendMessage(m_hListView, LVM_INSERTITEMW, 0&, uLVW) > -1)
If (SendMessageLong(m_hListView, LVM_GETITEMCOUNT, 0&, 0&) = 1) Then
m_bFirstItem = True: Me.ItemFocused(0) = True
Else
m_bFirstItem = False
End If
'ADD BY CHIP!
If ItemAdd = True Then
If Not IsMissing(GroupID) Then ItemGroup(Item) = GroupID
If m_IsFiltered = True Then ' IF WE ARE FILTERED THEN WE WILL NEED TO INCREASE THE OLD GROUP BUFFER
ReDim Preserve m_OldGroup(0 To Me.ItemCount - 1) As Long
If bUpdateFilter = True Then FilterItems m_FilterSearchColumn, m_Filter
End If
End If
End If
End Function
Public Function SubItemSet( _
ByVal Item As Long, _
ByVal SubItem As Long, _
ByVal Text As String, _
ByVal Icon As Long _
) As Boolean
Dim uLV As LVITEMW
If (m_hListView) Then
With uLV
.iItem = Item
.iSubItem = SubItem
.pszText = StrPtr(Text)
.cchTextMax = Len(Text) + 1
.iImage = Icon
.Mask = LVIF_TEXT Or LVIF_IMAGE 'LVIF_INDENT and LVIF_PARAM don't work for SubItem
End With
SubItemSet = CBool(SendMessage(m_hListView, LVM_SETITEMW, 0, uLV))
End If
End Function
Public Function ItemRemove(ByVal Item As Long) As Boolean
If (m_hListView) Then ItemRemove = CBool(SendMessageLong(m_hListView, LVM_DELETEITEM, Item, 0))
End Function
Private Function pStringFromPointer(ByVal Pointer As Long) As String
Dim sOut As String
Dim lLen As Long
Dim b() As Byte
If Pointer Then
lLen = lstrlenW(ByVal Pointer)
If lLen Then
' allocate string with nLen chars
pStringFromPointer = String$(lLen, 0)
' copy 2x nLen bytes for Unicode
'CopyMemory ByVal StrPtr(pStringFromPointer), ByVal Pointer, 2 * lLen
lstrcpyW ByVal StrPtr(pStringFromPointer), ByVal Pointer
End If
End If
End Function
-
LVM_GETGROUPCOUNT bugs:
1. LVM_GETGROUPCOUNT return wrong Group Count when calling GroupAdd to add a existing GroupId .
e.g. There're 5 Groups (GroupID=1,2,3,4,5). If we call ucListview1.GroupAdd(1,"GroupID=1") again, ucListview1.GroupCount will increase 1 and return 6,but actual distinct groups is only 5 (GroupID=1,2,3,4,5).
GroupCount = SendMessage(m_hListView, LVM_GETGROUPCOUNT, 0, 0)
Work around: use a Collection to help to count group. Operate Collection when call ItemGroup or ItemRemove or GroupAdd or GroupRemove.
2. In VB IDE, LVM_GETGROUPCOUNT failed.
-
How to get Group Index using LVM_HITTEST message?
Private Type LVHITTESTINFO
pt As POINTAPI
flags As Long
iItem As Long
iSubItem As Long
iGroup As Long '//Vista
End Type
Dim uLVHI As LVHITTESTINFO
Dim tPoint As POINTAPI
'/* get target Group index
GetCursorPos tPoint
ScreenToClient m_hListView, tPoint
LSet uLVHI.pt = tPoint
iGroupIDHitTest = SendMessage(m_hListView, LVM_HITTEST, -1, uLVHI)
If uLVHI.flags And LVHT_EX_GROUP = 0 Then Exit Function '/* make sure the target is a GroupHeader
MsgBox "uLVHI.iGroup=" & uLVHI.iGroup
-
Why LVN_LINKCLICK notification can't trigger?
ElseIf (uNMH.hwndFrom = m_hListView) Then
Select Case uNMH.code
Case LVN_LINKCLICK
MsgBox "Triggered"
'In Demo form
ucListview1.GroupTask(1)= "Group 1 Task"
'In uc
Public Property Let GroupTask(ByVal GroupID As Long, Text As String)
Dim tGRP As LVGROUPW
Dim lR As Long
If m_hListView Then
With tGRP
.cbSize = Len(tGRP)
.Mask = LVGF_TASK
.pszTask = StrPtr(Text)
.iGroupId = GroupID
End With
lR = SendMessageLong(m_hListView, LVM_SETGROUPINFO, GroupID, VarPtr(tGRP))
End If
End Property
I saw an article named" CListCtrl and Grouping Rows" on codepage.com ( http://www.codeproject.com/KB/list/CListCtrl_Grouping.aspx). He also use LVN_LINKCLICK notification to detect a Link clicked.
#include "stdafx.h"
#include "CListCtrl_Category_Groups.h"
#include <shlwapi.h>
#include "Resource.h"
//#include "ListCtrl_Category_GroupsDef.h"
BEGIN_MESSAGE_MAP(CListCtrl_Category_Groups, CListCtrl)
ON_WM_CONTEXTMENU() // OnContextMenu
ON_WM_LBUTTONDBLCLK()
ON_NOTIFY_REFLECT_EX(LVN_COLUMNCLICK, OnHeaderClick) // Column Click
#if _WIN32_WINNT >= 0x0600
ON_NOTIFY_REFLECT_EX(LVN_LINKCLICK, OnGroupTaskClick)
#endif
END_MESSAGE_MAP()
BOOL CListCtrl_Category_Groups::OnGroupTaskClick(NMHDR* pNMHDR, LRESULT* pResult)
{
#if _WIN32_WINNT >= 0x0600
NMLVLINK* pLinkInfo = (NMLVLINK*)pNMHDR;
int nGroupId = pLinkInfo->iSubItem;
CheckEntireGroup(nGroupId, true);
#endif
return FALSE;
}
-
The best ever Listview in .NET:
A Much Easier to Use ListView
By Phillip Piper | 6 Jul 2011
http://www.codeproject.com/KB/list/ObjectListView.aspx
http://sourceforge.net/projects/objectlistview/files/objectlistview/v2.5/
(http://www.codeproject.com/KB/list/ObjectListView/fancy-screenshot2.png)
(http://www.codeproject.com/KB/list/ObjectListView/fancy-screenshot3.png)
(http://www.codeproject.com/KB/list/ObjectListView/foobar-lookalike.png)
(http://www.codeproject.com/KB/list/ObjectListView/normal-animation.png)
(http://www.codeproject.com/KB/list/ObjectListView/dragdrop-dropbetween.png)
(http://www.codeproject.com/KB/list/ObjectListView/group-formatting.png)
-
Still stuck in GetFooterRECT & GetFooterItemRECT. GetFooterRECT & GetFooterItemRECT always return empty RECT. But Footer RECT height is always 15 pixels (?). I am afraid MS will update the Footer RECT in future (e.g. Add ImageList/Set Font...) if I set a const.
(http://www.vbforums.com/attachment.php?attachmentid=84580&stc=1&d=1309515492)
Private Function GetFooterItemRECT(hwnd As Long, ByVal Index As Long) As RECT2
'/* Get GetFooterItemRECT RECT ,no need to assign top & index
'//Failed
GetFooterItemRECT.y1 = LVGGR_GROUP
Call SendMessage(hwnd, LVM_GETFOOTERITEMRECT, Index, GetFooterItemRECT)
End Function
Private Function GetFooterRECT(hwnd As Long) As RECT2
'/* Get GetFooterRECT RECT ,no need to assign top & index
'//Failed
Call SendMessage(hwnd, LVM_GETFOOTERRECT, 0, GetFooterRECT)
End Function
A follow up on 26/7/2011:
We can set Group Gap (space) between two Groups:
Public Function SetGroupSpacing(ByVal Space As Long )
Dim tMetrics As LVGROUPMETRICS
With tMetrics
.cbSize = Len(tMetrics)
.Mask = LVGMF_BORDERSIZE
.Bottom = Space
End With
call SendMessage(m_hListView, LVM_SETGROUPMETRICS, 0&, tMetrics)
End Function
Edited: There is a minimum gap between two groups (depending on the font? ). The space can't be smaller than min. value.
-
...
Please refer this:
1. http://cboard.cprogramming.com/windows-programming/74680-moving-items-listview.html
2. Audica 0.6.0 source http://winandfx.narod.ru/data/project_audica_0.6.0_src.zip
Get off this, but when I run I get this error message:
Can't load BASS library
What should I do?
Thank
Traslate with google.
-
...
Please refer this:
1. http://cboard.cprogramming.com/windows-programming/74680-moving-items-listview.html
2. Audica 0.6.0 source http://winandfx.narod.ru/data/project_audica_0.6.0_src.zip
Get off this, but when I run I get this error message:
Can't load BASS library
What should I do?
Thank
Traslate with google.
I am sure the code can run on VB6.
Register the dll and supply right Path:
There're two ways to do:
1. Put BASS.DLL and tags.dll into your Application Folder then change the below code
2. Put BASS.DLL and tags.dll to your System Folder C:\Windows\System32 without any modifications.
Private Function initBass() As Boolean
' change and set the current path, to prevent from VB not finding BASS.DLL
ChDrive App.path
ChDir App.path
If b(libbass, LoadLibrary(App.Path & "\" & "bass.dll")) Then
' check the correct BASS was loaded
If (HiWord(BASS_GetVersion) <> BASSVERSION) Then
Call MsgBox("An incorrect version of BASS.DLL was loaded", vbCritical)
Exit Function
End If
' initialize default output device
If (BASS_Init(-1, 44100, 0, frm_info.hwnd, 0) = 0) Then
Call Error_("Can't initialize device")
Exit Function
End If
' check that DX8 features are available
Dim bi As BASS_INFO
Call BASS_GetInfo(bi)
If (bi.dsver < 8) Then
Call Error_("DirectX 8 is not installed")
Call BASS_Free
Exit Function
End If
' load tag-reading library
If Not b(libtags, LoadLibrary(App.Path & "\" & "tags.dll")) Then
Call MsgBox("Can't load tags.dll", vbCritical)
Call BASS_Free
Exit Function
End If
initBass = True
Else
Call MsgBox("Can't load BASS library", vbCritical)
End If
End Function
-
Thank you for responding.
Bass.dll y Tags.dll
not in the file: project_audica_0.6.0_src.zip
You may have to create it, il see
thanks
-
Thank you for responding.
Bass.dll y Tags.dll
not in the file: project_audica_0.6.0_src.zip
You may have to create it, il see
thanks
Go to http://winandfx.narod.ru/ to download the full bibrary:
http://winandfx.narod.ru/data/project_audica_0.6.0_bin_full.zip
-
ah ok, thanks, I see
-
Thank you for responding.
Bass.dll y Tags.dll
not in the file: project_audica_0.6.0_src.zip
You may have to create it, il see
thanks
Go to http://winandfx.narod.ru/ to download the full bibrary:
http://winandfx.narod.ru/data/project_audica_0.6.0_bin_full.zip
Thank you very much for responding. Already down and it works perfect, I read the code to see more or less
sorry dont speak english. use google
-
Greetings to all! :)
Estimated Ivan, I am pleasantly surprised :o by this forum, I can see and even writing in English dominates ! (don't worry about, it's a joke Je, Je ;D)
Ahora así como algunos tienen la amabilidad (en el caso tuyo Yvan) de escribir en otro idioma, los demás (los del "otro idioma") deberían seguir el ejemplo también, es solo por una cortesía !!! Sin ánimo de querer molestar a nadie que pudiese sentirse aludido (por si acaso).
Saludos.
Manuel F. Borrego S. 8)
Barcelona, Edo. Anzoátegui. Venezuela.
-
Why LVN_LINKCLICK notification can't trigger?
ElseIf (uNMH.hwndFrom = m_hListView) Then
Select Case uNMH.code
Case LVN_LINKCLICK
MsgBox "Triggered"
'In Demo form
ucListview1.GroupTask(1)= "Group 1 Task"
'In uc
Public Property Let GroupTask(ByVal GroupID As Long, Text As String)
Dim tGRP As LVGROUPW
Dim lR As Long
If m_hListView Then
With tGRP
.cbSize = Len(tGRP)
.Mask = LVGF_TASK
.pszTask = StrPtr(Text)
.iGroupId = GroupID
End With
lR = SendMessageLong(m_hListView, LVM_SETGROUPINFO, GroupID, VarPtr(tGRP))
End If
End Property
I saw an article named" CListCtrl and Grouping Rows" on codepage.com ( http://www.codeproject.com/KB/list/CListCtrl_Grouping.aspx). He also use LVN_LINKCLICK notification to detect a Link clicked.
#include "stdafx.h"
#include "CListCtrl_Category_Groups.h"
#include <shlwapi.h>
#include "Resource.h"
//#include "ListCtrl_Category_GroupsDef.h"
BEGIN_MESSAGE_MAP(CListCtrl_Category_Groups, CListCtrl)
ON_WM_CONTEXTMENU() // OnContextMenu
ON_WM_LBUTTONDBLCLK()
ON_NOTIFY_REFLECT_EX(LVN_COLUMNCLICK, OnHeaderClick) // Column Click
#if _WIN32_WINNT >= 0x0600
ON_NOTIFY_REFLECT_EX(LVN_LINKCLICK, OnGroupTaskClick)
#endif
END_MESSAGE_MAP()
BOOL CListCtrl_Category_Groups::OnGroupTaskClick(NMHDR* pNMHDR, LRESULT* pResult)
{
#if _WIN32_WINNT >= 0x0600
NMLVLINK* pLinkInfo = (NMLVLINK*)pNMHDR;
int nGroupId = pLinkInfo->iSubItem;
CheckEntireGroup(nGroupId, true);
#endif
return FALSE;
}
Follow up on 26/7/2011:
Still failed to find the way to resolve this issue. Subclass doesn't issue LVN_LINKCLICK notification at all. I saw someone complained the same problem on VB.NET: http://social.msdn.microsoft.com/Forums/en/vbgeneral/thread/c4caf1ac-94b8-4d32-92aa-aec1cdcd9171
Edited on 26/7/2011 19:00:
I see.
LVN_LINKCLICK notification was inhibited by WM_LBUTTONDOWN message if we bypassed the def procedure.
Case WM_LBUTTONDOWN
If GroupHeaderHitTest then bHandled = True
-
Bugs:
When Group is enabled and ViewMode is SmallIcon, if ItemText is too long, e.g. 20,some items disappear while mouse moveMove on.
-
I beg your pardon!
Guys, can someone have an instance of user control?
Unfortunately, the link that points to this copy:
http://www.convivea.com/download/ucListView2.5.2011.6.22.chip.rar (http://www.convivea.com/download/ucListView2.5.2011.6.22.chip.rar)
from this page: http://leandroascierto.com/foro/index.php?topic=731.msg5216#msg5216 (http://leandroascierto.com/foro/index.php?topic=731.msg5216#msg5216)
is no longer valid.
-
Here is it...
https://foro.elhacker.net/programacion_visual_basic/uclistviewex_25_clsiconlist-t320562.0.html