الاجراء التالى يسمح لنا تمرير مجموعة سجلات ADO إلى عنصر تحكم [ندعوك للتسجيل في المنتدى أو التعريف بنفسك لمعاينة هذا الرابط] مع تمييز عناصر معينة بالألوان

ففى المثال التالى يتم تحميل جدول المنتجات، وسيقوم جميع المنتجات التى سعر الشراء بقيمة "250" في الحقل "المنتجات" بتمييز السجلات باللون الاحمر على النحو التالى :


ملاحظة. يبرز المثال في بيانات الحالة هذه من النوع String ، ولكن يمكن استخدامها أيضًا لإبراز أنواع أخرى ، على سبيل المثال:

• في حقل Boolean كل ذلك يحتوي على قيمة False
  
• في الحقول التي تحتوي على ارقام ، يمكنك استخدام عوامل المقارنة أكبر من أصغر من ...الخ
  
• في حقل من نوع التاريخ ، تلك التي تنتمي إلى نطاق معين ، إلخ ...
  

فى قسم التصريحات العامة

الكود:

Private Declare Function SetErrorMode Lib "kernel32" (ByVal wMode As Long) As Long
Private Declare Sub InitCommonControls Lib "Comctl32" ()
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 Const LVM_SETCOLUMNWIDTH = &H101E


و الاجراء على النحو التالى :

الكود:

Public Sub Recordset_a_ListView( _
    ByRef rst As ADODB.Recordset, _
    ByRef ListView As ListView, _
    sValue As Variant, _
    Optional lColor As Long = vbBlue)
    
    On Error GoTo errSub
    
    Dim i As Integer, k As Integer, iColumna As Integer, vt() As Long
    Dim st() As Single, w() As Long, t As Long, LVitem As ListItem
    
    ListView.ListItems.Clear

    If rst.State = adStateOpen Then
      
       If Not (rst.BOF And rst.EOF) Then
          ListView.View = lvwReport
            iColumna = rst.Fields.Count - 1
            ReDim w(0 To iColumna)
            ReDim st(0 To iColumna)
            ReDim vt(0 To iColumna)


            For i = 0 To iColumna
                If rst(i).DefinedSize > 9 Then
                    w(i) = rst(i).DefinedSize
                Else
                    w(i) = 10
                End If
                t = t + w(i)
            Next
            For i = 0 To iColumna
                st(i) = w(i) / t
                vt(i) = rst.Fields(i).Type
            Next

            
            If ListView.ColumnHeaders.Count = 0 Then
            For i = 0 To iColumna
               ListView.ColumnHeaders.Add , , rst.Fields(i).Name, _
                                          ListView.Width * st(i)
            Next
            
            Else
            For i = 0 To iColumna
                ListView.ColumnHeaders(i + 1).Width = ListView.Width * st(i)
            Next
            End If
            rst.MoveFirst

            While Not rst.EOF
            
               If vt(0) = adBoolean Then
                  If rst.Fields(0).Value = vbFalse Then
                     Set LVitem = ListView.ListItems.Add(, , "NO")
                  Else
                     Set LVitem = ListView.ListItems.Add(, , "YES")
                  End If
               Else
                     Set LVitem = ListView.ListItems.Add(, , rst.Fields(0).Value)
               End If

               If iColumna > 0 Then

               For k = 1 To iColumna
                   If vt(k) = adBoolean Then
                      If rst.Fields(k).Value = vbFalse Then
                         LVitem.ListSubItems.Add , , "NO"
                       Else
                         LVitem.ListSubItems.Add , , "YES"
                       End If
                   Else
                       If IsNull(rst.Fields(k).Value) Then
                          LVitem.ListSubItems.Add , , ""
                       Else
                          LVitem.ListSubItems.Add , , rst.Fields(k).Value
                          If Trim(LCase(rst.Fields(k).Value)) = Trim(LCase(sValue)) Then
                             LVitem.ForeColor = lColor
                          End If
                       End If
                   End If
               Next
               End If
              
               rst.MoveNext
            Wend
            
            ListView.Sorted = True
            ListView.SortKey = 0
        End If
        End If

        db.Close
        Set rst = Nothing
        
        Call Autosize_Columns(ListView1)
    Exit Sub
errSub:
    MsgBox Err.Number & " " & Err.Description, vbCritical
    db.Close
    Set rst = Nothing
End Sub


ويتم الاتصال بهذا الاجراء على النحو التالى :

الكود:

Call Recordset_a_ListView(rst, ListView1, "250", vbRed)

حيث أن

RST : مصدر البيانات
ListView1 : عنصر التحكم الذى نريد تطبيق الاجراء عليه
"250" : القيمة المطلوب تميز السجلات باللون المحدد
vbRed : اللون الملطوب تطبيقة