Pascal/Turbo Pascal - Programa curioso

 
Vista:
sin imagen de perfil

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.
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder