标签：style http color os strong io for 2014
〇、下载地址
本程序的下载地址（百度网盘）：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
标签：style http color os strong io for 2014
原文地址：http://my.oschina.net/Tsybius2014/blog/297631
