form1.frm

懒人手写体模拟生成器 （免费软件） 此软件是为应付某些不能用电脑打印的文体（如思想汇报

Cht = Left(txt_Input.Text, 1)
If Len(txt_Input.Text) > 1 Then txt_Input.Text = Mid(txt_Input.Text, 2) Else txt_Input.Text = ""

If Cht <> "" And Asc(Cht) > 0 And Asc(Cht) <> 10 Then pcX = pcX + 0.48 * xR: plR = plR - 0.48 * xR
If Cht = Chr(13) Then plR = 0
If Cht <> "" And Asc(Cht) < 0 Then
oRder = 1: textCalculation
tmp = Int(96 * (xR + Rnd * (G2 - G1)) / 100)
pcX = pcX + tmp
plR = plR - tmp
End If

Loop

pg = pg + 1
time2 = Timer

SavePicture outPUTpic.Image, "C:\Output" + Trim(Str(pg)) + ".bmp"

If Check_Preview.Value = Checked Then ShellExecute Me.hwnd, "open", "C:\Output" + Trim(Str(pg)) + ".bmp", "", "", SW_SHOW

If txt_Input.Text <> "" Then GoTo StartPage

time3 = Timer

Beep
MsgBox "共" + Str(pg) + "页，用时：" + Str(CInt(time3 - time1)) + "秒", , "完成"

yn = MsgBox("注意！" + vbCrLf + "1.请先保存并关闭当前打开的所有 Word文档，否则会导致文件生成失败" + vbCrLf + _
"2.按下按钮后到出现完成信息之前，请不要按任何按键" + vbCrLf + "3.生成文件后请自行保存" + vbCrLf + vbCrLf + _
"是否生成 Word 文档（强烈推荐）", vbYesNo, "保存")

If yn = 6 Then
'建立一个word.application对象
Set wrdobj = CreateObject("Word.Application")
'显示word.application，即word文字处理系统界面
wrdobj.Visible = True
'在word文字处理系统中添加一个文档
Set vardoc = wrdobj.Documents.Add()
 
ActiveDocument.PageSetup.PageHeight = MillimetersToPoints(pH)
ActiveDocument.PageSetup.PageWidth = MillimetersToPoints(pW)
ActiveDocument.PageSetup.RightMargin = MillimetersToPoints(0)
ActiveDocument.PageSetup.LeftMargin = MillimetersToPoints(0)
ActiveDocument.PageSetup.TopMargin = MillimetersToPoints(0)
ActiveDocument.PageSetup.BottomMargin = MillimetersToPoints(0)
    
'在当前光标位置插入图片
For i = pg To 1 Step -1
Set varshape = vardoc.Shapes.AddPicture("C:\Output" + Trim(Str(i)) + ".bmp", False, True, , , , , wrdobj.Selection.Range)
If i <> 1 Then wrdobj.Selection.TypeText Text:=Chr(12): wrdobj.Selection.MoveUp unit:=wdParagraph, Count:=1
Next

yn2 = MsgBox("是否删除临时图象文件（C:\output1.bmp...）", vbYesNo, "完成")
If yn2 = 6 Then
For i = 1 To pg
Kill "C:\Output" + Trim(Str(i)) + ".bmp"
Next
End If

Else
MsgBox "本次生成临时文件" + Str(pg) + "个，最后一个是" + "C:\Output" + Trim(Str(pg)) + ".bmp", vbOKOnly, "完成"
End If

End
End Sub

Private Sub Command_Test_Click()
Cht = txt_Test.Text
oRder = 2
textCalculation
End Sub

Private Sub Form_Load()
Form_IO.Caption = "懒人手写体模拟生成器 V1.3  （当前字体：" + rawPic.Font + "）"

With Form_Setup
pW = Val(.Txt_W.Text)
pH = Val(.Txt_H.Text)
pL = Val(.Txt_L.Text)
pT = Val(.Txt_T.Text)
pB = Val(.Txt_B.Text)
plC = Val(.Txt_LC.Text)
pFix = .VScroll_Fix.Value

