回 帖 发 新 帖 刷新版面

主题:作图模式下显示汉字

这是个很老的话题.

必备文件:
graph.tpu   Tutbo pascal 7.0 自带
EGAVGA.BGI  Tutbo pascal 7.0 自带

HZK16           UCDOS6.0 的16*16汉字点阵。必须去找UCDOS6.0下的这个文件。大小才262K.可惜这里不能上传这个文件。

必备知识:
会启动Turbo pascal 7.0的BGI作图模式,会画一画图。  (^_^)

程序主要在作图模式下编出这样一个函数:
procedure outchinese(x,y:integer;s:string;blank:integer; color:integer);
x,y是坐标,blank是汉字之间的空格,color是字的颜色。
然后象outtextxy函数一样用。 注意s的内容必须全部为全角符号或者是汉字。

源程序:
==============================

(*   UCDOS 16*16 fonts display demo.
     Need file: HZK16 to run.
     display Chinese in graphics mode.
     programmed by jtchang.
*)

program chinese;
uses crt,graph;
Label aaa;

var
   gd,gm,q,w,x,y,ErrCode:integer;
   s:string;
   ch:char;


function inttostr(n:integer):string;
var
  s:string;
begin
    s:='';
    repeat
       s:=chr(ord('0')+n mod 10)+s;
       n:=n div 10;
    until n=0;
    inttostr:=s;
end;


procedure putone(x,y:integer;s:string;color:integer);
type
    chinesep=array[1..32] of byte;
var
    a:chinesep;
    f:file of chinesep;
    i,j,x0,y0:integer;
    k:byte;
    q,w:longint;

begin
    q:=ord(s[1])-160;
    w:=ord(s[2])-160;
    q:=(q-1)*94+(w-1);
    assign(f,'HZK16') ;
    reset(f);
    if (q<0) or (q>=filesize(f)) then
      begin
         close(f);
         exit;
      end;
    seek(f,q);
    read(f,a);
    close(f);
    y0:=y;
    for i:=1 to 32 do
     begin
       k:=a[i];
       if i mod 2=1 then
         begin
           x0:=7+x;
           y0:=y0+1;
         end
        else
              x0:=15+x;
       for j:=1 to 8 do
        begin
           if k and 1 =1 then putpixel(x0,y0,color);
            x0:=x0-1;
            k:=k shr 1;
        end;
     end;
end;

procedure outchinese(x,y:integer;s:string;blank:integer; color:integer);
var
   temps:string;
   k:integer;
begin
   k:=1;
   while k<length(s) do
    begin
       temps:=s[k]; k:=k+1;
       temps:=temps+s[k]; k:=k+1;
       putone(x+(k div 2-1)*(16+blank),y,temps,color);
    end;
end;

begin
    gd:=detect;
    initgraph(gd,gm,'');
    ErrCode:=graphresult;
    if  ErrCode<>grOK then
     begin
       Writeln('Graphics error: ', GraphErrorMsg(ErrCode));
       exit;
     end;
    setbkcolor(blue);
    outchinese(205,150,'汉字显示演示程序',5,RED+8);
    outchinese(120,200,'演示中按任意键继续,按ESC退出',5,RED+8);
    outchinese(280,350,'jtchang编程',3,RED+8);
    ch:=readkey;
    cleardevice;

    x:=10; y:=5;
    for q:=1 to 89 do
      for w:=1 to 94 do
        begin
           if w=1 then     setcolor(RED+8)
             else   setcolor(7);
           s:=inttostr(q div 10)+inttostr(q mod 10);
           s:=s+inttostr(w div 10)+inttostr(w mod 10);
           moveto(x,y+6);
           outtext(s);
           s:=chr(q+160)+chr(w+160);
           outchinese(x+40,y,s,0,yellow);
           x:=x+70;
           if x>580 then
            begin
               x:=10;
               y:=y+30;
            end;
           if  y+16>479  then
             begin
                ch:=readkey;
                if ch=#27 then goto aaa;
                x:=10;y:=5;
                cleardevice;
             end;
        end;
     ch:=readkey;
     cleardevice;
     outchinese(200,200,'所有汉字显示完毕!',8,RED+8);
     ch:=readkey;
aaa:
    closegraph;
end.
=====================

回复列表 (共13个回复)

11 楼

老大,有没有HZK12 UCDOS6.0 的12*12汉字点阵的显示汉字的算法
我用的老显示不出来

12 楼

I don't know!

13 楼

老大, 我不能显示汉字, please help

我来回复

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