|
|
|
 |
Foros de Programacion - Cominidad de Programadores |
|
|
|
 |
29 de agosto,2005, 15:51
|
|
Junior Member
|
|
Fecha de Ingreso: ago 2005
Mensajes: 9
|
|
unidad UTECLADO de proposito general
8) Unidad UTECLADO de proposito general
Código:
{ Micropais 2005 -
- Tecla_pulsada soporta "Equipos Portatiles" con Bola Mouse, detectandola
igual que si fueran las teclas del cursor leer notas mas abajo.
þ las siguientes funciones estan aqui solo por curiosidad algunas de ellas
han dejado de funcionar correctamente en el XP,pero si funcionan en el 98
95 y dos 5.0 y 620
probarlas de todas maneras
____________________________
write_no_teletipo
pulsa_cadena_bios
init_joypad
get_joystick_gamepad *observar que las variables del JOYstick o gamepack
ya estan inicializadas abajo del todo.
_izq iz
_der de
_arr arriba
_aba
_bo1 boton 1
_bo2 boton 2
_bo3 boton 3
_bo4 boton 4
____________________________
}
UNIT UTECLADO;
{°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°}
INTERFACE {.......... * simbolos publicos *..........................}
{°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°}
const
{ teclas de funcion }
f1=59;f2=60;f3=61;f4=62;f5=63;f6=64;f7=65;f8=66;f9=67;F10=68;
f11=87;f12=88;
impr_pant=42;
bloq_despl=70;
pausa=29;
{ teclas de cursor }
arriba_izquierda=71;
arriba =72;
arriba_derecha =73;
izquierda =75;
centro =76;
derecha =77;
abajo_izquierda =79;
abajo =80;
abajo_derecha =81;
colocar =82;{ insertar hace interferencias con func insert ??? }
suprimir =83;
escape = 1;
retroceso =14;
tabulador =15;
intro =28;
control =29;
alternativa=56;
espaciador =57;
{ para usar con tecla_pulsada }
{ ejemplo: if teclado[tecla_pulsada]<>'þ' then
cad:=cad+teclado[tecla_pulsada]
else cad:='';}
teclado1:array[0..57]of char=#0+'þ1234567890''*þ'+
'þQWERTYUIOP`+þ'+
'þASDFGHJKL¥''§'+
'þ€ZXCVBNM,._þþþ ';
teclado2:array[0..57]of char=#0+'þ!"ú$%&/()=?¨þ'+
'þqwertyuiop^*þ'+
'þasdfghjkl¤ù€'+
'þ€zxcvbnm;:-þþþ ';
var
estado:integer; {actualiza_togle}
insertar,Capslock,Numlock,Scrollock,Alt,Ctrl,
Shifizquierda,ShifDerecha:Boolean;
tec:byte;
procedure actualiza_toggle;
function tecla_pulsada:byte;
procedure write_no_teletipo(car,texto,fondo:byte);
function edita_cadxy(xx,yy:byte;cad:string;tipo:byte):string;
procedure pulsa_cadena_bios(cad:string);
{...........................................................................}
var
_cenxx:byte;
_cenyy:byte;
_izq,_der,_arr,_aba:byte;
_bo1,_bo2,_bo3,_bo4:byte;
function init_joypad:boolean;
procedure get_joystick_gamepad;
{////////////////////////////////////////////////////////////////////////////}
{°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°}
IMPLEMENTATION {.......... * simbolos privados *......................... }
{°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°}
uses crt,windos;
var regs:tregisters;
procedure actualiza_toggle;
begin
estado:=mem[$40:$17]; { estado de las teclas modificadoras shif y toggle }
if estado and 1=1 then Shifderecha :=TRUE else Shifderecha :=FALSE;
if estado and 2=2 then ShifIzquierda:=TRUE else ShifIzquierda:=FALSE;
if estado and 4=4 then Ctrl :=TRUE else Ctrl :=FALSE;
if estado and 8=8 then Alt :=TRUE else Alt :=FALSE;
if estado and 16=16 then Scrollock :=TRUE else Scrollock :=FALSE;
if estado and 32=32 then NumLock :=TRUE else NumLock :=FALSE;
if estado and 64=64 then CapsLock :=TRUE else CapsLock :=FALSE;
if estado and 128=128 then insertar :=TRUE else insertar :=FALSE;
{falta estado de insert (colocar) and 128=128 then }
end;
{...........................................................................}
{ actualizado 22-7-2001 ahora soporta equipos portatiles con bola mouse que}
{ mandan un codigo al puerto 60h del teclado cuando este se mueve }
{ interfiriendo con el teclado ahora se separa este mediante un codigo del }
{ puerto 64h cod 28=teclado cod 60=bola trackball }
function tecla_pulsada:byte;assembler;
asm
in al,64h
test al,100000b
je @ok1
xor ax,ax
jmp @fin
@ok1:
in al,60h
cmp al,128
jbe @ok2
xor ax,ax
jmp @fin
@ok2:
cli
push es
xor bx,bx
mov es,bx
mov bl,es:[41ah]
mov es:[41ch],bl
pop es
sti
@fin:
end;
{...........................................................................}
procedure write_no_teletipo(car,texto,fondo:byte);
begin
regs.ah:=$09;
regs.al:=car;
regs.bh:=0; { pagina }
regs.bl:=(fondo shl 4)or texto ;
regs.cx:=1;
intr($10,regs);
end;
{...........................................................................}
{ edita una cadena de texto en la posicion x,y indicada la cadena tendra la }
{ misma longitud inicial se debe especificar el filtro 0 ¢ 1 }
{ filtro modo 0 todos los caracteres menos los de control }
{ filtro modo 1 solo numeros del 0 al 9 para conversion por val }
{...........................................................................}
function edita_cadxy(xx,yy:byte;cad:string;tipo:byte):string;
procedure pita;
begin
sound(200);delay(500);nosound;
end;
var
dato:char;
cod_ext:boolean;
longitud_cadena:byte;
cursor_tipo:char;
color_texto:byte;
color_fondo:byte;
ii:byte;
cad_vacia:boolean;
begin
color_texto:=7;
color_fondo:=1;
cursor_tipo:=#27;
cod_ext:=false;
longitud_cadena:=length(cad);
cad_vacia:=true;
for ii:=1 to length(cad) do
begin
if cad[ii]<>' 'then cad_vacia:=false
end;
textcolor(color_texto);textbackground(color_fondo);
gotoxy(xx,yy);
if (cad_vacia=true) then begin
cad:='';
for ii:=1 to longitud_cadena+1 do write('Û');
gotoxy(xx,yy);
end else
begin
textcolor(15);
for ii:=1 to length(cad) do write('Û');{}
gotoxy(xx,yy);
textcolor(color_texto);
write(cad);
end;
repeat
dato:=readkey;
if dato=#0 then begin
cod_ext:=true;
dato:=readkey;
end;
if (not cod_ext) then
begin
if dato=#13 then begin
gotoxy(xx,yy);
write(cad,' ');
break;
end;
if tipo=0 then begin
if length(cad)<longitud_cadena then
if dato in[#32..#255]then
cad:=cad+dato else pita;
end;
if tipo=1 then begin
if length(cad)<longitud_cadena then
if dato in[#48..#57]then
cad:=cad+dato else pita;
end;
if dato=#8 then
begin
delete(cad,length(cad),1);
end;
gotoxy(xx,yy);
textcolor(color_texto);
textbackground(color_fondo);
for ii:=1 to longitud_cadena+1 do write('Û');
gotoxy(xx,yy);
write(cad);
textcolor(color_texto+128);textbackground(color_fondo);
write(cursor_tipo);
textcolor(color_texto);textbackground(color_fondo);{}
end;
cod_ext:=false;
until dato=#27;
for ii:=length(cad)+1to longitud_cadena do cad[ii]:=' ';
cad[0]:=chr(longitud_cadena);
edita_cadxy:=cad;
end;
{...........................................................................}
{...........................................................................}
{ pulsa_cadena_bios envia la cadena al buffer del teclado BIOS y abandona el}
{ el programa para que surta efecto. el efecto es el mismo que si estuviera-}
{ mos en el DOS y pulsasemos la cadena mas INTRO ejecutandose la cadena como}
{ si de un programa se tratase si la cadena tuviese sentido .La unica pega }
{ es que solo podremos utilizar una cadena de (16 caracteres)-1=15,el carac-}
{ ter INTRO se introduce automaticamente al final de la cadena, aunque el }
{ espacio esta limitado es suficiente para ejecutar en el peor de los casos }
{ un comando sin parametros o mejor aun ejecutar un archivo.BAT que este si }
{ que puede enviar parametros o ejecutar varios comandos o archivos sin nin-}
{ g£n problema teniendo la ventaja sobre un shell de que este metodo no }
{ precisa tanta MEMORIA ya que el programa se termina justo antes de llenar }
{ el buffer del teclado }
{ NOTA: *** MAXIMO 15 CARACTERES *** }
{...........................................................................}
procedure pulsa_cadena_bios(cad:string);
var longi:byte;
cnt:byte;
procedure pulsa_tecla(cad:char);
var regs:Tregisters;
begin
regs.ah:=$05;
regs.al:=0;
regs.cl:=ord(cad);
intr($16,regs);
end;
begin
cad:=cad+#13;
longi:=length(cad);
if longi >16 then exit;
for cnt:=1 to longi do pulsa_tecla(cad[cnt]);
halt;
end;
{...........................................................................}
{...........................................................................}
{...........................................................................}
{ devuelve true si hay conectado un joystick o gamepad false caso contrario }
{ y carga la variables globales _cenxx y _cenyy usadas por la F.joypad }
{////////////////////////////////////////////////////////////////////////////}
function init_joypad:boolean;assembler;
asm
mov ah,84h
mov dx,1
int 15h
mov _cenyy,bl
mov _cenxx,al
cmp al,0
je @error1
cmp bl,0
je @error2
mov ax,0ffffh
jmp @fin
@error1:
mov ax,0
jmp @fin
@error2:
mov ax,0
@fin:
end;
{////////////////////////////////////////////////////////////////////////////}
{ get_joystick_gamepad: }
{ carga _izq,_der,_arr,_aba_,bo1,bo2,bo3,bo4 de un joystick o gamepad }
procedure get_joystick_gamepad;
{////////////////////////////////////////////////////////////////////////////}
{ joypad: }
{ devuelve un byte con el contenido del las direcciones y botones de un }
{ joystick o de un gamepad en el sigiente orden }
{ izq, der, arr, aba, bo1, bo2, bo3, bo4 }
{ nota:izq=bit0 bo4=bit7 }
{ llamado por get_joystick_gamepad; }
{ SUBFUNCION joypad /////////////////////////////////////////////////////}
function joypad:byte;assembler;
var centrox,centroy:byte;
asm
mov ah,84h
mov dx,1
int 15h
mov dl,_cenxx
mov centrox,dl
mov dl,_cenyy
mov centroy,dl
xor dl,dl
sub centrox,16
cmp al,centrox
ja @no_izq
or dl,1b
@no_izq:
add centrox,32
cmp al,centrox
jb @no_der
or dl,10b
@no_der:
sub centroy,16
cmp bl,centroy
ja @no_arr
or dl,100b
@no_arr:
add centroy,32
cmp bl,centroy
jb @no_aba
or dl,1000b
@no_aba:
mov bl,dl
{ guardamos las direcciones en bl }
{ obtenemos los botones 1,2,3,4 en al }
mov dx,201h
in al,dx
not al
and al,11110000b
or al,bl
end;
{///////////////////////////////////////////////////////////////////////}
var padxy:byte;
begin
padxy:=joypad;
_izq:=padxy and 1 ;
_der:=padxy and 2 shr 1;
_arr:=padxy and 4 shr 2;
_aba:=padxy and 8 shr 3;
_bo1:=padxy and 16 shr 4;
_bo2:=padxy and 32 shr 5;
_bo3:=padxy and 64 shr 6;
_bo4:=padxy and 128 shr 7;
end;
{////////////////////////////////////////////////////////////////////////////}
END.
8) - Prueba de la unidad UTECLADO
Código:
{ Micropais 2005 - Prueba de la unidad UTECLADO, de proposito general }
uses crt,uteclado;
{***************************************************************************}
procedure cursor_off;assembler;
{ * apaga el cursor del BIOS (no mouse) }
asm
mov ah,01
mov ch,20h
mov cl,12
int 10h
end;
{***************************************************************************}
procedure cursor_on;assembler;
{ * restablece el cursor por defecto BIOS }
asm
mov ah,01
mov ch,11
mov cl,12
int 10h
end;
{***************************************************************************}
procedure test_datos;
var dato1,dato2,entrada_datos:string;
begin
repeat until (tecla_pulsada=0);
clrscr;
dato1:=' Bartolo ';
dato2:='91999888';
writeln('Modificando una cadena de texto por el metodo tradicional - Readkey -');
writeln('prueba rutina edita_cadxy con datos ya predefinidos DATO1 solo acepta ');
writeln('caracteres de texto DATO2 solo numeros. ');
writeln('usa la Tecla RETROCESO e INTRO');
writeln(' DATO1:',dato1,' DATO2:', dato2 );
textbackground(0);
gotoxy(1,10);
write('Nombre ');
entrada_datos:=dato1;
dato1:=edita_cadxy(10,10,entrada_datos,0);{ solo caracteres }
textbackground(0);
gotoxy(1,12);
write('Numero ');
entrada_datos:=dato2;
dato2:=edita_cadxy(10,12,entrada_datos,1);{ solo numeros }
textbackground(0);
gotoxy(1,13);
writeln('DATO1: ',dato1,' DATO2:',dato2);
writeln('- Pulsa intro para continuar -');
readln;
end;
{***************************************************************************}
procedure test_toggle;
begin
repeat until (tecla_pulsada=0);{hasta que se vacie el buffer del teclado}
clrscr;
writeln(' TEST de Teclas modificadoras - Pulsa ESC para salir -');
repeat
tec:=tecla_pulsada; { obtenemos la tecla que se ha pulsado }
actualiza_toggle; { obtemos el estado de la teclas especiales }
gotoxy(1,2);
if Shifderecha then write('Shifderecha On ') else write('Shifderecha Off ');
gotoxy(1,3);
if ShifIzquierda then write('ShifIzquierda On ') else write('ShifIzquierda Off');
gotoxy(1,4);
if Ctrl then write('Ctrl On ') else write('Ctrl Off ');
gotoxy(1,5);
if Alt then write('Alt On ') else write('Alt Off ');
gotoxy(1,6);
if Scrollock then write('Scrollock On ') else write('Scrollock Off ');
gotoxy(1,7);
if NumLock then write('NumLock On ') else write('NumLock Off ');
gotoxy(1,8);
if CapsLock then write('CapsLock On ') else write('CapsLock Off ');
gotoxy(1,9);
if insertar then write('insertar On ') else write('insertar Off ');
until (tec=escape); { repetimos hasta que se pulse la tecla ESC }
end;
{***************************************************************************}
procedure test_teclas;
begin
repeat
until (tecla_pulsada=0);{hasta que se vacie el buffer del teclado}
{ si no esperamos el valor de tec se hereda del anterior procedimiento
y este procedimiento no se ejecutaria , tambiem podriamos haber puesto
tec=''
}
clrscr;
repeat
tec:=tecla_pulsada;
gotoxy(1,1);
write('TEST teclas - pulsa F1.. F12 QWERTY Retroceso Intro... - Pulsa ESC para salir - ');
gotoxy(1,3);
case tec of
f1 :write('F1 ');
f2 :write('F2 ');
f3 :write('F3 ');
f4 :write('F4 ');
f5 :write('F5 ');
f6 :write('F6 ');
f7 :write('F7 ');
f8 :write('F8 ');
f9 :write('F9 ');
F10 :write('F10 ');
f11 :write('F11 ');
f12 :write('F12 ');
bloq_despl :write('bloq_despl ');
pausa :write('pausa ');
arriba_izquierda:write('arriba_izquierda');
arriba :write('arriba ');
arriba_derecha :write('arriba_derecha ');
izquierda :write('izquierda ');
centro :write('centro ');
derecha :write('derecha ');
abajo_izquierda :write('abajo_izquierda ');
abajo :write('abajo ');
abajo_derecha :write('abajo_derecha ');
colocar :write('colocar ');
suprimir :write('suprimir ');
escape :write('escape ');
retroceso :write('retroceso ');
tabulador :write('tabulador ');
intro :write('intro ');
control :write('control ');
alternativa :write('alternativa ');
espaciador :write('espaciador ');
else write('pulsa... ');
end;
write('COD :',tec,' ');
{ el array teclado1 contiene el codigo de las minusculas teclado2
el de las mayusculas }
if ((teclado1[tec]<>'þ') and (teclado2[tec]<>'þ') ) then
write('CAR :',teclado1[tec],' ',teclado2[tec],' ')
else write (' ');{}
until tec=escape;
end;
{***************************************************************************}
{////////////////////////////////////////////////////////////////////////////}
{ produce un retardo controlado por tiempo (igual para todos los ordenadores)
basado en microsegundos , en ordenadores rapidos y para valores minimos
podr* haber una peque¤a diferencia debido al tiempo en ejecutar las INT
mas rapidamente
hire word alto del valor total en microsegundos
lore word bajo del valor total en microsegundos
- en un principio vamos a usar micro_retardo_bios en vez de DELAY
para generar sonidos iguales,independientemente de la maquina que usemos.
{////////////////////////////////////////////////////////////////////////////}
procedure micro_retardo_bios(hire,lore:word);assembler;
asm
mov ah,86h
mov cx,hire
mov dx,lore
int 15h
end;
{***************************************************************************}
procedure test_juego;
var
ejx,ejy:byte;
ii: byte;
disparado:boolean;
anterior:boolean;
contador:word;
jj:word;
begin
repeat until (tecla_pulsada=0);
clrscr;
textcolor(7);
writeln('Usa Teclas del cursor - CTRL para disparar - ESC salir');
ejx :=1;
ejy :=24;
contador:=0; { contador infinito }
disparado:=false;
repeat
tec:=tecla_pulsada;{ obtenemos la tecla que se ha pulsado }
{ observamos las teclas del cursor }
actualiza_toggle; { obtemos el estado de la teclas especiales }
{ queremos observar la tecla CTRL }
contador:=contador+1;
{ efecto camara fotograficas solo dispararemos cuando
est‚ cargado el "LASER" avisandonos con un sonido }
if (contador and 63=1) then begin
anterior:=disparado;
disparado:=false;
if anterior then
begin
jj:=37;
while jj<3000 do
begin
sound(jj);
micro_retardo_bios(0,10);
jj:=jj+10;
end;
nosound;
end;{}
end;
{ obtenemos las teclas de direccion y ajustamos las coordenadas }
case tec of
izquierda :ejx:=ejx-1;
derecha :ejx:=ejx+1;
arriba :ejy:=ejy-1;
abajo :ejy:=ejy+1;
arriba_izquierda:begin ejy:=ejy-1;ejx:=ejx-1;end;
arriba_derecha :begin ejy:=ejy-1;ejx:=ejx+1;end;
abajo_izquierda :begin ejy:=ejy+1;ejx:=ejx-1;end;
abajo_derecha :begin ejy:=ejy+1;ejx:=ejx+1;end;
end;
{ aseguramos los limites de la pantalla }
if ejx<1 then ejx:=1;
if ejx>74 then ejx:=74;
if ejy>24 then ejy:=24;
if ejy<5 then ejy:=5;
{
dibujamos la nave, en la posicion actualizada X,Y, si podemos disparar
la nave sera de color verde si no, de color rojo, a su vez borramos
con ' 'para no dejar huella en el siguiente movimiento
}
if disparado then textcolor(12) else textcolor(2);
gotoxy(ejx,ejy);
write(' ÚÊ¿ ');
gotoxy(ejx,ejy+1);write(' ');
gotoxy(ejx,ejy-1);write(' ');
{
comprobamos si hemos pulsado el disparador CTRL y si tenemos permiso para
disparar , de ser as¡ , dibujamos el laser
}
if (Ctrl) and (not disparado) then
begin
textcolor(14);
jj:=37;
while jj<=600 do begin
sound(jj*8);
{
usamos micro_retardo_bios mas preciso que DELAY , ya que delay est* basado
en ciclos de cpu en vez de unidades de tiempo por eso cambia de un ordenador
a otro , produciendose efectos inesperados. micro_retardo_bios usa el bios
y un microsegundo es igual en cualquier ordenador }
micro_retardo_bios(0,5000);
jj:=jj+100;
end;
nosound;
for ii:=ejy-1 downto 3 do
begin
gotoxy(ejx+2,ii-1);
{ esperamos al retrazado vertical para evitar el 'efecto nieve' }
{ tambien lo usaremos para sincronizacion }
repeat until (port[$3da] and 8)<>0;{}
repeat until (port[$3da] and 8)<>8;{}
write('³');
gotoxy(ejx+2,ii-1);
repeat until (port[$3da] and 8)<>0;{}
repeat until (port[$3da] and 8)=8;{}
write(' ');
end;
disparado:=true;
end;
repeat until (port[$3da] and 8)<>0;{}
repeat until (port[$3da] and 8)<>8;{}
until (tec=escape);
end;
{///////////////////////////////////////////////////////////////////////////}
begin
textmode(co80);clrscr;textcolor(7);
cursor_off;{ desconectamos visualmente el cursor }
test_datos;
test_toggle;
test_teclas;
test_juego;
cursor_on; { activamos visualmente el cursor }
clrscr;textbackground(0);textcolor(7);
writeln('Programa terminado - Pulsa Intro para salir -');
readln;
end.
|
| Herramientas |
|
|
| Desplegado |
 Mode Lineal
|
Normas de Publicación
|
No puedes crear nuevos temas
No puedes responder temas
No puedes subir archivos adjuntos
No puedes editar tus mensajes
Las caritas están Activado
El codigo [IMG] está Activado
Código HTML está Desactivado
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
www.programatium.com© 1999 - web esta optimizada para  Microsoft explorer 6.0
|
|
|
|
|
|
Content Relevant URLs by vBSEO 3.2.0
|
Temas Similares
