Ir al contenido


Foto

Keypressed y Readkey (otra vez)


  • Por favor identifícate para responder
5 respuestas en este tema

#1 seoane

seoane

    Advanced Member

  • Administrador
  • 1.257 mensajes
  • LocationEspaña

Escrito 29 junio 2012 - 12:54

Bueno, este hilo es una repetición de otro que se borro, así que iré al grano y pondré solo el código:



delphi
  1. function Keypressed: Boolean;
  2. var
  3.   InputBuffer: THandle;
  4.   InputRecord: INPUT_RECORD;
  5.   Count: Cardinal;
  6. begin
  7.   Result:= FALSE;
  8.   InputBuffer:= GetStdHandle(STD_INPUT_HANDLE);
  9.   if InputBuffer <> INVALID_HANDLE_VALUE then
  10.     if PeekConsoleInput(InputBuffer,InputRecord,1,Count)and (Count = 1) then
  11.     begin
  12.       if InputRecord.EventType = KEY_EVENT then
  13.         if TKeyEventRecord(InputRecord.Event).bKeyDown then
  14.         begin
  15.           Result:= TRUE;
  16.           Exit;
  17.         end;
  18.       ReadConsoleInput(InputBuffer,InputRecord,1,Count)
  19.     end;
  20. end;
  21.  
  22. function Readkey: Char;
  23. var
  24.   InputBuffer: THandle;
  25.   InputRecord: INPUT_RECORD;
  26.   Count: Cardinal;
  27. begin
  28.   Result:= #0;
  29.   InputBuffer:= GetStdHandle(STD_INPUT_HANDLE);
  30.   if InputBuffer <> INVALID_HANDLE_VALUE then
  31.     while ReadConsoleInput(InputBuffer,InputRecord,1,Count) do
  32.       if InputRecord.EventType = KEY_EVENT then
  33.         if TKeyEventRecord(InputRecord.Event).bKeyDown then
  34.         begin
  35.           Result:= TKeyEventRecord(InputRecord.Event).AsciiChar;
  36.           Exit;
  37.         end;
  38. end;



Ejemplos de uso:


delphi
  1. repeat
  2.   Sleep(10);
  3. until Keypressed;





delphi
  1.   Writeln('Pulsa una tecla ...');
  2.   Writeln('Has pulsado la tecla: ' + ReadKey);





delphi
  1. repeat
  2.   Sleep(10);
  3. until Keypressed;
  4. Writeln('Has salido de bucle con  la tecla: ' + ReadKey);





delphi
  1. procedure Pause;
  2. begin
  3.   Writeln('Pulse una tecla para continuar ...');
  4.   ReadKey;
  5. end;





delphi
  1. var
  2.   C: Char;
  3. begin
  4.   repeat
  5.     Writeln;
  6.     Writeln('[1] Pulsa 1');
  7.     Writeln('[2] Pulsa 2');
  8.     Writeln;
  9.     Write('Escoge una opcion: ');
  10.     C:= Readkey;
  11.   until C in ['1','2'];
  12.   Writeln;
  13.   Writeln('Has escogido: ' + C);
  14. end;



Saludos

PD: escafandra ahora te toca a ti  ;)
  • 0

#2 escafandra

escafandra

    Advanced Member

  • Moderadores
  • PipPipPip
  • 3.965 mensajes
  • LocationMadrid - España

Escrito 29 junio 2012 - 01:20

PD: escafandra ahora te toca a ti  ;)


Caramba este tema ya me suena :D :D :D


Mi aportación al tema es simple, aprovechando la existencia de crtdll.dll una librería runtime para C que trae windows podemos importar las funciones equivalentes de C y usarlas el delphi si mas código que este:



delphi
  1. function Readkey: char; cdecl; external 'crtdll' name '_getch';
  2. function Keypressed: boolean; cdecl; external 'crtdll' name '_kbhit';



Simplemente importo las funciones con los mismos nombres de las funciones que publica el maestro seoane y su uso es igual.


Saludos.
  • 0

#3 Wilson

Wilson

    Advanced Member

  • Moderadores
  • PipPipPip
  • 2.137 mensajes

Escrito 29 junio 2012 - 05:23

Hago constar que he vuelto a dar  las "Gracias" a los maestros seoane y Escafandra:D :D

Saludos y gracias.
  • 0

#4 Delphius

Delphius

    Advanced Member

  • Administrador
  • 6.295 mensajes
  • LocationArgentina

Escrito 29 junio 2012 - 05:56

Me pregunto si llegará el día en que Seoane y Escafandra vinieran con una duda y sea yo el único que tuviera LA respuesta y dejarlos mudos. ¿O es un puro sueño, una mera fantasía?  :D

¡Combiden bocho pue!  :D

Saludos,
  • 0

#5 seoane

seoane

    Advanced Member

  • Administrador
  • 1.257 mensajes
  • LocationEspaña

Escrito 29 junio 2012 - 08:46

Este tema se puede alargar hasta el infinito  :)



