【VB开源代码栏目提醒】：网学会员,鉴于大家对VB开源代码十分关注，论文会员在此为大家搜集整理了“字模提取模拟工具VB源代码 - 编程语言”一文，供大家参考学习!

如果需要软件请联系daohao126.com VERSION 5.00 Begin VB.Form Form1 BorderStyle 1 Fixed Single Caption 字模模拟软件HZK16.GBK ClientHeight 5580 ClientLeft 45 ClientTop 375 ClientWidth 8325 FillColor H8000000B FillStyle 0 Solid ForeColor H80000015 KeyPreview -1 True LinkTopic Form1 MaxButton 0 False MinButton 0 False ScaleHeight 5580 ScaleWidth 8325 StartUpPosition 2 屏幕中心 Begin VB.TextBox outputtext Height 3735 Left 480 MultiLine -1 True TabIndex 3 Top 1560 Width 2295 End Begin VB.TextBox inputtext Height 375 Left 480 MaxLength 1 TabIndex 0 Top 600 Width 735 End Begin VB.CommandButton Command1 Caption 确定 Height 615 Left 1440 MaskColor H00000000 TabIndex 2 Top 480 Width 1215 End Begin VB.Shape Shape1 BackColor H000000FF BorderColor H00000000 FillColor H00C0C0C0 FillStyle 0 Solid Height 300 Index 0 Left 3200 Shape 3 Circle Top 600 Width 300 End Begin VB.Label Label3 Caption 汉字的字模显示 Height 255 Left 3240 TabIndex 5 Top 240 Width 1455 End Begin VB.Line Line4 X1 8000 X2 8000 Y1 600 Y2 5400 End Begin VB.Line Line3 X1 3200 X2 8000 Y1 600 Y2 600 End Begin VB.Line Line2 X1 3200 X2 3200 Y1 5400 Y2 600 End Begin VB.Line Line1 X1 8000 X2 3200 Y1 5400 Y2 5400 End Begin VB.Label Label2 Caption 汉字编码 Height 255 Left 480 TabIndex 4 Top 1200 Width 975 End Begin VB.Label Label1 Caption 输入汉字 Height 255 Left 480 TabIndex 1 Top 240 Width 1095 End End Attribute VB_Name Form1 Attribute VB_GlobalNameSpace False Attribute VB_Creatable False Attribute VB_PredeclaredId True Attribute VB_Exposed False Private Sub Command1_Click On Error Resume Next Call cleardraw Dim inputstr outputstr As String Dim codebyte1 To 32 As Byte Dim rel As Long inputstr inputtext.Text outputst 该汉字的字模: Dim l As Integer For l 1 To 32 codebytel 0 Next Open App.Path /HZK16.GBK For Binary As 1 rel getrelinputstr Dim i As Long For i 1 To 32 Get 1 rel i codebytei Next Call cleardraw Call drawzimucodebyte Dim k As Integer For k 1 To 32 outputstr outputstr Hexcodebytek H If k Mod 4 0 Then outputstr outputstr vbCrLf End If Next outputtext.Text outputstr Close 1 Exit Sub End Sub Private Sub Form_Load Dim vbred As Integer vbred HFF colorbegin HFFFFFF drawdotmatrix 画点阵1616 If LenDirApp.Path /HZK16.GBK 0 Then MsgBox ZHK16.GBK 字库文件不在安装目录下 vbOKOnly Command1.Enabled False inputtext.Enabled False End If End Sub Function drawdotmatrix Dim x As Integer Dim y As Integer For x 0 To 15 For y 0 To 15 If x 16 y Then Load Shape1x 16 y Shape1x 16 y.Left 3200 300 y Shape1x 16 y.Top 600 300 x Shape1x 16 y.Visible True End If Next Next End Function Private Sub drawzimucode As Byte Dim i j As Integer Dim k As Integer k 0 For i 0 To 31 For j 0 To 7 If codei 1 And 128 / 2 j Then Shape1i 8 j.FillColor vbred End If k i 8 j Next Next End Sub Function getrelByVal inhz As String As Long 此函数为汉字在hzk16中的偏移量的计算 Dim inhz_1 As String inhz_1 HexAscMidinhz 1 1 Dim rel As Long Dim relx As Long Dim rely As Long relx CLngH Midinhz_1 1 2 rely CLngH Midinhz_1 3 2 rel relx - HA1 94 rely - HA1 32 getrel rel End Function Private Sub cleardraw Dim k As Integer For k Shape1.LBound To Shape1.UBound Shape1k.FillColor HC0C0C0 Next End Sub