mshflexgrid模仿excel

     用vb做erp最郁闷的是没有大量录入数据的控件,在这里我们采用mshflexgrid录入与显示数据。默认情况下mshflexgrid是不能录入数据的,所以我们得借助点东西:文本框。我们在这里称之为:浮动文本框。

     原理是这样的:(模仿execel的实现)

     当我们双击时进入编辑模式,这时候让浮动文本框,显示出来(调用Show_txtFloat),用户输入的数据会保存到txtfloat里面。当用户输入结束的时候会在表格其他地方单击一下,这是我们将浮动文本框隐藏起来(调用Hide_txtFloat,这个函数会将txtfloat里面的数据保存到mshflexgrid里面)。

下面看这两个函数的代码:

Public Sub Show_txtFloat()
    txtFloat.Visible = False
    txtFloat.Width = mGrid.CellWidth
    txtFloat.Height = mGrid.CellHeight
    txtFloat.Left = mGrid.Left + mGrid.CellLeft - 10
    txtFloat.Top = mGrid.Top + mGrid.CellTop - 10
    txtFloat.Text = mGrid.TextMatrix(mGrid.Row, mGrid.Col)
    txtFloat.SelStart = Len(txtFloat.Text)
    txtFloat.Visible = True
    txtFloat.SetFocus
End Sub


Public Sub Hide_txtFloat()
    If txtFloat.Visible = True Then
        mGrid.TextMatrix(mGrid.Row, mGrid.Col) = txtFloat.Text
        txtFloat.Text = ""
        txtFloat.Visible = False
    End If
End Sub

 

     那肯定有人说了,我总不能想输入数据的时候每次都双击吧,那多麻烦。对的,我们看看excel的实现,直接按普通键会有什么反应。在这里我们得在mshflexgrid的keypress做文章了。

Private Sub mGrid_KeyPress(KeyAscii As Integer)
    If txtFloat.Visible = False And KeyAscii <> vbKeyDown And KeyAscii <> vbKeyUp And KeyAscii <> vbKeyLeft And KeyAscii <> vbKeyRight And KeyAscii <> vbKeyReturn Then
        Show_txtFloat
        txtFloat.Text = Chr(KeyAscii)
        txtFloat.SelStart = Len(txtFloat)
    End If

End Sub

 

我的mshflexgrid取名叫mGrid。

 

大家看到了,如果是下上左右以及tab,enter我都让它没反应。这些键的处理在下面。

 

