主题:求pascal各单元原代码
			 fxzxg
				 [专家分:430]  发布于 2005-12-09 14:12:00
 fxzxg
				 [专家分:430]  发布于 2005-12-09 14:12:00							
			+50
						
					 
		
			
回复列表 (共2个回复)
		
								
				沙发
				
					 绿步甲 [专家分:1610]  发布于 2005-12-09 19:05:00
绿步甲 [专家分:1610]  发布于 2005-12-09 19:05:00				
				CRT 的单元
unit _crt; 
interface 
type st=set of char; 
procedure setcursor(top,bottom:byte); 
procedure cursoroff; 
procedure cursoron; 
function presskey:byte; 
function keypressed:boolean; 
procedure clrscr; 
function wherex:byte; 
function wherey:byte; 
procedure gotoxy(x,y:byte); 
function readkey:char; 
function readchar(var c:char):byte; 
function inputkey(c:char;s:st):char; 
procedure MouseInit; 
procedure GetMouseLeftClick(var x,y:integer); 
procedure SetMouse(x,y:integer); 
implementation 
procedure setcursor; 
begin 
asm 
mov ah,1 
mov ch,top 
mov cl,bottom 
int 10h 
end 
end; 
procedure cursoroff; 
begin setcursor(32,32) end; 
procedure cursoron; 
begin setcursor(6,7) end; 
function presskey; 
var a:byte; 
begin 
asm 
mov ah,2 
int 16h 
mov a,al 
end; 
presskey:=a 
end; 
function keypressed; 
var a:boolean; 
begin 
asm 
mov ah,1 
int 16h 
lahf 
not ah 
and ah,40h 
mov a,ah 
end; 
keypressed:=a 
end; 
procedure clrscr; 
begin 
gotoxy(0,0);cursoroff; 
write(' ':80*25);cursoron 
end; 
function wherex; 
var x:byte; 
begin 
asm 
mov bh,0 
mov ah,3 
int 10h 
mov x,dl 
end; 
wherex:=x 
end; 
function wherey; 
var y:byte; 
begin 
asm 
mov bh,0 
mov ah,3 
int 10h 
mov y,dh 
end; 
wherey:=y 
end; 
procedure gotoxy; 
begin 
asm 
mov bh,0 
mov dl,x 
mov dh,y 
mov ah,2 
int 10h 
end 
end; 
function readkey; 
var r:char; 
begin 
asm 
mov ah,8 
int 21h 
mov r,al 
end; 
readkey:=r 
end; 
function readchar; 
var c0:char;s:byte; 
begin 
asm 
mov bh,0 
mov ah,8 
int 10h 
mov c0,al 
mov s,ah 
end; 
c:=c0; 
readchar:=s; 
end; 
function inputkey; 
var k:char; 
begin 
repeat 
k:=readkey; 
if k=#0 then readkey 
until (k in s)or (k=#13); 
if k=#13 then inputkey:=c else inputkey:=k; 
end; 
procedure MouseInit; 
begin 
asm 
mov ax,0 
int 33h 
mov ax,1 
int 33h 
end; 
end; 
procedure GetMouseLeftClick; 
var mx,my,b:word; 
begin 
repeat 
asm 
mov ax,3 
int 33h 
mov b,bx 
end; 
until b=1; 
repeat 
asm 
mov ax,3 
int 33h 
mov b,bx 
mov mx,cx 
mov my,dx 
end; 
until b=0; 
x:=mx;y:=my; 
end; 
procedure SetMouse; 
begin 
asm 
mov ax,4 
mov cx,x 
mov dx,y 
int 33h 
end 
end; 
end.
表忘了加分~~~~~~~~
							 
						
				板凳
				
					 绿步甲 [专家分:1610]  发布于 2005-12-09 19:05:00
绿步甲 [专家分:1610]  发布于 2005-12-09 19:05:00				
				加个分~~~~~~~
							 
									
			
我来回复