[转]加强型的MSFlexGrid

加强型的 MSFlexGrid
http://bbs.biirch.com/read.php?tid=376
来源:cww 更改王国荣的范例
修改过王国荣先生的范後，功能如下：
1.在MSFlexGrid上按Enter时，可以编修当格(Current Cell)的内容
2.在MSFlexGrid上Click时，可以编修当格(Current Cell)的内容
3.在MSFlexGrid上固定列与固定行上面按Mouse右键时可以修改其Title
4.允许MultiLine/MultiCol的Selection 与按Ctl-Mouse左键的MultiSelect Columns
5.进入Cell的EditMode时，按up/Down键会离开Current Cell而进入上/下 一行的Cell
6.进入Cell的EditMode时，按Escape回覆原本的字串

MSFlexGrid内的资料原本是不能让使用者直接KeyIn的，所以找个变通的方式，便是使用
TextBox来Keyin，再把TextBox内的值放入MSFlexGrid中，但重点就变成TextBox如何设
定位置、大小於MSFlexGrid之上。这个部份在toEditGrid的程式中做。何时启动TextBox
让之可以输入资料呢，有两个地方，一个在MSFlexGrid上的Mouse_Click，而且考虑可以
在Grid上做多栏的选取，所以只有在.ColSel = .Col And .RowSel = .Row时才可以进入
EditMode。另一个地方在MSFlexGrid上按Enter，也会令之进入EditMode。而离开EditMode
的时机在於TextBox上按Enter/Up/Down/Esc 键。

另外，我们如果想要保留MSFlexGrid可以整列整行选取，而且又可以更动MSFlexGrid最
上与最左边的固定列之Title，我的做法是，在MSFlexGrid上MouseUp时来判定Mouse所在
的Col与Row，如果MouseCol=0 or MouseRow = 0代表是在FixedCol/FixedRow 上按下
Mouse，如果按的是右键表示要修改FixCol或FixRow的Title，如果是左键，那不做任何
处理，此时，如果AllowBigSelection=True时，则会选取整行或整列。'
'以下在Form需一个MSFlexGrid, 一个TextBox
Option Explicit
Private OldText As String
Private ColSelect() As Boolean
Private SaveCellBkColor As Long

Private Sub Form_Load()
Text1.Visible = False
Me.Show
With MSFlexGrid1
  .Cols = 5
  .Rows = 15
  ReDim ColSelect(1 To .Cols - 1)
  SaveCellBkColor = .CellBackColor
  Call InitGrid
  .AllowBigSelection = True
  .FillStyle = flexFillRepeat
  '.AllowUserResizing = True '请事先设好
End With
End Sub

Private Sub InitGrid()
Dim i As Long
With MSFlexGrid1
.Row = 0
For i = 1 To .Cols - 1
    .Col = i: .Text = "Col" + Format(i, "00") '若Cols超出99，则修改Format
Next                        '的格式
End With
With MSFlexGrid1
.Col = 0
For i = 1 To .Rows - 1
    .Row = i: .Text = i
Next
End With
'Dim width5 As Long
'With MSFlexGrid1
'   width5 = .Width \ .Cols
'   For i = 0 To .Cols - 1
'       .ColWidth(i) = width5
'   Next
'End With
End Sub
Private Sub MSFlexGrid1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim inMostLeft As Boolean
Dim inMostTop As Boolean

Call ProcMultiColSel(Shift)
With MSFlexGrid1
  If Button = vbKeyRButton Then
   '按mouse 右键且位於最上列/最左行则是更动title
   If .MouseCol = 0 Or .MouseRow = 0 Then
      Call toEditGrid(.MouseCol, .MouseRow)
   End If
  Else
   If Button = vbKeyLButton Then
      If .ColSel = .Col And .RowSel = .Row Then
      '表示没有多个栏位的选取，这时才真正是可以输入
      Call toEditGrid(.Col, .Row)
      End If
   End If
  End If
End With
End Sub
Private Sub MSFlexGrid1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn And Not Text1.Visible Then
  With MSFlexGrid1
   Call toEditGrid(.Col, .Row)
  End With
End If
End Sub
'TextBox上的输入反映到MsFlexGrid上
Private Sub Text1_Change()
MSFlexGrid1.Text = Text1.Text
End Sub
'按下Down/Up 时结束TextBox的Keyin
Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyUp Then
  Text1.Visible = False
  MSFlexGrid1.SetFocus
  SendKeys "{up}"
