Selasa, 27 Januari 2015

Modul Menampilkan Data Pada List View (Visual Basic 6.0)

Sub Tampildata(X As String, ls As ListView, db As ADODB.Connection, icon As Integer)
On Error Resume Next
Dim pList  As ListItem
Dim pJudul As ColumnHeaders
Dim Rs As ADODB.Recordset
Dim Jr As Integer
Dim Total As Currency
Set Rs = New ADODB.Recordset
Dim I, j, Baris, jKolom As Integer
Rs.Open X, db, adOpenDynamic, adLockReadOnly
ls.View = lvwReport
ls.FullRowSelect = True
ls.GridLines = True
ls.AllowColumnReorder = True
ls.ColumnHeaders.Clear
ls.ListItems.Clear
If Not Rs.EOF Then
Jr = Rs.RecordCount
   Rs.MoveFirst
   jKolom = Rs.Fields.Count
  For I = 0 To jKolom - 1
       ls.ColumnHeaders.Add , , Rs.Fields(I).Name
       If IsAngkaNumerik(Trim(Rs.Fields(I).Type)) = True Then
          ls.ColumnHeaders.Item(I + 1).Alignment = lvwColumnRight
       End If
       If IsAngkaNumerik(Trim(Rs.Fields(I).Type)) = False Then
         ls.ColumnHeaders.Item(I + 1).Alignment = lvwColumnLeft
       End If
   Next I
       ls.ColumnHeaders.Item(I + 1).Alignment = lvwColumnLeft
   Baris = 0
   Total = 0
   While Not Rs.EOF
   Total = 0
   Baris = Baris + 1
        Set pList = ls.ListItems.Add(, , Rs.Fields(0), , icon)
         For I = 0 To jKolom - 1
             If ls.ColumnHeaders.Item(I + 1).Alignment = lvwColumnRight Then
                If Rs.Fields(I) < 1 Then
                    pList.SubItems(I) = 0
                Else
                    pList.SubItems(I) = Format(Rs.Fields(I), "###,###,###,###")
                End If
             Else
                pList.SubItems(I) = Rs.Fields(I)
             End If
         Next I
            Rs.MoveNext
       Wend
End If

End Sub
Function getItemList(ls As ListView, col As Integer) As String
On Error Resume Next
col = col - 1
    If col = 0 Then
        getItemList = ls.SelectedItem.Text
    Else
        getItemList = ls.SelectedItem.ListSubItems(col)
    End If
End Function

Cara penggunaannya
 xSQL = "Select * From Nama Tabel "
    Tampildata xSQL, ms, Mydb, 1
    Me.ms.ColumnHeaders.Item(2).Width = 2000

1 komentar: