just like CommonDialog1 ocx control replace to GetOpenFileName Lib "comdlg32.dll"
Printable View
just like CommonDialog1 ocx control replace to GetOpenFileName Lib "comdlg32.dll"
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.
How to modify the code to set the border line color of the control? Adjust the column width after displaying, or manually adjust?
Code: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
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.
WHo can down load for me,thank you
http://www.vbaccelerator.com/home/VB...ll_Source.html
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.
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
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
Attachment 187951
Sorry is there a question here or are you just sharing a random code snippet?
VB6 - Listview Rows Backcolor (Without subclassing)-VBForums
https://www.vbforums.com/showthread....t-subclassing)
https://www.vbforums.com/attachment....1&d=1203777861
like this:
Code: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
i need a easy grid control by listview,but can't set gridlines color,and grid line thickened.Quote:
Originally Posted by fafalone
set vb6 controls BorderColor,-VBForums
https://www.vbforums.com/showthread....05#post5610405
like this,how to use on listviewcontrol
Code: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
You linked a code example of how to draw new gridlines.
but it's not vb6 vodeQuote:
Originally Posted by fafalone
Maybe use listview background image,draw grid lines
Case NM_CUSTOMDRAW
Code: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
Code: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
chatgpt answer me,but can't run
Code: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
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.
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.
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.Quote:
Originally Posted by xiaoyao