中国DOS联盟论坛 - Powered by Discuz! Board

标题: 用QB编译，可以在DOS全屏下显示汉字的小程序 [打印本页]

作者: jmsxdp 时间: 2010-4-6 10:43 标题: 用QB编译，可以在DOS全屏下显示汉字的小程序

下面是一段用QB编写的能在英文下显示汉字的小程序片断，可以运行，运行后会在全屏幕状态下显示汉字，程序利用的是UCDOS的16点阵汉字库，用兴趣可以试一下。这是很多年前用过的，拿出来大家分享。其实QB编的小程序很有用，现在本人还时常编一段，用来应付一些烦人的转换，例如将两个STR电影字幕文件合并到一起，等等等等....，说远了，奉上程序：

'西文下显示汉字模块，需要文件UCDOS汉字库文件hzk16支持

DECLARE SUB xshz16 (zf$)  '点阵坐标用，待显字符串

DIM SHARED xsys

DIM SHARED hzk$

DIM SHARED er$

ON ERROR GOTO erro

er$ = "f"

OPEN "b", #4, "HZK16"  '汉字库文件

IF er$ = "t" THEN

hzk$ = "f"

END IF

SCREEN 12

xsys = 11              '字符颜色，数值为0-15,7:浅白，15：亮白，其他为彩色

'                      '++++++以下添加需要程序++++++

LOCATE 20, 1           '需要显示坐标

zf$ = "显示汉字123ABC"     '显示的字符

CALL xshz16(zf$)

q:                     '程序退出

SYSTEM

erro:                 '错误处理

  errs = ERR

  er$ = "t"

  RESUME NEXT

SUB xshz16 (zf$)        '显示汉字模块

IF xsys = 0 THEN xsys = 15

IF hzk$ = "f" GOTO hzkcl1

l = LEN(zf$)

zftmp$ = ""

FOR i = 1 TO l

m$ = MID$(zf$, i, 1)

IF m$ = "1" THEN m$ = "１"

IF m$ = "2" THEN m$ = "２"

IF m$ = "3" THEN m$ = "３"

IF m$ = "4" THEN m$ = "４"

IF m$ = "5" THEN m$ = "５"

IF m$ = "6" THEN m$ = "６"

IF m$ = "7" THEN m$ = "７"

IF m$ = "8" THEN m$ = "８"

IF m$ = "9" THEN m$ = "９"

IF m$ = "0" THEN m$ = "０"

IF m$ = "q" THEN m$ = "ｑ"

IF m$ = "Q" THEN m$ = "Ｑ"

IF m$ = "w" THEN m$ = "ｗ"

IF m$ = "W" THEN m$ = "Ｗ"

IF m$ = "e" THEN m$ = "ｅ"

IF m$ = "E" THEN m$ = "Ｅ"

IF m$ = "r" THEN m$ = "ｒ"

IF m$ = "R" THEN m$ = "Ｒ"

IF m$ = "t" THEN m$ = "ｔ"

IF m$ = "T" THEN m$ = "Ｔ"

IF m$ = "y" THEN m$ = "ｙ"

IF m$ = "Y" THEN m$ = "Ｙ"

IF m$ = "u" THEN m$ = "ｕ"

IF m$ = "U" THEN m$ = "Ｕ"

IF m$ = "i" THEN m$ = "ｉ"

IF m$ = "I" THEN m$ = "Ｉ"

IF m$ = "o" THEN m$ = "ｏ"

IF m$ = "O" THEN m$ = "Ｏ"

IF m$ = "p" THEN m$ = "ｐ"

IF m$ = "P" THEN m$ = "Ｐ"

IF m$ = "[" THEN m$ = "［"

IF m$ = "{" THEN m$ = "｛"

IF m$ = "]" THEN m$ = "］"

IF m$ = "}" THEN m$ = "｝"

IF m$ = "\" THEN m$ = "＼"

IF m$ = "|" THEN m$ = "｜"

IF m$ = "a" THEN m$ = "ａ"

IF m$ = "A" THEN m$ = "Ａ"

IF m$ = "s" THEN m$ = "ｓ"

IF m$ = "S" THEN m$ = "Ｓ"

IF m$ = "d" THEN m$ = "ｄ"

IF m$ = "D" THEN m$ = "Ｄ"

IF m$ = "f" THEN m$ = "ｆ"

IF m$ = "F" THEN m$ = "Ｆ"

IF m$ = "g" THEN m$ = "ｇ"

IF m$ = "G" THEN m$ = "Ｇ"

IF m$ = "h" THEN m$ = "ｈ"

IF m$ = "H" THEN m$ = "Ｈ"

IF m$ = "j" THEN m$ = "ｊ"

IF m$ = "J" THEN m$ = "Ｊ"

IF m$ = "k" THEN m$ = "ｋ"

IF m$ = "K" THEN m$ = "Ｋ"

IF m$ = "l" THEN m$ = "ｌ"

IF m$ = "L" THEN m$ = "Ｌ"

IF m$ = ";" THEN m$ = "；"

IF m$ = ":" THEN m$ = "："

IF m$ = CHR$(39) THEN m$ = "＇"

IF m$ = CHR$(34) THEN m$ = "＂"

IF m$ = "z" THEN m$ = "ｚ"

IF m$ = "Z" THEN m$ = "Ｚ"

IF m$ = "x" THEN m$ = "ｘ"

IF m$ = "X" THEN m$ = "Ｘ"

IF m$ = "c" THEN m$ = "ｃ"

IF m$ = "C" THEN m$ = "Ｃ"

IF m$ = "v" THEN m$ = "ｖ"

IF m$ = "V" THEN m$ = "Ｖ"

IF m$ = "b" THEN m$ = "ｂ"

IF m$ = "B" THEN m$ = "Ｂ"

IF m$ = "n" THEN m$ = "ｎ"

IF m$ = "N" THEN m$ = "Ｎ"

IF m$ = "m" THEN m$ = "ｍ"

IF m$ = "M" THEN m$ = "Ｍ"

IF m$ = "," THEN m$ = "，"

IF m$ = "<" THEN m$ = "＜"

IF m$ = "." THEN m$ = "．"

IF m$ = ">" THEN m$ = "＞"

IF m$ = "/" THEN m$ = "／"

IF m$ = "?" THEN m$ = "？"

IF m$ = "!" THEN m$ = "！"

IF m$ = "@" THEN m$ = "＠"

IF m$ = "#" THEN m$ = "＃"

IF m$ = "$" THEN m$ = "＄"

IF m$ = "%" THEN m$ = "％"

IF m$ = "^" THEN m$ = "︿"

IF m$ = "&" THEN m$ = "＆"

IF m$ = "*" THEN m$ = "＊"

IF m$ = "(" THEN m$ = "（"

IF m$ = ")" THEN m$ = "）"

IF m$ = "_" THEN m$ = "＿"

IF m$ = "+" THEN m$ = "＋"

IF m$ = "-" THEN m$ = "－"

IF m$ = CHR$(32) THEN m$ = "　"

IF m$ = "~" THEN m$ = "～"

IF m$ = CHR$(96) THEN m$ = "‘"

IF m$ = "=" THEN m$ = "＝"

zf1 = ASC(m$)

IF zf1 < 160 THEN m$ = "　"

zftmp$ = zftmp$ + m$

NEXT i

zf$ = zftmp$

hzbz = CSRLIN

zzbz = POS(hzb)

zzb = hzbz * 16 - 15

hzb = zzbz * 8 - 7

IF xsys = 0 THEN xsys = 7

IF hzb = 0 THEN hzb = 1

IF zzb = 0 THEN zzb = 1

hzbtmp = hzb

zzbtmp = zzb

l = LEN(zf$)

FOR i = 2 TO l STEP 2

zf1$ = MID$(zf$, i - 1, 1)

zf2$ = MID$(zf$, i, 1)

zf1 = ASC(zf1$)

zf2 = ASC(zf2$)

no = ((zf1 - 160 - 1) * 94 + zf2 - 160 - 1) * 32 + 1

SEEK #4, no

cch$ = INPUT$(32, 4)

FOR a = 1 TO 16

