回 帖 发 新 帖 刷新版面

主题:求pascal各单元原代码

+50

回复列表 (共2个回复)

沙发

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.
表忘了加分~~~~~~~~

板凳

加个分~~~~~~~

我来回复

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