吾爱破解 - LCG - LSG |安卓破解|病毒分析|www.52pojie.cn

 找回密码
 注册[Register]

QQ登录

只需一步,快速开始

查看: 4021|回复: 43
收起左侧

[其他原创] vb.net极简版 手写体生成软件

  [复制链接]
wyw6813 发表于 2023-3-20 15:11
本帖最后由 wyw6813 于 2023-3-22 09:13 编辑

今天看到别人做的一个手写体生成软件,感觉挺有意思,模仿着用vb.net写了一个极简版的,可执行程序只有18KB,去除了一些觉得无用的选项,只保留了基本功能。
1、可以选择背景纸张,内置了3种纸张(白纸,灰纸,格子纸);(可以自己增加背景纸张图片,分辨率最好是4000*5658,放到纸张目录,重启软件即可)
2、可以选择手写字体,内置了6种手写字体;(可以自己随意增加任何字体,字体文件放到字体目录,重启软件即可)
3、可以设置字体的大小,字体大小最好不要低于120,否则生成的图片中字体就太小了。

[代码见沙发]



链接:https://pan.baidu.com/s/1ntQkG-IsQl1orgAfUoEQHA
提取码:qvku

增加蓝奏云链接:
https://wwt.lanzouw.com/iA9xR0qql0ih
1679295866997.png

免费评分

参与人数 5吾爱币 +3 热心值 +4 收起 理由
Circulation2020 + 1 谢谢@Thanks!
wy19878 + 1 + 1 很有用,谢谢分享
ZeHao666 + 1 + 1 我很赞同!
synety + 1 我很赞同!
yanglinman + 1 谢谢@Thanks!

查看全部评分

发帖前要善用论坛搜索功能,那里可能会有你要找的答案或者已经有人发布过相同内容了,请勿重复发帖。

 楼主| wyw6813 发表于 2023-3-20 16:46
[Visual Basic .NET] 纯文本查看 复制代码
Imports System.Drawing.Imaging
Imports System.Drawing.Text
Imports System.IO

Public Class Form1
    Dim pfonts As PrivateFontCollection
    Dim fontpath As String
    Dim f As Font
    Dim MyImage As Image
    Dim page As String
    Dim fonts As String
    Dim fontsSize As Integer
    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        If pfonts.Families(0).IsStyleAvailable(FontStyle.Regular) Then
            Dim rect As Rectangle
            Dim g As Graphics
            MyImage = Image.FromFile(Application.StartupPath & "\纸张\" & page)
            g = Graphics.FromImage(MyImage)
            Dim MyText = RichTextBox1.Text
            fontsSize = TextBox1.Text
            If fontsSize < 120 Then
                fontsSize = 120
            End If
            Dim MyFont = New Font(pfonts.Families(0), fontsSize, FontStyle.Regular)

            Dim format As StringFormat = New StringFormat(StringFormatFlags.NoClip)
            Dim sizef As SizeF = g.MeasureString(MyText, MyFont, PointF.Empty, format)

            Dim width As Integer = CType((sizef.Width + 1), Integer)
            Dim height As Integer = CType((sizef.Height + 1), Integer)
            rect = New Rectangle(400, 300, width, height)


            g.CompositingQuality = System.Drawing.Drawing2D.CompositingQuality.GammaCorrected
            g.DrawString(MyText, MyFont, Brushes.Black, rect, format)
            Me.PictureBox1.Image = MyImage
            MyImage.Save(Application.StartupPath & "\" & ComboBox1.Text & "_" & ComboBox2.Text & "_" & TextBox1.Text & "_" & Strings.Format(Now, "yyyyMMddHHmmss") & ".jpg", ImageFormat.Jpeg)
            MessageBox.Show("图片已保存到 " & Application.StartupPath & "\" & ComboBox1.Text & "_" & ComboBox2.Text & "_" & TextBox1.Text & "_" & Strings.Format(Now, "yyyyMMddHHmmss") & ".jpg", "手写体")
        End If
    End Sub



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

        For Each file As String In System.IO.Directory.GetFiles(Application.StartupPath & "\纸张\", "*.jpg")
            ComboBox1.Items.Add(System.IO.Path.GetFileName(file))
        Next
        ComboBox1.Text = ComboBox1.Items(0)
        For Each file As String In System.IO.Directory.GetFiles(Application.StartupPath & "\字体\")
            ComboBox2.Items.Add(System.IO.Path.GetFileName(file))
        Next
        ComboBox2.Text = ComboBox2.Items(0)

        fontpath = Application.StartupPath & "\字体\" & ComboBox2.Text
        pfonts = New PrivateFontCollection()
        pfonts.AddFontFile(fontpath)
        f = New Font(pfonts.Families(0), 25, FontStyle.Regular)
        RichTextBox1.Font = f
        page = ComboBox1.Text

        AddHandler ComboBox1.SelectedIndexChanged, AddressOf OnComboBox1Changed
        AddHandler ComboBox2.SelectedIndexChanged, AddressOf OnComboBox2Changed
    End Sub
    Private Sub OnComboBox1Changed(sender As Object, e As EventArgs)
        Dim cbBox As ComboBox = sender

        If IsDBNull(cbBox) Then
            Return
        Else
            page = cbBox.SelectedItem.ToString()
        End If
    End Sub
    Private Sub OnComboBox2Changed(sender As Object, e As EventArgs)
        Dim cbBox As ComboBox = sender

        If IsDBNull(cbBox) Then
            Return
        Else
            fonts = cbBox.SelectedItem.ToString()
            fontpath = Application.StartupPath & "\字体\" & fonts
            pfonts = New PrivateFontCollection()
            pfonts.AddFontFile(fontpath)
            f = New Font(pfonts.Families(0), 25, FontStyle.Regular)
            RichTextBox1.Font = f
        End If
    End Sub
End Class
mayujieaoshi 发表于 2023-3-20 17:33
WJia 发表于 2023-3-20 19:00
满不懂 发表于 2023-3-20 19:59
感谢分享源码!收藏学习。
泡菜久坛 发表于 2023-3-20 20:16
手写字体很不错,以后用得着
marco527 发表于 2023-3-20 20:39
感谢分享,有时间一定好好研究研究。
头像被屏蔽
juy 发表于 2023-3-20 22:49
提示: 作者被禁止或删除 内容自动屏蔽
hzxszxd 发表于 2023-3-21 07:05
谢谢分享
chenhschic 发表于 2023-3-21 09:05
学习了········
您需要登录后才可以回帖 登录 | 注册[Register]

本版积分规则 警告:本版块禁止灌水或回复与主题无关内容,违者重罚!

快速回复 收藏帖子 返回列表 搜索

RSS订阅|小黑屋|处罚记录|联系我们|吾爱破解 - LCG - LSG ( 京ICP备16042023号 | 京公网安备 11010502030087号 )

GMT+8, 2024-4-28 22:11

Powered by Discuz!

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表