datashow.bas

为个人用户开发的车险秘书系统

Attribute VB_Name = "DataShow"
Option Explicit

Public Sub InitSingleCol(Flex As MSFlexGrid, Value, Col, Row, Width)
    Flex.Row = Row
    Flex.Col = Col
    Flex.ColAlignment(Col) = flexAlignCenterCenter
    Flex.Text = Value
    Flex.Font.Bold = True
    Flex.ColWidth(Col) = Width
    Flex.RowHeight(Row) = 300
End Sub

Public Sub AddRowInFlex(Flex As MSFlexGrid, ByVal Description As String)
    Dim CurrRow, ShowNum As Integer
    Dim imax As Integer
    Dim mystring
    On Error Resume Next
    ' 高度
    Flex.Height = (240 * (Flex.Rows + 1)) + 50
    ' 新的行
    Flex.Rows = Flex.Rows + 1
    ' 获取行填充数据
    CurrRow = Flex.Rows - 1
    
    mystring = Split(Description, "◆◆", -1, vbTextCompare)
    imax = UBound(mystring)
    For ShowNum = 0 To imax - 1
        Flex.TextMatrix(CurrRow, ShowNum) = mystring(ShowNum)
        Flex.RowHeight(CurrRow) = 300
    Next
End Sub

Public Sub ShowTextBox(Flex As MSFlexGrid, Tinsert As TextBox)
        '首先要实现文本框显示的时候，能与网格单元准确重合。ShowTextBox子例程便可以实现此功能。
        '在此考虑网格本身的Top和Left值、网格单元的高度和宽度、分隔网格单元的边框的宽度。

        With Flex
         '隐藏文本框，设置高度和宽度
         Tinsert.Visible = False
         Tinsert.Height = .RowHeight(.Row) - (Screen.TwipsPerPixelY) * 2
         Tinsert.Width = .ColWidth(.Col)
        ' 计算文本框左坐标
         Tinsert.Left = .CellLeft + .Left
         Tinsert.Top = .CellTop + .Top
         Tinsert.Visible = True
         Tinsert.SetFocus
     End With
End Sub

Public Sub MSFDblClick(Flex As MSFlexGrid, Tinsert As TextBox)
    '双击网格单元可以对网格单元中内容进行编辑。
    If Flex.Row > 0 And Flex.Col >= 1 Then
        Call MSFKeyPress(13, Flex, Tinsert)
    End If
    
End Sub

Public Sub MSFDblClicksel(Flex As MSFlexGrid, Tinsert As ComboBox)
    '双击网格单元可以对网格单元中内容进行编辑。
    If Flex.Row > 0 And Flex.Col >= 1 Then
        Call MSFKeyPresssel(13, Flex, Tinsert)
    End If
    
End Sub

Public Sub MSFKeyPress(KeyAscii As Integer, Flex As MSFlexGrid, Tinsert As TextBox)
    '当有按键触发网格单元时，则把单元中的内容保存到文本框中，然后显示文本框等待编辑。
    Dim char As String

    If KeyAscii = 13 Then
        Tinsert.Text = Flex.Text
        Tinsert.SelStart = Len(Tinsert.Text)
    Else
        char = Chr$(KeyAscii)
        Tinsert.Text = char
        Tinsert.SelStart = 1
    End If
    Call ShowTextBox(Flex, Tinsert)
    KeyAscii = 0
End Sub

Public Sub MSFKeyPresssel(KeyAscii As Integer, Flex As MSFlexGrid, Tinsert As ComboBox)
    '当有按键触发网格单元时，则把单元中的内容保存到文本框中，然后显示文本框等待编辑。
    Dim char As String

    If KeyAscii = 13 Then
        Tinsert.Text = Flex.Text
        Tinsert.SelStart = Len(Tinsert.Text)
    Else
        char = Chr$(KeyAscii)
        Tinsert.Text = char
        Tinsert.SelStart = 1
    End If
    Call ShowTextBoxSel(Flex, Tinsert)
    KeyAscii = 0
End Sub

Public Sub ShowTextBoxSel(Flex As MSFlexGrid, Tinsert As ComboBox)
        '首先要实现文本框显示的时候，能与网格单元准确重合。ShowTextBox子例程便可以实现此功能。
        '在此考虑网格本身的Top和Left值、网格单元的高度和宽度、分隔网格单元的边框的宽度。

        With Flex
         '隐藏文本框，设置高度和宽度
         Tinsert.Visible = False
         'Tinsert.Height = .RowHeight(.Row) - (Screen.TwipsPerPixelY) * 2
         Tinsert.Width = .ColWidth(.Col)
        ' 计算文本框左坐标
         Tinsert.Left = .CellLeft + .Left
         Tinsert.Top = .CellTop + .Top
         Tinsert.Visible = True
         Tinsert.SetFocus
     End With
