主题:作图模式下显示汉字
这是个很老的话题.
必备文件:
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.
=====================
必备文件:
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.
=====================