fillrecord.bas

来自「农村水电费记帐录入」· BAS 代码 · 共 69 行

Attribute VB_Name = "FillRecord"
Option Explicit

Private Type MatchFieldPair
   rsField As ADODB.Field
   grField As grproLibCtl.IGRField
End Type

Public Sub GRFetchRecordFromRecordset(Report As GridppReport, rs As ADODB.Recordset)
    If rs.BOF And rs.EOF Then Exit Sub

    Dim grRecordset As grproLibCtl.IGRRecordset
    Set grRecordset = Report.DetailGrid.Recordset

    Dim FieldCount As Integer
    FieldCount = grRecordset.Fields.Count
    
    Dim rsFieldCount As Integer
    rsFieldCount = rs.Fields.Count
    
    Dim FieldPairs() As MatchFieldPair
    ReDim FieldPairs(FieldCount)
    
    Dim MatchFieldCount As Integer
    MatchFieldCount = 0
    Dim I As Integer
    For I = 1 To FieldCount
        Set FieldPairs(MatchFieldCount).grField = grRecordset.Fields.Item(I)
        'Set FieldPairs(MatchFieldCount).rsField = rs.Fields.Item(FieldPairs(MatchFieldCount).grField.Name)
        Dim J As Integer
        For J = 0 To rsFieldCount - 1
            If LCase(FieldPairs(MatchFieldCount).grField.Name) = LCase(rs.Fields.Item(J).Name) Then
                Set FieldPairs(MatchFieldCount).rsField = rs.Fields.Item(J)
                MatchFieldCount = MatchFieldCount + 1
                Exit For
            End If
        Next
    Next

    rs.MoveFirst
    Do Until rs.EOF
        Report.DetailGrid.Recordset.Append
        
         For I = 0 To MatchFieldCount - 1
            If Not IsNull(FieldPairs(I).rsField.Value) Then
                Select Case FieldPairs(I).grField.FieldType
                Case grftString
                    FieldPairs(I).grField.AsString = FieldPairs(I).rsField.Value
                Case grftInteger
                    FieldPairs(I).grField.AsInteger = FieldPairs(I).rsField.Value
                Case grftFloat
                    FieldPairs(I).grField.AsFloat = FieldPairs(I).rsField.Value
                Case grftBoolean
                    FieldPairs(I).grField.AsBoolean = FieldPairs(I).rsField.Value
                Case grftDateTime
                    FieldPairs(I).grField.AsDateTime = FieldPairs(I).rsField.Value
                Case Else 'grftBinary
                    FieldPairs(I).grField.Value = FieldPairs(I).rsField.Value
                End Select
            End If
        Next
        
        Report.DetailGrid.Recordset.Post
    
        rs.MoveNext
   Loop
End Sub