End Sub

Public Sub MSFLeaveCell(Flex As MSFlexGrid)
'当焦点离开一个网格单元时，先保存文本框中的内容到网格单元，然后检测离开单元是否在最大行第一列（可自己设第几列），如果是自动加一行。
    'If vid > 0 Then
    'MsgBox vid
    '    If Tinsert.Text <> "" Then
    '        MSF.Text = Tinsert.Text
   '         If vid <> MSF.Row Then
   '             vid = MSF.Row
                'MsgBox MSF.Row
   '         End If
    '    End If
        If Flex.Col = 0 And Flex.Row <> 0 And Flex.Row = Flex.Rows - 1 And Flex.Text <> "" Then
             Flex.Rows = Flex.Rows + 1
         End If
    'End If
End Sub

Public Sub MSFMouseDown(Tinsert As TextBox)
    '响应鼠标动作
    Tinsert.Visible = False
End Sub
Public Sub MSFMouseDownSel(Tinsert As ComboBox)
    '响应鼠标动作
    Tinsert.Visible = False
End Sub

Public Sub MSFRowColChange(Flex As MSFlexGrid, Tinsert As TextBox)
    '当网格单元发生变化时，取网格单元内容到文本框，等待编辑，从而保证文本框中的内容最新。
    Tinsert.Text = Flex.Text
End Sub

Public Sub MSFRowColChangeSel(Flex As MSFlexGrid, Tinsert As ComboBox)
    '当网格单元发生变化时，取网格单元内容到文本框，等待编辑，从而保证文本框中的内容最新。
    Tinsert.Text = Flex.Text
End Sub

Public Sub showCombox(Tinsert As ComboBox, vid As Integer)
    Tinsert.Clear
    Select Case vid
    Case 1
        With Tinsert
            .AddItem "男"
            .AddItem "女"
            .ListIndex = 0
        End With
    Case 2
        With Tinsert
            .AddItem "成交"
            .AddItem "未成交"
            .ListIndex = 0
        End With
    Case 3
        With Tinsert
            .AddItem "有赔偿"
            .AddItem "上年无赔"
            .ListIndex = 0
        End With
    Case 4
        With Tinsert
            .AddItem "满意"
            .AddItem "不满意"
            .AddItem "未知"
            .ListIndex = 0
        End With
    Case 5
        With Tinsert
            .AddItem "已结案"
            .AddItem "未结案"
            .ListIndex = 0
        End With
    Case 6
        Call showselcb(Tinsert, "车辆颜色")
    Case 7
        Call showselcb(Tinsert, "承保公司名称")
    Case 8
        With Tinsert
            .AddItem "中国境内"
            .AddItem "省内"
            .AddItem "未知"
            .ListIndex = 0
        End With
    Case Else
    End Select
End Sub

Public Sub ShowSelBox(vname As ComboBox, vtn As String)
    Dim sql As String
    Dim rs As Recordset
    Dim vdb As Boolean
    
    vname.Clear
    sql = "select 属性 from sys where 类别='" & vtn & "'"
    vdb = ExcSql
    If vdb = True Then
        Set rs = conn.Execute(sql)
        If Not rs.EOF Then
        With vname
            Do While Not rs.EOF
                .AddItem rs("属性")
            rs.MoveNext
            Loop
            .ListIndex = 0
        End With
        End If
        rs.Close
        Set rs = Nothing
    End If

End Sub

Public Sub printDate(Flex As MSFlexGrid)
    Dim i As Integer
    Dim j As Integer
    Dim xlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = True
    'Set xlBook = xlApp.Workbooks.Add
    'On Error Resume Next
    Set xlBook = xlApp.Workbooks.Add
    Set xlSheet = xlBook.Worksheets(1)
    'xlSheet.Cells(2, 1) = "i"

    For i = 0 To Flex.Rows - 1
        Flex.Row = i
        For j = 1 To Flex.Cols - 1
            Flex.Col = j
        
            'If IsNull(MSFzy.Text) = False Then
                xlSheet.Cells(i + 1, j) = Flex.Text
            'End If
        Next j
    Next i
End Sub