mlistviewloader.bas

来自「一个关于电脑管理汽车的软件」· BAS 代码 · 共 125 行

Attribute VB_Name = "mListviewLoader"
'---------------------------------------------------------------------------------------
' Module    : mListviewLoader
' DateTime  : 03/07/04 14:06
' Author    : Robert Rowe
' Purpose   : Modified to work with VBMySQLDirect
'---------------------------------------------------------------------------------------
'
'    Copyright 2003 Mike Hillyer (www.vbmysql.com)
'
' Module    : mListviewLoader
' DateTime  : November 27, 2003
' Author    : MIKE HILLYER
' Purpose   : See ListViewLoad Sub

Option Explicit
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Const LVM_SETITEMCOUNT As Long = 4096 + 47
 
Public Sub ListViewLoad(lvwData As Control, rs As MYSQL_RS, Optional Owner As Variant = 0)
'---------------------------------------------------------------------------------------
' Procedure : ListViewLoad
' DateTime  : 03/07/04 14:09
' Author    : Robert Rowe
' Purpose   : Modified to work with VBMySQLDirect
'---------------------------------------------------------------------------------------

'THIS FUNCTION IS USED TO TAKE DATA FROM A ADODB RECORDSET AND LOAD IT INTO
'A LISTVIEW CONTROL. PLACING A PROGRESS BAR NAMED pbrProgress ON OWNER FORM
'WILL ALLOW FOR AN UPDATING PROGRESS BAR TO SHOW HOW FAR ALONG YOU ARE WHEN
'OWNER PARAMETER IS SPECIFIED DURING CALL.
'
'NOTE: LISTVIEWS ARE NOT VERY EFFICIENT WITH MEMORY, AND THIS FUNCTION
'IS NOT RECCOMENDED FOR RECORDSETS WITH > 10,000 RECORDS
'
'AUTHOR: MIKE HILLYER
'
'USAGE: ListViewLoad lvwMyListView, rsMyRecordset[, me]
 
    On Error Resume Next
     
    Dim lngCounter As Long
     
    Dim FirstColumn As Boolean
    Dim TempRS As New MYSQL_RS
    Dim TempStr As String
    Dim TempLow As Long
    Dim TempCount As Long
    Dim TempSQL As String
    'FirstColumn = lvwData.Sorted
    lvwData.View = lvwReport                    'THESE PARAMETERS CREATE
    lvwData.LabelEdit = lvwManual               'A DATAGRID-LIKE APPEARANCE
    lvwData.GridLines = True
    lvwData.FullRowSelect = True
     
    lvwData.ListItems.Clear
    lvwData.ColumnHeaders.Clear
    
    TempLow = 0
    TempCount = 0
    TempSQL = "Select * From chinesetable " 'where englishname = " & Quote(TempStr)
    Set TempRS = gCnn.Execute(TempSQL)
    For lngCounter = 0 To rs.FieldCount - 1
        TempStr = rs.Fields(lngCounter).Name
       With rs.Fields(lngCounter + 1)
        If TempStr = "AKey" Or TempStr = "typebs" Or ((TempStr = "billnum" Or TempStr = "drawbillnum") And ((.Name = "goodscoding") Or (.Name = "itemcode") Or (.Name = "datacontxt"))) Then
          If ((.Name = "goodscoding") Or (.Name = "itemcode") Or (.Name = "datacontxt")) And (TempStr = "billnum" Or TempStr = "drawbillnum") Then TempLow = TempLow + 1
         If TempStr = "AKey" Then TempLow = TempLow + 1
        Else
         With TempRS
          .MoveFirst
          .MovePrevious
          .FindNext "englishname", TempStr
          lvwData.ColumnHeaders.Add , , .Fields(2).Value
         End With
         TempCount = TempCount + 1
        End If
      End With
    Next
    TempRS.CloseRecordset
    TempRS.ReleaseMemory
    Set TempRS = Nothing
 
    'PREALLOCATE MEMORY FOR ROWS
    SendMessage lvwData.hWnd, LVM_SETITEMCOUNT, TempCount, 0&
     
    Dim MyItems As MSComctlLib.ListItems
    Set MyItems = lvwData.ListItems
     
    Do Until rs.EOF
        FirstColumn = True      'FIRST COLUMN IS A LISTITEM, REST ARE LISTSUBITEMS
        For lngCounter = TempLow To rs.FieldCount - 1
          If rs.Fields(lngCounter).Name <> "typebs" Then
            If FirstColumn Then
                If Not IsNull(rs.Fields(lngCounter).Value) Then
                    MyItems.Add , , rs.Fields(lngCounter).Value
                Else
                    MyItems.Add , , ""  'NULL FIELDS NEED A BLANK ITEM
                End If                  'TO KEEP DATA FROM SHIFTING LEFT
                FirstColumn = False
            Else
                If Not IsNull(rs.Fields(lngCounter).Value) Then
                    MyItems(MyItems.Count).ListSubItems.Add , , rs.Fields(lngCounter).Value
                Else
                    MyItems(MyItems.Count).ListSubItems.Add , , ""
                End If
            End If
          End If
        Next
        'If Not IsMissing(Owner) Then Owner.pbrProgress.Value = (rs.AbsolutePosition / rs.RecordCount) * 100
        rs.MoveNext
    Loop
    If Owner = 0 Then
     If MyItems.Count > 1 Then
      lvwData.SortKey = 0
      lvwData.SortOrder = 0
      lvwData.Sorted = True
     ' lvwData.Sorted = False
      'FirstColumn = lvwData.Sorted
     End If
    End If
    ' If Asc(left(MyItems.Item(0).Text, 1)) > 125 Then
      
End Sub