Private Sub mGrid_KeyDown(KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
        Case vbKeyTab
            If mGrid.Col <= mGrid.cols - 1 Then
                mGrid.Col = mGrid.Col + 1
            ElseIf mGrid.Row < mGrid.rows - 1 Then
                mGrid.Row = mGrid.Row + 1
                mGrid.Col = 1
            End If
            mGrid.SetFocus
        Case vbKeyReturn
            If mGrid.Row < mGrid.rows - 1 Then mGrid.Row = mGrid.Row + 1
            mGrid.SetFocus
        Case vbKeyBack
            Show_txtFloat
            txtFloat.Text = ""
        Case 46
            MSGrid_Clear mGrid
    End Select
End Sub

 

上下左右,默认mshflexgrid会处理的,在这里就不需要处理了。

 

还有一点,如果用户正在编辑模式下,按下上下左右等等怎么处理呢?

 

Private Sub txtFloat_KeyDown(KeyCode As Integer, Shift As Integer)
    Dim PageRows As Integer
    PageRows = mGrid.Height / mGrid.CellHeight
    Select Case KeyCode
        Case vbKeyDown, vbKeyReturn               '下箭头
        
            Hide_txtFloat
            If mGrid.Row < mGrid.rows - 1 Then mGrid.Row = mGrid.Row + 1
            mGrid.SetFocus
            
        Case vbKeyUp  '上箭头
        
            Hide_txtFloat
             If mGrid.Row > 1 Then mGrid.Row = mGrid.Row - 1
            mGrid.SetFocus
              
        Case vbKeyLeft                   '左箭头
            If GetCaretPos(txtFloat) <> 0 Then Exit Sub
            Hide_txtFloat
            If mGrid.Col <> 1 Then
               mGrid.Col = mGrid.Col - 1
            ElseIf mGrid.Row > 1 Then
               mGrid.Row = mGrid.Row - 1
                mGrid.Col = mGrid.cols - 1
            End If
            mGrid.SetFocus
        
         Case vbKeyRight            '右箭头
         
            If GetCaretPos(txtFloat) < Len(Trim(txtFloat)) Then Exit Sub
            
            Hide_txtFloat
            
            If mGrid.Col <= mGrid.cols - 1 Then
                mGrid.Col = mGrid.Col + 1
            ElseIf mGrid.Row < mGrid.rows - 1 Then
                mGrid.Row = mGrid.Row + 1
                mGrid.Col = 1
            End If
            mGrid.SetFocus
    End Select
End Sub

 

 

 

   到这里,按键的处理基本上完成了。还有点东西要处理,复制、粘贴、剪切,等怎么处理呢。看我封装的函数。在菜单中调用就ok了。

 

 

Public Sub MSGrid_AddLine(mGrid As MSHFlexGrid)
   '####################################################################
   '往mshflexgrid里面添加一行
   '####################################################################
   mGrid.AddItem "", mGrid.Row
End Sub
Public Sub MSGrid_DelLine(mGrid As MSHFlexGrid)
   '####################################################################
   'mshflexgrid里面删除一行
   '####################################################################
    Dim beginRow%, endRow%                                  '定义起始行列
    With mGrid
            beginRow = IIf(.Row < .RowSel, .Row, .RowSel)
            endRow = IIf(.Row > .RowSel, .Row, .RowSel)
            If .rows <= 2 Then
                MsgBox "只有一行数据不能删除 ", vbInformation, G_ERPWindowsName
                Exit Sub
            End If
            For i = endRow To beginRow Step -1
                If i = 1 Then Exit Sub
                .RemoveItem i
            Next i
            For i = 1 To .rows - 1
                .TextMatrix(i, 0) = i
            Next i
     End With
End Sub
Public Sub MSGrid_Copy(mGrid As MSHFlexGrid)
   '####################################################################
   'mshflexgrid里面复制一行
   '####################################################################
    Dim str As String
    Clipboard.clear
    str = mGrid.Clip & Chr(13)
    Clipboard.SetText str, vbCFText
End Sub
Public Sub MSGrid_Paste(mGrid As MSHFlexGrid)
   '####################################################################
   'mshflexgrid里面粘贴一行
   '####################################################################
    Dim temp As String
    Dim beginRow As Integer
    Dim beginCol As Integer
    Dim endRow As Integer
    Dim endCol As Integer
    Dim rows As Integer '选区行数
    Dim cols As Integer '选区列数
    Dim i As Integer
    Dim itab As Integer 'tab键个数
    Dim ienter As Integer 'enter键个数
    temp = Clipboard.GetText
    If (Len(temp) = 0) Then
        Exit Sub
    End If
    
     For i = 1 To Len(temp)
     
        If Mid(temp, i, 1) = Chr(vbKeyReturn) Then
            ienter = ienter + 1
        End If
        If Mid(temp, i, 1) = Chr(vbKeyTab) Then
            itab = itab + 1
        End If
        
    Next i
    
    If Mid(temp, Len(temp), 1) = Chr(10) Then
        rows = ienter
    Else
        rows = ienter + 1
    End If
    
    cols = itab / rows
    
    beginRow = IIf(mGrid.Row < mGrid.RowSel, mGrid.Row, mGrid.RowSel)
    beginCol = IIf(mGrid.Col < mGrid.ColSel, mGrid.Col, mGrid.ColSel)
    endRow = IIf(mGrid.Row > mGrid.RowSel, mGrid.Row, mGrid.RowSel)
    endCol = IIf(mGrid.Col > mGrid.RowSel, mGrid.Col, mGrid.ColSel)
    If Abs(mGrid.RowSel - mGrid.Row) < rows Then
        beginRow = IIf(mGrid.Row < mGrid.RowSel, mGrid.Row, mGrid.RowSel)
        If mGrid.rows < beginRow + rows Then    '需要增行
            mGrid.rows = beginRow + rows
        End If
        endRow = beginRow + rows - 1
    End If
    
    If Abs(mGrid.ColSel - mGrid.Col) < cols Then
        beginCol = IIf(mGrid.Col < mGrid.ColSel, mGrid.Col, mGrid.ColSel)
        If mGrid.cols < beginCol + cols + 1 Then    '超过最大列数
            endCol = mGrid.cols - 1
        Else
            endCol = beginCol + cols
        End If
    End If
    mGrid.Row = beginRow
    mGrid.Col = beginCol
    mGrid.RowSel = endRow
    mGrid.ColSel = endCol
    mGrid.Clip = Clipboard.GetText
End Sub
Public Sub MSGrid_Cut(mGrid As MSHFlexGrid)
   '####################################################################
   'mshflexgrid里面剪切一行
   '####################################################################
   MSGrid_Copy mGrid
   MSGrid_Clear mGrid
End Sub
Public Sub MSGrid_Clear(mGrid As MSHFlexGrid)
   '####################################################################
   'mshflexgrid里面剪切一行
   '####################################################################
    With mGrid
        For i = IIf(.Row < .RowSel, .Row, .RowSel) To IIf(.Row > .RowSel, .Row, .RowSel)
            For j = IIf(.Col < .ColSel, .Col, .ColSel) To IIf(.Col > .ColSel, .Col, .ColSel)
               .TextMatrix(i, j) = ""
            Next j
        Next i
    End With
End Sub
Public Sub MSGrid_Repeat(mGrid As MSHFlexGrid)
    '####################################################################
    'mshflexgrid里面剪切一行
    '####################################################################
    Dim i As Integer
    Dim j As Integer
    With mGrid
        For i = IIf(.Row < .RowSel, .Row, .RowSel) To IIf(.Row > .RowSel, .Row, .RowSel)
            For j = IIf(.Col < .ColSel, .Col, .ColSel) To IIf(.Col > .ColSel, .Col, .ColSel)
               .TextMatrix(i, j) = .TextMatrix(IIf(.Row < .RowSel, .Row, .RowSel), IIf(.Col < .ColSel, .Col, .ColSel))
            Next j
        Next i
    End With
End Sub
Public Sub MSGrid_Increase(mGrid As MSHFlexGrid)
   '####################################################################
   'mshflexgrid里面剪切一行
   '####################################################################
    Dim beginRow As Integer
    Dim beginCol As Integer
    Dim start As Integer
    Dim gap As Integer
    Dim j As Integer
    With mGrid
        If .Row = .RowSel And .Col = .ColSel Then
            Exit Sub
        End If
        If .Row <> .RowSel And .Col <> .ColSel Then
            Exit Sub
        End If
        beginRow = IIf(.Row < .RowSel, .Row, .RowSel)
        beginCol = IIf(.Col < .ColSel, .Col, .ColSel)
        start = Val(.TextMatrix(beginRow, beginCol))
        If .Row = .RowSel Then
            gap = Val(.TextMatrix(beginRow, beginCol + 1)) - Val(.TextMatrix(beginRow, beginCol))
            For j = IIf(.Col < .ColSel, .Col, .ColSel) + 1 To IIf(.Col > .ColSel, .Col, .ColSel)
               .TextMatrix(.Row, j) = Val(.TextMatrix(.Row, j - 1)) + gap
            Next j
        ElseIf .Col = .ColSel Then
            gap = Val(.TextMatrix(beginRow + 1, beginCol)) - Val(.TextMatrix(beginRow, beginCol))
            For j = IIf(.Row < .RowSel, .Row, .RowSel) + 1 To IIf(.Row > .RowSel, .Row, .RowSel)
               .TextMatrix(j, .Col) = Val(.TextMatrix(j - 1, .Col)) + gap
            Next j
        End If
    End With
End Sub
Public Sub MSGrid_SelectAll(mGrid As MSHFlexGrid)
   '####################################################################
   'mshflexgrid里面剪切一行
   '####################################################################
    Dim endRow As Integer
    Dim endCol As Integer
    endRow = 1
    endCol = 1
    mGrid.Row = 1
    mGrid.Col = 1
    For i = 1 To mGrid.rows - 1
        For j = 1 To mGrid.cols - 1
            If mGrid.TextMatrix(i, j) <> "" Then
                If endRow < i Then endRow = i
                If endCol < j Then endCol = j
            End If
        Next j
    Next i
    mGrid.RowSel = endRow
    mGrid.ColSel = endCol
End Sub

 

这个里面就粘贴代码长点。原因是excel复制出来的东西比mshflexgrid本身复制出来的东西多一个enter+shift键吧,所以得讨论下。mGrid.Clip = Clipboard.GetText 是核心代码,它能将粘贴板上的东西粘贴到mshflexgrid上,不过它只粘贴你选中的mshflexgrid单元格,超出的部分不管,我做了一点增强。

 

在我的程序里是不允许改变列数的,所以你要是用可能得改改。增行就是插入一行。重复就是在后面的选中的单元格中填入第一个单元格的内容。递增不用说了吧,试试。

 

到这里我想普通的excel应用就能完成了。

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值