Else
If KeyCode = vbKeyDown Then
  Text1.Visible = False
  MSFlexGrid1.SetFocus
  SendKeys "{down}"
End If
End If
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
  KeyAscii = 0
  Text1.Visible = False
  MSFlexGrid1.SetFocus
End If
If KeyAscii = vbKeyEscape Then
  KeyAscii = 0
  MSFlexGrid1.Text = OldText
  Text1.Visible = False
  MSFlexGrid1.SetFocus
End If
End Sub

Private Sub Text1_LostFocus()
Text1.Visible = False
End Sub
'设定TextBox於MSFlexGrid1的Current Cell上
Private Sub toEditGrid(ByVal C As Integer, ByVal R As Integer)
With MSFlexGrid1
  .Col = C: .Row = R
  Text1.Left = .Left + .ColPos(C)
  Text1.Top = .Top + .RowPos(R)
  If .Appearance = flex3D Then
    Text1.Left = Text1.Left + 2 * Screen.TwipsPerPixelX
    Text1.Top = Text1.Top + 2 * Screen.TwipsPerPixelY
  End If
  Text1.Width = .ColWidth(C)
  Text1.Height = .RowHeight(R)
  Text1.Text = .Text
  OldText = .Text
End With
Text1.Visible = True
Text1.SelStart = Len(Text1.Text)
Text1.SetFocus
End Sub
'以下程式处理Multi-column Selection的问题
Private Sub ProcMultiColSel(ByVal Shift As Integer)
Dim i As Long, HaveSel As Boolean
Dim SelSt As Long, SelEnd As Long
Dim OldRowSel As Long, OldColSel As Long
With MSFlexGrid1
OldRowSel = .RowSel: OldColSel = .ColSel
If HaveSelEntireCol Then
  '如果有整行被选取的清况，则计算选取的起始结束行
  SelSt = IIf(.Col <= .ColSel, .Col, .ColSel)
  SelEnd = IIf(.Col > .ColSel, .Col, .ColSel)
  For i = SelSt To SelEnd
    ColSelect(i) = True
  Next
  .CellBackColor = .BackColorSel
  If Shift <> vbCtrlMask Then '没有按Ctl键则清除其他Column的Selection
    Call RefreshCols(SelSt, SelEnd)
  End If
Else
  HaveSel = False
  For i = 1 To .Cols - 1
    HaveSel = HaveSel Or ColSelect(i)
  Next
  If HaveSel Then
    Call RefreshAll
  End If
End If
.RowSel = OldRowSel
.ColSel = OldColSel
End With
End Sub
'Check是否有整行的选取
Private Function HaveSelEntireCol() As Boolean
With MSFlexGrid1
If .RowSel = (.Rows - 1) And .Row = 1 Then
  HaveSelEntireCol = True
Else
  HaveSelEntireCol = False
End If
End With
End Function
'清除所有的Selection
Private Sub RefreshAll()
Dim SaveCol As Long, SaveRow As Long, i As Long
With MSFlexGrid1
  SaveCol = .Col: SaveRow = .Row
  .Col = 1: .Row = 1
  .ColSel = .Cols - 1: .RowSel = .Rows - 1
  MSFlexGrid1.CellBackColor = SaveCellBkColor
  .Col = SaveCol: .Row = SaveRow
  .ColSel = SaveCol: .RowSel = SaveRow
  For i = 1 To .Cols - 1
   ColSelect(i) = False
  Next
End With
End Sub
'清除其他Column的Selection除了columns From Selst to SelEnd外，其他清除
Private Sub RefreshCols(ByVal SelSt As Long, ByVal SelEnd As Long)
Dim SaveCol As Long, SaveRow As Long, i As Long
With MSFlexGrid1
  SaveCol = .Col: SaveRow = .Row
  For i = 1 To .Cols - 1
    If Not (i >= SelSt And i <= SelEnd) And ColSelect(i) Then
   .Col = i: .Row = 1
   .ColSel = i: .RowSel = .Rows - 1
   MSFlexGrid1.CellBackColor = SaveCellBkColor
   ColSelect(i) = False
    End If
  Next
  .Col = SaveCol: .Row = SaveRow
  .ColSel = SaveCol: .RowSel = SaveRow
End With
End Sub

Private Sub MSFlexGrid1_Scroll()
SendKeys "{ESC}"
End Sub