📄 form1.frm
字号:
VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 5625
ClientLeft = 60
ClientTop = 450
ClientWidth = 7155
LinkTopic = "Form1"
ScaleHeight = 5625
ScaleWidth = 7155
StartUpPosition = 3 '窗口缺省
Begin VB.TextBox Text1
Height = 270
Left = 240
TabIndex = 1
Text = "Text1"
Top = 120
Width = 1455
End
Begin MSFlexGridLib.MSFlexGrid MSFlexGrid1
Height = 4215
Left = 720
TabIndex = 0
Top = 600
Width = 5655
_ExtentX = 9975
_ExtentY = 7435
_Version = 393216
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
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
MSFlexGrid1.Cols = 5
MSFlexGrid1.Rows = 15
ReDim ColSelect(1 To .Cols - 1)
SaveCellBkColor = MSFlexGrid1.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 MSFlexGrid1.Cols - 1
MSFlexGrid1.Col = i: MSFlexGrid1.Text = "Col" + Format(i, "00") '若Cols超出99,则修改Format
Next '的格式
End With
With MSFlexGrid1
MSFlexGrid1.Col = 0
For i = 1 To MSFlexGrid1.Rows - 1
MSFlexGrid1.Row = i: MSFlexGrid1.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 MSFlexGrid1.MouseCol = 0 Or MSFlexGrid1.MouseRow = 0 Then
Call toEditGrid(MSFlexGrid1.MouseCol, MSFlexGrid1.MouseRow)
End If
Else
If Button = vbKeyLButton Then
If MSFlexGrid1.ColSel = MSFlexGrid1.Col And MSFlexGrid1.RowSel = MSFlexGrid1.Row Then
'表示没有多个栏位的选取,这时才真正是可以输入
Call toEditGrid(MSFlexGrid1.Col, MSFlexGrid1.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(MSFlexGrid1.Col, MSFlexGrid1.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
MSFlexGrid1.Col = C: MSFlexGrid1.Row = R
Text1.Left = MSFlexGrid1.Left + MSFlexGrid1.ColPos(C)
Text1.Top = MSFlexGrid1.Top + .RowPos(R)
If MSFlexGrid1.Appearance = flex3D Then
Text1.Left = Text1.Left + 2 * Screen.TwipsPerPixelX
Text1.Top = Text1.Top + 2 * Screen.TwipsPerPixelY
End If
Text1.Width = MSFlexGrid1.ColWidth(C)
Text1.Height = MSFlexGrid1.RowHeight(R)
Text1.Text = MSFlexGrid1.Text
OldText = MSFlexGrid1.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 = MSFlexGrid1.RowSel: OldColSel = MSFlexGrid1.ColSel
If HaveSelEntireCol Then
'如果有整行被选取的清况,则计算选取的起始结束行
SelSt = IIf(MSFlexGrid1.Col <= MSFlexGrid1.ColSel, MSFlexGrid1.Col, MSFlexGrid1.ColSel)
SelEnd = IIf(MSFlexGrid1.Col > MSFlexGrid1.ColSel, MSFlexGrid1.Col, MSFlexGrid1.ColSel)
For i = SelSt To SelEnd
ColSelect(i) = True
Next
MSFlexGrid1.CellBackColor = MSFlexGrid1.BackColorSel
If Shift <> vbCtrlMask Then '没有按Ctl键则清除其他Column的Selection
Call RefreshCols(SelSt, SelEnd)
End If
Else
HaveSel = False
For i = 1 To MSFlexGrid1.Cols - 1
HaveSel = HaveSel Or ColSelect(i)
Next
If HaveSel Then
Call RefreshAll
End If
End If
MSFlexGrid1.RowSel = OldRowSel
MSFlexGrid1.ColSel = OldColSel
End With
End Sub
'Check是否有整行的选取
Private Function HaveSelEntireCol() As Boolean
With MSFlexGrid1
If MSFlexGrid1.RowSel = (.Rows - 1) And MSFlexGrid1.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 = MSFlexGrid1.Col: SaveRow = MSFlexGrid1.Row
MSFlexGrid1.Col = 1: MSFlexGrid1.Row = 1
MSFlexGrid1.ColSel = MSFlexGrid1.Cols - 1: MSFlexGrid1.RowSel = MSFlexGrid1.Rows - 1
MSFlexGrid1.CellBackColor = SaveCellBkColor
MSFlexGrid1.Col = SaveCol: .Row = SaveRow
MSFlexGrid1.ColSel = SaveCol: MSFlexGrid1.RowSel = SaveRow
For i = 1 To MSFlexGrid1.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 = MSFlexGrid1.Col: SaveRow = MSFlexGrid1.Row
For i = 1 To MSFlexGrid1.Cols - 1
If Not (i >= SelSt And i <= SelEnd) And ColSelect(i) Then
MSFlexGrid1.Col = i: MSFlexGrid1.Row = 1
.ColSel = i: .RowSel = .Rows - 1
MSFlexGrid1.CellBackColor = SaveCellBkColor
ColSelect(i) = False
End If
Next
MSFlexGrid1.Col = SaveCol: MSFlexGrid1.Row = SaveRow
MSFlexGrid1.ColSel = SaveCol: MSFlexGrid1.RowSel = SaveRow
End With
End Sub
Private Sub MSFlexGrid1_Scroll()
SendKeys "{ESC}"
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -