CSDN 新帖速递 工程源代码及工程下载

   '附注:

    '主要屏幕合成过程:

    'DrawBP(目标窗体,要合成的图片,透明度)

    'DrawBP合成未注释,请参阅Moudle1.vb

    '文字描边效果参见DrawItems()

    '程序占用资源释放参见代码结尾

    '转载请保留此信息

    '工程标题:桌面秀版CSDN VB.NET版块新帖速递 BY DYLIKE

'代码版本:VB.net 2008

‘工程文件及资源图片见附件

    'http://dylike.czdown.com

    '工程结构:

    'Resources

    '--BK.png       '背景

    '--close.png    '关闭按钮

    '--Light.png    '光线

    '--Min2.png     '最小化按钮

    '--Mouse2.png   '鼠标箭头按钮

    '--titlebar.png '项背景

    'Form1.vb

    'Module1.vb

'未标题-1副本.ico

 

  

Form1.vb

Imports System.Net

Public Class Form1

    Private WB As Net.HttpWebRequest '使用HttpWebRequest

    Private RP As Net.HttpWebResponse '用来获取WB数据

    Private URL As String '论坛版块的网址,未启用,适用于以后修改成多版块浏览切换

    Private RD As IO.StreamReader '读数据用

    Private tmpSTR As String '用来临时处理的临时字串

    Private WithEvents WBS As New WebBrowser '为方便,使用WebBrowser的载入完成事件

    Private C1, C2 As Collection 'C1放置提取的文字,C2放置提取的链接

    Private T1 As String = "<col class=" & Chr(34) & "function" & Chr(34) & " />" '从网页源码的哪里开始分析,通过该截断可以避免过多的无用链接

    Private SF As New StringFormat '文字样式,如对齐等

    Private LLB As Label '用来动态生成N个Label,并提供各自事件

    Private BP2, BP3, BP4 As Bitmap '临时背景,加载动态配景,前景

    Private ISBUSY As Boolean = False '是否忙碌?以显示底部光线动画

    Delegate Sub AA() '委托用

    Private TT As Threading.Thread '独立线程准备

    Private III, JJJ As Integer '临用计算数字



    Private Sub Form1_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing

        NotifyIcon1.Dispose() '窗体关闭时消除托盘图标

    End Sub

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

        On Error Resume Next '为避免不同电脑可能出现的问题,由于不需要针对错误处理,此处容错

        SF.LineAlignment = StringAlignment.Center '文字垂直居中,详见列表项文字效果

        SF.Alignment = StringAlignment.Near '文字水平居左,详见列表项文字效果

        C1 = New Collection '新建数据组1

        C2 = New Collection '新建数据组2

        BP3 = New Bitmap(Me.Width, Me.Height)    '初始化前景,置空

        BP2 = New Bitmap(Me.Width, Me.Height)    '初始化状态配景,置空

        BP = New Bitmap(My.Resources.BK)         '初始化背景,预置从资源读取

        BP4 = New Bitmap(Me.Width, Me.Height)    '初始化前景,置空,以准备绘制内容

        DrawBP(Me, BP, 255)                      '绘制背景,此时无绘制状态配景及前景

        Me.Show()                                '强制显示

        Timer1.Enabled = True                    '激活计时器

        TT = New Threading.Thread(AddressOf NewWBS) '独立线程准备

        TT.Start()                               '独立线程开始工作

    End Sub



    Private Sub WBS_DocumentCompleted(ByVal sender As Object, ByVal e As System.Windows.Forms.WebBrowserDocumentCompletedEventArgs) Handles WBS.DocumentCompleted

        On Error Resume Next    '容错处理

        C1.Clear()              '清空旧数据组1

        C2.Clear()              '清空旧数据组2

        For I As Integer = 0 To WBS.Document.Links.Count - 1    '循环获取网页所有链接

            If WBS.Document.Links(I).OuterHtml.Contains("TopicManage") = False Then '是否有"Topicmanage"字样?如果没有,则接下去处理

                If Trim(WBS.Document.Links(I).OuterText) <> "" Then '链接文字是否为空?

                    C1.Add(WBS.Document.Links(I).OuterText)         '如果不是,则在数据组1加入链接文字

                    C2.Add(GetLink(WBS.Document.Links(I).OuterHtml)) '如果不是,则在数据组2加入处理后的对应链接网址

                Else

                    C1.Add("无")                                    '反之,加入空白内容,必须,否则出错

                    C2.Add("")                                      '如果没有获取链接,则留空

                End If

            End If

        Next

        ISBUSY = False                                              '工作忙完了?是的

        DrawItems()                                                 '开始画前景

    End Sub

    Protected Overloads Overrides ReadOnly Property CreateParams() As CreateParams

        Get

            Dim cp As CreateParams = MyBase.CreateParams '获取扩展属性

            cp.ExStyle = cp.ExStyle Or &H80000           '设置扩展属性

            Return cp                                    '应用扩展属性

        End Get

    End Property



    Private Sub Form1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseDown

        On Error Resume Next                                '考虑可能的用户鼠标操作速度,避免出错,此处容错处理

        If e.Button = Windows.Forms.MouseButtons.Left Then  '点击了左键?

            ReleaseCapture()                                '捕获鼠标

            SendMessage(sender.Handle.ToInt32(), WM_SysCommand, SC_MOVE, 0) '发送移动窗口的消息

        End If

    End Sub



    Private Sub L_Click(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs)

        On Error Resume Next    '鼠标操作,尽可能使用容错处理,以免发生意外

        If e.Button = Windows.Forms.MouseButtons.Left Then   '点击了左键?

            If Trim(sender.name) <> "" AndAlso C1.Count > 1 Then '点击的控件是不是我要的控件?此时数据组1是否已经有内容?

                Dim TTMP As Integer = Int(sender.name.Replace("AAAA", "")) '过滤掉被点击控件名字中的多余字符,留下数字

                Process.Start(C2(TTMP)) '点击后用默认的浏览器打开目标网址

            End If

        End If

    End Sub



    Private Sub L_MouseEnter(ByVal sender As Object, ByVal e As System.EventArgs)

        On Error Resume Next '鼠标操作,容错处理

        sender.image = My.Resources.titlebar '鼠标移上去时,项LABEL显示选择栏图片

        DrawFore()                           '一点点改动就要即时绘制前景

        If Trim(sender.name) <> "" AndAlso C1.Count > 1 Then '如果相同索引的数据组1里相同索引有内容

            Dim TTMP As Integer = Int(sender.name.Replace("AAAA", "")) '获取数字

            ToolTip1.SetToolTip(sender, C1(TTMP) & vbCrLf & "帖子作者:" & C1(TTMP + 1) & vbCrLf & "最后回复:" & C1(TTMP + 2)) '分配提示内容

        End If

    End Sub



    Private Sub L_MouseLeave(ByVal sender As Object, ByVal e As System.EventArgs)

        sender.image = Nothing  '鼠标移出,无需容错,取消项背景

        DrawFore()              '绘制前景

    End Sub

    Private Sub DrawFore()

        On Error Resume Next '此句容错一定要,不同的机器绘制速度差别原因可能会导致GDI+异常

        If BP2 IsNot Nothing Then BP2.Dispose() '为避免占用过多内存,强制释放资源

        BP2 = New Bitmap(Me.Width, Me.Height)   '新开画布以准备绘制

        Using G As Graphics = Graphics.FromImage(BP2) '开始绘制

            For Each CT As Control In Me.Controls  '枚举窗体中所有控件

                If CT.Name.Contains("AAAA") = True AndAlso TypeOf (CT) Is Label OrElse CT.Name.Contains("Light") = True Then '是否控件名称中包含指定内容并且排除一些不相关的控件

                    LLB = CT '临时赋值

                    If LLB.Image IsNot Nothing Then '区别于该项是否有鼠标在上面,即是否该项有image

                        G.DrawImage(LLB.Image, CT.Bounds) '绘制到画布上

                    End If

                End If

            Next

        End Using

        If BP3 IsNot Nothing Then BP3.Dispose() '为避免占用过多内存,强制释放资源

        BP3 = New Bitmap(Me.Width, Me.Height)   '新开画布以准备绘制

        Using G As Graphics = Graphics.FromImage(BP3) '开始绘制

            G.DrawImage(BP, New Rectangle(0, 0, Me.Width, Me.Height), New Rectangle(0, 0, Me.Width, Me.Height), GraphicsUnit.Pixel) '注意层次,先画背景

            G.DrawImage(BP2, New Rectangle(0, 0, Me.Width, Me.Height), New Rectangle(0, 0, Me.Width, Me.Height), GraphicsUnit.Pixel) '再画前置于背景的其他图像

        End Using

        DrawBP(Me, BP3, 255) '屏幕合成

    End Sub

    Private Sub DH()  'DH.我的名字的拼音开头,可随意命名

        Try

            While ISBUSY = True     '当工作状态处于忙碌时

                If III >= 366 Then  '检查光线是否已经超过了规定长度

                    III = -20       '如果超过,那么恢复-值,该值取决于后面的Step步进,否则会出现画面闪烁

                End If

                III += 20 '步进值,光线每次该增加多长

                JJJ = 363 / 2 + 16 - LIGHT.Width / 2 '公式,使光线在窗体居中(排除窗体投影位置),结果为LEFT值

                LIGHT.Width = III '光线新长度

                LIGHT.Left = JJJ  '光线左位置

                If ISBUSY = False Then LIGHT.Width = 0 '工作状态完成了?那么光线消失

                If BP4 IsNot Nothing Then BP4.Dispose() '即时释放资源

                BP4 = New Bitmap(Me.Width, Me.Height) '准备绘制光线层

                Using G2 As Graphics = Graphics.FromImage(BP4)

                    G2.DrawImage(My.Resources.Light, New Rectangle(LIGHT.Left, LIGHT.Top, LIGHT.Width, 5), New Rectangle(0, 0, 33, 33), GraphicsUnit.Pixel) '绘制光线

                End Using

                If BP3 IsNot Nothing Then BP3.Dispose() '释放资源

                BP3 = New Bitmap(Me.Width, Me.Height)   '准备绘制背景,光线,前景等

                Using G As Graphics = Graphics.FromImage(BP3)

                    G.DrawImage(BP, New Rectangle(0, 0, Me.Width, Me.Height), New Rectangle(0, 0, Me.Width, Me.Height), GraphicsUnit.Pixel)  '绘制背景

                    G.DrawImage(BP2, New Rectangle(0, 0, Me.Width, Me.Height), New Rectangle(0, 0, Me.Width, Me.Height), GraphicsUnit.Pixel) '文字层

                    G.DrawImage(BP4, New Rectangle(0, 0, Me.Width, Me.Height), New Rectangle(0, 0, Me.Width, Me.Height), GraphicsUnit.Pixel) '绘制光线层

                End Using

                DrawBP(Me, BP3, 255) '屏幕合成

                Application.DoEvents() '避免假死

            End While

            LIGHT.Width = 0 '工作状态不再是忙碌

            DrawFore()      '绘制前景

        Catch ex As Exception

            LIGHT.Width = 0 '如果出错,让光线消失,避免给人一种正在加载的感觉

        End Try

    End Sub

    Private Sub DrawItems() '绘制文字层[关键]

        On Error Resume Next  '同样考虑不同机器速度的GDI+异常,容错处理

        '{

        For Each CT As Control In Me.Controls

            If CT.Name.StartsWith("AAAA") Then

                CT.Dispose()

            End If

        Next

        '提取窗体中所有带有指定内容的控件名的控件

        '}

        If BP IsNot Nothing Then BP.Dispose() '释放旧资源,使程序不要太过吃内存

        BP = New Bitmap(Me.Width, Me.Height)     '准备画布

        Using G As Graphics = Graphics.FromImage(BP)

............................



End Module