modattachdatagrid.bas

ktv场所的包房开房、迎宾、预定管理系统。

Attribute VB_Name = "ModAttachdatagrid"
Option Explicit
'**************************************************************
'*模块名称：ModAttachdataGrid
'*模块功能：将dataGrid中的数据添加到报表类
'*说明：
'*
'*备注：
'*
'*作者：progame
'*日期：2002-04-09 18:54:58
'***************************************************************

Private Const ModalName = "ModAttachdataGrid"


'**************************************************************
'*名称：AttachdataGrid
'*功能：将FlexGrid(dataGrid)中的数据添加到报表类
'*传入参数：
'*      rpt                 --报表类
'*      datagrid            --网格控件
'*返回参数：
'*      是否成功
'*作者：progame
'*日期：2002-04-09 18:58:40
'**************************************************************
Public Function funAttachdataGrid(rpt As report, datagrid 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 datagrid
        col = 0
        
        For i = 1 To .Columns.count
            '*先对控件进行处理...
                '*如果未定义过列宽(即列宽值为-1)，则设置为1005
                If .Columns(i - 1).width = 0 Then
                    .Columns(i - 1).width = 1005
                End If

                '*列的对齐方式的设置，如果为字符串左对齐，数据右对齐，则设置为左对齐
                If .Columns(i - 1).alignment = 9 Then
                    .Columns(i - 1).alignment = 1
                End If
                '*列头 (如果为字符串左对齐，数据右对齐，则设置为居中对齐)

                If .Columns(i - 1).width > LEASTWIDTH Then
                    col = col + 1
                End If
        Next i
        '*设置对象的行列数
        rpt.ColHeader.SetColRows col, 1
        rpt.Content.SetColRows col, .VisibleRows
        col = 0
        For i = 1 To .Columns.count
            If .Columns(i - 1).width > LEASTWIDTH Then
                col = col + 1
                '*取列头对齐和列对齐方式
                alignColHeader = tymiddle ' Int(.ColAlignmentHeader(0, i - 1) / 3)
                alignCol = Int(.Columns(i - 1).alignment / 3)
                .col = i - 1
                '*列头
                For j = 1 To 1
                    .row = j - 1
                    Set cell = New clsCell
                    With cell
                        .colFrom = col
                        .colTo = col
                        .rowFrom = j
                        .rowTo = j
                        .text.drawBorder = True
                        .text.stringX = datagrid.Columns(i - 1).Caption
                        .text.Align = alignColHeader
                        .text.width = datagrid.Columns(i - 1).width
                        '.text.height = datagrid.rowheight(j - 1)
                        .text.rowheight = datagrid.rowheight
                        '.text.ForeColor = datagrid.CellForeColor
                    End With
                    rpt.ColHeader.SetCell cell
                    Set cell = Nothing
                Next j
                
                '*设置正文的列属性
                .row = 0
                Set cText = New clsText
                With cText
                    .rowheight = datagrid.rowheight
                    .width = datagrid.Columns(i - 1).width
                    .drawBorder = True
                    .Align = alignCol
                    '.ForeColor = datagrid.CellForeColor
                    
                    rpt.Content.SetColText col, cText
                End With
                Set cText = Nothing
                
                '*正文
                For j = 1 To .VisibleRows
                    Set cellnew = New clsCellNew
                    With cellnew
                        .colFrom = col
                        .colTo = col
                        .rowFrom = j
                        .rowTo = j
                        datagrid.row = j - 1
                        .stringX = "" & datagrid.Columns(i - 1).text
                        .height = datagrid.rowheight
                    End With
                    rpt.Content.SetCell cellnew
                    Set cellnew = Nothing
                Next j
                
                '*设置合并列
'                If .mergeCol(i - 1) Then
'                    rpt.Content.SetMergeCol col, True
'                End If
            End If
        Next i
        
    End With
    funAttachdataGrid = True
    Exit Function
    
err_proc:
    funAttachdataGrid = False
    MsgBox Err.Description & Err.Number

End Function