VB.NET-QQ新闻弹窗样式图片制作工具

〇、下载地址

本程序的下载地址（百度网盘）：http://pan.baidu.com/s/1qWBGGGG

一、关于本程序

Gnaea是一个QQ新闻弹窗的填字工具，可以在输入新闻标题和新闻内容后生成一张类似QQ新闻弹窗的图片。生成的图片可以被保存为BMP和PNG两种格式，或是直接复制到剪贴板。

效果如下图（注：内容纯属虚构）

二、程序控件

三、程序资源

被用作素材的资源：My.Resources.PopUp，取材于一张PNG格式的图片

四、程序代码

Imports System.Text

Public Class FormGnaea

#Region "初始化窗体"

    ‘加载窗体
    Private Sub FormGnaea_Load(sender As Object, e As EventArgs) _
        Handles MyBase.Load

        Me.pnlMiddle.BorderStyle = BorderStyle.FixedSingle
        Me.pnlButtom.BorderStyle = BorderStyle.FixedSingle
        Me.picPreview.Image = My.Resources.PopUp

    End Sub

#End Region
#Region "更新图片相关"

    ‘按新闻标题和内容更新图片信息
    Private Sub PreviewOnPic()

        Dim bmp As Bitmap = My.Resources.PopUp
        Dim g = Graphics.FromImage(bmp)

        ‘绘制新闻标题
        Dim lenOfTitle = Encoding.Default.GetByteCount(txtTitle.Text.Trim)
        g.DrawString(
             txtTitle.Text,
             New Font("宋体", 10, FontStyle.Bold),
             New SolidBrush(Color.FromArgb(255, 47, 75, 87)),
             New Point(125 - lenOfTitle * 3.5, 30))

        ‘绘制新闻内容
        Dim s As String = "　　" + txtContent.Text
        Dim s1 = New StringBuilder
        Dim s2 = New StringBuilder
        Dim s3 = New StringBuilder
        Dim s4 = New StringBuilder
        For i As Integer = 0 To s.Length - 1
            ‘略过一切回车符和换行符
            If s(i) = vbCrLf Or s(i) = vbCr Or s(i) = vbLf Then
                Continue For
            End If
            ‘将合法的字符分配到各行
            If Encoding.Default.GetByteCount(s.Substring(0, i + 1)) < 33 Then
                s1.Append(s(i)) ‘第一行
            ElseIf Encoding.Default.GetByteCount(s.Substring(0, i + 1)) < 65 Then
                s2.Append(s(i)) ‘第二行
            ElseIf Encoding.Default.GetByteCount(s.Substring(0, i + 1)) < 97 Then
                s3.Append(s(i)) ‘第三行
            ElseIf Encoding.Default.GetByteCount(s.Substring(0, i + 1)) < 129 Then
                s4.Append(s(i)) ‘第四行
            End If
        Next

        ‘第一行
        g.DrawString(
             s1.ToString,
             New Font("宋体", 10, FontStyle.Regular),
             New SolidBrush(Color.FromArgb(255, 47, 75, 87)),
             New Point(20, 53))
        g.DrawString(
             s2.ToString,
             New Font("宋体", 10, FontStyle.Regular),
             New SolidBrush(Color.FromArgb(255, 47, 75, 87)),
             New Point(20, 73))
        g.DrawString(
             s3.ToString,
             New Font("宋体", 10, FontStyle.Regular),
             New SolidBrush(Color.FromArgb(255, 47, 75, 87)),
             New Point(20, 93))
        g.DrawString(
             s4.ToString,
             New Font("宋体", 10, FontStyle.Regular),
             New SolidBrush(Color.FromArgb(255, 47, 75, 87)),
             New Point(20, 113))

        picPreview.Image = bmp

    End Sub

    ‘修改新闻标题时自动更新图片
    Private Sub txtTitle_TextChanged(sender As Object, e As EventArgs) _
        Handles txtTitle.TextChanged

        Try
            PreviewOnPic()
        Catch ex As Exception
            MessageBox.Show(ex.Message)
        End Try

    End Sub

    ‘修改新闻内容时自动更新图片
    Private Sub txtContent_TextChanged(sender As Object, e As EventArgs) _
        Handles txtContent.TextChanged

        Try
            PreviewOnPic()
        Catch ex As Exception
            MessageBox.Show(ex.Message)
        End Try

    End Sub

#End Region
#Region "按钮事件相关"

    ‘按钮：将图片复制到剪贴板
    Private Sub btnCopy_Click(sender As Object, e As EventArgs) _
        Handles btnCopy.Click

        Clipboard.SetImage(picPreview.Image)

    End Sub

    ‘按钮：保存图片
    Private Sub btnSave_Click(sender As Object, e As EventArgs) _
        Handles btnSave.Click

        Try

            ‘保存图片窗体
            Dim sfd As SaveFileDialog = New SaveFileDialog
            With sfd
                .OverwritePrompt = True
                .Filter = "Windows位图(bmp)|*.bmp|可移植网络图形|*.png"
                .FileName = "新闻_" & DateTime.Now.ToString("yyyyMMdd_HHmmss")
                .Title = "保存图片"
            End With
            ‘保存图片
            If sfd.ShowDialog = Windows.Forms.DialogResult.OK Then
                If sfd.FilterIndex = 1 Then
                    picPreview.Image.Save(sfd.FileName, Imaging.ImageFormat.Bmp)
                ElseIf sfd.FilterIndex = 2 Then
                    picPreview.Image.Save(sfd.FileName, Imaging.ImageFormat.Png)
                End If
            End If

        Catch ex As Exception

            MessageBox.Show(ex.Message)

        End Try

    End Sub

    ‘按钮：退出程序
    Private Sub btnClose_Click(sender As Object, e As EventArgs) _
        Handles btnClose.Click

        Application.Exit()

    End Sub

#End Region

End Class

END

VB.NET-QQ新闻弹窗样式图片制作工具,布布扣,bubuko.com