| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 1365 人关注过本帖, 1 人收藏
标题:字库查询
只看楼主 加入收藏
roy1557
Rank: 1
等 级:新手上路
帖 子:2
专家分:0
注 册:2011-1-6
结帖率:0
收藏(1)
已结贴  问题点数:20 回复次数:5 
字库查询
做字库查询,HZK16字库,生成点阵,但不知道怎么去查询字库,有说VB不好搞,要用C做个》DLL查询,但是不会做封装。求助各位。。。
可以Q我15576080。

[ 本帖最后由 roy1557 于 2011-1-6 13:13 编辑 ]
搜索更多相关主题的帖子: 查询 
2011-01-06 13:12
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4947
专家分:30084
注 册:2008-10-15
收藏
得分:7 
以前用QB做过读字库的,现不记得扔到那里去了。
HZK16 的字库,每个字是多少字节,然后 每个汉字,转为 单字节的 二个字符,根据这二个字符计算出 在字库里的起始位置来。

字库里读出来的是 按二进制保存的。 1显示黑点,0 显示白点(或不显示)。

授人于鱼,不如授人于渔
早已停用QQ了
2011-01-06 13:27
Artless
Rank: 19Rank: 19Rank: 19Rank: 19Rank: 19Rank: 19
等 级:贵宾
威 望:103
帖 子:4211
专家分:28888
注 册:2009-4-8
收藏
得分:7 
以下是引用roy1557在2011-1-6 13:12:03的发言:

做字库查询,HZK16字库,生成点阵,但不知道怎么去查询字库,有说VB不好搞,要用C做个》DLL查询,但是不会做封装。求助各位。。。
可以Q我15576080。

系统字库不能用吗?

无知
2011-01-06 18:06
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4947
专家分:30084
注 册:2008-10-15
收藏
得分:0 
回复 楼主 roy1557
程序代码:
Option Explicit


Public Sub 显示字模(cs() As Byte, obj As PictureBox, X As Long, Y As Long)          '复杂转换,但比较容易理解

Const 格 = 15               '每个格子大小,用于计算坐标的,一般 15缇=1像素

Dim i As Long, j As Long
Dim m As String

For i = 0 To 15                 '一共有 16行
   
    m = Hex(cs(i * 2))                  '取一个字节,这行的前半段,并转16进制
    If Len(m) = 1 Then m = "0" & m      '如果长度为1,则补个 0
    m = 二进制(m)                       '转 2进制字符串
   
    For j = 0 To 7                      '显示这8个点,空白点不显示
        If Mid(m, j + 1, 1) = 1 Then
            obj.PSet (X + j * 格, Y + i * 格), 0
        End If
    Next j
   
    m = Hex(cs(i * 2 + 1))              '取一个字节,为本行的后半段,操作同上
    If Len(m) = 1 Then m = "0" & m
    m = 二进制(m)
   
    For j = 8 To 15
        If Mid(m, j - 7, 1) = 1 Then
            obj.PSet (X + j * 格, Y + i * 格), 0
        End If
    Next j
Next i

End Sub


Public Sub 显示字模2(cs() As Byte, obj As PictureBox, X As Long, Y As Long)         '无转换,直接判断位,不容易理解,运算量少

Const 格 = 15               '每个格子大小,用于计算坐标的,一般 15缇=1像素

Dim i As Long, j As Long
Dim m As String

'如果是大型程序,掩码计算需要放在程序初始化为完成,不要放到每次调用时来计算.
Dim YM(0 To 7) As Byte          '各位掩码
YM(7) = 1                       '最左边,也就是 第 7个掩码为 1
For i = 6 To 0 Step -1
    YM(i) = YM(i + 1) * 2       '计算其它各个掩码
Next i

For i = 0 To 15                 '一共有 16行
  
    For j = 0 To 7                      '显示前 8 个点
        If (cs(i * 2) And YM(j)) = YM(j) Then      '与掩码进行 字节 AND 操作,结果为 掩码或者 0
            obj.PSet (X + j * 格, Y + i * 格), 0
        End If
    Next j
   
    For j = 8 To 15                     '显示后 8 个点
        If (cs(i * 2 + 1) And YM(j - 8)) = YM(j - 8) Then        '与掩码进行 字节 AND 操作,结果为 掩码或者 0
            obj.PSet (X + j * 格, Y + i * 格), 0
        End If
    Next j
Next i

End Sub

Public Sub 读字模(cs As String, dat() As Byte)

Dim fr As Long
fr = FreeFile                           '取文件号

Dim dd() As Byte                        '定义变量,dd只使用前二位,实际上就是一个汉字.
dd = StrConv(cs, vbFromUnicode)         '转为ASC字串

Dim qh As Long, wh As Long              '二个变量,计算区和位的
Dim i As Long

qh = dd(0) - 160                        '区   160=&ha0
wh = dd(1) - 160                        '

Open "HZK16" For Binary Access Read As #fr          '打开文件
    Seek #fr, (94 * (qh - 1) + (wh - 1)) * 32 + 1   '跳到位置,+1,因为VB文件起始位置是1
   
    For i = 0 To 31                     '按字节,一个字节一个字节的读,共读32个字节
        Get #fr, , dat(i)
    Next i
   
Close #fr

End Sub


'  qh=c1-32-128=c1-160 wh=c2-32-128=c2-160
'
'  qh=c1-0xa0 wh=c2-0xa0
'  qh,wh为汉字的区号和位号,c1,c2为汉字的第一字节和第二字节。
'根据区号和位号可以得到汉字字模在文件中的位置:
'  location=(94*(qh-1)+(wh-1))*32。


Public Function 二进制(cs As String) As String

Dim i As Long, j As String

cs = UCase(cs)                  '转大写
If Len(cs) = 1 Then             '长度为1
    Select Case cs              '直接分支选择得到
        Case "0"
            j = "0000"
        Case "1"
            j = "0001"
        Case "2"
            j = "0010"
        Case "3"
            j = "0011"
        Case "4"
            j = "0100"
        Case "5"
            j = "0101"
        Case "6"
            j = "0110"
        Case "7"
            j = "0111"
        Case "8"
            j = "1000"
        Case "9"
            j = "1001"
        Case "A"
            j = "1010"
        Case "B"
            j = "1011"
        Case "C"
            j = "1100"
        Case "D"
            j = "1101"
        Case "E"
            j = "1110"
        Case "F"
            j = "1111"
    End Select

Else
    For i = 1 To Len(cs)                '长度不为1 ,使用循环调用自己来得到最后的数据.
        j = j & 二进制(Mid(cs, i, 1))   '调用自己
    Next i
End If
    二进制 = j      '返回值

End Function


测试代码:
程序代码:
Option Explicit

Private Sub Command1_Click()
Dim dat(31) As Byte
Call 读字模("", dat())
Call 显示字模2(dat(), Picture1, 100, 100)
End Sub

注意,我的程序是只显示第一个汉字,也就是说,如果你有二个汉字的话,也只会显示第一个汉字.
如果你能理解的话,建议使用 显示字模2 进行显示汉字

程序没有判定 hzk16 这个文件是否存在

授人于鱼,不如授人于渔
早已停用QQ了
2011-01-06 20:30
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4947
专家分:30084
注 册:2008-10-15
收藏
得分:0 
经速度测试,在我用的电脑上, 显示字模2 的速度是 显示字模 速度的 2倍.
同样显示10000次, 显示字模 耗时 6 秒, 显示字模2 耗时3秒.
测试代码如下:

程序代码:
Private Sub Command2_Click()

Dim dat(31) As Byte

Call 读字模("", dat())

Dim t1 As Date
Dim t2 As Date
Dim t3 As Date
Dim i As Long


t1 = Time
For i = 1 To 10000
    Call 显示字模(dat(), Picture1, 100, 100)
Next i
t2 = Time
For i = 1 To 10000
    Call 显示字模2(dat(), Picture1, 100, 100)
Next i
t3 = Time

Debug.Print (t2 - t1) * 60 * 60 * 24 ;""
Debug.Print (t3 - t2) * 60 * 60 * 24 ;""

MsgBox (t2 - t1) * 60 * 60 * 24 & vbCrLf & (t3 - t2) * 60 * 60 * 24

End Sub

授人于鱼,不如授人于渔
早已停用QQ了
2011-01-06 21:08
gupiao175
Rank: 16Rank: 16Rank: 16Rank: 16
等 级:版主
威 望:40
帖 子:1787
专家分:7527
注 册:2007-6-27
收藏
得分:7 
windows下做字库的意义何在,我还以为你想做个在DOS下用的字库,方便DOS下显示自己独特的东西!

Q:1428196631,百度:开发地 即可找到我,有事请留言!
2011-01-06 22:40
快速回复:字库查询
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.020968 second(s), 7 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved