请问大家怎么样在mshflexgrid中实现checkbox功能啊谢谢大家了帮帮忙吧~~~~

gxsuyong 2003-01-20 05:29:30
请问大家怎么样在mshflexgrid中实现checkbox功能啊谢谢大家了帮帮忙吧~~~~,我已经找了很多网站了都找不到真急死人了.
...全文
64 点赞 收藏 9
写回复
9 条回复
切换为时间正序
当前发帖距今超过3年,不再开放新的回复
发表回复
gxsuyong 2003-01-21
请问月光宝盒上面的
NewClassText6.Visible = False
NewClassCom6.Visible = False
是什么意思啊?
回复
gxsuyong 2003-01-21
谢谢!那我试试看~~
回复
chenjiaxiong 2003-01-21
在窗体上加入一个Msflexgrid控件,命名为newclassMS,再加入一个checkbox,把下面的代码的控件名稍作改动就行了..
'==================================================
Option Explicit
Private OldText As String
Private ColSelect() As Boolean
Private SaveCellBkColor As Long

Private Sub Form_Load()
NewClassText6.Visible = False
NewClassCom6.Visible = False
Me.Show

With NewClassMS

.Cols = 4
.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

NewClassMS.TextMatrix(0, 1) = "列名"
NewClassMS.TextMatrix(0, 2) = "数据类型"
NewClassMS.TextMatrix(0, 3) = "长度"

With NewClassMS
.Col = 0
For i = 1 To .Rows - 1
.Row = i: .Text = i
Next
End With

End Sub

Private Sub NewClassCom6_Change()
NewClassMS.Text = NewClassCom6.Text
End Sub

Private Sub NewClassCom6_LostFocus()
NewClassCom6.Visible = False
End Sub

Private Sub NewClassMS_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim inMostLeft As Boolean
Dim inMostTop As Boolean

Call ProcMultiColSel(Shift)

If Button = vbKeyLButton Then
If NewClassMS.ColSel = NewClassMS.Col And NewClassMS.RowSel = NewClassMS.Row Then
'表示没有多个栏位的选取,这时才真正是可以输入
Call toEditGrid(NewClassMS.Col, NewClassMS.Row)
End If
End If
End Sub
Private Sub NewClassMS_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn And Not NewClassText6.Visible Then
With NewClassMS
Call toEditGrid(.Col, .Row)
End With
End If
End Sub
'TextBox上的输入反映到MsFlexGrid上
Private Sub NewClassText6_Change()
NewClassMS.Text = NewClassText6.Text
End Sub
'按下Down/Up 时结束TextBox的Keyin
Private Sub NewClassText6_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyUp Then
NewClassText6.Visible = False
NewClassMS.SetFocus
SendKeys "{up}"
Else
If KeyCode = vbKeyDown Then
NewClassText6.Visible = False
NewClassMS.SetFocus
SendKeys "{down}"
End If
End If
End Sub
Private Sub NewClassText6_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
KeyAscii = 0
NewClassText6.Visible = False
NewClassMS.SetFocus
End If
If KeyAscii = vbKeyEscape Then
KeyAscii = 0
NewClassMS.Text = OldText
NewClassText6.Visible = False
NewClassMS.SetFocus
End If
End Sub

Private Sub NewClassText6_LostFocus()
NewClassText6.Visible = False
End Sub
'设定TextBox於MSFlexGrid1的Current Cell上
Private Sub toEditGrid(ByVal C As Integer, ByVal R As Integer)

If C = 2 Then

With NewClassMS
.Col = C: .Row = R

NewClassCom6.Left = .Left + .ColPos(C)
NewClassCom6.Top = .Top + .RowPos(R)
If .Appearance = flex3D Then
NewClassCom6.Left = NewClassCom6.Left + 2 * Screen.TwipsPerPixelX
NewClassCom6.Top = NewClassCom6.Top + 2 * Screen.TwipsPerPixelY
End If
NewClassCom6.Width = .ColWidth(C)
'NewClassCom6.Height = .RowHeight(R)
NewClassCom6.Text = .Text
OldText = .Text
End With
NewClassCom6.Visible = True
NewClassCom6.SelStart = Len(NewClassCom6.Text)
NewClassCom6.SetFocus

Else

With NewClassMS
.Col = C: .Row = R

NewClassText6.Left = .Left + .ColPos(C)
NewClassText6.Top = .Top + .RowPos(R)
If .Appearance = flex3D Then
NewClassText6.Left = NewClassText6.Left + 2 * Screen.TwipsPerPixelX
NewClassText6.Top = NewClassText6.Top + 2 * Screen.TwipsPerPixelY
End If
NewClassText6.Width = .ColWidth(C)
NewClassText6.Height = .RowHeight(R)
NewClassText6.Text = .Text
OldText = .Text
End With
NewClassText6.Visible = True
NewClassText6.SelStart = Len(NewClassText6.Text)
NewClassText6.SetFocus


End If


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 NewClassMS
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 NewClassMS
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 NewClassMS
SaveCol = .Col: SaveRow = .Row
.Col = 1: .Row = 1
.ColSel = .Cols - 1: .RowSel = .Rows - 1
NewClassMS.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 NewClassMS
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
NewClassMS.CellBackColor = SaveCellBkColor
ColSelect(i) = False
End If
Next
.Col = SaveCol: .Row = SaveRow
.ColSel = SaveCol: .RowSel = SaveRow
End With
End Sub

Private Sub NewClassMS_Scroll()
SendKeys "{ESC}"
End Sub
回复
amolucky 2003-01-21
www.videosoft.com 有得下
回复
gxsuyong 2003-01-21
在那有载如果上面的兄弟有的话可以给我一个吗?谢谢了,我现在真的很急用到它。
我的email是suyong@china.com.cn
回复
amolucky 2003-01-20
兄弟 换用VSFLEXGRID这个控件 一步到位
回复
I_Iverson 2003-01-20
Private Sub MSHFlexGrid1_Click()
With MSHFlexGrid1
.TextMatrix(.Row, 4) = IIf(.TextMatrix(.Row, 4) = "", "£¥", "") '把网格内容换成勾,我没找到,你自己找找,在WORD里面
End With
End Sub
回复
I_Iverson 2003-01-20
为何一定要?
回复
饮水需思源 2003-01-20
在mshflexgrid中添加checkbox控件,用代码实现其操作
回复
相关推荐
发帖

1187

社区成员

VB 数据库(包含打印,安装,报表)
申请成为版主
帖子事件
创建了帖子
2003-01-20 05:29
社区公告
暂无公告