回 帖 发 新 帖 刷新版面

主题:汉字提取程序

程序是在qb45的基础上加以改进 而成的,
提取后的字库在hzdata.bas中(见1楼)
前景色为红色,背景色为绿色

DECLARE SUB getzk (hz.word$)
OPEN "hzdata.bas" FOR OUTPUT AS #1
OPEN "hzk12" FOR BINARY AS #2
OPEN "asc16" FOR BINARY AS #3

hz1$ = "你好啊!aAbBcCdD"
CALL getzk(hz1$)
CLOSE
RUN "hzdata.bas"
END

SUB getzk (hz.word$)
  hzlen = LEN(hz.word$): toprint = 0
  FOR now = 1 TO hzlen
    qu = ASC(MID$(hz.word$, now, 1))
    IF qu > 161 THEN
      qu = qu - 161: now = now + 1
      wei = ASC(MID$(hz.word$, now, 1)) - 161
      ps& = (qu * 94& + wei) * 24 + 1
      SEEK #2, ps&
      zimo$ = INPUT$(24, #2)
      PRINT #1, "'"; MID$(hz.word$, now - 1, 2)
      PRINT #1, "DATA ";
      FOR y = 1 TO 12
        hzchr$ = MID$(zimo$, 2 * y, 1) + MID$(zimo$, 2 * y - 1, 1)
        PRINT #1, HEX$(CVI(hzchr$)); ",";
      NEXT y
      PRINT #1, 0
      toprint = toprint + 1
    ELSE
      PRINT #1, "'" + CHR$(qu)
      SEEK #3, qu * 16
      zimo$ = INPUT$(16, #3)
      PRINT #1, "DATA ";
      FOR y = 3 TO 14
        zmchr$ = CHR$(0) + MID$(zimo$, y, 1)
        PRINT #1, HEX$(CVI(zmchr$)); ",";
      NEXT y
      PRINT #1, 0
      toprint = toprint + 1
    END IF
  NEXT now
  PRINT #1, "SCREEN 12"
  PRINT #1, "FOR i = 0 TO"; toprint - 1
  PRINT #1, "  FOR j = 0 TO 12"
  PRINT #1, "    READ fon$"
  PRINT #1, "    font = VAL(" + CHR$(34) + "&H" + CHR$(34) + " + fon$)"
  PRINT #1, "    LINE (100 + 14 * i, 100 + j)-STEP(15, 0), 12, , font"
  PRINT #1, "    LINE (100 + 14 * i, 100 + j)-STEP(15, 0), 10, , &HFFFF - font"
  PRINT #1, "  NEXT j"
  PRINT #1, "NEXT i"
  PRINT #1, "END"
END SUB

回复列表 (共11个回复)

11 楼

修改一下适应中英文混合显示

hz1$ = "旅ABC中华人民共和国"
OPEN "asc16" FOR BINARY AS #1
OPEN "hzk16" FOR BINARY AS #2
lzh1% = LEN(hz1$)
FOR i% = 1 TO LEN(hz1$)
  IF ac2% THEN ac1% = ac2% ELSE ac1% = ASC(MID$(hz1$, i%, 1))
  IF i% < lzh1% THEN ac2% = ASC(MID$(hz1$, i% + 1, 1))
  IF ac1% > 160 AND ac2% > 160 THEN
    SEEK #2, ((ac1% - 161&) * 94& + ac2% - 161&) * 32 + 1&
    hzk$ = INPUT$(32, #2)
    FOR j% = 1 TO LEN(hzk$) STEP 2
      zimo$ = zimo$ + MID$(hzk$, j%, 1)
    NEXT
    FOR j% = 2 TO LEN(hzk$) STEP 2
      zimo$ = zimo$ + MID$(hzk$, j%, 1)
    NEXT
    i% = i% + 1
    ac2%=0
  ELSE
    SEEK #1, ac1% * 16& + 1
    zimo$ = zimo$ + INPUT$(16, #1)
  END IF
NEXT
CLOSE #1,#2

SCREEN 12
DEF SEG = &HA000
o = 3 * 80 + 630 \ 8
FOR i = 1 TO LEN(zimo$)
  POKE o, ASC(MID$(zimo$, i, 1))
  o = o + 80
  IF i MOD 16 = 0 THEN
     o = o - 16 * 80 + 1
     IF o MOD 80 = 0 THEN o = o + 15 * 80
  END IF
NEXT
DEF SEG
k$ = INPUT$(1)
SCREEN 0

我来回复

您尚未登录,请登录后再回复。点此登录或注册