ch1$ = MID$(cch$, a * 2 - 1, 1)

ch2$ = MID$(cch$, a * 2, 1)

ch$ = ch2$ + ch1$

s = CVI(ch$)

LINE (hzb, zzb)-(hzb + 15, zzb), xsys, , s

zzb = zzb + 1

IF zzb - zzbtmp = 16 THEN

zzb = zzbtmp

hzb = hzb + 16

END IF

NEXT a

NEXT i

GOTO xshz16subq

hzkcl1:

PRINT zf$

xshz16subq:

END SUB

作者: jmsxdp 时间: 2010-4-6 10:45
汉字库为UCDOS16点阵字库，可以上网查找。

作者: jmsxdp 时间: 2010-4-6 10:51
另一个，这个不是把英文字母统统转化成中文字母，而是按原样显示：

'西文下显示汉字模块，需要文件UCDOS汉字库文件hzk16支持

DECLARE SUB xshz16 (zf$)  '点阵坐标用，待显字符串

DIM SHARED xsys

DIM SHARED hzk$

DIM SHARED er$

ON ERROR GOTO erro

er$ = "f"

OPEN "b", #4, "HZK16"  '汉字库文件hzk16

IF er$ = "t" THEN

hzk$ = "f"

END IF

SCREEN 12

xsys = 14              '字符颜色0-15,7:浅白，15：亮白，其他为彩色

'                      '++++++以下添加需要程序++++++

LOCATE 20, 10           '需要显示坐标,为第20行10列

zf$ = "显示1234;"     '显示的字符

CALL xshz16(zf$)      '调用程序显示

'                     '--------------添加部分结束-------------

q:                     '程序退出

SYSTEM

erro:                 '错误处理

  errs = ERR

  er$ = "t"

  RESUME NEXT

SUB xshz16 (zf$)        '显示汉字模块

IF xsys = 0 THEN xsys = 14

IF hzk$ = "f" GOTO hzkcl1

l = LEN(zf$)

hzbz = CSRLIN

zzbz = POS(hzb)

zzb = hzbz * 16 - 15

hzb = zzbz * 8 - 7

IF hzb = 0 THEN hzb = 1

IF zzb = 0 THEN zzb = 1

hzbtmp = hzb

zzbtmp = zzb

l = LEN(zf$)

txtmp = 2

xsmk1:

FOR i = txtmp - 1 TO l

zf1$ = MID$(zf$, i, 1)

zf2$ = MID$(zf$, i + 1, 1)

zf1 = ASC(zf1$)

zf2 = ASC(zf2$)

IF zf1 < 159 GOTO xsasc

no = ((zf1 - 160 - 1) * 94 + zf2 - 160 - 1) * 32 + 1

SEEK #4, no

cch$ = INPUT$(32, 4)

FOR a = 1 TO 16

ch1$ = MID$(cch$, a * 2 - 1, 1)

ch2$ = MID$(cch$, a * 2, 1)

ch$ = ch2$ + ch1$

s = CVI(ch$)

LINE (hzb, zzb)-(hzb + 15, zzb), xsys, , s

zzb = zzb + 1

IF zzb - zzbtmp = 16 THEN

zzb = zzbtmp

hzb = hzb + 16

END IF

NEXT a

i = i + 1

NEXT i

GOTO xshz16subq

xsasc:

LOCATE zzb / 16 + 1, hzb / 8 + 1

PRINT zf1$

txtmp = i + 2

i = txtmp

hzb = hzb + 8

GOTO xsmk1

hzkcl1:

PRINT zf$

xshz16subq:

END SUB

作者: 070 时间: 2010-4-8 15:15
QB确实还挺有用的，就像写小工具，也是还可以用到20年前的Turbo c

作者: lqg2118 时间: 2010-7-2 11:45
真的很不错，用来做启动界面很好的。

作者: cnch 时间: 2010-9-5 14:52
还在用QB啊,也算是老法师啦.

作者: aq2007 时间: 2010-10-29 00:23
~~不错啊,好东西....正在准备在用...谢谢..

作者: lswd 时间: 2020-2-7 14:06
谢谢分享