delphi
  1. unit crt;
  2.  
  3. interface
  4.  
  5. uses Windows, Sysutils;
  6.  
  7. type
  8.   KeySet = Set of AnsiChar;
  9.  
  10. var
  11.   Terminated: Boolean;
  12.  
  13. function FlushInputBuffer: Boolean;
  14. function Keypressed: Boolean;
  15. function Readkey: AnsiChar;
  16. procedure Pause;
  17. function WaitForKey(ms: Cardinal): Boolean;
  18. function Choice(Options: Keyset): AnsiChar;
  19. function WaitForChoice(Options: Keyset; ms: Cardinal): AnsiChar;
  20.  
  21.  
  22.  
  23. implementation
  24.  
  25. function FlushInputBuffer: Boolean;
  26. var
  27.   InputBuffer: THandle;
  28. begin
  29.   Result:= FALSE;
  30.   InputBuffer:= GetStdHandle(STD_INPUT_HANDLE);
  31.   if InputBuffer <> INVALID_HANDLE_VALUE then
  32.     FlushConsoleInputBuffer(InputBuffer);
  33. end;
  34.  
  35. function Keypressed: Boolean;
  36. var
  37.   InputBuffer: THandle;
  38.   InputRecord: INPUT_RECORD;
  39.   Count: Cardinal;
  40. begin
  41.   Result:= FALSE;
  42.   InputBuffer:= GetStdHandle(STD_INPUT_HANDLE);
  43.  
  44.   if InputBuffer <> INVALID_HANDLE_VALUE then
  45.     if PeekConsoleInput(InputBuffer,InputRecord,1,Count)and (Count = 1) then
  46.     begin
  47.       if InputRecord.EventType = KEY_EVENT then
  48.         if TKeyEventRecord(InputRecord.Event).bKeyDown then
  49.         begin
  50.           Result:= TRUE;
  51.           Exit;
  52.         end;
  53.       ReadConsoleInput(InputBuffer,InputRecord,1,Count);
  54.     end;
  55. end; 
  56.  
  57. function Readkey: AnsiChar;
  58. var
  59.   InputBuffer: THandle;
  60.   InputRecord: INPUT_RECORD;
  61.   Count: Cardinal;
  62. begin
  63.   Result:= #0;
  64.   InputBuffer:= GetStdHandle(STD_INPUT_HANDLE);
  65.   if InputBuffer <> INVALID_HANDLE_VALUE then
  66.     while ReadConsoleInput(InputBuffer,InputRecord,1,Count) do
  67.       if InputRecord.EventType = KEY_EVENT then
  68.         if TKeyEventRecord(InputRecord.Event).bKeyDown then
  69.         begin
  70.           Result:= TKeyEventRecord(InputRecord.Event).AsciiChar;
  71.           Exit;
  72.         end;
  73. end;
  74.  
  75. procedure Pause;
  76. begin
  77.   Writeln;
  78.   Writeln;
  79.   Writeln('Press any key to continue ...');
  80.   FlushInputBuffer;
  81.   ReadKey;
  82. end;
  83.  
  84. function WaitForKey(ms: Cardinal): Boolean;
  85. var
  86.   Ticks: Cardinal;
  87. begin
  88.   Result:= FALSE;
  89.   Ticks:= GetTickCount;
  90.   FlushInputBuffer;
  91.   while not Keypressed do
  92.   begin
  93.     Sleep(10);
  94.     if GetTickCount - Ticks > ms then
  95.       Exit;
  96.   end;
  97.   Result:= TRUE;
  98. end;
  99.  
  100. function Choice(Options: Keyset): AnsiChar;
  101. begin
  102.   FlushInputBuffer;
  103.   repeat
  104.     Result:= Readkey;
  105.   until Result in Options;
  106. end;
  107.  
  108. function WaitForChoice(Options: Keyset; ms: Cardinal): AnsiChar;
  109. begin
  110.   FlushInputBuffer;
  111.   repeat
  112.     if WaitForKey(ms) then
  113.       Result:= Readkey
  114.     else begin
  115.       Result:= #0;
  116.       Exit;
  117.     end;
  118.   until Result in Options;
  119. end;
  120.  
  121. // Esta rutina maneja la señal "Ctrl+C"
  122. function HandlerRoutine(dwCtrlType: DWORD): BOOL; stdcall;
  123. begin
  124.   Result:= TRUE;
  125.   case dwCtrlType of
  126.     CTRL_C_EVENT:
  127.       Terminated:= TRUE;
  128.     CTRL_CLOSE_EVENT:
  129.       Terminated:= TRUE;
  130.     CTRL_LOGOFF_EVENT:
  131.       Terminated:= TRUE;
  132.     CTRL_SHUTDOWN_EVENT:
  133.       Terminated:= TRUE;
  134.     else
  135.       Result:= FALSE;
  136.   end;
  137. end;
  138.  
  139. initialization
  140.   Terminated:= FALSE;
  141.   SetConsoleCtrlHandler(@HandlerRoutine,TRUE);
  142. finalization
  143.  
  144. end.



Esta unidad añade las funciones Pause, WaitForKey, Choice y WaitForChoice, ademas de la variable "Terminated" que nos indica si se ha pulsado Ctrl+C.

Lo dicho se puede alargar hasta el infinito pero yo creo que con esto ya llega por ahora ...  :)

Saludos
  • 0

#6 egostar

egostar

    missing my father, I love my mother.

  • Administrador
  • 14.187 mensajes
  • LocationMéxico

Escrito 29 junio 2012 - 08:53

Lamentable que se haya perdido información de ayer a hoy, ya estamos trabajando para solucionar de tajo los problemas......

Saludos

PD, Yo sigo mudo con las apps de consola :lipsrsealed: :cry:
  • 0