我写的关于DataGrid具有超链接样式的ColumnStyle,想要源码请留Email

ganenpingsohucom 2003-09-04 10:10:52
设计思路:
1 继承ColumnStyle
2 重写Paint,在其中检测鼠标的位置,鼠标的按键,抛出Click事件
3 在DataGrid.MouseMove事件中引发局部更新
...全文
70 28 打赏 收藏 转发到动态 举报
写回复
用AI写文章
28 条回复
切换为时间正序
请发表友善的回复…
发表回复
ganenpingsohucom 2003-09-08
  • 打赏
  • 举报
回复
Protected Overloads Overrides Sub Paint(ByVal g As Graphics, _
ByVal Bounds As Rectangle, _
ByVal Source As CurrencyManager, _
ByVal RowNum As Integer)
Paint(g, Bounds, Source, RowNum, False)
End Sub
Public Event Click(ByVal RowNum As Integer, ByVal UserDefine As String)
'重画的主要函数
Private OldMouseButton As System.Windows.Forms.MouseButtons = MouseButtons.None
Protected Overloads Overrides Sub Paint(ByVal g As Graphics, _
ByVal Bounds As Rectangle, _
ByVal Source As CurrencyManager, _
ByVal RowNum As Integer, _
ByVal AlignToRight As Boolean)
'测量文本的大小
If m_datagrid.IsSelected(RowNum) Then
g.FillRectangle(Brushes.DarkBlue, Bounds)
Else
g.FillRectangle(Brushes.White, Bounds)
End If
'取到绑定的数据
Dim text As String
Try
text = Me.GetText(Me.GetColumnValueAtRow(Source, RowNum))
Catch e As System.Exception
Trace.WriteLine("deletestyle->Paint->GetColumnValueAtRow error,detail:" & e.ToString)
End Try
Me.Size_m_text = g.MeasureString(Me.m_text, Me.m_font)
'文本的bounds
Dim m_bounds As New Rectangle(Bounds.X + (Bounds.Width - Size_m_text.Width) / 2, Bounds.Y + (Bounds.Height - Me.Size_m_text.Height) / 2, Me.Size_m_text.Width, Me.Size_m_text.Height)
If m_datagrid.IsSelected(RowNum) Then
g.DrawString(Me.m_text, Me.m_font, Brushes.White, m_bounds.X, m_bounds.Y)
Else
g.DrawString(Me.m_text, Me.m_font, Brushes.Blue, m_bounds.X, m_bounds.Y)
End If
End Sub
Private oldcell As DataGridCell
'实现鼠标按下,删除格更新
Private Sub m_datagrid_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles m_datagrid.MouseDown
'得到鼠标位置的row和column值
Dim MousePosition As Point = m_datagrid.PointToClient(m_datagrid.MousePosition)
Dim hittest As DataGrid.HitTestInfo = m_datagrid.HitTest(MousePosition)
'Me.m_CurrentRow = -1
Dim cell As New DataGridCell(hittest.Row, m_datagrid.TableStyles(0).GridColumnStyles.IndexOf(Me))
'如果不是旧格,引发更新
If Not (cell.Equals(oldcell)) Then
Try
m_datagrid.Invalidate(m_datagrid.GetCellBounds(oldcell), False)
Catch ex As System.Exception
Trace.WriteLine("m_datagrid_MouseDown->m_datagrid.Invalidate(m_datagrid.GetCellBounds(oldcell), False) error,detail:" & ex.ToString)
End Try
oldcell = cell
End If
End Sub
'引发事件
Private Sub m_datagrid_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles m_datagrid.MouseUp
'得到鼠标位置的row和column值
Dim MousePosition As Point = m_datagrid.PointToClient(m_datagrid.MousePosition)
Dim hittest As DataGrid.HitTestInfo = m_datagrid.HitTest(MousePosition)
If hittest.Column < 0 Or hittest.Row < 0 Then Exit Sub
'Me.m_CurrentRow = hittest.Row
'得到此列当前行的bounds
Dim cell As New DataGridCell(hittest.Row, m_datagrid.TableStyles(0).GridColumnStyles.IndexOf(Me))
Dim bounds As Rectangle = m_datagrid.GetCellBounds(cell)

