Attribute VB_Name = "ModAttachListView"
Option Explicit
'**************************************************************
'*模塊名稱：ModAttachListView
'*模塊功能：將FlexGrid中的數據添加到報表類
'*說明：
'*
'*備注：
'*
'*作者：progame
'*日期：2002-04-28 12:21:58
'***************************************************************

Private Const ModalName = "ModAttachListView"


'**************************************************************
'*名稱：ModAttachListView
'*功能：將ListView中的數據添加到報表類
'*傳入參數：
'*      rpt             --報表類
'*      listview        --ListView控件
'*返回參數：
'*      是否成功
'*作者：progame
'*日期：2002-04-09 18:58:40
'**************************************************************
Public Function funAttachListView(rpt As Report, listview As Object) As Boolean

Dim i               As Integer
Dim j               As Integer
Dim cell            As clsCell          '*單元格
Dim cellnew         As clsCellNew
Dim col             As Integer
Dim cText           As clsText
Dim alignColHeader  As typeAlign        '*列頭對齊方式
Dim alignCol        As typeAlign        '*列對齊方式

    
    On Error GoTo err_proc
    
    With listview
        col = 0
        For i = 1 To .ColumnHeaders.Count
            If .ColumnHeaders(i).width > LEASTWIDTH Then
                col = col + 1
            End If
        Next i
        
        '*設置對象的行列數
        rpt.ColHeader.SetColRows col, 1
        rpt.Content.SetColRows col, listview.ListItems.Count
        
        col = 0
        For i = 1 To .ColumnHeaders.Count
        
            If .ColumnHeaders(i).width > LEASTWIDTH Then
                col = col + 1

                
                '*取列頭對齊和列對齊方式
                Select Case .ColumnHeaders(i).Alignment
                    Case 0
                        alignCol = tyLeft
                    Case 1
                        alignCol = tyRight
                    Case 2
                        alignCol = tymiddle
                End Select

                alignColHeader = tymiddle
                
                '*列頭
                For j = 1 To 1

                    Set cell = New clsCell
                    With cell
                        .colFrom = col
                        .colTo = col
                        .rowFrom = j
                        .rowTo = j
                        .text.drawBorder = True
                        .text.stringX = listview.ColumnHeaders(i).text
                        .text.Align = alignColHeader
                        .text.width = listview.ColumnHeaders(i).width
                        .text.height = CalHeight(listview.Font.Size) + 2 * MYSPACE
                        .text.rowheight = .text.height
                        .text.ForeColor = vbBlack
                    End With
                    rpt.ColHeader.SetCell cell
                    Set cell = Nothing
                Next j
                
                '*設置正文的列屬性
                Set cText = New clsText
                With cText
                    .rowheight = CalHeight(listview.Font.Size) + 2 * MYSPACE
                    .width = listview.ColumnHeaders(i).width
                    .Align = alignCol
                    .ForeColor = listview.ListItems(1).ForeColor
                    .drawBorder = True
                    .Align = alignCol
                    rpt.Content.SetColText col, cText
                End With
                Set cText = Nothing
                
                '*正文
                For j = 1 To .ListItems.Count
                    Set cellnew = New clsCellNew
                    With cellnew
                        .colFrom = col
                        .colTo = col
                        .rowFrom = j
                        .rowTo = j
                        If i = 1 Then
                            .stringX = listview.ListItems(j).text
                        Else
                            .stringX = listview.ListItems(j).SubItems(i - 1)
                        End If
                        .height = CalHeight(listview.Font.Size) + 2 * MYSPACE
                    End With
                    rpt.Content.SetCell cellnew
                    Set cellnew = Nothing
                Next j
            End If
        Next i
        
    End With
    funAttachListView = True
    Exit Function
    
err_proc:
    funAttachListView = False
End Function