MSHFLEXGRID控件讲座(2).网格的编辑,保存与加载

Question

1)  MSHFLEXGRID的编辑.
关于MSHFLEXGRID的编辑,很多书都有介绍.一般都是用一个TEXTBOX作为的输入框,通过移动TEXTBOX来达到类似于EXCEL的编辑功能.很多书介绍的方法是在MOUSEDOWN或CLICK事件中移动TEXTBOX,然后,再在LeaveCell事件中写入.
本文的方法与其有类似之处,但亦有小许不同,主要在写入网格时,在TEXTBOX的Change事件中写入.
2)网格内容的保存与加载
对于网格的保存,一般人喜欢使用.Clip属性,将整个网格一次性地写入一个文件中,当然,在文件不大时,这当然是一个好办法.但是,当网格达到几千行几万行时,这个方法好象不是很好.(各位如果有兴趣的话,可以试试下面的程序)‘将网格设置成5000*12,然后用随机数填充网格.然后,调用下面程序
Private Sub Command4_Click()
        Dim msgStr As String
        Dim FileID As Long
        Dim T1 As Date
        Dim T2 As Date
        
        T1 = Timer()
        With MSHFlexGrid1
                .Row = 0
                .Col = 0
                .RowSel = .Rows - 1
                .ColSel = .Cols - 1
                FileID = FreeFile
                msgStr = .Clip
                Open "C:\LX.TXT" For Output As #FileID
                     Print #FileID, msgStr
                Close #FileID
        End With
        T2 = Timer()
        MsgBox T2 - T1
End Sub
反正我的感觉是:好象死机一般,要过一分多钟后计算机才能反应过来(实测是82.5秒左右,我的计算机是:AMD2500+,512M内存).
为什么一次性的写入会如此的慢呢?这大概是有的人想不到的地方.其实,这跟VB处理字符串的机制有关,如果处理5K的字符串要一秒的话,那么,处理30K的字符串绝不是处理5K的6倍,而是长得多.这种关系几乎是呈某种几何级数的关系.
明白了VB原来处理大字符串的效率原来是这么底.那么,解决的办法自然就有了.就是一个字:拆,将大拆小将会大大地加快处理字符串的速度.
所以,下面的网格的保存函数的主要思想就将网格中的数据分步保存,每一次保存一小部分.直到整个网格保存完成.当然,其中还有一些细小的技巧,例如:保存时将先将网格中的行,列,固定行,固定列的总数保存,然后,保存各列的宽度,再然后正式保存数据.这都是为了加载的方便与快捷作了一定的处理.(参考下面的程序)

Answer 1

Option ExplicitDim m_Row As Long
Dim m_Col As LongPrivate Sub Command3_Click()
         '填充网格
          Dim R As Long
          Dim C As Long
          
          For R = 0 To MSHFlexGrid1.Rows - 1
              For C = 0 To MSHFlexGrid1.Cols - 1
                 MSHFlexGrid1.TextMatrix(R, C) = R & C
              Next
          Next
End SubPrivate Sub Form_Load()
        With MSHFlexGrid1
             Text1.Visible = False
            .RowHeight(-1) = 285
             '设定网格是5000行.12列.
            .Rows = 5000: .Cols = 12
        End With
End Sub'保存文件
Private Sub Command1_Click()
        Call SaveFile(MSHFlexGrid1, "c:\kk.grd")
End Sub'加载文件
Private Sub Command2_Click()
         Call LoadFile(MSHFlexGrid1, "c:\kk.grd")
End SubPrivate Sub MSHFlexGrid1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
        Text1.Visible = False
        With MSHFlexGrid1
            m_Row = .MouseRow
            m_Col = .MouseCol
            If m_Row < .FixedRows Then m_Row = .FixedRows
            If m_Col < .FixedCols Then m_Col = .FixedCols
            .Row = m_Row: .Col = m_Col
            Text1.Move .Left + .CellLeft, .Top + .CellTop, .CellWidth, .CellHeight
            Text1.Text = .Text
            Text1.Visible = True
            Text1.SetFocus
        End With
End SubPrivate Sub Text1_Change()
        With MSHFlexGrid1
            .TextMatrix(m_Row, m_Col) = Text1
        End With
End Sub'//**以下是相应的功能函数
'
'加载一个文件到表格.
'函数:LoadFileToGrid
'参数:MsgObj Mshfelxgrid控件名,FileName 加载的文件名
'返回值:=True 成功.=True 失败.
Public Function LoadFile(MsgObj As Control, FileName As String) As Long
    Dim InputID As Long, FileID As Long
    Dim EndRow As Long, DltAdd As Long
    Dim AddFlag As Boolean
    Dim KeyTab As String, KeyEnter As String
    Dim FixedRows As Long, FixedCols As Long
    Dim GridInput As String, AddSum As String, RowColMax() As String
    Dim GridColMax As Long, GridRowMax As Long
    Dim OleRow As Long, OleCol As Long
    Dim SumFmtStr As String
    Dim DltCol As Long
    
    On Error Resume Next
    
    With MsgObj
        .Redraw = False
        Err.Clear: SetAttr FileName, 0
        If Err.Number <> 0 Then '如果文件不存在
           Err.Clear
           Call SaveFile(MsgObj, FileName)
           .Redraw = True
           Exit Function
        End If
        
        KeyTab = Chr$(vbKeyTab): KeyEnter = Chr$(13)
        InputID = 0: AddSum = ""
        AddFlag = False: DltAdd = 25: DltCol = 1
        .Redraw = False: .FixedRows = 0: .FixedCols = 0
        
        FileID = FreeFile
        Open FileName For Input As #FileID
             Do While Not EOF(FileID) ' 循环至文件尾。
                Line Input #FileID, GridInput
                If InputID <= 1 Then
                   '取出总行数和总列数,以及各列的宽度.
                   If InputID = 0 Then
                        RowColMax = Split(GridInput, "|")
                        GridRowMax = CLng("0" & RowColMax(0)): GridColMax = CLng("0" & RowColMax(1))
                        If CLng("0" & RowColMax(0)) < 2 Then GridRowMax = 1
                        If CLng("0" & RowColMax(1)) < 2 Then GridColMax = 1
                        .Rows = GridRowMax: .Cols = GridColMax
                   Else
                        SumFmtStr = GridInput '格式字符串.
                   End If
                Else
                   If AddFlag Then
                      AddSum = AddSum & KeyEnter & GridInput
                   Else
                      AddSum = GridInput: AddFlag = True
                   End If
                   If (InputID - DltCol) Mod DltAdd = 0 Then
                      .Row = InputID - DltAdd - DltCol: .Col = 0
                      .RowSel = InputID - 1 - DltCol: .ColSel = GridColMax - 1
                      .Clip = AddSum: AddSum = ""
                      EndRow = InputID - DltCol: AddFlag = False
                   End If
                End If
                InputID = InputID + 1
             Loop
             If (InputID - DltCol) - EndRow > 1 Then
                .Row = EndRow: .Col = 0
                .RowSel = GridRowMax - 1
                .ColSel = GridColMax - 1
                .Clip = AddSum
                AddSum = ""
             End If
        Close #FileID
        
        Call FormatGrid(MsgObj, SumFmtStr)
        
        .FixedRows = CLng("0" & RowColMax(2)): .FixedCols = CLng("0" & RowColMax(3))
        .Redraw = True
        
        .Row = .FixedRows
        .Col = .FixedCols
        .RowSel = .FixedRows
        .ColSel = .FixedCols
    End With
End Function'
'保存表格数据
'函数:SaveFile
'参数:MsgObj Mshfelxgrid控件名,FileName 加载的文件名
'返回值:=True 成功.=True 失败.
Public Function SaveFile(MsgObj As Control, FileName As String) As Boolean
'/保存文件
    Dim FileID As Long, ConTents As String
    Dim A As Long, B As Long
    Dim RowMax As Long, ColMax As Long
    Dim FixRows As Long, FixCols As Long
    Dim OleRow As Long, OleCol As Long
    Dim SFmtStr As String
    Dim strColWidth As String
    
    On Error Resume Next
    
    With MsgObj
        .Redraw = False
        FixRows = .FixedRows: FixCols = .FixedCols
        RowMax = .Rows - 1: ColMax = .Cols - 1
        .FixedRows = 0: .FixedCols = 0
        FileID = FreeFile        Open FileName For Output As #FileID
             ConTents = RowMax + 1 & "|" & ColMax + 1 & "|" & FixRows & "|" & FixCols & "|"
             Print #FileID, ConTents  '保存总的行数和列数.
             For A = 0 To .ColMax
                 strColWidth = strColWidth & .ColWidth(A) & "|"
             Next
             Print #FileID, Left$(strColWidth, Len(strColWidth) - 1) '保存各列的宽度.
             
             For A = 0 To RowMax
                 .Row = A: .Col = 0
                 .RowSel = A: .ColSel = ColMax
                 ConTents = .Clip
                 Print #FileID, ConTents
             Next A
        Close #FileID
        .FixedRows = FixRows: .FixedCols = FixCols
        .Redraw = True
    End With
    SaveFile = (Err.Number = 0)
    Err.Clear
End Function'格式网格:在这里是设置网格宽度.
Function FormatGrid(MsgObj As Control, FmtStr As String)
         Dim I As Long
         Dim WithArr() As String
         On Error Resume Next
         WithArr = Split(FmtStr)
         For I = 0 To UBound(WithArr)
             If IsNumeric(WithArr(I)) Then
                MsgObj.CellWidth(I) = CLng("0" & WithArr(I))
             End If
         Next
End Function

Answer 2

晕，变成2个贴了，呵呵。MSTOP不错不错。

Answer 3

   稍为更正一下:'格式网格:在这里是设置网格宽度.
Function FormatGrid(MsgObj As Control, FmtStr As String)
         Dim I As Long
         Dim WithArr() As String
         On Error Resume Next
         WithArr = Split(FmtStr)
         For I = 0 To UBound(WithArr,"|")
             If IsNumeric(WithArr(I)) Then
                MsgObj.CellWidth(I) = CLng("0" & WithArr(I))
             End If
         Next
End Function

Answer 4

稍为更正一下:'格式网格:在这里是设置网格宽度.
Function FormatGrid(MsgObj As Control, FmtStr As String)
         Dim I As Long
         Dim WithArr() As String
         On Error Resume Next
         WithArr = Split(FmtStr,"|")
         For I = 0 To UBound(WithArr)
             If IsNumeric(WithArr(I)) Then
                MsgObj.CellWidth(I) = CLng("0" & WithArr(I))
             End If
         Next
End Function

Answer 5

   对不起，写得太匆忙了，这个函数一错再错。最后一次更正。
   55555555555555'格式网格:在这里是设置网格宽度.
Function FormatGrid(MsgObj As Control, FmtStr As String)
         Dim I As Long
         Dim WithArr() As String
         
         WithArr = Split(FmtStr, "|")
         For I = 0 To UBound(WithArr)
             If IsNumeric(WithArr(I)) Then
                If Val(WithArr(I)) > 0 Then MsgObj.ColWidth(I) = CLng("0" & WithArr(I))
             End If
         Next
End Function

Answer 6

听课ing
如何按照内容，自动调整显示宽度呢？？？

Answer 7

如何按照内容，自动调整显示宽度呢？？？
'---------------------------------------
要按照内容自动调整列宽。只要适当地修改一下Text1_Change函数即可，如下：Private Sub Text1_Change()
        Dim OleWidth As Long
        Dim NewWidth As Long
        
        With MSHFlexGrid1
         .TextMatrix(m_Row, m_Col) = Text1
         .Text = Text1
         '根据输入自动调列宽
         NewWidth = Me.TextWidth(.Text)'新列宽
         OleWidth = .CellWidth         '旧列宽
         If NewWidth > OleWidth Then   '如果新列大于旧列，则将列宽设置为一个新值。
            .ColWidth(.Col) = NewWidth
            Text1.Width = NewWidth
            DoEvents
         End If
       End With
End Sub

Answer 8

这乎这样不是很有效，因为代码看起来比较乱。也难于理解。
这样吧，我干脆将功能打包成类。在下一章里，我将一些关于MSHFLEXGRID的编辑功能教大家打包成一相类，这样用起来也方便不少。当然，功能要悉当加强。除有上面所说之外，加入键盘的移动，添加删除列和列表达式计算等一些功能。
对于数据库方面的功能，由于过于冗长，将不会汲及。仅仅是打包普通的编辑功能。

Answer 9

dd这个数据库是要求windows integrated authentication还是混合认证？