'计算文本的bounds
Dim m_bounds As New Rectangle(bounds.X + (bounds.Width - Size_m_text.Width) / 2, bounds.Y + (bounds.Height - Me.Size_m_text.Height) / 2, Me.Size_m_text.Width, Me.Size_m_text.Height)
'如果是此列当前行而且属于文本的位置,执行删除事件
If m_bounds.Contains(m_datagrid.PointToClient(m_datagrid.MousePosition)) Then
RaiseEvent Click(hittest.Row, m_datagrid.Item(cell))
'删除此列后,选中列悬空
'Me.m_CurrentRow = -1
'引发更新
m_datagrid.Refresh()
End If
End Sub
Protected Overloads Sub Paint(ByVal g As Graphics, _
ByVal Bounds As Rectangle, _
ByVal Source As CurrencyManager, _
ByVal RowNum As Integer, _
ByVal BackBrush As Brush, _
ByVal ForeBrush As Brush, _
ByVal AlignToRight As Boolean)
Paint(g, Bounds, Source, RowNum, False)
End Sub

Protected Overloads Overrides Sub SetDataGridInColumn(ByVal Value As DataGrid)
MyBase.SetDataGridInColumn(Value)
Me.m_datagrid = Value
End Sub
Protected Overloads Overrides Sub UpdateUI(ByVal Source As CurrencyManager, _
ByVal RowNum As Integer, ByVal InstantText As String)
End Sub
Private ReadOnly Property DataGridTableGridLineWidth() As Integer
Get
If Me.DataGridTableStyle.GridLineStyle = DataGridLineStyle.Solid Then
Return 1
Else
Return 0
End If
End Get
End Property
'得到绑定的数据源的某列的某行的文本
Private Function GetText(ByVal Value As Object) As String
If Value Is System.DBNull.Value Then Return NullText
If Not Value Is Nothing Then
Return Value.ToString
Else
Return String.Empty
End If
End Function
'在mousemove事件中引发当前行的paint,和old行的paint
'纪录前次的行值
Private Sub m_datagrid_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles m_datagrid.MouseMove
'如果激活的窗体不是住窗体,不要动
If Not (Form.ActiveForm Is m_datagrid.FindForm) Then
Exit Sub
End If
'得到鼠标位置的row和column值
Dim MousePosition As Point = m_datagrid.PointToClient(m_datagrid.MousePosition)
Dim hittest As DataGrid.HitTestInfo = m_datagrid.HitTest(MousePosition)
'设置当前行
'Me.CurrentRow = hittest.Row
If hittest.Row >= 0 Then
'如果当前行存在,找到此列,根据Bounds改变鼠标
Dim cell As New DataGridCell(hittest.Row, m_datagrid.TableStyles(0).GridColumnStyles.IndexOf(Me))
Dim bounds As Rectangle = m_datagrid.GetCellBounds(cell)
'计算文本的bounds
Dim m_bounds As New Rectangle(bounds.X + (bounds.Width - Size_m_text.Width) / 2, bounds.Y + (bounds.Height - Me.Size_m_text.Height) / 2, Me.Size_m_text.Width, Me.Size_m_text.Height)
'如果鼠标在文本的bounds中,改变鼠标显示
If m_bounds.Contains(m_datagrid.PointToClient(m_datagrid.MousePosition)) Then
Me.m_datagrid.FindForm.Cursor = Cursors.Hand
Else
Me.m_datagrid.FindForm.Cursor = Cursors.Default
End If
Else
Me.m_datagrid.FindForm.Cursor = Cursors.Default
End If
End Sub
End Class
ganenpingsohucom 2003-09-08
  • 打赏
  • 举报
回复
Imports System.Collections
Imports System.ComponentModel
Imports System.Drawing
Imports System.Windows.Forms
Imports System.Data
Public Class PaintColumn
Inherits DataGridColumnStyle
Private xMargin As Integer = 2
Private yMargin As Integer = 1
'Private CurrentRow As Integer = -1 '用于datagrid_mousemove事件中,引起label的更新
'Private m_CurrentRow As Integer = 0 '用于datagrid_mousedown事件,选中此行
Private WithEvents m_datagrid As DataGrid
'需要显示的图像
Private m_image As Image
'Jian Ti
Public m_simplified As Boolean = True
'显示的文本大小
Private Size_m_text As SizeF
'显示的文本
Private m_text As String = "删除"
Private m_font As Font
'初始化
Sub New()
'Me.CurrentRow = -1
m_font = New Font("宋体", 9, FontStyle.Underline)
End Sub
'------------------------------------------------------
'从 DataGridColumnStyle类继承下来的方法
'------------------------------------------------------
Protected Overloads Overrides Sub Abort(ByVal RowNum As Integer)
End Sub
' 接受改变
Protected Overloads Overrides Function Commit(ByVal DataSource As CurrencyManager, _
ByVal RowNum As Integer) As Boolean
End Function
' 移开聚焦
Protected Overloads Overrides Sub ConcedeFocus()