plH = pH - pT - pB
paH = plH / (plC - 1)
paW = pW - pL * 2
End With

xR = HScroll_xr.Value
lT = VScroll_lt.Value
lB = VScroll_lb.Value
rT = VScroll_rt.Value
rB = VScroll_rb.Value
G1 = HScroll_g1.Value
G2 = HScroll_g2.Value
hR = HScroll_hr.Value
yS = HScroll_ys.Value
scr = HScroll_scr.Value

Command_CpL_Click
Drawline
outPUTpic.AutoRedraw = True
rawPic.AutoRedraw = True

LoadStyle
Combo_Style.Text = "默认设置"
End Sub

Private Sub Form_Unload(Cancel As Integer)
End
End Sub

Private Sub HScroll_g1_Change()
Label_g1.Caption = HScroll_g1.Value
G1 = HScroll_g1.Value
End Sub

Private Sub HScroll_g1_Scroll()
HScroll_g1_Change
End Sub

Private Sub HScroll_g2_Change()
Label_g2.Caption = HScroll_g2.Value
G2 = HScroll_g2.Value
End Sub

Private Sub HScroll_g2_Scroll()
HScroll_g2_Change
End Sub

Private Sub HScroll_hr_Change()
Label_hR.Caption = HScroll_hr.Value: hR = HScroll_hr.Value
End Sub
Private Sub HScroll_hr_Scroll()
HScroll_hr_Change
End Sub

Private Sub HScroll_ys_Change()
Label_ys.Caption = HScroll_ys.Value: yS = HScroll_ys.Value
End Sub
Private Sub HScroll_ys_Scroll()
HScroll_ys_Change
End Sub

Private Sub HScroll_scr_Change()
Label_scr.Caption = HScroll_scr.Value: scr = HScroll_scr.Value
End Sub
Private Sub HScroll_scr_Scroll()
HScroll_scr_Change
End Sub


Private Sub HScroll_xr_Change()
Label_xr.Caption = HScroll_xr.Value: xR = HScroll_xr.Value
Drawline
End Sub

Private Sub HScroll_xr_Scroll()
HScroll_xr_Change
End Sub

Private Sub textCalculation()
Dim tmpTxt(100, 100), fuPoc(100, 100)

Cls
rawPic.Cls
rawPic.Print Cht

Records:
For j = 1 To 96
For i = 1 To 96
If rawPic.Point(i, j) = 0 Then tmpTxt(i, j) = 1
Next: Next


Eatting:
'手写化处理
For i = 1 To 96
For j = 1 To 96
fuPoc(i, j) = tmpTxt(i, j)
Next: Next

u = 3
For i = 1 To 96
For j = 1 To 96
tmpTxt(i, j) = tmpTxt(i, j) And fuPoc(i + u, j + u)
tmpTxt(i, j) = tmpTxt(i, j) And fuPoc(i - 1, j + u)
tmpTxt(i, j) = tmpTxt(i, j) And fuPoc(i + u, j - 1)
tmpTxt(i, j) = tmpTxt(i, j) And fuPoc(i - 1, j - 1)
Next: Next

For i = 1 To 96
For j = 1 To 96
fuPoc(i, j) = 0
Next: Next

'For t = 1 To 1
'For i = 1 To 96
'For j = 1 To 96
'If tmpTxt(i, j) = 0 Then
's = 0
'For m = -1 To 1
'For n = -1 To 1
'If tmpTxt(i + m, j + n) = 1 Then s = s + 1
'Next: Next
'If s > 1 Then fuPoc(i, j) = 1
'End If
'Next: Next
'For i = 1 To 96
'For j = 1 To 96
'tmpTxt(i, j) = tmpTxt(i, j) Or fuPoc(i, j)
'fuPoc(i, j) = 0
'Next: Next
'Next t

Futher_Process:
'变形处理
If oRder = 1 Then
tlt = lT: trt = rT: tlb = lB: trb = rB
lT = Int(lT - Rnd * scr)
rT = Int(rT - Rnd * scr)
lB = Int(lB + Rnd * scr)
rB = Int(rB + Rnd * scr)
End If

For i = 1 To 96
u = Sin(3.14 * i / 96) * 5
v = 1 - Sin(3.14 * i / 96) * 0.05
For j = 1 To 96

If tmpTxt(i, j) = 1 Then
ct = lT + (rT - lT) * i / 96
cb = lB + (rB - lB) * i / 96
cs = 96 * (1 - ct / 100)
cr = (ct - cb) / 100
fuPoc(i, (cs + j * cr) * v + u) = 1
End If
Next
Next
For i = 1 To 96
For j = 1 To 96
tmpTxt(i, j) = fuPoc(i, j)
fuPoc(i, j) = 0
Next
Next

For j = 1 To 96
u = Sin(3.14 * j / 96) * 5
v = 1 - Sin(3.14 * j / 96) * 0.05
For i = 1 To 96
If tmpTxt(i, j) = 1 Then fuPoc((i * xR / 100) + v + u, j) = 1
Next: Next
For i = 1 To 96
For j = 1 To 96
tmpTxt(i, j) = fuPoc(i, j)
fuPoc(i, j) = 0
Next
Next

'绘图
If oRder = 1 Then
tmp = (pcX / (plR + pcX)) * pFix * PAr
pcY = pcY - tmp

lT = tlt: rT = trt: lB = tlb: rB = trb
For i = 1 To 96
For j = 1 To 96
If tmpTxt(i, j) = 1 Then outPUTpic.PSet (i + pcX, j + pcY + lB - 96 - yS * 0.96), Label_C.BackColor
Next: Next

pcY = pcY + tmp
End If

If oRder And 2 = 2 Then
Picture_Test.Cls
For i = 1 To 96
For j = 1 To 96
If tmpTxt(i, j) = 1 Then Picture_Test.PSet (i, j), Label_C.BackColor
Next: Next
End If

End Sub

Private Sub txt_Test_Click()
txt_Test.SelStart = 0
txt_Test.SelLength = 1
End Sub

Private Sub VScroll_C_Change(Index As Integer)
Label_C.BackColor = &H10000 * VScroll_C(1).Value + &H1 * VScroll_C(0).Value + &H100 * VScroll_C(2).Value
End Sub

Private Sub VScroll_lt_Change()
Label_lt.Caption = VScroll_lt.Value: lT = VScroll_lt.Value
Drawline
End Sub
Private Sub VScroll_lt_Scroll()
VScroll_lt_Change
End Sub

Private Sub VScroll_rt_Change()
Label_rt.Caption = VScroll_rt.Value: rT = VScroll_rt.Value
Drawline
End Sub
Private Sub VScroll_rt_Scroll()
VScroll_rt_Change
End Sub

Private Sub VScroll_lb_Change()
Label_lb.Caption = VScroll_lb.Value: lB = VScroll_lb.Value
Drawline
End Sub
Private Sub VScroll_lb_Scroll()
VScroll_lb_Change
End Sub

Private Sub VScroll_rb_Change()
Label_rb.Caption = VScroll_rb.Value: rB = VScroll_rb.Value
Drawline
End Sub
Private Sub VScroll_rb_Scroll()
VScroll_rb_Change
End Sub

Private Sub Drawline()
Picture_Test.Cls
ltp = 96 * (1 - lT / 100): rtp = 96 * (1 - rT / 100)
lbp = 96 * (1 - lB / 100): rbp = 96 * (1 - rB / 100)
Picture_Test.Line (1, ltp)-(96 * xR / 100, rtp)
Picture_Test.Line (1, lbp)-(96 * xR / 100, rbp)
Picture_Test.Line (1, ltp)-(1, lbp)
Picture_Test.Line (96 * xR / 100, rtp)-(96 * xR / 100, rbp)
End Sub

Private Sub LoadStyle()
Combo_Style.Clear
File_Style.Refresh
File_Style.Pattern = "*.cfg"
If File_Style.ListCount > 0 Then
For i = 1 To File_Style.ListCount
Combo_Style.AddItem Left(File_Style.List(i - 1), Len(File_Style.List(i - 1)) - 4)
Next
End If
End Sub