模仿qq的动态列表框
来源：互联网 发布：广州趣米网络 编辑：程序博客网 时间：2024/05/01 23:44
这两天做了一个模仿qq动态列表框。代码很简单，这里就不详述了。有兴趣的朋友可以自己下载看看源代码。地址：
（csdn很烂啦。资源都上传了，可就是不能马上看到。也罢，这里就贴上关键代码，貌似没有vb.net代码？？）
Imports System.ComponentModelImports System.DrawingImports System.Drawing.Drawing2DNamespace ListboxExNS ''' <summary> '''类似qq登陆列表框，支持 图标及大小变化 ''' </summary> ''' <remarks></remarks> <DefaultEvent("ItemClick")> _ Public Class ListBoxEx Inherits ScrollableControl Public Event ItemClick(ByVal sender As Object, ByVal e As ItemClickEventArgs) Public Sub OnItemClick(ByVal e As ItemClickEventArgs) RaiseEvent ItemClick(Me, e) End Sub#Region "初始化及析构" Sub New() SetStyle(ControlStyles.UserPaint + ControlStyles.OptimizedDoubleBuffer + ControlStyles.AllPaintingInWmPaint, True) SetStyle(ControlStyles.Selectable, True) SetStyle(ControlStyles.ResizeRedraw, True) UpdateStyles() AutoScroll = True _items = New List(Of listitem) End Sub#End Region#Region "属性" Public _hotItem As Int32 = 0 '默认第一个项为索引 ''' <summary> ''' 图像框 ''' </summary> ''' <value></value> ''' <returns></returns> ''' <remarks></remarks> <Description("图像框"), DefaultValue("nothing")> _ Property Imagelist() As ImageList Get Return _Imagelist End Get Set(ByVal value As ImageList) _Imagelist = value End Set End Property Dim _Imagelist As ImageList ''' <summary> ''' 条目集合 ''' </summary> ''' <value></value> ''' <returns></returns> ''' <remarks></remarks> <DesignerSerializationVisibility(DesignerSerializationVisibility.Content)> _ Property Items() As List(Of listitem) Get Return _items End Get Set(ByVal value As List(Of listitem)) _items = value End Set End Property Dim _items As List(Of listitem) Dim _itemHeight As Int32 = 24 Property ItemHeight() As Int32 Get Return _itemHeight End Get Set(ByVal value As Int32) _itemHeight = value End Set End Property Property Zoon() As Int32 Get Return _zoon * 2 End Get Set(ByVal value As Int32) _zoon = value / 2 End Set End Property Private _zoon As Int32 = 10 Property StringAlign() As StringAlign Get Return _StringAlign End Get Set(ByVal value As StringAlign) _StringAlign = value End Set End Property Private _StringAlign As StringAlign = StringAlign.left#End Region#Region "重载" Protected Overrides Sub OnMouseClick(ByVal e As System.Windows.Forms.MouseEventArgs) MyBase.OnMouseClick(e) Dim index As Int32 = GetItemFromPoint(e.Location) If index <> -1 Then OnItemClick(New ItemClickEventArgs(Items(index))) End If End Sub Protected Overrides Sub OnScroll(ByVal se As System.Windows.Forms.ScrollEventArgs) MyBase.OnScroll(se) 'Dim f As Single = se.NewValue / ItemHeight 'Dim n As Int32 = Math.Floor(f) 'If f - n > 0.00001 Then ' se.NewValue = n * ItemHeight 'End If Me.Invalidate() End Sub Protected Overrides Sub OnMouseMove(ByVal e As System.Windows.Forms.MouseEventArgs) MyBase.OnMouseMove(e) Dim index As Int32 = GetItemFromPoint(e.Location) If index <> _hotItem Then If index <> -1 Then _hotItem = index Me.Invalidate() End If End Sub Private Sub testpaint(ByVal e As System.Windows.Forms.PaintEventArgs) Dim g As Graphics = e.Graphics g.SmoothingMode = SmoothingMode.HighQuality g.TranslateTransform(AutoScrollPosition.X, AutoScrollPosition.Y) Dim x, y As Int32 Dim bkclr As Color = Color.FromArgb(198, 211, 227) Dim clr1 As Color = Color.FromArgb(235, 244, 245) Dim bkP As New Pen(bkclr) Dim sf As New StringFormat sf.Alignment = StringAlign sf.LineAlignment = StringAlignment.Center Dim t As Int32 For i As Int32 = 0 To Items.Count - 1 If i = _hotItem - 1 Then t = Zoon ElseIf i = _hotItem Then t = 2 * Zoon ElseIf i = _hotItem + 1 Then t = Zoon Else t = 0 End If Dim rect As New Rectangle(x, y, Width, ItemHeight + t) y += rect.Height '绘制背景 Using bgSB As New LinearGradientBrush(rect, Color.White, clr1, LinearGradientMode.Vertical) g.FillRectangle(bgSB, rect) End Using g.DrawRectangle(bkP, rect) '绘制图白哦 Dim image As Image = Imagelist.Images(Items(i).ImageIndex) If image IsNot Nothing Then Dim r As New Rectangle(2, rect.Y + 2, rect.Height - 4, rect.Height - 4) g.DrawImage(image, r) End If '绘制文字 Dim txtRect As New Rectangle(rect.Height, rect.Y, rect.Width - rect.Height, rect.Height) g.DrawString(Items(i).Text, Font, Brushes.Black, txtRect, sf) Next End Sub Protected Overrides Sub OnPaint(ByVal e As System.Windows.Forms.PaintEventArgs) If DesignMode Then Dim rect As New Rectangle(0, 0, Width - 1, Height - 1) e.Graphics.FillRectangle(Brushes.White, rect) e.Graphics.DrawRectangle(New Pen(Color.FromArgb(59, 163, 218)), rect) Return End If ' testpaint(e) If Items.Count = 0 Then MyBase.OnPaint(e) Return End If '计算起始行和结束行，都加上1 防止绘制缺欠 Dim startI As Int32 = VerticalScroll.Value / ItemHeight - 1 Dim finishI As Int32 = (VerticalScroll.Value + ClientSize.Height) / ItemHeight + 1 startI = Math.Max(startI, 0) finishI = Math.Min(finishI, Items.Count - 1) Dim g As Graphics = e.Graphics g.SmoothingMode = SmoothingMode.HighQuality g.TranslateTransform(AutoScrollPosition.X, AutoScrollPosition.Y) Dim y As Int32 = 0 Dim x As Int32 = 1 Dim w As Int32 = Width Dim h As Int32 = ItemHeight Dim scrollW As Int32 = 0 If AutoScrollMinSize.Height > ClientSize.Height Then scrollW = 18 Dim blnImage As Boolean = _Imagelist IsNot Nothing Dim bkclr As Color = Color.FromArgb(198, 211, 227) Dim clr1 As Color = Color.FromArgb(235, 244, 245) ' Dim bgSB As LinearGradientBrush Dim bkP As New Pen(bkclr) Dim sf As New StringFormat sf.Alignment = StringAlign sf.LineAlignment = StringAlignment.Center If startI = 0 Then y = 0 ElseIf startI = _hotItem Then y = ItemHeight * (startI + 0) + Zoon ElseIf startI - _hotItem > 1 Then y = ItemHeight * (startI + 0) + 3 * Zoon ElseIf startI - _hotItem > 2 Then y = ItemHeight * (startI + 0) + 4 * Zoon Else y = ItemHeight * (startI + 0) End If 'If startI = _hotItem Then ' y = ItemHeight * (startI + 0) + Zoon 'Else ' y = ItemHeight * (startI + 0) 'End If For i As Int32 = startI To finishI Dim rect As Rectangle If i = _hotItem - 1 Then rect = New Rectangle(x, y, w, h + Zoon) ElseIf i = _hotItem Then rect = New Rectangle(x, y, w, h + 2 * Zoon) ElseIf i = _hotItem + 1 Then rect = New Rectangle(x, y, w, h + Zoon) Else rect = New Rectangle(x, y, w, h) End If If i = _hotItem Then clr1 = Color.Orange Else clr1 = Color.FromArgb(235, 244, 245) End If '绘制背景 Using bgSB As New LinearGradientBrush(rect, Color.White, clr1, LinearGradientMode.Vertical) g.FillRectangle(bgSB, rect) End Using g.DrawRectangle(bkP, rect) '绘制图白哦 Dim image As Image = Imagelist.Images(Items(i).ImageIndex) If image IsNot Nothing Then Dim r As New Rectangle(2, rect.Y + 2, rect.Height - 4, rect.Height - 4) g.DrawImage(image, r) End If '绘制文字 Dim txtRect As New Rectangle(rect.Height, rect.Y, rect.Width - rect.Height - scrollW, rect.Height) g.DrawString(Items(i).Text, Font, Brushes.Black, txtRect, sf) y += rect.Height Next g.TranslateTransform(-AutoScrollPosition.X, -AutoScrollPosition.Y) Using Pen As New Pen(Color.FromArgb(59, 163, 218)) g.DrawRectangle(Pen, New Rectangle(0, 0, Width - 1, Height - 1)) End Using End Sub ''' <summary> ''' 计算指定点所在item ''' </summary> ''' <param name="pt"></param> ''' <returns></returns> ''' <remarks></remarks> Public Function GetItemFromPoint(ByVal pt As Point) As Int32 If Items.Count = 0 Then Return -1 Dim index As Int32 = -1 Dim curY As Int32 '当前热点所 If _hotItem = 0 Then curY = 0 Else curY = _hotItem * ItemHeight + Zoon ' End If pt = pt - AutoScrollPosition '判断点在热点之前或者后 If pt.Y < curY Then '在前面 If pt.Y > curY - ItemHeight - Zoon Then '是否前一个 index = _hotItem - 1 Else Dim n As Int32 = Math.Ceiling(pt.Y / ItemHeight) 'Math.Ceiling((curY - ItemHeight - Zoon) / ItemHeight) index = n ' - 1 ' _hotItem - n + 1 End If Else '在后面 '判断是否在源热点 If pt.Y < (curY + ItemHeight + 2 * Zoon) Then index = _hotItem ElseIf pt.Y < curY + ItemHeight * 2 + Zoon * 3 Then '是否在热点下一个 index = _hotItem + 1 Else Dim n As Int32 = pt.Y - (curY + ItemHeight + Zoon * 3) index = Math.Ceiling((pt.Y - ItemHeight * 2 - Zoon * 3) / ItemHeight) + 1 End If End If If index < 0 OrElse index > Items.Count - 1 Then index = -1 End If Return index End Function Public Sub fnCaseSize() Dim w As Int32 = Width Dim h As Int32 = (ItemHeight * Items.Count + 0) + 4 * Zoon If h > ClientSize.Height Then w -= 18 AutoScrollMinSize = New Size(w, h) End Sub#End Region End ClassEnd Namespace
Namespace ListboxExNS <Serializable()> Public Class listitem Private _text As String Private _imageindex As Int32 = -1 Sub New(ByVal text As String) _text = text End Sub Sub New(ByVal text As String, ByVal imageindex As Int32) _text = text _imageindex = imageindex End Sub Property Text() As String Get Return _text End Get Set(ByVal value As String) _text = value End Set End Property Property ImageIndex() As Int32 Get Return _imageindex End Get Set(ByVal value As Int32) _imageindex = value End Set End Property Public Overrides Function ToString() As String Return Text End Function End ClassEnd Namespace
Namespace ListboxExNS Public Class ItemClickEventArgs Inherits EventArgs Sub New(ByVal item As listitem) _item = item End Sub Private _item As listitem Property Item() As listitem Get Return _item End Get Set(ByVal value As listitem) _item = value End Set End Property End ClassEnd Namespace
Namespace ListboxExNS ''' <summary> ''' 文本对齐方式 ''' </summary> ''' <remarks></remarks> Public Enum StringAlign ''' <summary> ''' 左对齐 ''' </summary> ''' <remarks></remarks> left = 0 ''' <summary> ''' 中间对齐 ''' </summary> ''' <remarks></remarks> center = 1 ''' <summary> ''' 右对齐 ''' </summary> ''' <remarks></remarks> right = 2 End EnumEnd Namespace
- 模仿qq的动态列表框
- 模仿qq列表的ActiveX控件
- 模仿QQ农场好友列表
- 模仿QQ好友列表的ExpandableListView实现的效
- 模仿combbox的创建下拉列表js支持动态选项
- 模仿QQ 输入框
- 模仿QQ，实现列表简单折叠
- Qt 模仿QQ截图 动态吸附直线
- Qt 模仿QQ截图 动态吸附直线
- Android常用控件(能折叠的ListView)--ExpandableListView的使用模仿QQ好友列表
- QT 模仿QQ的截图
- iOS模仿QQ的折叠
- 模仿qq的抽屉view
- jquery模仿QQ消息框
- 模仿qq头像上传的弹出框效果
- 模仿QQ左滑删除当前会话列表
- 模仿QQ左侧的工具栏（QQBar）
- 模仿QQ弹出窗口的源代码(推荐)
- 线程的同步--条件变量
- sleep()和wait()的区别
- 关于ArrayList
- 分段函数
- how to implement the WaitForMultipleObjects in linux
- 模仿qq的动态列表框
- 运算符优先级
- mysql的存储过程
- Gzip 的HTTP支持(一)
- Gzip 的HTTP支持 (二)
- 尚观之webmail搭建笔记
- php内核探索方法与资源
- VS2008整合DirectX9.0开发环境
- Andriond参考