End Sub
' 编辑单元格
Protected Overloads Overrides Sub Edit(ByVal Source As CurrencyManager, _
ByVal Rownum As Integer, _
ByVal Bounds As Rectangle, _
ByVal [ReadOnly] As Boolean, _
ByVal InstantText As String, _
ByVal CellIsVisible As Boolean)
End Sub

Protected Overloads Overrides Function GetMinimumHeight() As Integer

End Function
Protected Overloads Overrides Function GetPreferredHeight(ByVal g As Graphics, _
ByVal Value As Object) As Integer
Dim NewLineIndex As Integer = 0
Dim NewLines As Integer = 0
Try

Dim ValueString As String = Me.GetText(Value)
Do
While NewLineIndex <> -1
NewLineIndex = ValueString.IndexOf("r\n", NewLineIndex + 1)
NewLines += 1
End While
Loop
Catch es As Exception
End Try
Return FontHeight * NewLines + yMargin
End Function
Protected Overloads Overrides Function GetPreferredSize(ByVal g As Graphics, _
ByVal Value As Object) As Size
Dim Extents As Size
Try
Extents = System.Drawing.Size.Ceiling(g.MeasureString(GetText(Value), _
Me.DataGridTableStyle.DataGrid.Font))
Extents.Width += xMargin * 2 + DataGridTableGridLineWidth
Extents.Height += yMargin
Catch es As Exception
End Try
Return Extents
End Function
menuvb 2003-09-05
  • 打赏
  • 举报
回复
给我也一份 8926304aaa@21cn.com
jackeyyang 2003-09-05
  • 打赏
  • 举报
回复
来的还不算太晚吧
谢谢,jackeyyang99@163.com
长沙侯 2003-09-05
  • 打赏
  • 举报
回复
我要,谢谢! tommy_hou@sohu.com
ganenpingsohucom 2003-09-05
  • 打赏
  • 举报
回复
我又给发了,GGJJDDMM如果觉得有什么好的方法和建议等等,请不吝赐教阿 :(
htwoolotus 2003-09-05
  • 打赏
  • 举报
回复
顺便:
http://expert.csdn.net/Expert/topic/1827/1827708.xml?temp=.1455957
-------------------------
htwoo@peoplemail.com.cn
siugwan 2003-09-05
  • 打赏
  • 举报
回复
我也要,谢谢!
siugwan@pub.guangzhou.gd.cn
foxbuilder 2003-09-05
  • 打赏
  • 举报
回复
多谢!

afox@vip.sina.com
eastfiat 2003-09-05
  • 打赏
  • 举报
回复
谢谢,俺要一份
eastfiat@21cn.com
lululei 2003-09-05
  • 打赏
  • 举报
回复
lululei@163.com 谢谢。。。。
flyinglx16 2003-09-05
  • 打赏
  • 举报
回复
flyinglx16@163.com
谢谢!
canyqf 2003-09-05
  • 打赏
  • 举报
回复
dimpub@163.com
谢谢!
tracylmm 2003-09-05
  • 打赏
  • 举报
回复
能再发给我一份吗 ?
jobtracyxu@hotmail.com
rock29 2003-09-04
  • 打赏
  • 举报
回复
me:
rock29@eyou.com,thanks!
ganenpingsohucom 2003-09-04
  • 打赏
  • 举报
回复
我已经发了,收到请回阿
mingyuebin 2003-09-04
  • 打赏
  • 举报
回复
shaobinwang@21cn.com

谢谢!
chenzhongfei 2003-09-04
  • 打赏
  • 举报
回复
谢谢
ymss23@163.com
coolpine 2003-09-04
  • 打赏
  • 举报
回复
kingpine@tsinghua.org.cn
多谢
dzq_1 2003-09-04
  • 打赏
  • 举报
回复
谢谢!
dzq_801102@163.com
加载更多回复(8)

16,553

社区成员

发帖
与我相关
我的任务
社区描述
VB技术相关讨论,主要为经典vb,即VB6.0
社区管理员
  • VB.NET
  • 水哥阿乐
  • 无·法
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