mlistoperate.bas

地面测试仪

Attribute VB_Name = "mListOperate"
Option Base 1
Option Explicit
'list的操作
'添加，删除，查找

Function SetMSFlex(Msf As MSFlexGrid)
'**********************************************************************
'* 函数名称:SetMSFlex
'* 函数描述:设置网格样式
'* 参数列表:Msf,MSFlexGrid网格
'* 返    回:
'* 作    者:
'* 创建日期: 2008-03-07
'**********************************************************************
Dim i As Integer
Msf.FocusRect = 2
Msf.Cols = 11
Msf.Rows = 12

Msf.MergeCells = flexMergeRestrictRows
Msf.MergeRow(0) = True
Msf.MergeRow(1) = True
Msf.MergeRow(2) = True

For i = 1 To 10
    Msf.colWidth(i) = 1000
Next

'1

Msf.TextMatrix(0, 0) = "试验"

For i = 1 To 6
    Msf.TextMatrix(0, i) = "压力示值MPa"
Next

Msf.TextMatrix(0, 7) = "平均值"
Msf.TextMatrix(0, 8) = "平均值"

Msf.TextMatrix(0, 9) = "最大"
Msf.TextMatrix(0, 10) = "示 值"
'2
Msf.TextMatrix(1, 0) = "套压"

Msf.TextMatrix(1, 1) = "一次"
Msf.TextMatrix(1, 2) = "一次"
Msf.TextMatrix(1, 3) = "两次"
Msf.TextMatrix(1, 4) = "两次"
Msf.TextMatrix(1, 5) = "三次"
Msf.TextMatrix(1, 6) = "三次"

Msf.TextMatrix(1, 7) = "MPa"
Msf.TextMatrix(1, 8) = "MPa"
Msf.TextMatrix(1, 9) = "误差"
Msf.TextMatrix(1, 10) = "误 差"


'3
Msf.TextMatrix(2, 0) = "MPa"
For i = 0 To 3
    Msf.TextMatrix(2, i * 2 + 1) = "加载"
    Msf.TextMatrix(2, (i + 1) * 2) = "减载"
Next
Msf.TextMatrix(2, 9) = "Sx"
Msf.TextMatrix(2, 10) = "MPa"

End Function

'添加一条
Function addList(strFile As String)
'**********************************************************************
'* 函数名称:addList
'* 函数描述:添加一条
'* 参数列表:strFile文件名
'* 返    回:
'* 作    者:
'* 创建日期: 2007-10-08
'**********************************************************************

Dim strTemp As String
Dim ListNum As Integer
Dim itmx As ListItem
strTemp = Dir(strFile) '获得文件名
ListNum = findList(strFile) '查找文件
If ListNum > 0 Then
    setListFocus ListNum '设置焦点
Else
    Set itmx = mList.ListItems.Add(, , strTemp, , 8) '图标
    itmx.ToolTipText = strFile
    ListNum = itmx.Index
End If
setListFocus ListNum
End Function
'删除一条
Function delList(strFile As String)
'**********************************************************************
'* 函数名称:delList
'* 函数描述:删除一条
'* 参数列表:strFile文件名
'* 返    回:
'* 作    者:
'* 创建日期: 2007-10-08
'**********************************************************************
Dim ListNum As Integer

ListNum = findList(strFile)

If ListNum > 0 Then
    mList.ListItems.Remove ListNum
End If
End Function
'查找一条 返回索引
Function findList(strFile As String) As Integer
'**********************************************************************
'* 函数名称:findList
'* 函数描述:查找一条 返回索引
'* 参数列表:strFile文件名
'* 返    回:索引值
'* 作    者:
'* 创建日期: 2007-10-08
'**********************************************************************
Dim itmx As ListItem
findList = 0
For Each itmx In mList.ListItems
    If itmx.ToolTipText = strFile Then
        findList = itmx.Index
        Exit For
    End If
Next
End Function
'设置焦点
Function setListFocus(Optional ListIndex = 1)
'**********************************************************************
'* 函数名称:setListFocus
'* 函数描述:设置焦点
'* 参数列表:ListIndex索引值 默认值1
'* 返    回:
'* 作    者:
'* 创建日期: 2007-10-08
'**********************************************************************
Dim itmx As ListItem
Set itmx = mList.ListItems(ListIndex)
itmx.Selected = True
End Function

'
Sub setListData(list As ListView)
'**********************************************************************
'* 函数名称:setListData
'* 函数描述:设置列表框显示数据（针对回归数据）
'* 参数列表:list列表框
'* 返    回:
'* 作    者:
'* 创建日期: 2007-10-08
'**********************************************************************
Dim itmx As ListItem
Dim i As Integer

    
    '列名
    If list.ColumnHeaders.Count = 0 Then
        list.ColumnHeaders.Add , , "序号", 600, 0
        list.ColumnHeaders.Add , , "时间 ", 700, 2
        list.ColumnHeaders.Add , , "套压", 800, 2
        list.ColumnHeaders.Add , , "液面深", 800, 2
    End If
   
    list.ListItems.Clear
    If TempDmyData.ReadSuc Or list.ToolTipText <> TempDmyData.fileName Then
        list.ToolTipText = TempDmyData.fileName
        For i = 1 To UBound(TempDmyData.dmyYT)
            Set itmx = list.ListItems.Add(, , CStr(i))
            itmx.SubItems(1) = TempDmyData.dmyYT(i, 1)
            itmx.SubItems(2) = TempDmyData.dmyYT(i, 3)
            itmx.SubItems(3) = TempDmyData.dmyYT(i, 2)
        Next
        list.ListItems(1).Selected = True
    End If

End Sub