Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Otros temas > Trucos
Registrarse FAQ Miembros Calendario Guía de estilo Buscar Temas de Hoy Marcar Foros Como Leídos

Los mejores trucos

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 01-07-2006
Avatar de dec
dec dec is offline
Moderador
 
Registrado: dic 2004
Ubicación: Alcobendas, Madrid, España
Posts: 12.560
Poder: 27
dec Va camino a la famadec Va camino a la fama
"Presionar" teclas programáticamente

Código Delphi [-]
unit sndkey;

interface

Uses
  SysUtils, Windows, Messages;

Function SendKeys(SendKeysString : String) : Boolean;

implementation

(*
 Envia un string de caracteres, incluyendo nombres de teclas y
 presiona las teclas por el usuario desde tu programa.

Teclas especiles:
+ = Shift
^ = Control
% = Alt
~ = Enter

Nombres de teclas soportadas:
Obs.: Los nombres de las teclas deben ser colocados entre llaves.

BKSP, BS, BACKSPACE
BREAK
CAPSLOCK
CLEAR
DEL
DELETE
DOWN
END
ENTER
ESC
ESCAPE
F1
F2
F3
F4
F5
F6
F7
F8
F9
F10
F11
F12
F13
F14
F15
F16
HELP
HOME
INS
LEFT
NUMLOCK
PGDN
PGUP
PRTSC
RIGHT
SCROLLLOCK
TAB
UP

Para repetir uma misma tecla várias veces, basta colocar su nombre
seguido de espacio y el número de vezes que quisieras repetir.
Por ex.: {left 6}.

Sintaxis:

SendKeys('abc123{left}{left}{left}def{end}456{left 6}ghi{end}789');

Ejemplo de uso:

// añadir la unit ShellAPI en uses;
WinExec('Notepad.exe',1);
SendKeys('Hola desde {CAPSLOCK}d{CAPSLOCK}elphi');

*)

Function SendKeys(SendKeysString : String) : Boolean;
type
  WBytes = array[0..pred(SizeOf(Word))] of Byte;

  TSendKey = record
    Nome : String;
    VTecla : Byte;
  end;

const
  MaxSendKeyRecs = 41;
  SendKeyRecs : array[1..MaxSendKeyRecs] of TSendKey =
  (
   (Nome:'BKSP';            VTecla:VK_BACK),
   (Nome:'BS';              VTecla:VK_BACK),
   (Nome:'BACKSPACE';       VTecla:VK_BACK),
   (Nome:'BREAK';           VTecla:VK_CANCEL),
   (Nome:'CAPSLOCK';        VTecla:VK_CAPITAL),
   (Nome:'CLEAR';           VTecla:VK_CLEAR),
   (Nome:'DEL';             VTecla:VK_DELETE),
   (Nome:'DELETE';          VTecla:VK_DELETE),
   (Nome:'DOWN';            VTecla:VK_DOWN),
   (Nome:'END';             VTecla:VK_END),
   (Nome:'ENTER';           VTecla:VK_RETURN),
   (Nome:'ESC';             VTecla:VK_ESCAPE),
   (Nome:'ESCAPE';          VTecla:VK_ESCAPE),
   (Nome:'F1';              VTecla:VK_F1),
   (Nome:'F2';              VTecla:VK_F2),
   (Nome:'F3';              VTecla:VK_F3),
   (Nome:'F4';              VTecla:VK_F4),
   (Nome:'F5';              VTecla:VK_F5),
   (Nome:'F6';              VTecla:VK_F6),
   (Nome:'F7';              VTecla:VK_F7),
   (Nome:'F8';              VTecla:VK_F8),
   (Nome:'F9';              VTecla:VK_F9),
   (Nome:'F10';             VTecla:VK_F10),
   (Nome:'F11';             VTecla:VK_F11),
   (Nome:'F12';             VTecla:VK_F12),
   (Nome:'F13';             VTecla:VK_F13),
   (Nome:'F14';             VTecla:VK_F14),
   (Nome:'F15';             VTecla:VK_F15),
   (Nome:'F16';             VTecla:VK_F16),
   (Nome:'HELP';            VTecla:VK_HELP),
   (Nome:'HOME';            VTecla:VK_HOME),
   (Nome:'INS';             VTecla:VK_INSERT),
   (Nome:'LEFT';            VTecla:VK_LEFT),
   (Nome:'NUMLOCK';         VTecla:VK_NUMLOCK),
   (Nome:'PGDN';            VTecla:VK_NEXT),
   (Nome:'PGUP';            VTecla:VK_PRIOR),
   (Nome:'PRTSC';           VTecla:VK_PRINT),
   (Nome:'RIGHT';           VTecla:VK_RIGHT),
   (Nome:'SCROLLLOCK';      VTecla:VK_SCROLL),
   (Nome:'TAB';             VTecla:VK_TAB),
   (Nome:'UP';              VTecla:VK_UP)
  );

  {Códigos extras de interface API do Windows}
  VK_NULL=0;
  VK_SemiColon=186;
  VK_Equal=187;
  VK_Comma=188;
  VK_Minus=189;
  VK_Period=190;
  VK_Slash=191;
  VK_BackQuote=192;
  VK_LeftBracket=219;
  VK_BackSlash=220;
  VK_RightBracket=221;
  VK_Quote=222;
  VK_Last=VK_Quote;

  ExtendedVKeys : set of byte =
  [VK_Up,
   VK_Down,
   VK_Left,
   VK_Right,
   VK_Home,
   VK_End,
   VK_Prior,  {PgUp}
   VK_Next,   {PgDn}
   VK_Insert,
   VK_Delete];

const
  INVALIDKEY = $FFFF {Unsigned -1};
  VKKEYSCANSHIFTON = $01;
  VKKEYSCANCTRLON = $02;
  VKKEYSCANALTON = $04;
  UNITNAME = 'SendKeys';
var
  UsingParens, ShiftDown, ControlDown, AltDown, FoundClose : Boolean;
  VKey,PosSpace : Byte;
  I, L, NumTimes, MKey : Word;
  KeyString : String[20];

procedure DisplayMessage(Message : String);
begin
  MessageBox(0,PChar(Message),UNITNAME,0);
end;

function BitSet(BitTable, BitMask : Byte) : Boolean;
{  inline($5A/$58/$20/$D0/$74/$02/$B0/$01);}
begin
  Result:=Boolean(BitTable and BitMask);
end;

procedure SetBit(var BitTable : Byte; BitMask : Byte);
{  inline($58/$5F/$07/$26/$08/$05);}
begin
  BitTable:=BitTable or Bitmask;
end;

Procedure SendKeyDown(VKey: Byte; NumTimes : Word; GenUpMsg : Boolean);
var
  Cnt : Word;
  ScanCode : Byte;
begin
  ScanCode:=Lo(MapVirtualKey(VKey,0));
  For Cnt:=1 to NumTimes do
    If (VKey in ExtendedVKeys)then begin
      keybd_event(VKey, ScanCode, KEYEVENTF_EXTENDEDKEY,0);
      If (GenUpMsg) then
        keybd_event(VKey, ScanCode, KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP, 0)
    end else begin
      keybd_event(VKey, ScanCode, 0 ,0);
      If (GenUpMsg) then keybd_event(VKey, ScanCode, KEYEVENTF_KEYUP,0);
    end;
end;

Procedure SendKeyUp(VKey: Byte);
var
  ScanCode : Byte;
begin
  ScanCode:=Lo(MapVirtualKey(VKey,0));
  If (VKey in ExtendedVKeys)then
    keybd_event(VKey, ScanCode, KEYEVENTF_EXTENDEDKEY and KEYEVENTF_KEYUP, 0)
  else keybd_event(VKey, ScanCode, KEYEVENTF_KEYUP,0);
end;

Procedure SendKey(MKey: Word; NumTimes : Word; GenDownMsg : Boolean);
begin
  If (BitSet(Hi(MKey),VKKEYSCANSHIFTON)) then SendKeyDown(VK_SHIFT,1,False);
  If (BitSet(Hi(MKey),VKKEYSCANCTRLON)) then SendKeyDown(VK_CONTROL,1,False);
  If (BitSet(Hi(MKey),VKKEYSCANALTON)) then SendKeyDown(VK_MENU,1,False);
  SendKeyDown(Lo(MKey), NumTimes, GenDownMsg);
  If (BitSet(Hi(MKey),VKKEYSCANSHIFTON)) then SendKeyUp(VK_SHIFT);
  If (BitSet(Hi(MKey),VKKEYSCANCTRLON)) then SendKeyUp(VK_CONTROL);
  If (BitSet(Hi(MKey),VKKEYSCANALTON)) then SendKeyUp(VK_MENU);
end;

