HOW To show listview Control by vb6 api?

[xiaoyao]

just like CommonDialog1 ocx control replace to GetOpenFileName Lib "comdlg32.dll"

[fafalone]

You use CreateWindowEx. Krool's VBCCR ListView is done that way; for something simpler this post of mine uses one in virtual mode (very high performance) that's not too complicated, as it's just to show how to dynamically resize icons in it like Explorer.

[xiaoyao]

How to modify the code to set the border line color of the control? Adjust the column width after displaying, or manually adjust?

Option Explicit
Private Const WS_CHILD = &H40000000
Private Const WS_VISIBLE = &H10000000
Private Const LVS_REPORT = &H1
Private Declare Function CreateWindowEx Lib "user32.dll" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, ByRef lpParam As Any) As Long
Private Declare Function DestroyWindow Lib "user32" (ByVal hWnd 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 Type LVCOLUMN
    Mask        As Long
    Fmt         As Long
    cX          As Long
    pszText     As String
    cchTextMax  As Long
    iSubItem    As Long
    iImage      As Long
    iOrder      As Long
End Type
Private Const LVM_INSERTCOLUMNA = &H101B

Private Const LVCF_WIDTH = &H2
Private Const LVCF_TEXT = &H4

Private Type LVITEM
    Mask        As Long
    iItem       As Long
    iSubItem    As Long
    State       As Long
    StateMask   As Long
    pszText     As String
    cchTextMax  As Long
    iImage      As Long
    lParam      As Long
    iIndent     As Long
End Type
Private Const LVIF_TEXT = &H1
Private Const LVM_INSERTITEMA = &H1007
Private Const LVM_SETITEMA = &H1006

Private LVhWnd  As Long

Private Sub Form_Load()
    Dim dwStyle     As Long
    dwStyle = WS_CHILD Or WS_VISIBLE Or LVS_REPORT
    LVhWnd = CreateWindowEx(0, "SysListView32", vbNullString, dwStyle, 0, 0, 500, 600, Me.hWnd, 0, App.hInstance, ByVal 0)

    Call ColumnHeadAdd(0, "Col 1")
    Call ColumnHeadAdd(1, "cOL 2")
    
    Call RowAdd(0, "Row1")
    Call RowSubAdd(0, 1, "Row1 Col 2")
    Call RowAdd(1, "Row2")
    Call RowSubAdd(1, 1, "Row2 Col 2")
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Call DestroyWindow(LVhWnd)
End Sub

Private Sub ColumnHeadAdd(ByVal Index As Long, ByVal Text As String)
    Dim ColHead As LVCOLUMN
    With ColHead
        .Mask = LVCF_WIDTH Or LVCF_TEXT
        .cX = 100
        .pszText = Text
    End With
    Call SendMessage(LVhWnd, LVM_INSERTCOLUMNA, Index, ColHead)
End Sub

Private Sub RowAdd(ByVal Index As Long, ByVal Text As String)
    Dim iItem       As LVITEM
    With iItem
        .Mask = LVIF_TEXT
        .iItem = Index
        .pszText = Text
    End With
    Call SendMessage(LVhWnd, LVM_INSERTITEMA, 0, iItem)
End Sub

Public Sub RowSubAdd(ByVal Row As Long, ByVal Index As Long, ByVal Text As String)
    Dim iItem     As LVITEM
    With iItem
        .Mask = LVIF_TEXT
        .iItem = Row
        .iSubItem = Index
        .pszText = Text
    End With
    Call SendMessage(LVhWnd, LVM_SETITEMA, 0, iItem)
End Sub

[fafalone]

LVM_SETCOLUMNWIDTH changes the column width; the border color is a system style I think. Use no border then draw one yourself in a different color if you want it different.

[xiaoyao]

WHo can down load for me,thank you

http://www.vbaccelerator.com/home/VB...ll_Source.html

[SearchingDataOnly]

https://github.com/tannerhelland/vbAccelerator-Archive

[fafalone]

As far as standalone ListView controls go, I'm partial to ucListViewEx. It's originally based on the vbAccelerator one, but modified to be entirely self-contained (no ssubtmr, no .bas files, just the .ctl) with a number of additional features.

Hard to find a working link, especially to the 3.0 version, so I'll attach it.

----
PS, you've posted on the tB GitHub, so if 64bit is something you're interested in, the only known 64bit implementations are in my ucShellBrowse control (as an UserControl) and in my ETW File Activity Monitor (not wrapped in a control). But they're pretty tightly integrated, not independent controls simply consumed by the program; the latter isn't too bad though. tbShellLib has all the API definitions (and the IListView undocumented COM interface) in 64bit compatible form as well.

[xiaoyao]

Thank you very much, this only needs one file (control). I don't know if there is any simpler table control, maybe it can be realized with a text box or an array of LABEL controls. It is a simple table, you can set the number of rows, columns, cell background color and font color, just for simple display table effect.

I also just worked on a Webbrowser version of the table control implemented in HTML tables.
You can set the number of rows and columns, you can use code to modify the cell value, set the color

[SearchingDataOnly]

VB6 HTMLGrid-UserControl

[xiaoyao]

ListControl control draws grid lines_lvs_ex_gridlines
https://blog.csdn.net/qing666888/art...tails/49928917

The default grid lines are too hard to see. I want to make the grid lines thicker. How to set them?
or set the line color

[fafalone]

Sorry is there a question here or are you just sharing a random code snippet?

[xiaoyao]

VB6 - Listview Rows Backcolor (Without subclassing)-VBForums
https://www.vbforums.com/showthread....t-subclassing)

like this:

Private Sub SetListBackground()
    Dim i As Long
    Dim lw As Single  'list width
    Dim lh As Single  'list height
    Dim rh As Single  'row height
    Dim t1 As Single  'top of row 1
    Dim ti As Single  'top of row i
    Dim bh As Single  'background height
    Dim col As Long   'colour of row
    Dim cnt As Long   'number of rows
    
    cnt = lvwBackColour.ListItems.Count
    
    If cnt > 0 Then
    
        picBG.Cls
        picBG.ScaleMode = Me.ScaleMode

        lw = lvwBackColour.Width
        
        t1 = lvwBackColour.ListItems(1).Top
        rh = lvwBackColour.ListItems(1).Height
        lh = rh * cnt
        
        picBG.Width = lw
        picBG.Height = lh
        
        bh = picBG.Height
        
        'note: picturebox has a maximum possible height
        '      if list is too long, bh < lh (items at end of list will not be coloured)
        
        For i = 1 To cnt
            ti = lvwBackColour.ListItems(i).Top - t1
            If ti > bh Then
                'past bottom of background picturebox.
                'Debug.Print "Row " & i & " onwards cannot be highlighted."
                Exit For
            Else
                If lvwBackColour.ListItems(i).Checked = True Then
                    col = &H80FFFF
                Else
                    col = &HFFFFFF
                End If
                picBG.Line (0, ti)-(lw, ti + rh), col, BF
            End If
        Next i
        
        lvwBackColour.Picture = picBG.Image
    Else
        lvwBackColour.Picture = Nothing
    End If
End Sub

[xiaoyao]

Sorry is there a question here or are you just sharing a random code snippet?

i need a easy grid control by listview,but can't set gridlines color,and grid line thickened.

set vb6 controls BorderColor,-VBForums
https://www.vbforums.com/showthread....05#post5610405

like this,how to use on listviewcontrol

setBorderColor Text1.hWnd, vbBlue
Text1.Refresh

Private Function pFrameRect(ByVal hDC As Long, ByVal x As Long, y As Long, ByVal Width As Long, ByVal Height As Long) As Long
    Dim TmpRect     As RECT
    Dim m_hBrush    As Long
    With TmpRect
        .Left = x
        .Top = y
        .Right = x + Width
        .Bottom = y + Height
    End With
    m_hBrush = CreateSolidBrush(Color)
    pFrameRect = FrameRect(hDC, TmpRect, m_hBrush)
    DeleteObject m_hBrush
End Function

[fafalone]

You linked a code example of how to draw new gridlines.

[xiaoyao]

You linked a code example of how to draw new gridlines.

but it's not vb6 vode
Maybe use listview background image,draw grid lines
Case NM_CUSTOMDRAW

 Case NM_CUSTOMDRAW
        If Not lAllowCustomDrawItem Then Exit Function
        
        Dim lvct As NMLVCUSTOMDRAW
        
        Dim retCD As Long  '返回值
        CopyMemory lvct, ByVal addrLParam, LenB(lvct)
        
        retCD = 0
        If lvct.nmcd.dwDrawStage And CDDS_PREPAINT Then retCD = retCD Or CDRF_NOTIFYITEMDRAW
        
        If (lvct.nmcd.dwDrawStage And CDDS_ITEMPREPAINT) = CDDS_ITEMPREPAINT Then
            Dim idxSubItem As Long
            Dim clrText As Long, clrTextBK As Long, idxUsrFont As Long
            Dim blCancelDD As Boolean
            Dim blUserChangeFont As Boolean '用户在事件子程序中是否改变了颜色或字体

            blUserChangeFont = False
            clrText = lvct.colorText
            clrTextBK = Me.BackColor ' lvct.colorTextBK
             
            idxUsrFont = 0
            blCancelDD = False
            If lvct.nmcd.dwDrawStage And CDDS_SUBITEM Then idxSubItem = lvct.iSubItem + 1 Else idxSubItem = -1
            RaiseEvent CustomDrawItem(lvct.nmcd.dwItemSpec + 1, idxSubItem, _
              lvct.nmcd.hdc, clrText, clrTextBK, idxUsrFont, blCancelDD)

            '用户在事件子程序中改变了 ColorText 的颜色，将新颜色应用  LenB(NMCUSTOMDRAW)=48
            If clrText <> lvct.colorText Then CopyMemory ByVal addrLParam + 48, clrText, 4: blUserChangeFont = True
            '用户在事件子程序中改变了 ColorTextBK 的颜色，将新颜色应用  LenB(NMCUSTOMDRAW)=48
            If clrTextBK <> lvct.colorTextBK Then CopyMemory ByVal addrLParam + 48 + 4, clrTextBK, 4: blUserChangeFont = True
            '用户在事件子程序中指明需要使用一种预先定义好的字体显示该项目
            If idxUsrFont > 0 And idxUsrFont <= lUserFontCount Then
                SelectObject lvct.nmcd.hdc, lhUserFont(idxUsrFont)
                blUserChangeFont = True
            End If
            '用户在事件子程序中指明不要让系统默认绘制此项
            If blCancelDD Then retCD = retCD Or CDRF_SKIPDEFAULT

            If blUserChangeFont Then retCD = retCD Or CDRF_NEWFONT
        End If
        
        EventsGeneratorFromParent = retCD

 If IndexSubItem = 1 Then
        Listview1.GetItemRect IndexItem, IndexSubItem, 0, iLeft, iTop, iWidth, iHeight, LVIR_SELECTBOUNDS
'        mAPILsv.GetItemRect IndexItem, IndexSubItem, 0, 0, 0, iwidth2, 0, LVIR_LABEL
        iWidth = Listview1.ColumnWidth(IndexSubItem)
        SelectObject hdc, hPen 'GetStockObject(7)
        'SelectObject hdc, hBrush
        Rectangle hdc, iLeft, iTop, iLeft + iWidth, iTop + iHeight - 1
        'DFDrawEdgePB hdc, EDGE_ETCHED, 0, iLeft, iTop, iWidth + 1, iHeight

[xiaoyao]

chatgpt answer me,but can't run

Private Const NM_CUSTOMDRAW = (-12)

Private Type NMCUSTOMDRAW
    hdr As NMHDR
    dwDrawStage As Long
    hdc As Long
    rc As RECT
    dwItemSpec As Long
    uItemState As Long
    lItemlParam As Long
End Type

Private Type NMHDR
    hWndFrom As Long
    idFrom   As Long
    code    As Long
End Type

Private Const CDDS_ITEM As Long = &H10000
Private Const CDDS_SUBITEM As Long = &H20000
Private Const CDDS_ITEMPREPAINT As Long = &H10001
Private Const CDDS_SUBITEMPREPAINT As Long = &H20001
Private Const CDRF_DODEFAULT As Long = &H0
Private Const CDRF_SKIPDEFAULT As Long = &H4

Private Sub ListView1_CustomDraw(ByVal Ctrl As Object, ByVal CustomDraw As MSComctlLib.ICustomDraw)

    Dim nmcd As NMCUSTOMDRAW
    
    nmcd.hdr.hWndFrom = ListView1.hWnd
    nmcd.hdr.idFrom = ListView1.ID
    nmcd.hdr.code = NM_CUSTOMDRAW
    nmcd.dwDrawStage = CDDS_ITEMPREPAINT Or CDDS_SUBITEMPREPAINT
    nmcd.hdc = CustomDraw.hdc
    nmcd.dwItemSpec = CustomDraw.DrawItemIndex
    nmcd.uItemState = CustomDraw.ItemState
    nmcd.lItemlParam = CustomDraw.ItemData
    
    Select Case CustomDraw.DrawStage
    Case CDDS_ITEMPREPAINT
        CustomDraw.DrawText "This is an example text", RectFromNMCustomDraw(nmcd.rc), DT_SINGLELINE Or DT_LEFT Or DT_VCENTER
    End Select
    
    CustomDraw.ReturnValue = CDRF_SKIPDEFAULT
    
End Sub

Private Function RectFromNMCustomDraw(ByRef rc As RECT) As RECT

    Dim rcReturn As RECT
    
    With rc
        rcReturn.Left = .Left + 5 ' X position of the text
        rcReturn.Right = .Right ' Use the width of the listview item
        rcReturn.Top = .Top
        rcReturn.Bottom = .Bottom
    End With
    
    RectFromNMCustomDraw = rcReturn
    
End Function

[fafalone]

ChatGPT was just making up random stuff that looks good. The ListView has no CustomDraw event built in, you have to subclass it to get NM_CUSTOMDRAW.

[xiaoyao]

Sooner or later, Microsoft's technology will be out of date, because it is too troublesome to set various parameters, and it has never been improved for 10 or 20 years.
The end of IE is inevitable.
So there are still advantages to use web pages as controls, which can be set at will, especially what color images and controls, size, thickness and so on.
The future is the world of web pages and JS.

Didn't Bill Gates think that the grid color could be set from the very beginning?
The most basic functions can not be done. Like the web socket, the skeleton has been in use for five years before Microsoft caught up.

[-Franky-]

Sooner or later, Microsoft's technology will be out of date, because it is too troublesome to set various parameters, and it has never been improved for 10 or 20 years.
The end of IE is inevitable.
So there are still advantages to use web pages as controls, which can be set at will, especially what color images and controls, size, thickness and so on.
The future is the world of web pages and JS.

As far as controls are concerned, everything at Microsoft is currently moving in the direction of WinUI2/3 (XAML) The design possibilities are almost limitless under WinUI.