
Programa curioso
Publicado por Mechanic (177 intervenciones) el 02/07/2007 21:16:20
Program mousound;
Uses Crt, Graph, Mouse4;
var GrapDriver, GraphMode, CodError : Integer;
Procedure IniciaGraficas;
begin
GrapDriver := Detect;
InitGraph(GrapDriver, GraphMode,' ');
CodError := GraphResult;
if CodError <> grOK then
begin
writeln('Error de gr ficas: ', GraphErrorMsg(CodError),' Presione tecla');
Repeat until KeyPressed;
end;
end;
begin
IniciaGraficas;
ShowMouse;
Rectangle(20,20,150,150); Rectangle(170,170,300,300);
Repeat
if ((mgetx >= 20) and (mgetx <= 150)
and (mgety >= 20)and(mgety <= 150))
then
begin
Sound(mgetx * 10);
delay(mgety div 10);
NoSound;
delay(1);
end;
if ((mgetx >= 170) and (mgetx <= 300)
and (mgety >= 170)and(mgety <= 300))
then
begin
Sound(mgetx * 5);
delay(mgety div 29);
NoSound;
delay(1);
end;
Until KeyPressed
end.
______________________________________________________________
La siguiente Unit no la hice yo. Sólamente le quité código para acortarla.
______________________________________________________________
{ $O+}
unit mouse4;
interface
var
mouseinstalled : boolean;
buttons : word; { Anzahl der Mouse-Buttons (2 oder 3) }
linkshaender : boolean;
shown : boolean;
type
graphcursor = array[0..31] of word;
function mgetx : integer;
function mgety : integer;
procedure showmouse;
procedure hidemouse;
implementation
uses crt,dos;
var r : registers;
dummy : byte;
ax1,ay1,ax2,ay2:word;
sx1,sy1,sx2,sy2:word;
procedure showmouse; assembler;
asm
cmp shown, 0
jne @ende
xor dx, dx
mov ax, 01h
int 33h
mov shown, 1
@ende:
end;
procedure hidemouse; assembler;
asm
cmp shown, 0
je @ende
xor dx, dx
mov ax, 02h
int 33h
mov shown, 0
@ende:
end;
function MgetX : integer;assembler;
asm
mov ax, 03h
int 33h
mov ax, cx
inc ax
end;
function MGetY : integer;assembler;
asm
mov ax, 03h
int 33h
mov ax, dx
inc ax
end;
begin
ax1:=0;
ay1:=0;
ax2:=mem[$40:$4A] shl 3;
ay2:=mem[$40:$84] shl 3;
shown:=false;
if paramcount>0 then
for dummy:=1 to paramcount do
if (paramstr(dummy)='-l') or (paramstr(dummy)='-L') then linkshaender:=true else linkshaender:=false;
end.
Uses Crt, Graph, Mouse4;
var GrapDriver, GraphMode, CodError : Integer;
Procedure IniciaGraficas;
begin
GrapDriver := Detect;
InitGraph(GrapDriver, GraphMode,' ');
CodError := GraphResult;
if CodError <> grOK then
begin
writeln('Error de gr ficas: ', GraphErrorMsg(CodError),' Presione tecla');
Repeat until KeyPressed;
end;
end;
begin
IniciaGraficas;
ShowMouse;
Rectangle(20,20,150,150); Rectangle(170,170,300,300);
Repeat
if ((mgetx >= 20) and (mgetx <= 150)
and (mgety >= 20)and(mgety <= 150))
then
begin
Sound(mgetx * 10);
delay(mgety div 10);
NoSound;
delay(1);
end;
if ((mgetx >= 170) and (mgetx <= 300)
and (mgety >= 170)and(mgety <= 300))
then
begin
Sound(mgetx * 5);
delay(mgety div 29);
NoSound;
delay(1);
end;
Until KeyPressed
end.
______________________________________________________________
La siguiente Unit no la hice yo. Sólamente le quité código para acortarla.
______________________________________________________________
{ $O+}
unit mouse4;
interface
var
mouseinstalled : boolean;
buttons : word; { Anzahl der Mouse-Buttons (2 oder 3) }
linkshaender : boolean;
shown : boolean;
type
graphcursor = array[0..31] of word;
function mgetx : integer;
function mgety : integer;
procedure showmouse;
procedure hidemouse;
implementation
uses crt,dos;
var r : registers;
dummy : byte;
ax1,ay1,ax2,ay2:word;
sx1,sy1,sx2,sy2:word;
procedure showmouse; assembler;
asm
cmp shown, 0
jne @ende
xor dx, dx
mov ax, 01h
int 33h
mov shown, 1
@ende:
end;
procedure hidemouse; assembler;
asm
cmp shown, 0
je @ende
xor dx, dx
mov ax, 02h
int 33h
mov shown, 0
@ende:
end;
function MgetX : integer;assembler;
asm
mov ax, 03h
int 33h
mov ax, cx
inc ax
end;
function MGetY : integer;assembler;
asm
mov ax, 03h
int 33h
mov ax, dx
inc ax
end;
begin
ax1:=0;
ay1:=0;
ax2:=mem[$40:$4A] shl 3;
ay2:=mem[$40:$84] shl 3;
shown:=false;
if paramcount>0 then
for dummy:=1 to paramcount do
if (paramstr(dummy)='-l') or (paramstr(dummy)='-L') then linkshaender:=true else linkshaender:=false;
end.
Valora esta pregunta


0