REM    汉字与ASCII显示程序
REM　　需要字库，字库请下载附件
REM    附件有两个字库文件和本文源码及exe文件
REM    把字库放在与bas或exe相同的目录下就可以
DECLARE SUB CloseFontFile ()
DECLARE SUB DrawText (x!, y!, l, c, on$, cb, Text$)
DECLARE SUB DrawAscii (x!, y!, l, c, on$, cb, Text$)
DECLARE SUB OpenFontFile (c$)
DECLARE SUB DrawChs (x!, y!, l, c, on$, cb, Text$)
ON ERROR GOTO catcherr: 'set error catch
DIM SHARED error$
c$ = COMMAND$
OpenFontFile c$

SCREEN 12  '设制为640*480的图形显示模式
'调用16点阵汉字程序模块,用来显示相应坐标和相应颜色的汉字.
CALL DrawChs(240, 16, 0, 16, "on", 8, "汉字显示实例")
CALL DrawChs(16, 16 + 20, 0, 1, "", 0, "我是蓝色汉字。")
CALL DrawChs(16, 16 + 40, 0, 4, "", 0, "我是红色汉字。")
CALL DrawChs(16, 16 + 60, 0, 1, "ON", 8, "我是前景蓝色背景灰色的汉字。")
CALL DrawChs(16, 16 + 80, 0, 4, "ON", 7, "我是前景红色背景白色的汉字。")
CALL DrawChs(16, 16 + 100, 8, 9, "", 0, "我是间距为８点的亮蓝色汉字。")
CALL DrawChs(16, 16 + 120, 12, 12, "", 0, "我是间距为１２点的朱红色汉字。")
CALL DrawChs(16, 16 + 140, 0, 9, "", 0, "汉字阴影特效。")
CALL DrawChs(16 + 1, 16 + 140 + 2, 0, 8, "", 0, "汉字阴影特效。")

 
CALL DrawAscii(14, 200 - 4, 0, 7, "", 0, "hello world!")
CALL DrawAscii(16, 200, 0, 16, "", 0, "hello world!")
CALL DrawAscii(16, 220, 0, 16, "ON", 7, "hello world!")

CALL DrawText(16, 380, 0, 16, "ON", 7, "汉字与字母子SUB DrawText (x!, y, l, c, on$, cb, Text$)混合显示。")

CALL DrawChs(16, 480 - 20, 0, 16, "", 0, "按任意键结束实例程序。")

CloseFontFile
SLEEP
END

catcherr:
BEEP
IF ERR = 53 THEN
PRINT "File " + error$ + " not found!"
PRINT "Press any key to end!"
ELSE
PRINT "Unknow error,ERR:"; ERR
PRINT "Press any key to end!"
END IF
SLEEP
END

SUB CloseFontFile
    CLOSE #1
END SUB

SUB DrawAscii (x!, y!, l, c, on$, cb, Text$)
DIM buffer(16)
DIM model(16, 8)

IF "ON" = UCASE$(on$) THEN LINE (x, y)-(x + (8 * LEN(Text$) + (LEN(Text$) - 1) * l), y + 16), cb, BF

FOR n = 1 TO LEN(Text$)
    Ascii$ = MID$(Text$, n, 1)
    'PRINT ASC(ascii$)
    FilePoint& = ASC(Ascii$) * 16
    SEEK #1, FilePoint&
  
   cclib$ = INPUT$(16, #1)
   FOR i = 1 TO 16
   buffer(i) = ASC(MID$(cclib$, i, 1))
   NEXT i
   FOR i = 1 TO 16
   num = buffer(i)
   FOR j = 8 TO 1 STEP -1
       model(i, j) = num MOD 2
       num = num \ 2
       NEXT
   NEXT

   FOR i = 1 TO 16
          FOR k = 1 TO 8
              IF model(i, k) = 1 THEN PSET (k + x, i + y), c
          NEXT
   NEXT
x = x + l + 8
NEXT n

END SUB

SUB DrawChs (x!, y!, l, c, on$, cb, Text$)
'显示１６点阵汉字程序模块
'x 为SCREEN 上的X坐标
'y 为SCREEN 上的Y坐标
'c 为汉字的前景颜色
'l 为两汉字之间的距离
'on$ 是否显示背景颜色的标记 如果on$="ON"或on$="on"则显示背景为cb的颜色
'cb 为背景颜色值
'Text$ 要显示在SCREEN上的汉字

Text$ = LTRIM$(RTRIM$(Text$))
DIM buffer(32)
DIM model(32, 8)

IF "ON" = UCASE$(on$) THEN LINE (x, y)-(x + (8 * LEN(Text$) + (LEN(Text$) / 2 - 1) * l), y + 16), cb, BF

FOR n = 1 TO LEN(Text$) STEP 2
high$ = MID$(Text$, n, 1)
low$ = MID$(Text$, n + 1, 1)
area = ASC(high$) - 161
location = ASC(low$) - 161
rec = area * 94 + location '每区94个字符
num& = rec * 32 + 1 + 4096
SEEK #1, num&
   cclib$ = INPUT$(32, #1)
   FOR i = 1 TO 32
   buffer(i) = ASC(MID$(cclib$, i, 1))
   NEXT i
   FOR i = 1 TO 32
   num = buffer(i)
       FOR j = 8 TO 1 STEP -1
       model(i, j) = num MOD 2
       num = num \ 2
       NEXT
   NEXT

   FOR i = 1 TO 16
      FOR j = 1 TO 2
          FOR k = 1 TO 8
              IF model((i - 1) * 2 + j, k) = 1 THEN PSET ((j - 1) * 8 + k + x, i + y), c
          NEXT
      NEXT
   NEXT
x = x + l + 16
NEXT n
END SUB

SUB DrawText (x!, y!, l, c, on$, cb, Text$)
'
'
'
'
'
'
DIM n  AS INTEGER:  n = 1
DIM Chs$
DIM Ascii$
DIM temp$
DIM signl, sigbak
signl = 0: sigbak = 0

FOR n = 1 TO LEN(Text$)
 temp$ = MID$(Text$, n, 1)
IF (ASC(temp$) > 127) THEN
   Chs$ = Chs$ + temp$
   signl = 1
ELSE
   Ascii$ = Ascii$ + temp$
   signl = 2
END IF
IF ((signl <> sigbak) AND (sigbak <> 0)) THEN
 IF (1 = signl) THEN
      CALL DrawAscii(x!, y!, l, c, on$, cb, Ascii$)
      Ascii$ = ""
   ELSEIF (2 = signl) THEN
      CALL DrawChs(x!, y!, l, c, on$, cb, Chs$)
      Chs$ = ""
END IF
   IF ("ON" = UCASE$(on$)) THEN LINE (x - l, y)-(x, y + 16), cb, BF
END IF
sigbak = signl
NEXT n
IF (0 < LEN(Ascii$)) THEN CALL DrawAscii(x!, y!, l, c, on$, cb, Ascii$)
IF (0 < LEN(Chs$)) THEN CALL DrawChs(x!, y!, l, c, on$, cb, Chs$)
END SUB

SUB OpenFontFile (c$) 'c$为传递进来的命令参数
IF c$ = "F" OR c$ = "/F" THEN   '如果命令参数为Ｆ则打开繁体字厍
    error$ = "FONT16F.FON"
    OPEN "font16f.fon" FOR INPUT AS #1
    CLOSE
    OPEN "font16f.fon" FOR BINARY ACCESS READ AS #1
    fontnum = 1
ELSEIF c$ = "?" OR c$ = "/?" THEN  '如果令参数为为？则帮助
SCREEN 0, 1
PRINT "Copyright Weng Rongjian All right reserved"
PRINT
PRINT "FONT [/?] [/J] [/F]"
PRINT "      /? Get this page"
PRINT "      /J Open then file FONT16.FON"
PRINT "      /F Open then file FONF16F.FON"
END
ELSE    '如果没有参数或其它则打开简体字厍
error$ = "FONT16J.FON"
OPEN "font16j.fon" FOR INPUT AS #1
CLOSE
OPEN "font16j.fon" FOR BINARY ACCESS READ AS #1
fontnum = 0
END IF
END SUB