{busca binária para localizar nomes de teclas especiais}

Function StringToVKey(KeyString : String) : Word;
var
  Found, Collided : Boolean;
  Index : Byte;
  Bottom, Top, Middle : Byte;
begin
  Found:=false;
  Result:=INVALIDKEY;
  Bottom:=1;
  Top:=MaxSendKeyRecs;
  Found:=false;
  Collided:=false;
  Middle:=(Bottom+Top) div 2;
  Repeat
    Collided:=((Bottom=Middle) or (Top=Middle));
    If (KeyString=SendKeyRecs[Middle].Nome) then begin
       Found:=True;
       Result:=SendKeyRecs[Middle].VTecla;
    end else begin
       If (KeyString>SendKeyRecs[Middle].Nome) then Bottom:=Middle
       else Top:=Middle;
       Middle:=(Succ(Bottom+Top)) div 2;
    end;
  Until (Found or Collided);
  If (Result=INVALIDKEY) then DisplayMessage('Tecla inválida');
end;

procedure PopUpShiftKeys;
begin
  If (not UsingParens) then begin
    If ShiftDown then SendKeyUp(VK_SHIFT);
    If ControlDown then SendKeyUp(VK_CONTROL);
    If AltDown then SendKeyUp(VK_MENU);
    ShiftDown:=false;
    ControlDown:=false;
    AltDown:=false;
  end;
end;

begin
  Result:=false;
  UsingParens:=false;
  ShiftDown:=false;
  ControlDown:=false;
  AltDown:=false;
  I:=1;
  L:=Length(SendKeysString);
  If (L=0) then Exit;
  While (I<=L) do begin
    case SendKeysString[i] of
    '(' : begin
            UsingParens:=True;
            Inc(I);
          end;
    ')' : begin
            UsingParens:=False;
            PopUpShiftKeys;
            Inc(I);
          end;
    '%' : begin
             AltDown:=True;
             SendKeyDown(VK_MENU,1,False);
             Inc(I);
          end;
    '+' :  begin
             ShiftDown:=True;
             SendKeyDown(VK_SHIFT,1,False);
             Inc(I);
           end;
    '^' :  begin
             ControlDown:=True;
             SendKeyDown(VK_CONTROL,1,False);
             Inc(I);
           end;
    '{' : begin
            NumTimes:=1;
            If (SendKeysString[Succ(I)]='{') then begin
              MKey:=VK_LEFTBRACKET;
              SetBit(Wbytes(MKey)[1],VKKEYSCANSHIFTON);
              SendKey(MKey,1,True);
              PopUpShiftKeys;
              Inc(I,3);
              Continue;
            end;
            KeyString:='';
            FoundClose:=False;
            While (I<=L) do begin
              Inc(I);
              If (SendKeysString[i]='}') then begin
                FoundClose:=True;
                Inc(I);
                Break;
              end;
              KeyString:=KeyString+Upcase(SendKeysString[i]);
            end;
            If (Not FoundClose) then begin
               DisplayMessage('No Close');
               Exit;
            end;
            If (SendKeysString[i]='}') then begin
              MKey:=VK_RIGHTBRACKET;
              SetBit(Wbytes(MKey)[1],VKKEYSCANSHIFTON);
              SendKey(MKey,1,True);
              PopUpShiftKeys;
              Inc(I);
              Continue;
            end;
            PosSpace:=Pos(' ',KeyString);
            If (PosSpace<>0) then begin
               NumTimes:=StrToInt(Copy(KeyString,Succ(PosSpace),Length(KeyString)-PosSpace));
               KeyString:=Copy(KeyString,1,Pred(PosSpace));
            end;
            If (Length(KeyString)=1) then MKey:=vkKeyScan(KeyString[1])
            else MKey:=StringToVKey(KeyString);
            If (MKey<>INVALIDKEY) then begin
              SendKey(MKey,NumTimes,True);
              PopUpShiftKeys;
              Continue;
            end;
          end;
    '~' : begin
            SendKeyDown(VK_RETURN,1,True);
            PopUpShiftKeys;
            Inc(I);
          end;
    else  begin
             MKey:=vkKeyScan(SendKeysString[i]);
             If (MKey<>INVALIDKEY) then begin
               SendKey(MKey,1,True);
               PopUpShiftKeys;
             end else DisplayMessage('Nombre de tecla inválido');
             Inc(I);
          end;
    end;
  end;
  Result:=true;
  PopUpShiftKeys;
