登录  
 加关注
查看详情
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

樱之花

叶散的时候,你明白欢聚;花谢的时候,你明白青春.

 
 
 

日志

 
 
关于我

分类中“我的实验室”是我在日常工作中的一些知识总结,有些写的比较匆忙,可能大家在阅读时会产生困扰,后期有时间我会重新整理编辑,谢谢大家的到访,您们的支持是我前进的动力!

MSHFLEXGRID控件网格的编辑保存与加载  

2007-08-01 14:44:23|  分类: Visual Basic |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |

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原来处理大字符串的效率原来是这么底.那么,解决的办法自然就有了.就是一个字:拆,将大拆小将会大大地加快处理字符串的速度.
所以,下面的网格的保存函数的主要思想就将网格中的数据分步保存,每一次保存一小部分.直到整个网格保存完成.当然,其中还有一些细小的技巧,例如:保存时将先将网格中的行,列,固定行,固定列的总数保存,然后,保存各列的宽度,再然后正式保存数据.这都是为了加载的方便与快捷作了一定的处理.(参考下面的程序)

Option Explicit

Dim m_Row As Long
Dim m_Col As Long

Private 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 Sub

Private 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 Sub

Private 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 Sub

Private 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

 

  评论这张
 
阅读(1003)| 评论(0)

历史上的今天

在LOFTER的更多文章

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2018