Das Einfärben einzelner ListView Zeilen ist beim ListView von Haus aus leider nicht gestattet. Hier ein Tipp, wie man es mit Subclassing doch hinbekommen kann. ACHTUNG: Das Subclassing muss beim Unload unbedingt wieder deaktiviert werden, sonst stürzt VB ab. Beim Testen bitte NICHT den Stop-Button der VB-Entwicklungsumgebung verwenden. Folgenden Code in ein Modul kopieren: Option Explicit ' Benötigte API Deklarationen Public Declare Function SetWindowLong Lib "user32.dll" _ Alias "SetWindowLongA" ( _ ByVal hWnd As Long, _ ByVal nIndex As Long, _ ByVal dwNewLong As Long) As Long Public Declare Sub CopyMemory Lib "kernel32.dll" _ Alias "RtlMoveMemory" ( _ Destination As Any, _ Source As Any, _ ByVal Length As Long) Public Declare Function CallWindowProc Lib "user32.dll" _ Alias "CallWindowProcA" ( _ ByVal lpPrevWndFunc As Long, _ ByVal hWnd As Long, _ ByVal Msg As Long, _ ByVal wParam As Long, _ ByVal lParam As Long) As Long ' Benötigte öffentliche Konstante Public Const GWL_EXSTYLE = -20 Public Const GWL_HINSTANCE = -6 Public Const GWL_HWNDPARENT = -8 Public Const GWL_ID = -12 Public Const GWL_STYLE = -16 Public Const GWL_USERDATA = -21 Public Const GWL_WNDPROC = -4 Public Const DWL_DLGPROC = 4 Public Const DWL_MSGRESULT = 0 Public Const DWL_USER = 8 Public Const NM_CUSTOMDRAW = (-12&) Public Const WM_NOTIFY As Long = &H4E& Public Const CDDS_PREPAINT As Long = &H1& Public Const CDRF_NOTIFYITEMDRAW As Long = &H20& Public Const CDDS_ITEM As Long = &H10000 Public Const CDDS_ITEMPREPAINT As Long = CDDS_ITEM Or CDDS_PREPAINT Public Const CDRF_NEWFONT As Long = &H2& Public Type NMHDR hWndFrom As Long ' Fenster Handle des sendenden Controls idFrom As Long ' ID des sendenden Controls code As Long ' Code End Type ' Substruktur der NMCUSTOMDRAW Struktur Public Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type ' generische CustomDraw Struktur Public 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 ' ListView spezifische CustomDraw Struktur Public Type NMLVCUSTOMDRAW nmcd As NMCUSTOMDRAW clrtext As Long clrtextbk As Long ' Falls der IE >= 4.0, kann dieses Mitglied der Struktur auch verwendet werden: 'iSubItem As Integer End Type ' Öffentliche Variablen Public g_addProcOld As Long Public g_MaxItems As Long Public clrtextbk() As Long Public clrtext() As Long ' Öffentliche Funktion zum "ReDrawen" des ListViews Public Function WindowProc(ByVal hWnd As Long, _ ByVal iMsg As Long, ByVal wParam As Long, _ ByVal lParam As Long) As Long Select Case iMsg Case WM_NOTIFY Dim udtNMHDR As NMHDR CopyMemory udtNMHDR, ByVal lParam, 12& With udtNMHDR If .code = NM_CUSTOMDRAW Then Dim udtNMLVCUSTOMDRAW As NMLVCUSTOMDRAW CopyMemory udtNMLVCUSTOMDRAW, ByVal lParam, Len(udtNMLVCUSTOMDRAW) With udtNMLVCUSTOMDRAW.nmcd Select Case .dwDrawStage Case CDDS_PREPAINT WindowProc = CDRF_NOTIFYITEMDRAW Exit Function Case CDDS_ITEMPREPAINT If clrtext(.dwItemSpec) <> 0 Or clrtextbk(.dwItemSpec) <> 0 Then ' Farbe des Textes, des Eintrages, ' wird mit der nächsten Zeile bestimmt: If clrtext(.dwItemSpec) <> 0 Then udtNMLVCUSTOMDRAW.clrtext = clrtext(.dwItemSpec) End If If clrtextbk(.dwItemSpec) <> 0 Then udtNMLVCUSTOMDRAW.clrtextbk = clrtextbk(.dwItemSpec) End If CopyMemory ByVal lParam, udtNMLVCUSTOMDRAW, Len(udtNMLVCUSTOMDRAW) End If WindowProc = CDRF_NEWFONT Exit Function End Select End With End If End With End Select WindowProc = CallWindowProc(g_addProcOld, hWnd, iMsg, wParam, lParam) End Function ' Öffentliche Funktion, um die Hintergrundfarbe eines ListView Eintrages zu ändern Public Sub SetLIBackColor(lv As ListView, nitem As Integer, BkColor As Long) clrtextbk(nitem - 1) = BkColor lv.Refresh End Sub ' Öffentliche Funktion, um die Schriftfarbe eines ListView Eintrages zu ändern Public Sub SetLIForeColor(lv As ListView, nitem As Integer, ForeColor As Long) clrtext(nitem - 1) = ForeColor lv.Refresh End Sub Jetzt auf die Form folgende Controls platzieren:
Folgenden Code in den Code-Teil der Form einfügen: Option Explicit Private Sub Form_Load() With ListView1 ' ListView Darstellung .View = lvwReport .FullRowSelect = True .GridLines = True .Width = 5600 .Height = 2300 ' ListView-Spalten hinzufügen .ColumnHeaders.Add 1, , "ID" .ColumnHeaders.Add 2, , "Vorname" .ColumnHeaders.Add 3, , "Nachname" ' Spalten-Breiten festlegen .ColumnHeaders(1).Width = 1500 .ColumnHeaders(2).Width = 2000 .ColumnHeaders(3).Width = 2000 ' Vier Einträge hinzufügen .ListItems.Add 1, , "1" .ListItems(1).SubItems(1) = "Martin" .ListItems(1).SubItems(2) = "Mustermann" .ListItems.Add 2, , "2" .ListItems(2).SubItems(1) = "Max" .ListItems(2).SubItems(2) = "Mustermann" .ListItems.Add 3, , "3" .ListItems(3).SubItems(1) = "Michael" .ListItems(3).SubItems(2) = "Mustermann" .ListItems.Add 4, , "4" .ListItems(4).SubItems(1) = "Marco" .ListItems(4).SubItems(2) = "Mustermann" End With Command1.Caption = "Färbe Zeile 3 rot ein, " & _ "und ändere ihre Schriftfarbe in gelb!" ' Subclassing aktivieren ReDim Preserve clrtext(ListView1.ListItems.Count) ReDim Preserve clrtextbk(ListView1.ListItems.Count) g_MaxItems = ListView1.ListItems.Count - 1 g_addProcOld = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc) End Sub Private Sub Command1_Click() ' ListView einfärben (Funktionsaufruf im Modul) SetLIBackColor ListView1, 3, vbRed SetLIForeColor ListView1, 3, vbYellow End Sub ' -------------------------------------------------------------- ' !!!!WICHTIG!!!! ' -------------------------------------------------------------- ' Das Programm muss unbedingt über die Unload-Funktion ' beendet werden, sonst stürzt Visual Basic ab! ' ' Zum Beenden des Programmes NICHT den VB-Stoppknopf ' verwenden, sondern das Programm über das rote X schließen !!! ' -------------------------------------------------------------- Private Sub Form_Unload(Cancel As Integer) ' Subclassing deaktivieren SetWindowLong hWnd, GWL_WNDPROC, g_addProcOld End Sub Dieser Tipp wurde bereits 20.912 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv Vol.6 (einschl. Beispielprojekt!) Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! - nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten - Symbol-Galerie mit mehr als 3.200 Icons im modernen Look Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m. |
vb@rchiv CD Vol.6 Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! Online-Update-Funktion Entwickler-Vollversionen u.v.m. Tipp des Monats März 2024 Dieter Otter UTF-8 Konvertierung von Dateien und Strings VB6 selbst verfügt über keine Funktionen zur UTF-8 Konvertierung von Daten. Mit Hilfe des ADODB.Stream-Objekts lassen sich diese fehlenden Funktionen aber schnell nachrüsten. sevOutBar 4.0 Vertikale Menüleisten á la Outlook Erstellen von Outlook ähnlichen Benutzer- interfaces - mit beliebig vielen Gruppen und Symboleinträgen. Moderner OfficeXP-Style mit Farbverläufen, Balloon-Tips, u.v.m. |
||||||||||||||||
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein. |