end;

end.
Responder Con Cita
  #2  
Antiguo 05-08-2014
Avatar de Neftali
Neftali Neftali is offline
-Germán Estévez-
 
Registrado: jul 2004
Ubicación: Barcelona - España
Posts: 15.402
Poder: 10
Neftali Va camino a la famaNeftali Va camino a la fama
Modificación al truco

Gracias a marconi por esta corrección al truco:

La función StringToVKey hace una búsqueda alfabética y para eso, SendKeyRecs debe estar ordenado o algunas teclas (como F10) no las encontrará.
La definición correcta de SendKeyRecs será:

Código Delphi [-]
SendKeyRecs : array[1..MaxSendKeyRecs] of TSendKey =
  (
   (Nome:'BACKSPACE';       VTecla:VK_BACK),
   (Nome:'BKSP';            VTecla:VK_BACK),
   (Nome:'BREAK';           VTecla:VK_CANCEL),
   (Nome:'BS';              VTecla:VK_BACK),
   (Nome:'CAPSLOCK';        VTecla:VK_CAPITAL),
   (Nome:'CLEAR';           VTecla:VK_CLEAR),
   (Nome:'DEL';             VTecla:VK_DELETE),
   (Nome:'DELETE';          VTecla:VK_DELETE),
   (Nome:'DOWN';            VTecla:VK_DOWN),
   (Nome:'END';             VTecla:VK_END),
   (Nome:'ENTER';           VTecla:VK_RETURN),
   (Nome:'ESC';             VTecla:VK_ESCAPE),
   (Nome:'ESCAPE';          VTecla:VK_ESCAPE),
   (Nome:'F1';              VTecla:VK_F1),
   (Nome:'F10';             VTecla:VK_F10),
   (Nome:'F11';             VTecla:VK_F11),
   (Nome:'F12';             VTecla:VK_F12),
   (Nome:'F13';             VTecla:VK_F13),
   (Nome:'F14';             VTecla:VK_F14),
   (Nome:'F15';             VTecla:VK_F15),
   (Nome:'F16';             VTecla:VK_F16),
   (Nome:'F2';              VTecla:VK_F2),
   (Nome:'F3';              VTecla:VK_F3),
   (Nome:'F4';              VTecla:VK_F4),
   (Nome:'F5';              VTecla:VK_F5),
   (Nome:'F6';              VTecla:VK_F6),
   (Nome:'F7';              VTecla:VK_F7),
   (Nome:'F8';              VTecla:VK_F8),
   (Nome:'F9';              VTecla:VK_F9),
   (Nome:'HELP';            VTecla:VK_HELP),
   (Nome:'HOME';            VTecla:VK_HOME),
   (Nome:'INS';             VTecla:VK_INSERT),
   (Nome:'LEFT';            VTecla:VK_LEFT),
   (Nome:'NUMLOCK';         VTecla:VK_NUMLOCK),
   (Nome:'PGDN';            VTecla:VK_NEXT),
   (Nome:'PGUP';            VTecla:VK_PRIOR),
   (Nome:'PRTSC';           VTecla:VK_PRINT),
   (Nome:'RIGHT';           VTecla:VK_RIGHT),
   (Nome:'SCROLLLOCK';      VTecla:VK_SCROLL),
   (Nome:'TAB';             VTecla:VK_TAB),
   (Nome:'UP';              VTecla:VK_UP)
  );
__________________
Germán Estévez => Web/Blog
Guía de estilo, Guía alternativa
Utiliza TAG's en tus mensajes.
Contactar con el Clubdelphi

P.D: Más tiempo dedicado a la pregunta=Mejores respuestas.
Responder Con Cita
  #3  
Antiguo 14-11-2014
elrayo76 elrayo76 is offline
Miembro
 
Registrado: ene 2004
Ubicación: En la tierra, por eso mis archivos en la tierra y no en la nuebe...
Posts: 202
Poder: 14
elrayo76 Va por buen camino
La función esta muy buena, pero tengo una duda. Porque se hizo todo dentro de una sola función, es decir, funciones dentro de la principal, type, constantes, etc.

No es lo mismo que hacer las funciones y todo lo demas fuera de la principal?.

Saludos,
El Rayo
Responder Con Cita
Respuesta


Herramientas Buscar en Tema
Buscar en Tema:

Búsqueda Avanzada
Desplegado

Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro


La franja horaria es GMT +2. Ahora son las 12:57:42.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi