form1.frm

这里有很多很实用的VB编程案例,方便大家学习VB.

VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form Form1 
   Caption         =   "MSFlexGrid控件"
   ClientHeight    =   4365
   ClientLeft      =   165
   ClientTop       =   450
   ClientWidth     =   5790
   LinkTopic       =   "Form1"
   ScaleHeight     =   4365
   ScaleWidth      =   5790
   StartUpPosition =   3  '窗口缺省
   Begin VB.TextBox txtEdit 
      Height          =   285
      Left            =   120
      TabIndex        =   1
      Top             =   3000
      Visible         =   0   'False
      Width           =   855
   End
   Begin MSFlexGridLib.MSFlexGrid MSFlexGrid1 
      Height          =   2175
      Left            =   120
      TabIndex        =   0
      ToolTipText     =   "Doubleclick for Input"
      Top             =   600
      Width           =   3615
      _ExtentX        =   6376
      _ExtentY        =   3836
      _Version        =   393216
      Cols            =   10
   End
   Begin MSComctlLib.ImageList imlToolbar 
      Left            =   1800
      Top             =   3120
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   16
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   11
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Form1.frx":0000
            Key             =   ""
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Form1.frx":0352
            Key             =   ""
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Form1.frx":08A4
            Key             =   ""
         EndProperty
         BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Form1.frx":0DF6
            Key             =   ""
         EndProperty
         BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Form1.frx":1348
            Key             =   ""
         EndProperty
         BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Form1.frx":189A
            Key             =   ""
         EndProperty
         BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Form1.frx":19AC
            Key             =   ""
         EndProperty
         BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Form1.frx":1EFE
            Key             =   ""
         EndProperty
         BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Form1.frx":2450
            Key             =   ""
         EndProperty
         BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Form1.frx":29A2
            Key             =   ""
         EndProperty
         BeginProperty ListImage11 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Form1.frx":2EF4
            Key             =   ""
         EndProperty
      EndProperty
   End
   Begin MSComctlLib.Toolbar tbrMain 
      Align           =   1  'Align Top
      Height          =   360
      Left            =   0
      TabIndex        =   2
      Top             =   0
      Width           =   5790
      _ExtentX        =   10213
      _ExtentY        =   635
      ButtonWidth     =   609
      ButtonHeight    =   582
      AllowCustomize  =   0   'False
      Appearance      =   1
      Style           =   1
      ImageList       =   "imlToolbar"
      _Version        =   393216
      BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
         NumButtons      =   9
         BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Key             =   "Cut"
            Object.ToolTipText     =   "Cut (Ctrl+X)"
            ImageIndex      =   9
         EndProperty
         BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Key             =   "Copy"
            Object.ToolTipText     =   "Copy (Ctrl+C)"
            ImageIndex      =   7
         EndProperty
         BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Key             =   "Paste"
            Object.ToolTipText     =   "Paste (Ctrl+V)"
            ImageIndex      =   8
         EndProperty
         BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Key             =   "Delete"
            Object.ToolTipText     =   "Delete (Del)"
            ImageIndex      =   10
         EndProperty
         BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Style           =   3
         EndProperty
         BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Enabled         =   0   'False
            Key             =   "Undo"
            Object.ToolTipText     =   "Undo (Ctrl+Z)"
            ImageIndex      =   11
         EndProperty
         BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Style           =   3
         EndProperty
         BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Key             =   "InsertRow"
            Object.ToolTipText     =   "Insert Row"
            ImageIndex      =   5
         EndProperty
         BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Key             =   "DelRow"
            Object.ToolTipText     =   "Remove Row"
            ImageIndex      =   6
         EndProperty
      EndProperty
   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 Type FlxCell
    row As Long
    col As Long
End Type
Private m_ActiveCell As FlxCell

Private Type UndoType
    uText As String
    uRows As Long
    uCols As Long
    uName As String
End Type

Private m_UndoBuffer() As UndoType
Private intMaxUndo As Integer
Private Sub EmptyUndoBuffer()
    ReDim m_UndoBuffer(0)
    EnableUndo
End Sub
Private Sub EnableUndo()
    tbrMain.Buttons("Undo").Enabled = (UBound(m_UndoBuffer) > 1)
    If UBound(m_UndoBuffer) > 1 Then
        tbrMain.Buttons("Undo").ToolTipText = "Undo: " & _
        m_UndoBuffer(UBound(m_UndoBuffer)).uName & " (Ctrl+Z)"
    
    Else
        tbrMain.Buttons("Undo").ToolTipText = "Undo: Not possible (Ctrl+Z)"
    End If
End Sub
Public Sub MakeUndoBuffer(Optional UndoName As String)
    On Error GoTo DimBuff
    Dim i As Long
    Dim j As Long
    Dim strClip As String
    Dim tmpClip() As UndoType
    
    With MSFlexGrid1
        For i = 1 To .Rows - 1
            For j = 1 To .Cols - 1
                strClip = strClip & .TextMatrix(i, j) & vbTab
            Next
            strClip = strClip & vbCr
        Next
        
        If strClip = m_UndoBuffer(UBound(m_UndoBuffer)).uText And _
        m_UndoBuffer(UBound(m_UndoBuffer)).uRows = .Rows And _
        m_UndoBuffer(UBound(m_UndoBuffer)).uCols = .Cols Then Exit Sub
        
        If UBound(m_UndoBuffer) = (intMaxUndo - 1) Then
            ReDim tmpClip(intMaxUndo - 1)
            ReDim m_UndoBuffer(intMaxUndo - 1)
            For i = 0 To intMaxUndo - 1
                tmpClip(i).uCols = m_UndoBuffer(i).uCols
                tmpClip(i).uRows = m_UndoBuffer(i).uRows
                tmpClip(i).uText = m_UndoBuffer(i).uText
                tmpClip(i).uName = m_UndoBuffer(i).uName
            Next i
            For i = 0 To intMaxUndo - 2
                m_UndoBuffer(i).uCols = tmpClip(i + 1).uCols
                m_UndoBuffer(i).uRows = tmpClip(i + 1).uRows
                m_UndoBuffer(i).uText = tmpClip(i + 1).uText
                tmpClip(i).uName = m_UndoBuffer(i).uName
            Next i
        Else
            ReDim Preserve m_UndoBuffer(UBound(m_UndoBuffer) + 1)
        End If

        m_UndoBuffer(UBound(m_UndoBuffer)).uRows = .Rows
        m_UndoBuffer(UBound(m_UndoBuffer)).uCols = .Cols
        m_UndoBuffer(UBound(m_UndoBuffer)).uText = strClip
        If Len(UndoName) Then
            m_UndoBuffer(UBound(m_UndoBuffer)).uName = UndoName
        Else
            m_UndoBuffer(UBound(m_UndoBuffer)).uName = "Last Action"
        End If
    End With
    
    EnableUndo
    Exit Sub
DimBuff:
    ReDim m_UndoBuffer(0)
    Resume
End Sub
Private Sub mnuEditCopy_Click()
    Clipboard.Clear
    Clipboard.SetText MSFlexGrid1.Clip
End Sub

Private Sub mnuEditcut_Click()
    Clipboard.Clear
    Clipboard.SetText MSFlexGrid1.Clip
    Dim i As Integer
    Dim j As Integer
    Dim strClip As String
    With MSFlexGrid1
        For i = 1 To .RowSel
            For j = 1 To .ColSel
                strClip = strClip & "" & vbTab
            Next
            strClip = strClip & vbCr
        Next
        .Clip = strClip
    End With
    MakeUndoBuffer "Cut"
End Sub

Private Sub mnuEditDelete_Click()
    Dim i As Integer
    Dim j As Integer
    Dim strClip As String
    With MSFlexGrid1
        For i = 1 To .RowSel
            For j = 1 To .ColSel
                strClip = strClip & "" & vbTab
            Next
            strClip = strClip & vbCr
        Next
        .Clip = strClip
    End With
    MakeUndoBuffer "Delete"
End Sub
Private Sub mnuEditDelRow_Click()
    With MSFlexGrid1
        If .Rows > 2 Then
            .RemoveItem .row
            MakeUndoBuffer "Remove Row"
        End If
    End With
End Sub
Private Sub mnuEditInsertRow_Click()
    MSFlexGrid1.AddItem "", MSFlexGrid1.row
    MakeUndoBuffer "Insert Row"
End Sub
Private Sub mnuEditPaste_Click()
    If Len(Clipboard.GetText) Then
        MSFlexGrid1.Clip = Clipboard.GetText
        MakeUndoBuffer "Paste"
    End If
End Sub

Private Sub mnuEditSelectAll_Click()
    With MSFlexGrid1
        .Visible = False
        .row = 1
        .col = 1
        .RowSel = .Rows - 1
        .ColSel = .Cols - 1
        .TopRow = 1
        .Visible = True
    End With
End Sub
Private Sub mnuEditUndo_Click()
    Undo
End Sub
Private Sub mnuFileExit_Click()
    Unload Me
End Sub
Private Sub Undo()
    Dim lngRow As Long
    Dim lngCol As Long
    Dim lngTopRow As Long
    
    With MSFlexGrid1
        .Visible = False
        lngRow = .row
        lngCol = .col
        lngTopRow = .TopRow
        .Rows = m_UndoBuffer(UBound(m_UndoBuffer) - 1).uRows
        .Cols = m_UndoBuffer(UBound(m_UndoBuffer) - 1).uCols
        
        .row = 1
        .col = 1
        .RowSel = .Rows - 1
        .ColSel = .Cols - 1
        
        .Clip = m_UndoBuffer(UBound(m_UndoBuffer) - 1).uText
        ReDim Preserve m_UndoBuffer(UBound(m_UndoBuffer) - 1)
        On Error Resume Next
        .row = lngRow
        .col = lngCol
        .TopRow = lngTopRow
        .Visible = True
    End With

    EnableUndo
End Sub
Private Sub Form_Load()
    MSFlexGrid1.RowHeightMin = txtEdit.Height
    intMaxUndo = 40
    EmptyUndoBuffer
    MakeUndoBuffer
End Sub

Private Sub Form_Resize()
    With MSFlexGrid1
        .Left = 0
        .Top = tbrMain.Top + tbrMain.Height
        .Width = Me.ScaleWidth
        .Height = Me.ScaleHeight - .Top
    End With
End Sub


















Private Sub MSFlexGrid1_DblClick()
    If MSFlexGrid1.row > 0 Then
        m_ActiveCell.row = MSFlexGrid1.row
        m_ActiveCell.col = MSFlexGrid1.col
        With txtEdit
            .Top = MSFlexGrid1.CellTop + MSFlexGrid1.Top
            .Left = MSFlexGrid1.CellLeft + MSFlexGrid1.Left
            .Width = MSFlexGrid1.CellWidth
            .Text = MSFlexGrid1.Text
            .Visible = True
            .ZOrder
            .SetFocus
        End With
    End If
End Sub

Private Sub tbrMain_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.Key
        Case "Cut"
            mnuEditcut_Click
        Case "Copy"
            mnuEditCopy_Click
        Case "Paste"
            mnuEditPaste_Click
        Case "Delete"
            mnuEditDelete_Click
        Case "Undo"
            Undo
        Case "InsertRow"
            mnuEditInsertRow_Click
        Case "DelRow"
            mnuEditDelRow_Click
    End Select
End Sub

Private Sub txtEdit_LostFocus()
    MSFlexGrid1.TextMatrix(m_ActiveCell.row, m_ActiveCell.col) = txtEdit.Text
    txtEdit.Visible = False
    MakeUndoBuffer "Input"
End Sub