fpSpreadでVirtualModeを簡単に使う拡張クラス

スプレッドに表示するデータをデータベースから取得しているとします。セルには複雑めの書式を設定していて、3000件くらい読み込むと、うーーーーーんぱ、くらい待たされます。というときに、うぱっと開くためのfpSpread拡張クラスです。

うぱっと開くにはVirtualModeを使います。VirtualModeは画面に表示しそうな範囲だけを処理対象にすることで高速化しています。デフォルトではQueryDataイベントがこれにあたりますが、1レコード複数行のレイアウトを使っていると、データソースとスプレッドの表示位置を対応付ける計算が微妙にめんどくさいので、カレント1レコードごとにQueryRowイベントを発火させるようにしてみました。

fpSpreadEx.cls

Option Explicit
Private WithEvents This As fpSpread
Private OraDynaset      As OraDynaset
Private OnFirst         As Boolean
Private SpreadFormat    As SpreadFormat

Public Event QueryRow()     '1レコード分のデータ要求イベント
Public Event OnFirstQuery() '初回要求時のイベント

' 初期処理
Public Sub Init(Spread As fpSpread, OraDynaset As OraDynaset)
    Set This = Spread
    Set OraDynaset = OraDynaset
    Set SpreadFormat = GetSpreadFormat(This) 'スプレッドから1レコード分のフォーマットを読み込む処理
    OnFirst = True

    This.VirtualMaxRows = OraDynaset.RecordCount * RecordRows
    This.VirtualRows = 100 * RecordRows
    This.VirtualOverlap = 0
    This.VirtualMode = True
End Sub

Public Property Get RecordRows() As Long
    RecordRows = This.ColHeaderRows
End Property
Public Property Get RecordCols() As Long
    RecordCols = This.MaxCols
End Property
Private Function RowToRowPosition(Row As Long) As Long
    RowToRowPosition = (Row - 1) \ RecordRows + 1
End Function
Private Function CurrentTopRow() As Long
    CurrentTopRow = (OraDynaset.RowPosition - 1) * RecordRows + 1
End Function
Private Function CurrentBottomRow() As Long
    CurrentBottomRow = OraDynaset.RowPosition * RecordRows
End Function

'SpreadデフォルトのQueryDataイベント
Private Sub This_QueryData(ByVal Row As Long, ByVal RowsNeeded As Long, RowsLoaded As Long, ByVal Direction As Integer, AtTop As Boolean, AtBottom As Boolean)
    'Row                          'スプレッド先頭Row
    'Row + RowsNeeded - 1         'スプレッド末尾Row
    Dim lngTopRowPosition As Long 'Dynaset先頭RowPosition
    Dim lngEndRowPosition As Long 'Dynaset末尾RowPosition
    lngTopRowPosition = RowToRowPosition(Row)
    lngEndRowPosition = RowToRowPosition(Row + RowsNeeded - 1)

    With This
        Call OraDynaset.MoveTo(lngTopRowPosition)

        Do While Not OraDynaset.EOF
            If OraDynaset.RowPosition > lngEndRowPosition Then
                Exit Do
            End If

            'スプレッド書式設定
            If OraDynaset.RowPosition = lngTopRowPosition Or _
               This.ActiveRow = CurrentTopRow - RecordRows Then
                Call SetFormat
            Else
                Call CopyFormat
            End If
            If This.ActiveRow = CurrentTopRow Then
                Call SetSelectedFormat
            End If
            'RowPositionのデータ要求イベントを発火
            RaiseEvent QueryRow

            OraDynaset.MoveNext
        Loop

        If OnFirst Then
            OnFirst = False
            '初回要求時のイベントを発火
            RaiseEvent OnFirstQuery
        End If
    End With

    RowsLoaded = RowsNeeded
    AtTop = (Row = 1)
    AtBottom = OraDynaset.EOF
End Sub

Private Sub SetFormat()
    'Initで読んでおいたSpreadFormat(スプレッドの1レコード分のセルフォーマット)を、
    'スプレッドに適用する処理を記載する
End Sub

Private Sub SetSelectedFormat()
    '選択行の文字色、背景色の切り替えなどはここで
End Sub

Private Sub CopyFormat()
    '1レコード前のセルフォーマットをまるっとコピーする
    Call This.CopyRowRange(CurrentTopRow - RecordRows, _
                           CurrentBottomRow - RecordRows, _
                           CurrentTopRow)
End Sub

使い方
拡張クラスのInitでスプレッドとデータセットを紐付けます。

Begin FPSpreadADO.fpSpread Spread

Public OraDynaset As OraDynaset
Private WithEvents SpreadEx As fpSpreadEx

'読み込みボタン押下時の処理
    Set OraDynaset = OraDataBase.CreateDynaset(SQL, GC_ORADYN_READONLY)
    Call SpreadEx.Init(Spread, OraDynaset)

要求1レコードごとにQueryRowイベントが発火するので、ここで、データセットのCurrentをスプレッドのCurrentTopRowへ貼り付けます。

Private Sub SpreadEx_QueryRow()
    Dim arr() As String
    ReDim arr(1 To SpreadEx.RecordRows, 0 To SpreadEx.RecordCols)

    With OraDynaset
        '行番号
        arr(1, 0) = .RowPosition

        'データ 1段目
        arr(1, 1) = .Fields("COLUMN1").Value
        arr(1, 2) = .Fields("COLUMN2").Value
        arr(1, 3) = .Fields("COLUMN3").Value

        'データ 2段目
        arr(2, 1) = .Fields("COLUMN4").Value
        arr(2, 2) = .Fields("COLUMN5").Value
        arr(2, 3) = .Fields("COLUMN6").Value
    End With

    Call Spread.SetArray(0, SpreadEx.CurrentTopRow, arr)
End Sub

ちなみに、ユーザーが操作した直後の一回だけの処理（例えばSetFocusとかEnabledを切り替えとか）はOnFirstQueryイベントに記述します。

Private Sub SpreadEx_OnFirstQuery()
    'スプレッドでアクティブ行を切り替えたときの処理など
End Sub