⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 form1.frm

📁 实现邮件的发送接收
💻 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 + -