Как изменить цвет фона строки в ListView

@anton-sf · Регистрация: 29.03.2015

Author24 — интернет-сервис помощи студентам

Привет форумчане и гости.

Я нещадно использую Excel, есть много макросов и форм со списками.
Мой скилл и знания программирования довольно низок - школьный курс по Бейсику в начале 90-х и справка Excel.
Уже как пару-тройку лет периодически приходится автоматизировать труд в Excel - самообразование получаю.
Недавно озадачился проблемой юзабилити ListView в режиме таблицы (Report) - очень захотелось заиметь чередование цветов строк.
Неделю копался по форумам, толкового и готового решения не нашел.
Конечно, я начитался про функции WinAPI - эти варианты для меня сложные, к тому же не готовые и не очень-то понятные, в таких обсуждениях очень много воды либо незаконченные диалоги.
Решение мной нашлось простое - использовать картинку. Это подсказал мне сам ListView когда я скролил список - картинка так же смещалась.
Без WinAPI не обошлось, такие функции я раздобыл где-то в сети, не помню где, не помню авторов, не в обиду им.

Visual Basic    
        
            
                
                
                
                
            
        
    Скопировано
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
'WinAPI - декларация функций 
Public Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
Public Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As Bitmap, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Public Declare Function Rectangle Lib "gdi32" (ByVal hDC As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Public Declare Function FillRect Lib "user32" (ByVal hDC As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Public Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As Integer
Public Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
 
Public Type PointAPI
    X As Long
    Y As Long
End Type
 
Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
    Width As Long
    Height As Long
End Type
 
Public Type GUID
   Data1 As Long
   Data2 As Integer
   Data3 As Integer
   Data4(7) As Byte
End Type
 
Public Type Bitmap
   Size As Long
   Type As Long
   hBmp As Long
End Type
 
Public Const TWIPSPERINCH = 1440
Public Const LOGPIXELSX = 88
Public Const LOGPIXELSY = 90
 
'Высота строки ListView в режиме Report, в пикселях
Public Const LV_RowHeight = 24
 
'Перевод пикселей в точки по оси X
'Точки - единицы измерения расстояний у всех элементов управления
Public Function PixelsToPointsX(ByVal PixelX As Long)
    Dim DesktopDC As Long
    Dim PixelsPerInchX As Long
    DesktopDC = GetDC(0)
    PixelsPerInchX = GetDeviceCaps(DesktopDC, LOGPIXELSX)
    ReleaseDC 0, DesktopDC
    PixelsToPointsX = PixelX * TWIPSPERINCH / 20 / PixelsPerInchX
End Function
 
'Перевод пикселей в точки по оси Y
'Точки - единицы измерения расстояний у всех элементов управления
Public Function PixelsToPointsY(ByVal PixelY As Long)
    Dim DesktopDC As Long
    Dim PixelsPerInchY As Long
    DesktopDC = GetDC(0)
    PixelsPerInchY = GetDeviceCaps(DesktopDC, LOGPIXELSY)
    ReleaseDC 0, DesktopDC
    PixelsToPointsY = PixelY * TWIPSPERINCH / 20 / PixelsPerInchY
End Function
 
'Перевод точек в пиксели по оси X
'Пиксели - единицы измерения расстояний у процедур WinAPI
Public Function PointsToPixelsX(ByVal PointX As Single)
    Dim DesktopDC As Long
    Dim PixelsPerInchX As Long
    DesktopDC = GetDC(0)
    PixelsPerInchX = GetDeviceCaps(DesktopDC, LOGPIXELSX)
    ReleaseDC 0, DesktopDC
    PointsToPixelsX = PointX / TWIPSPERINCH * 20 * PixelsPerInchX
End Function
 
'Перевод точек в пиксели по оси Y
'Пиксели - единицы измерения расстояний у процедур WinAPI
Public Function PointsToPixelsY(ByVal PointY As Single)
    Dim DesktopDC As Long
    Dim PixelsPerInchY As Long
    DesktopDC = GetDC(0)
    PixelsPerInchY = GetDeviceCaps(DesktopDC, LOGPIXELSY)
    ReleaseDC 0, DesktopDC
    PointsToPixelsY = PointY / TWIPSPERINCH * 20 * PixelsPerInchY
End Function
 
'Функция конвертации формата .BMP в понятный для ListView.Picture
Public Function ConvertBmpToIPicture(hBmp As Long) As IPictureDisp
    Dim Pic As Bitmap
    Dim IPic As IPictureDisp
    Dim IID_IDispatch As GUID
    With IID_IDispatch
       .Data1 = &H20400
       .Data4(0) = &HC0
       .Data4(7) = &H46
    End With
    With Pic
       .Size = Len(Pic)     ' Length of structure.
       .Type = 1            ' Type of Picture (bitmap).
       .hBmp = hBmp         ' Handle to bitmap.
    End With
    ' Create Picture object.
    Dim rez As Long
    rez = OleCreatePictureIndirect(Pic, IID_IDispatch, 1, IPic)
    Set ConvertBmpToIPicture = IPic
End Function
 
'Функция создания графического изображения 
Public Function CreateIPictureDisp(ByVal Width As Integer, ByVal Heigth As Integer) As IPictureDisp
    Dim hDCDest As Long
    Dim hBMPDest As Long
    Dim hBMPOld As Long
    Dim hDCScreen As Long
    hDCScreen = GetDC(0)
    hDCDest = CreateCompatibleDC(hDCScreen)
    hBMPDest = CreateCompatibleBitmap(hDCScreen, Width, Heigth)
    hBMPOld = SelectObject(hDCDest, hBMPDest)
    Rectangle hDCDest, 1, 1, Width, Heigth
    hBMPDest = SelectObject(hDCDest, hBMPOld)
    DeleteDC hDCDest
    ReleaseDC 0, hDCScreen
    Set CreateIPictureDisp = ConvertBmpToIPicture(hBMPDest)
End Function
 
'Функция создания графического изображения, с чередованием цветов,
'её результат подставляется в ListView.Picture
Public Function CreateIPictureDispInterleave(ByVal Width As Integer, ByVal Height As Integer, ByVal RowHeight As Integer, ByVal Color1 As Long, ByVal Color2 As Long) As IPictureDisp
    Dim hDCDest As Long
    Dim hBMPDest As Long
    Dim hBMPOld As Long
    Dim hDCScreen As Long
    Dim lpRect As RECT
    Dim hBrush As Long
    Dim hBrush1 As Long
    Dim hBrush2 As Long
    Dim RowTop As Integer
    hDCScreen = GetDC(0)
    hDCDest = CreateCompatibleDC(hDCScreen)
    hBMPDest = CreateCompatibleBitmap(hDCScreen, Width, Height)
    hBMPOld = SelectObject(hDCDest, hBMPDest)
    hBrush1 = CreateSolidBrush(Color1)
    hBrush2 = CreateSolidBrush(Color2)
    lpRect.Left = 0
    lpRect.Right = Width
    For RowTop = 0 To Height Step RowHeight
        lpRect.Top = RowTop
        lpRect.Bottom = lpRect.Top + RowHeight
        If hBrush = hBrush1 Then
            hBrush = hBrush2
        Else
            hBrush = hBrush1
        End If
        FillRect hDCDest, lpRect, hBrush
        Debug.Print lpRect.Top, lpRect.Bottom
    Next
    hBMPDest = SelectObject(hDCDest, hBMPOld)
    DeleteObject hBrush1
    DeleteObject hBrush2
    DeleteDC hDCDest
    ReleaseDC 0, hDCScreen
    Set CreateIPictureDispInterleave = ConvertBmpToIPicture(hBMPDest)
End Function

Теперь, когда есть необходимые инструменты, в коде наполнения ListView
используем их для создание картики c чередованием цветов и такой высотой,
что бы она соответствовала количеству записей, после помещаем картинку в ListView

Visual Basic    
        
            
                
                
                
                
            
        
    Скопировано
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Private Sub ListViewFill()
    '
    'Заполняем список данными
    '
    If ListView1.ListItems.Count > 0 Then
        Dim RowHeight As Integer
        Dim Color1 As Long
        Dim Color2 As Long
        Dim PicWidth As Integer
        Dim PicHeight As Integer
        Color1 = RGB(255, 255, 255)
        Color2 = RGB(245, 245, 245)
        If ListView1.GridLines Then
            RowHeight = LV_RowHeight + 1
        Else
            RowHeight = LV_RowHeight
        end if
        PicWidth = PointsToPixelsX(ListView1.Width)
        PicHeight = ListView1.ListItems.Count * RowHeight
        Set ListView1.Picture = CreateIPictureDispInterleave(PicWidth, PicHeight, RowHeight, Color1, Color2)
    Else
        Set ListView1.Picture = Nothing
    End If
End Sub

Вот и всё, кому-то пригодится.

Как изменить цвет фона строки в ListView

@anton-sf · 29.03.2015, 16:34 **[ТС]**

Ой, ой, забыл про создание самого ListView, я добавляю его программно,
и настраиваю высоту строк картинкой. Код модуля формы

Visual Basic    
        
            
                
                
                
                
            
        
    Скопировано
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
Option Explicit
 
Private ListView1 As ListView
Private ImageList1 As ImageList
 
Private Sub UserForm_Initialize()
    Set ImageList1 = Me.Controls.Add("MSComctlLib.ImageListCtrl", "ImageList1", False)
    'Вот тут создается картинка определяющая высоту строки ListView и помещается в контейнер иконок
    ImageList1.ListImages.Add Picture:=CreateIPictureDisp(LV_RowHeight, LV_RowHeight)
    Set ListView1 = Me.Controls.Add("MSComCtlLib.ListViewCtrl", "ListView1", True)
    With ListView1
        .Width = 716
        .Height = 467 ' + 13
        .Top = 0
        .Left = 0
        .TabStop = False
        .Visible = True
        .AllowColumnReorder = False
        .Appearance = ccFlat
        .BackColor = vbWindowBackground
        .BorderStyle = ccNone
        .CheckBoxes = False
        .Enabled = True
        .FlatScrollBar = False
        .Font = Me.Font
        .ForeColor = &H404040    'vbWindowText
        .FullRowSelect = True
        .Gridlines = True
        .HideColumnHeaders = True
        .HideSelection = True
        .HotTracking = False
        .HoverSelection = False
        .LabelEdit = lvwManual
        .LabelWrap = False
        .MultiSelect = False
        .Sorted = False
        .TextBackground = 0
        .View = lvwReport
        .ListItems.Clear
        .ColumnHeaders.Clear
        .ColumnHeaders.Add 1, "Иконка", "Иконка", 0, lvwColumnLeft
        .ColumnHeaders.Add 2, "Ключ", "Ключ", 0, lvwColumnLeft
        .ColumnHeaders.Add 3, "Индекс", "Индекс", 42, lvwColumnRight
        .ColumnHeaders.Add 4, "Логин", "Логин", 36, lvwColumnCenter
        .ColumnHeaders.Add 5, "Дата", "Дата", 60, lvwColumnRight
        .ColumnHeaders.Add 6, "Контрагент", "Контрагент", 48, lvwColumnLeft
        .ColumnHeaders.Add 7, "Вид", "Вид", 78, lvwColumnLeft
        .ColumnHeaders.Add 8, "Префикс", "Префикс", 18, lvwColumnCenter
        .ColumnHeaders.Add 9, "Номер", "Номер", 36, lvwColumnRight
        .ColumnHeaders.Add 10, "ВидУслуг", "ВидУслуг", 66, lvwColumnLeft
        .ColumnHeaders.Add 11, "Изделие1", "Изделие1", 18, lvwColumnCenter
        .ColumnHeaders.Add 12, "Изделие2", "Изделие2", 18, lvwColumnCenter
        .ColumnHeaders.Add 13, "Сумма", "Сумма", 54, lvwColumnRight
        .ColumnHeaders.Add 14, "Примечание", "Примечание", 242 - 12.75, lvwColumnLeft
    End With
    'Вот тут и регулируется высота строки ListView картинкой в контейнере
    Set ListView1.SmallIcons = ImageList1
    ListView1.Font = Me.Font
End Sub

Добавлено через 11 часов 14 минут
Надо заметить что в ListView рендер текста на картинку отличается от того же без картинки, это заметно когда выделяешь любую строку - после смены выделения ListView по другому рендерит текст на предыдущей выделенной строке

Добавлено через 1 минуту
Попробовал перебирая строки циклом устанавливать каждую в выделение и тут его снимать - не помогло

Добавлено через 5 минут
Помог вызов ListView.Refresh, после добавления всех строк

@glGizma · 24.02.2016, 13:04

Да какое описание...
Вообщем можно просто copy/past сделать...
Хотя реализация не оптимальная, но общая идея - та что нужна =)))
***************************************************** }

Delphi    
        
            
                
                
                
                
            
        
    Скопировано
1
2
3
4
5
6
7
8
9
10
11
procedure TForm1.ListView1CustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
var
  i: word;
begin
  //if item = nil then
    //EXIT;
  i := Item.Index;
  if trunc((i) / 2) < (i / 2) then sender.canvas.brush.Color := cl3DLight
  else sender.canvas.brush.Color := clwhite;
end;

Новые блоги и статьи Все статьи Все блоги /
Лучшие практики оптимизации Docker Image Mr. Docker 13.03.2025 Размер Docker-образа влияет на множество аспектов работы с контейнерами. Чем больше образ, тем дольше его загрузка в реестр и выгрузка из него. Для команд разработки, работающих с CI/ CD пайплайнами,. . .	Вопросы на собеседовании по Docker Mr. Docker 13.03.2025 Ты сидишь напротив технического специалиста, и вдруг звучит вопрос про Docker Swarm или многоэтапные сборки. Пот на лбу? Не переживай, после этой статьи ты будешь готов ко всему! Эта статья будет. . .	Поиск текста в сносках : замена дефиса на тире или тире на дефис... РоΜа 13.03.2025 Нужно было найти текст в сносках и заменить. Почему-то метод селекшн не сработал. . . пришлось гуглить. найденный на форумвба код пришлось править. Смысл - заменяет в сносках дефисы и тире на нужные. . . .	Real PATH definitions in bash scripts jigi33 13.03.2025 Как поймать путь и путь к директории относительно запускаемого файла в BASH 1. поймать путь через вывод $(pwd) 2. более правильно - на основе realpath (см. скриншот)	Django или Flask: что выбрать для веб-разработки на Python py-thonny 13.03.2025 Django – это высокоуровневый фреймворк, который придерживается философии "всё включено". Он предоставляет разработчику готовые решения для большинства типичных задач веб-разработки: от аутентификации. . .
Непрерывное развертывание в Java с Kubernetes Javaican 13.03.2025 Чем так привлекателен Kubernetes для развертывания Java-приложений? Этот оркестратор контейнеров позволяет автоматизировать развертывание, масштабирование и управление контейнеризированными. . .	Предотвращение XSS, CSRF и SQL-инъекций в JavaScript run.dev 13.03.2025 JavaScript занимает первые позиции среди языков веб-разработки, но его распространенность делает его привлекательной целью для злоумышленников. Межсайтовый скриптинг (XSS), межсайтовая подделка. . .	PHP 8: JIT-компиляция и улучшение производительности Jason-Webb 13.03.2025 PHP никогда не славился своей скоростью. Многие сталкивались с проблемами производительности при работе со сложными вычислениями или обработкой больших объемов данных. Традиционная модель выполнения. . .	Сериализация данных с Apache Avro в Kafka Javaican 12.03.2025 Apache Kafka стала одним из ключевых решений для работы с большими потоками данных. Однако с ростом объемов передаваемых данных возникает проблема: как эффективно сериализовать и десериализовать. . .	Создание потребителей Kafka с помощью Reactor Kafka Javaican 12.03.2025 Reactor Kafka — это библиотека, объединяющая Apache Kafka с реактивным программированием на базе Project Reactor. Такое сочетание позволяет строить неблокирующие, асинхронные приложения с контролем. . .