下面我给大家讲一下MSHFLEXGRID常用的属性,方法事件,还有一些不能不知道的技巧.
1) MSHFLEXGRID的重要属性.
MSHFLEXGRID的属性非常多,其实绝大部分的属性和网格的显示的外观有关.在MSDN里,这些属性足以将人搞得眼花缭乱的了(我相信你没有耐性一个一个地翻查).
下面列出常用的属性,方法事件及其简要说明.以便查阅.
属性 类型 说明
AllowBigSelector Boolean 返回/设置一个值,定义当在行或列的头部单击时,是否该行或列将整个被选中
AllowUseResizing Enum 设置/返回一个值,定义用户是否可以调整网格行,列的尺寸
BackColor Ole_Color 设置/返回一网格中非固定单元的背景色
BackColorBand Array/Ole_Color 设置/返回网格中每个独立BAND的背景色
BachColorBkg Ole_Color 设置/返回网格的背景色(单元头部除外)
BackColorFixed Ole_Color 设置/返回网格中固定单元的背景色
BackColorHeader Array/Ole_Color 设置/返回网格头部单元的背景色
BackColorIndent Array/Ole_Color 设置/返回网格中凹痕部分的背景色
BackColorSel Ole_Color 设置/返回网格选中单元的背景色
BackColorUnpopulated Ole_Color 设置/返回网格非用户操作区的背景色
BandData Array/Long 为独BAND设置/返回任意的值,以合在代码中通过这些值确定BAND
BandDisplay Enum 定义在网格中BAND是水平还是垂直显示
BandExpandable ARRAY/BOOLEN 设置/返回值指明独立的BAND能否被折叠或展开
BandIndent Array/Long 定义BAND划分的字段数量
BandLevel Long 返回当前的单元包含的BAND总数量
Bands Long 返回网格中BAND总数量
CellAlignment Integer 设置/返回一个值以定义当前单元的水平和垂直对齐方式
CellBackColor Ole_Color 定义当前单元的字体是否为粗体
CellFontBold Boolean 定义当前单元的字体是否为粗体
CellFontItalic Boolean 定义当前单元的字体是否为斜体
CellFontName String 定义当前单元的字体名
CellFontSize String 定义当前单元的字体大小
CellFontStrikeThough Boolean 定义当前单元的字体是否为突显示
CellFontUnderline Boolean 定义当前单元的字体是有下划线
CellFontWidth Single 定义当前单元的字体宽(用点表示)
CellFontColor Ole_Color 设置/返回当前单元格的前景色
CellHeight Long 设置/返回当前单元格的高度
CellLeft Long 返回当前单元格的左边距
CellPicture StdPicture 设置/返回当前单元格的图片
CellPictureAlignment Integer 设置/返回当前单元格或某范围的单元格的图像对齐方式
CelltextStyle Enum 设置/返回当前单元或选中范围单元文本的3D风格
CellTop Long 返回当前单元格的垂直位置
CellType Enum 设置/返回当前单元格的类型(标准.固定)
CellWidth Long 返回/设置当前的单元的宽度
Clip String 设置/返回网格选定范围单元的内容
Col Array/Integer 设置/返回当前单元的水平坐标
ColAlignment Array/Integer 设置/返回当前列的对齐方式
ColalignmentBand Array/Integer 设置/返回BAND数据列的对齐方式
ColAlignmentFixed Array/Integer 设置/返回固定单元数据的对齐方式
ColAlignmentHeader Array/Integer 设置/返回固定头部单元数据的对齐方式
ColData Ayyay/Long 为独立列设置/返回任意的值,以合在代码中通过这些值确定列
ColHeader Array/Enum 定义每个BAND头部是否显示
ColHeaderCaption Array/Single 定义每个BAND的列头部显示的文本
ColIsVisible ARRAY/BOOLEN 返回/设置某个列是否可见
ColPos Array/Long 返回某个给定列的左上角和网格左上角的距离
Colposition Array/Long 设置网格列的位置
Cols Long 返回/设置网格的列数量
ColSel Array/Long 设置/返回某个范围单元的起始列
ColWidth Array/Long 设置/返回某个列的宽度
ColWordWrapOption Array/Integer 设置/返回网格的非固定单元是否允许WRAP
ColWordWrapOptionBand Array/Integer 定义网格的BAND是否允许WRAP
ColWordWrapOptionFixed Array/Integer 定义列的固定单元是否允许WRAP
ColWordWrapOptionHeader Array/Integer 定义各头部是否允许WRAP
DataField Array/Single 一个独立列绑定的数据库字段
FillStyle Enum 定义改变文本或单元的其他属性是影响所有的选中单元还是只影响活动单元
FixedCols Long 设置/返回固定列的列数
FixedRows Long 设置/返回固定行的行数
FocusRect Enum 定义控件对当前单元的焦点表示
Font StdFont 返回/设置默认字体或各单元使用的字体
FontBand Array/StdFont 设置/返回各BAND使用文本的字体
FontFixed Single 设置/返回固定单元使用的字体
FontHeader Array/StdFont 设置/返回各头部使用的字体
FontWidth Single 设置/返回默认字体宽度
FontWidthBand Array/Single 设置/返回BAND使用的字宽
FontWidthFixed Single 设置/返回固定单元使用的字宽
FontWidthHeader Array/Single 设置/返回每个头部使用的字宽
ForeColr Ole_Color 设置/返回网格非固定单元使用的前景色
ForeColorBand Array/Ole_Color 设置/返回网格各BAND的前景色
ForeColorFixed Ole_Color 设置/返回网格固定单元的前景色.
ForeColorHeader Array/Ole_Color 设置/返回网格头部单元的前景色
ForeColorSel Ole_Color 设置/返回设置单元的前景色
FormatString String 定义一个格式串用来设置网格列的宽度,对齐方式,固定行文本固定列文本
GridColor Ole_Color 设置/返回网格单元间的线的颜色
GridColorBand Array/Ole_Color 设置/返回网格BAND的线的颜色
GridColorFixed Ole_Color 设置返回网格固定单元间的线的颜色
GridColorHeader Array/Ole_Color 设置/返回网格头部间的线的颜色
GridColorIndent Ole_Color 设置/返回网格INDENT单元间的线的颜色
GridColorUnpopulated Ole_Color 设置/返回网格UNPOPULATED区域间的颜色
GrigLine Enum 定义网格单元间的线的类型
GrigLinesBand Array/Enum 定义网格各BAND间的线的类型
GrigLinesFixed Enum 定义网格固定单元的线的类型
GrigLinesHeader Array/Enum 定义网格各头部间的线的类型
GrigLinesIndent Array/Enum 定义网格INDENT单元间的线的类型
GrigLinesUnpopulated Enum 定义网格UNPOPULATED区域间的线的类型
GrigLinesWidth Integer 设置/返回网格单元间的线的宽度
GrigLinesWidthBand Array/Integer 设置/返回网格各BAND间的线的宽度
GrigLinesWidthFixed Integer 设置/返回网格固定单元间的线的宽度
GrigLinesWidthHeader Array/Integer 设置/返回网格各头间的线的宽度
GrigLinesWidthIndent Array/Integer 设置/返回网格INDENT单元间的线的宽度
GrigLinesWidthUnpopulated Integer 设置/返回网格UNPOPULATED区域间的宽度
Hieght Enum 定义如何以及何时高亮度显示网格的选中单元
LeftCol Long 网格最械的可见列
MergeCells Enum 设置/返回一个值表明如何及何时将有相同内容的记录进行合并
MergeCol ARRAY/BOOLEN 设置/返回一个值表明哪些列可以将内容合并
MergeRow ARRAY/BOOLEN 设置/返回一个值表明哪些行可以将内容合并
MouseCol Long 返回鼠标光标的列坐标位置
MouseRow Long 返回鼠标光标的行坐标位置
Picture StdPicture 返回MSHFLEXGRID的控件快照
PictureType Enum 设置/返回PICTURE类型
Redraw Boolean 设置/返回一个值,表明MSHFLEXGRIDR控件是否在每个改变后重画
Row Long 设置/返回当前单元的垂直坐标
RowData Array/Long 为各行设置/返回任意的值,以合在代码中通过这些值确定行
RowExpandable Boolean 定义当前行是否可以展开
RowExpanded Boolean 返回一个值表明当前行是否展开
RowHeight Array/Long 设置/返回各行的高度
RowHeightMin Long 设置/返回网格中行的最小高度
RowIsVisible ARRAY/BOOLEN 设置/返回一个值,表明某个特定列是否可见
RowPos Array/Long 返回给定行左上角和MSHFLEXGRID控件左上角的距离
RowPosition Array/Long 设置某个网格行的位置
Rows Long 返回网格的行的总数或者或BAND的行的总数
RowSel Long 设置/返回一个范围的单元的起始行
RowSizingMode Enum 设置/返回一个值表明对一行的设置是影响网格的所有行还是只影响被调整的行
ScrollBars Enum 设置/返回一个值表明MSHFLEXGRID控件的滚动条类型
ScrollTrack Boolean 设置/返回一个值表明网格内容是在用户移动滚动条时随着改变还是滚动结束后改变
SelectionMode Enum 设置/返回一个值表明MFHFLEXGRID控件允许的选择类型.
Sort Enum 根据某些村准备设置排序的值
Text String 设置/返回一个单元或一个范围内单元的文本内容
TextArray array/string 不改变ROW,COL属性,设置/返回任意单元的文本内容
TextMatrix array/string 设置/返回某个选定行,列的单元的文本内容
TextStyle Enum 设置/返回网格通常单元的3D文本风格
TextStyleBand Array/Enum 设置/返回网格BAND的3D文本风格
TextStyleFixed Enum 设置/返回网格各固定行的3D文本风格
TextStyleHeader Array/Enum 设置/返回网格各头部的3D文本风格
TopRow Long 设置/返回网格最上面的可见行
Version Integer 返回正在使用MSHFLEXGRID控件的版本
WordWrap Boolean 定义当到达单元的边界时,网格的单元的内容是否WRAP
2) MSHFLEXGRID控件的重要方法
方法 说明
AddItem 向网格中加入一新行
Clear 清除网格中的内容
ClearStructure 清除网格的结构(映射信息)
CollapseAll 折叠网格的某个特定的所有行
ExpandAll 展开网格的某个特定的所有行
RemoveItem 从网格中清除一行
方法AddItem和RemoveItem可以用来向网格中加入或删除行(BANDS).如果折叠或展开某个BAND的所有行,则可以使用COLLAPSEALL和EXPAANDALL方法.
方法CLEAR可以清除网格中的内容,但不影响网格的行,列数,如果要清除网格的结构,包括顺序及网格各列的名称,应当使用ClearStructure方法.
3) MSHFELXGRID的控件的主要事件
Collapse 用户折叠了网格的一行
Compare 当SORT属性被设置为CUSTOMERSORT,允许用户定义排序过程
EnterCell 当一个新的单元成为当前活动单元时
Expand 用户展开了网格的一行
LeaveCell 当一个新单元成为当前活动单元前
RowColChange 当一个新单元成为当前活动单元时
Scroll 用户用键盘,滚动条滚动网格的内容或网格的内容由程序滚动时
SelChangeEvent 一个新范围内的单元被选中
EnterCell, LeaveCell, RowColChange事件相互联系,因为字们都在当一个新单元成为当前活动单元时被激发,实际上这些事件的顺序是:LeaveCell, EnterCell然后是RowColChange.
Collapse和Expand事件在用户折叠或者展开网格的一行(BAND)时被激发.属性ROW和COL可以用来确定用户折叠或者展开的单元.
当SORT属性设置为9时,对网格的每两行发生一次COMPARE事件,用户排序方法使你可以选择按照午任意列或单元对行排序.注意,使用这种排序方式的速度会慢于BUILD-IN排序.
不论采用何种方式,只要对网格进行滚动时,SCROLL事件就会被激发.当SCROLLTRACK属性设置为TRUE时,如果用户用鼠标拖动或滚动时,该事件也被激发,如果SCROLLTRACK属性被设置为FALSE时,SCROLL事件只在拖动结束后激发一次.
当选择单元格变化时, SelChangeEvent事件会被激发,对选择的单元范围的改变,可以通过用户操作或程序代码来实现.
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
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
要按照内容自动调整列宽。只要适当地修改一下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
编写一个类,首先在确定其功能。对某个控件功能的扩充,无非是增加一些原控件没有的属性和方法而已。只要你曾经设计过类或设计过控件,这些相对而言并不是很难。本文假定用户曾有个设计过一个简单类的经历。
功能的提出:网格编辑,文件保存,文件加载,键盘的移动(用箭头,PAGEUP,PAGEDOWN实现向左,向下,翻页等),网格插入一行,网格插入一列,删除一行,删除一列,范围内删除内容,范围内删除列,范围内删除行。
实现要点:对于网格的编辑,保存和加载。此不再叙述。对于键盘的移动,这里有一个难点。因为,我们并不能通过MSHFLEXGRID的滚动来移动当前表格,这里用到一个技巧,就是:移动编辑框到相应的网格即可实现滚动功能。对于插入行列等,其实思路非常简单,实质上就是内容的“搬运”。例如,要在当前行下插入一行,则将网格扩展一行,然后,将所有内容向下移动一行,再清空当前行。实现插入列也一样。仅上面将行变成列而已。关于范围内删除内容则更简单,清空即可。删除行可直接将选择的行删除(MSHFLEXGRID提供了相应的方法),删除列则麻烦一点。先将列内容前移,然后,重新设置网格的列数即可。
由于程序比较长,所以,我也不能细述每部分的功能,而且,也可能存在BUG。当然,我既然有胆将这片药膏贴出来,致到运行上基本能通过了。
下面的该类提供的属性和方法:
**属性**
BindGrid 绑定表格,如:SET BindGrid=Mshflexgrid1.(该属性是最重要的属性.必须首先设置)
BindText 绑定文本框,如:SET BindText=ev_text.(该属性是最重要的属性.必须首先设置)
BindPicture 绑定图片框,如:SET BindPicture=PictureBox1.(该属性是最重要的属性.必须首先设置)
EditFixed 是否可以编辑固定行.
EnterAction 回车键的行为
EnterNextRow 如果是向右移到了网格的尽头,是否跳转下一行.(EnterAction=True)
PageEnabled 是否可以翻页
ArrowEnabled 是否可以用箭头移动编辑框.
DltL 输入框左边距微调量
DltT 输入框顶距边距微调量
DltW 输入框宽度微调量.
DltH 输入框高度微调量.
AutoSize 当网格的行距或列距改变时,是否可以自动调整编辑框的位置.
**方法**
保存表格数据
函数:SaveFile
参数:FileName 加载的文件名
返回值:=True 成功.=False 失败.
加载一个文件到表格.
函数:LoadFileToGrid
参数:FileName 加载的文件名
返回值:=True 成功.=True 失败.
表格中添加一个新行
函数:AddNewRow
参数:无.
返回值:无
表格当前行前插入空行
函数:InsertRow
参数:InsRows 插入的空行数.
返回值:
在表格当前列前面插入列
函数:InsertCol
参数:InsCols 插入的列数.
返回值:
在表格未尾添加一列
函数:AddNewCol
参数:
返回值:
删除当前行
函数:DelGridRow
参数:
返回值:
删除当前列
函数:DelGridCol
参数:
返回值:
删除指定范围的行数
函数:KillGridRows
参数:StarRow 删除的开始行 ,EndRow 删除的结束行.
返回值:
删除指定范围的列数
函数:KillGridCols
参数:StarCol 删除的开始列 ,EndCol 删除的结束列.
返回值:
删除指定范围的内容
函数:KillSelGrid
参数:StarRow 删除的开始行,StarCol 删除的开始列 ,EndRow 删除的结束行 ,EndCol 删除和结束列.
返回值:
应用举例:
新建一个工程,在工程中添加一个PICTUREBOX,一个TEXTBOX,一个MSHFLEXGRID控件.两个按钮.
Dim M_EditGrid As New GridText.EgridText
Private Sub Form_Load()
Dim A As Long
With MSHFlexGrid1
.Rows = 5001
.Cols = 12
For A = 0 To .Cols - 1
.ColWidth(A) = 900
Next
For A = 0 To .Rows - 1
.TextMatrix(A, 0) = A
Next
End With
'(重点):注意.使用前一定要先绑定.
With M_EditGrid
Set .BindGrid = MSHFlexGrid1
Set .BindText = Text1
Set .BindPicture = Picture1
.DltL = -15: .DltT = -15
.AutoSize = True
End With
End Sub
'保存文件
Private Sub Command1_Click()
M_EditGrid.SaveFile "c:/asdf.grd"
End Sub
'加载文件
Private Sub Command2_Click()
M_EditGrid.LoadFile "c:/asdf.grd"
End Sub
下面进入主题,类的编写.
新开一个工程,选择ACTIVEX DLL,将工程名设为:GridText,Class1改名为EGridText.一字不漏地COPY以下代码.
然后编译成GridText.dll.即可.如果应用到该类,则在工程中引用该DLL,再参考上面的例子和说明.
‘以下部他是正式代码,仅供参考和学习交流用.CJWA@21CN.COM
Option Explicit
Dim LostFlag As Boolean
Dim M_DltL As Long '左增量
Dim M_DltT As Long '顶增量
Dim M_DltW As Long '宽增量
Dim M_DltH As Long '高增量
'/以下属性不能显示给用户.
Public M_MoveFlag As Boolean
Public M_EditRow As Long
Public M_EditCol As Long
Private M_AutoSize As Boolean '自动大小
Private M_PageEnabled As Boolean '翻页是否有效
Private M_ArrowEnabled As Boolean '箭头是否有效
Private M_EnterAction As Boolean '回车键的行为.
Private M_EditFix As Boolean '是否可编辑固定行
Private M_EnterNextRow As Boolean '如果是向右移到了网格的尽头,是否跳转下一行
Dim M_Picture As VB.PictureBox
'/事件声明
Private WithEvents Ev_GridObj As VBControlExtender '定义一个针对MSHFLEXGRID的通用事件.
Private WithEvents Ev_Text As VB.TextBox '定义一个TEXT事件
'/
'/******************属性******************
'BindGrid 绑定表格,如:SET BindGrid=Mshflexgrid1.(该属性是最重要的属性.必须首先设置)
Public Property Get BindGrid() As Object
Set BindGrid = Ev_GridObj
End Property
Public Property Set BindGrid(ByRef NewGrid As Object)
If UCase$(TypeName(NewGrid)) = UCase$("MSHFlexGrid") Then
Set Ev_GridObj = NewGrid '事件
Else
Set Ev_GridObj = Nothing
MsgBox "该属性只能与 MSHFlexGrid 绑定!" & Chr$(13) & "Cjwa@21cn.com" & Chr$(13) & "(0668)6422489", vbOKOnly, "错误!"
End If
End Property
'BindText 绑定文本框,如:SET BindText=ev_text.(该属性是最重要的属性.必须首先设置)
Public Property Get BindText() As Object
Set BindGrid = Ev_GridObj
End Property
Public Property Set BindText(ByRef NewText As Object)
If UCase$(TypeName(NewText)) = UCase$("TextBox") Then
Set Ev_Text = NewText '事件
Ev_Text.Text = ""
Ev_Text.Visible = False
Else
Set BindText = Nothing
MsgBox "该属性只能与 TextBox 绑定!" & Chr$(13) & "Cjwa@21cn.com" & Chr$(13) & "(0668)6422489", vbOKOnly, "错误!"
End If
End Property
'BindPicture 绑定图片框,如:SET BindPicture=PictureBox1.(该属性是最重要的属性.必须首先设置)
Public Property Get BindPicture() As Object
Set BindPicture = M_Picture
End Property
Public Property Set BindPicture(ByRef NewPicture As Object)
If UCase$(TypeName(NewPicture)) = UCase$("PictureBox") Then
Set M_Picture = NewPicture '事件
M_Picture.Visible = False
Else
Set BindPicture = Nothing
MsgBox "该属性只能与 PictureBox 绑定!" & Chr$(13) & "Cjwa@21cn.com" & Chr$(13) & "(0668)6422489", vbOKOnly, "错误!"
End If
End Property
'EditFixed 是否可以编辑固定行.
Public Property Get EditFixed() As Boolean
EditFixed = M_EditFix
End Property
Public Property Let EditFixed(ByVal NewValue As Boolean)
M_EditFix = NewValue
End Property
'EnterAction 回车键的行为
Public Property Get EnterAction() As Boolean
EnterAction = M_EnterAction
End Property
Public Property Let EnterAction(ByVal NewValue As Boolean)
M_EnterAction = NewValue
End Property
'EnterNextRow 如果是向右移到了网格的尽头,是否跳转下一行.(EnterAction=True)
Public Property Get EnterNextRow() As Boolean
EnterNextRow = M_EnterNextRow
End Property
Public Property Let EnterNextRow(ByVal NewValue As Boolean)
M_EnterNextRow = NewValue
End Property
'PageEnabled 是否可以翻页
Public Property Get PageEnabled() As Boolean
PageEnabled = M_PageEnabled
End Property
Public Property Let PageEnabled(ByVal NewValue As Boolean)
M_PageEnabled = NewValue
End Property
'ArrowEnabled 是否可以用箭头移动编辑框.
Public Property Get ArrowEnabled() As Boolean
ArrowEnabled = M_ArrowEnabled
End Property
Public Property Let ArrowEnabled(ByVal NewValue As Boolean)
M_ArrowEnabled = NewValue
End Property
'DltL 输入框左边距微调量
Public Property Get DltL() As Long
DltL = M_DltL
End Property
Public Property Let DltL(ByVal NewValue As Long)
M_DltL = NewValue
End Property
'DltT 输入框顶距边距微调量
Public Property Get DltT() As Long
DltT = M_DltT
End Property
Public Property Let DltT(ByVal NewValue As Long)
M_DltT = NewValue
End Property
'DltW 输入框宽度微调量.
Public Property Get DltW() As Long
DltW = M_DltW
End Property
Public Property Let DltW(ByVal NewValue As Long)
M_DltW = NewValue
End Property
'DltH 输入框高度微调量.
Public Property Get DltH() As Long
DltH = M_DltH
End Property
Public Property Let DltH(ByVal NewValue As Long)
M_DltH = NewValue
End Property
'AutoSize 当网格的行距或列距改变时,是否可以自动调整编辑框的位置.
Public Property Get AutoSize() As Boolean
AutoSize = M_AutoSize
End Property
Public Property Let AutoSize(ByVal NewValue As Boolean)
M_AutoSize = NewValue
End Property
'***********************方法**************************
'/在Scroll 事件中
Private Sub GridScroll()
On Error Resume Next
Ev_Text.Visible = False
End Sub
'/在KeyDown事件中
Private Sub TextKeyDown(KeyCode As Integer)
Dim EtxtSel As Long
On Error Resume Next
EtxtSel = Ev_Text.SelStart
If EtxtSel = 0 Then
If KeyCode = vbKeyLeft Then
Call CodeMove(KeyCode)
Exit Sub
End If
End If
If EtxtSel = Len(Ev_Text.Text) Then
If KeyCode = vbKeyRight Then
Call CodeMove(KeyCode)
Exit Sub
End If
End If
If KeyCode = vbKeyDown Or KeyCode = vbKeyUp Or _
KeyCode = vbKeyTab Or KeyCode = vbKeyReturn Or _
KeyCode = vbKeyPageUp Or KeyCode = vbKeyPageDown _
Or KeyCode = vbKeyHome Or KeyCode = vbKeyEnd Then
Call CodeMove(KeyCode)
End If
End Sub
Private Sub Class_Initialize()
M_AutoSize = False
M_PageEnabled = True '翻页是否有效
M_ArrowEnabled = True '箭头是否有效
M_EnterAction = True '回车键的行为.
M_EditFix = False '是否可编辑固定行
M_MoveFlag = True
M_EnterNextRow = True
End Sub
'/受绑定的MSHFLEXGRID中的事件.
Private Sub Ev_GridObj_ObjectEvent(Info As EventInfo)
'/通用事件接口
Select Case UCase$(Info.Name)
Case UCase$("MouseDown")
Call GridMouseDown
Case UCase$("Scroll")
Call GridScroll
Case UCase$("GotFocus")
Case UCase$("MouseUp")
Case UCase$("LeaveCell") '选择改变前发生.
Case UCase$("EnterCell") '选择改变后发生.
Case UCase$("RowColChange") '最后发生.
End Select
End Sub
'/TextChange
'/返回参数:
'/说明:编辑框的改变事件.
Private Sub Ev_Text_Change()
Dim OleWidth As Long
Dim NewWidth As Long
If Not (Ev_GridObj Is Nothing) Then
If Ev_GridObj.Visible And Ev_Text.Visible And M_AutoSize Then
With M_Picture
.Font.Name = Ev_Text.Font.Name
.Font.Bold = Ev_Text.Font.Bold
.Font.Italic = Ev_Text.Font.Italic
.Font.Underline = Ev_Text.Font.Underline
OleWidth = Ev_GridObj.ColWidth(M_EditCol)
NewWidth = .TextWidth(Ev_Text + "A") '这里你可以适当调整一下.有一个字符的差别
End With
With Ev_GridObj
If NewWidth > OleWidth Then
.ColWidth(.Col) = NewWidth
Ev_Text.Width = NewWidth
End If
End With
End If
Ev_GridObj.TextMatrix(M_EditRow, M_EditCol) = Ev_Text
End If
End Sub
'/用键盘事件移动编辑框
Private Sub CodeMove(KeyCode As Integer)
Dim FixRows As Long, FixCols As Long
Dim VisRow As Long
On Error Resume Next
M_MoveFlag = False
VisRow = CLng(Ev_GridObj.Height / (Ev_GridObj.RowHeight(Ev_GridObj.Rows - 1) + 37.5))
If M_EditFix Then
FixRows = 0: FixCols = 0
Else
FixRows = Ev_GridObj.FixedRows: FixCols = Ev_GridObj.FixedCols
End If
With Ev_GridObj
Select Case KeyCode
Case Is = vbKeyUp
If M_ArrowEnabled Then
If M_EditRow > FixRows Then
M_EditRow = M_EditRow - 1
Else
M_MoveFlag = True
Exit Sub
End If
Else
M_MoveFlag = True
Exit Sub
End If
Case Is = vbKeyDown
If M_ArrowEnabled Then
If M_EditRow < Ev_GridObj.Rows - 1 Then
M_EditRow = M_EditRow + 1
Else
M_MoveFlag = True
Exit Sub
End If
Else
M_MoveFlag = True
Exit Sub
End If
Case Is = vbKeyLeft
If M_ArrowEnabled Then
If M_EditCol > FixCols Then
M_EditCol = M_EditCol - 1
Else
M_MoveFlag = True
Exit Sub
End If
Else
M_MoveFlag = True
Exit Sub
End If
Case Is = vbKeyRight
If M_ArrowEnabled Then
If M_EditCol < Ev_GridObj.Cols - 1 Then
M_EditCol = M_EditCol + 1
Else
M_MoveFlag = True
Exit Sub
End If
Else
M_MoveFlag = True
Exit Sub
End If
Case Is = vbKeyTab
If M_EditCol < Ev_GridObj.Cols - 1 Then
M_EditCol = M_EditCol + 1
Else
M_MoveFlag = True
Exit Sub
End If
Case Is = vbKeyReturn
If EnterAction Then '向下移
If M_EditRow < Ev_GridObj.Rows - 1 Then
M_EditRow = M_EditRow + 1
Else
M_MoveFlag = True
Exit Sub
End If
Else '向右移
If M_ArrowEnabled Then
If M_EditCol < Ev_GridObj.Cols - 1 Then
M_EditCol = M_EditCol + 1
ElseIf M_EditCol = Ev_GridObj.Cols - 1 Then
If M_EnterNextRow Then
If M_EditRow < Ev_GridObj.Rows - 1 Then
M_EditCol = FixCols
M_EditRow = M_EditRow + 1
Else
M_MoveFlag = True
Exit Sub
End If
End If
Else
M_MoveFlag = True
Exit Sub
End If
Else
M_MoveFlag = True
Exit Sub
End If
End If
Case Is = vbKeyPageUp
If PageEnabled Then
If M_EditRow > FixCols + VisRow Then
M_EditRow = M_EditRow - VisRow
Else
M_EditRow = FixRows
End If
Else
M_MoveFlag = True
Exit Sub
End If
Case Is = vbKeyPageDown
If PageEnabled Then
If M_EditRow < Ev_GridObj.Rows - VisRow Then
M_EditRow = M_EditRow + VisRow
Else
M_EditRow = Ev_GridObj.Rows - 1
End If
Else
M_MoveFlag = True
Exit Sub
End If
Case Is = vbKeyHome
If PageEnabled Then
M_EditRow = FixRows
Else
M_MoveFlag = True
Exit Sub
End If
Case Is = vbKeyEnd
If PageEnabled Then
M_EditRow = Ev_GridObj.Rows - 1
Else
M_MoveFlag = True
Exit Sub
End If
End Select
DoEvents
Call GridMouseDown
If KeyCode = vbKeyRight Then
Ev_Text.SelStart = Len(Ev_Text.Text)
End If
If KeyCode = vbKeyLeft Then
Ev_Text.SelStart = 0
End If
End With
End Sub
Private Sub GridMouseDown()
Dim L As Long, T As Long
Dim W As Long, H As Long
Dim FixRows As Long
Dim FixCols As Long
Dim ValTmp As String
Dim FldName As String
On Error Resume Next
FixRows = Ev_GridObj.FixedRows: FixCols = Ev_GridObj.FixedCols
Ev_GridObj.SetFocus
DoEvents
With Ev_GridObj
If M_MoveFlag Then
M_EditRow = Ev_GridObj.MouseRow
M_EditCol = Ev_GridObj.MouseCol
If Not M_EditFix Then
If M_EditRow <= FixRows - 1 Then
M_EditRow = FixRows
End If
If M_EditCol <= FixCols - 1 Then
M_EditCol = FixCols
End If
End If
End If
Ev_GridObj.Row = M_EditRow: Ev_GridObj.Col = M_EditCol
DoEvents
Ev_Text.Text = .Text
L = .Left + .CellLeft
W = .cellwidth
T = .Top + .CellTop
H = .CellHeight
'/移动编辑框.
Ev_Text.Move L + DltL, T + DltT, W + DltW, H + DltH
Ev_Text.Font.Name = .CellFontName
Ev_Text.ForeColor = .ForeColor
Ev_Text.BackColor = .BackColor
Ev_Text.Font.Size = .Font.Size
Ev_Text.Visible = True
Ev_Text.SetFocus
End With
M_MoveFlag = True
End Sub
'
'保存表格数据
'函数:SaveFile
'参数:FileName 加载的文件名
'返回值:=True 成功.=False 失败.
Public Function SaveFile(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 Ev_GridObj
.Redraw = False: M_MoveFlag = 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)
M_MoveFlag = True
Err.Clear
End Function
'加载一个文件到表格.
'函数:LoadFileToGrid
'参数:FileName 加载的文件名
'返回值:=True 成功.=True 失败.
Public Function LoadFile(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 Ev_GridObj
.Redraw = False: M_MoveFlag = False
Err.Clear: SetAttr FileName, 0
If Err.Number <> 0 Then '如果文件不存在
Err.Clear
Call SaveFile(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(SumFmtStr)
.FixedRows = CLng("0" & RowColMax(2)): .FixedCols = CLng("0" & RowColMax(3))
.Redraw = True
.Row = .FixedRows
.Col = .FixedCols
.RowSel = .FixedRows
.ColSel = .FixedCols
End With
M_MoveFlag = True
End Function
'格式网格:在这里是设置网格宽度.
Private Function FormatGrid(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 Ev_GridObj.ColWidth(I) = CLng("0" & WithArr(I))
End If
Next
End Function
Private Sub Ev_Text_KeyDown(KeyCode As Integer, Shift As Integer)
Call TextKeyDown(KeyCode)
End Sub
'
'表格中添加一个新行
'函数:AddNewRow
'参数:无.
'返回值:无
Public Sub AddNewRow()
Dim RowID As Long, B As Long
Dim AddFlag As Boolean
Ev_Text.Visible = False
If M_EditRow = Ev_GridObj.Rows - 1 Then
AddFlag = False
For RowID = Ev_GridObj.FixedCols To Ev_GridObj.Cols - 1
If Len(Trim$(Ev_GridObj.TextMatrix(Ev_GridObj.Rows - 1, RowID))) > 0 Then
AddFlag = True: Exit For
End If
Next RowID
If AddFlag Then
Ev_GridObj.Rows = Ev_GridObj.Rows + 1
End If
End If
End Sub
'
'表格当前行前插入空行
'函数:InsertRow
'参数:InsRows 插入的空行数.
'返回值:
Public Sub InsertRow(Optional InsRows As Long = 1)
Dim Rs As Long, Rend As Long
Dim Cs As Long, Cend As Long
Dim MoveStr As String
On Error Resume Next
If InsRows <= 0 Then Exit Sub
With Ev_GridObj
Ev_Text.Visible = False
.Redraw = False
.Rows = .Rows + InsRows
For Rs = .Rows - InsRows - 1 To M_EditRow Step -1
.Row = Rs: .Col = 0
.RowSel = Rs: .ColSel = .Cols - 1
MoveStr = .Clip
.Row = Rs + InsRows: .Col = 0
.RowSel = Rs + InsRows: .ColSel = .Cols - 1
.Clip = MoveStr
Next Rs
For Rs = M_EditRow To M_EditRow + InsRows - 1
For Cs = 0 To .Cols - 1
.TextMatrix(Rs, Cs) = ""
Next Cs
Next Rs
.Redraw = True
End With
End Sub
'在表格当前列前面插入列
'函数:InsertCol
'参数:InsCols 插入的列数.
'返回值:
Public Sub InsertCol(Optional InsCols As Long = 1)
Dim Rs As Long, Rend As Long
Dim Cs As Long, Cend As Long
Dim MoveStr As String
On Error Resume Next
If InsCols <= 0 Then Exit Sub
With Ev_GridObj
Ev_Text.Visible = False
.Redraw = False
.Cols = .Cols + InsCols
For Cs = .Cols - InsCols - 1 To M_EditCol Step -1
.Row = 0: .Col = Cs
.RowSel = .Rows - 1: .ColSel = Cs
MoveStr = .Clip
.Row = 0: .Col = Cs + InsCols
.RowSel = .Rows - 1: .ColSel = Cs + InsCols
.Clip = MoveStr
Next Cs
For Rs = 0 To .Rows - 1
For Cs = M_EditCol To M_EditCol + InsCols - 1
.TextMatrix(Rs, Cs) = ""
Next Cs
Next Rs
.Redraw = True
End With
End Sub
'
'在表格未尾添加一列
'函数:AddNewCol
'参数:
'返回值:
Public Sub AddNewCol()
Ev_GridObj.Cols = Ev_GridObj.Cols + 1
Ev_Text.Visible = False
End Sub
'
'删除当前行
'函数:DelGridRow
'参数:
'返回值:
Public Sub DelGridRow()
Dim MoveStr As String
Dim RowID As Long
Ev_Text.Visible = False
Ev_GridObj.Redraw = False
Ev_GridObj.RemoveItem M_EditCol
Ev_GridObj.Redraw = True
End Sub
'
'删除当前列
'函数:DelGridCol
'参数:
'返回值:
Public Sub DelGridCol()
Dim MoveStr As String
Dim RowID As Long
Ev_Text.Visible = False
Ev_GridObj.Redraw = False
If M_EditCol = Ev_GridObj.Cols - 1 Then
Ev_GridObj.Cols = Ev_GridObj.Cols - 1
Else
For RowID = M_EditCol + 1 To Ev_GridObj.Cols - 1
Ev_GridObj.Row = 0: Ev_GridObj.Col = RowID
Ev_GridObj.RowSel = Ev_GridObj.Rows - 1: Ev_GridObj.ColSel = RowID
MoveStr = Ev_GridObj.Clip
Ev_GridObj.Row = 0: Ev_GridObj.Col = RowID - 1
Ev_GridObj.RowSel = Ev_GridObj.Rows - 1: Ev_GridObj.ColSel = RowID - 1
Ev_GridObj.Clip = MoveStr
Next RowID
If Ev_GridObj.Cols > 2 Then
Ev_GridObj.Cols = Ev_GridObj.Cols - 1
End If
End If
If M_EditCol > Ev_GridObj.Cols - 1 Then M_EditCol = Ev_GridObj.Cols - 1
Ev_GridObj.Redraw = True
End Sub
'
'删除指定范围的行数
'函数:KillGridRows
'参数:StarRow 删除的开始行 ,EndRow 删除的结束行.
'返回值:
Public Sub KillGridRows(StarRow As Long, EndRow As Long)
Dim RowID As Long, AddID As Long, A As Long, B As Long
Dim RemoArr() As Long
Ev_Text.Visible = False
Ev_GridObj.Redraw = False
For RowID = StarRow To EndRow
AddID = AddID + 1
ReDim Preserve RemoArr(AddID)
RemoArr(AddID - 1) = RowID
Next
If ArrEmpty(RemoArr) Then
For RowID = 0 To UBound(RemoArr) - 1
Ev_GridObj.RemoveItem RemoArr(RowID)
DoEvents
If RowID <= UBound(RemoArr) - 1 Then
For A = RowID To UBound(RemoArr) - 1
RemoArr(A) = RemoArr(A) - 1
Next
End If
Next RowID
End If
Ev_GridObj.Redraw = True
End Sub
'删除指定范围的列数
'函数:KillGridCols
'参数:StarCol 删除的开始列 ,EndCol 删除的结束列.
'返回值:
Public Sub KillGridCols(StarCol As Long, EndCol As Long)
Dim MoveStr As String
Dim RowID As Long, RedCol As Long
Ev_Text.Visible = False
Ev_GridObj.Redraw = False
If M_EditCol = Ev_GridObj.Cols - 1 Then
Ev_GridObj.Cols = Ev_GridObj.Cols - 1
Else
For RowID = StarCol To Ev_GridObj.Cols - 1
RedCol = RowID + EndCol - StarCol + 1
If RedCol > Ev_GridObj.Cols - 1 Then Exit For
Ev_GridObj.Row = 0: Ev_GridObj.Col = RedCol
Ev_GridObj.RowSel = Ev_GridObj.Rows - 1: Ev_GridObj.ColSel = RedCol
MoveStr = Ev_GridObj.Clip
Ev_GridObj.Row = 0: Ev_GridObj.Col = RowID
Ev_GridObj.RowSel = Ev_GridObj.Rows - 1: Ev_GridObj.ColSel = RowID
Next
If Ev_GridObj.Cols > EndCol - StarCol + 2 Then Ev_GridObj.Cols = Ev_GridObj.Cols - (EndCol - StarCol + 1)
End If
If M_EditCol > Ev_GridObj.Cols - 1 Then M_EditCol = Ev_GridObj.Cols - 1
Ev_GridObj.Redraw = True
End Sub
'
'删除指定范围的内容
'函数:KillSelGrid
'参数:StarRow 删除的开始行,StarCol 删除的开始列 ,EndRow 删除的结束行 ,EndCol 删除和结束列.
'返回值:
Public Sub KillSelGrid(StarRow As Long, StarCol As Long, EndRow As Long, EndCol As Long)
Dim RowID As Long, B As Long
Ev_Text.Visible = False
For RowID = StarRow To EndRow
For B = StarCol To EndCol
Ev_GridObj.TextMatrix(RowID, B) = ""
Next
Next
Ev_GridObj.Redraw = True
End Sub
'/数组是否已经初始化.
'/函数:ArrEmpty
'/参数:MyArr 传入的数据名称.
'/返回值:TRUE 已经初始化,FALSE 未初始化.
'/例子:
Private Function ArrEmpty(ByRef MyArr) As Boolean
Dim K As Long
On Error Resume Next
K = UBound(MyArr)
If Err.Number <> 0 Or K < 0 Then
Err.Clear
ArrEmpty = False
Else
ArrEmpty = True
End If
End Function