« Diferenças entre a CAT-102/2007 e a CAT-13/2008 | Home | Função para validar Inscrição Estadual - Ajustes »
Simular InKey do clipper no delphi
By Paulo (CincoBytes) | April 21, 2008
Se você trabalhou com clipper, com certeza você conheceu a função Inkey (ela interrompia a execução do programa até que alguma tecla fosse pressionada). Semana passada encontrei um código em delphi que simula em parte essa função.
procedure WaitUntilKeyPressed(seconds: Integer);
var
i: Byte;
j: integer;
KeyboardState: TKeyboardState;
keypress: Boolean;
Msg: TMsg;
begin
// Limpa buffer do teclado/mouse
while PeekMessage(Msg, 0, WM_KEYFIRST, WM_KEYLAST, PM_REMOVE or
PM_NOYIELD) do ;
while PeekMessage(Msg, 0, WM_MOUSEFIRST, WM_MOUSELAST, PM_REMOVE or
PM_NOYIELD) do ;
// aguarda n segundos...
for j := 0 to (seconds * 100) do
begin
keypress := False;
GetKeyboardState(KeyboardState);
for i := 0 to 255 do
begin
if (KeyboardState[i] and 128) = 128 then
begin
// ...sai se houve o pressionamento de uma tecla ou clique do mouse
keypress := True;
Break;
end;
end;
if keypress then
Break;
Sleep(10);
Application.ProcessMessages;
end;
end;
C-Ó-D-I-G-O A-L-T-E-R-N-A-T-I-V-O
Hoje a tarde (23/4/08) recebi um comentário enviado por Rubem Nascimento da Rocha, e pelo fato do mesmo conter um código alternativo optei por publica-lo; como a idéia é simular o InKey do clipper considero esse código bastante adequado, não respondendo ao click do mouse e retornando o código da tecla pressionada. Segue abaixo comentário e código:
Duas coisas:
1) O Windows não é como o MS-DOS pra ter buffer de teclado. Ao invés disso, o Windows processa mensagens enviadas de e para as janelas das aplicações. O Windows não tem buffer, e sim uma fila de mensagens.
2) Essa rotina eu faria como uma função, assim como era a INKEY() do Clipper, assim:
unit uKbdTools;
interface
procedure ClearInputMessages;
function InKey(Secs: Double): integer; overload;
function InKey(MSecs: LongWord): integer; overload;
implementation
uses
Windows, Messages;
// Limpa mensagens de entrada (teclado e mouse) da fila de mensagens do Windows.
// Não existe no Windows a figura do buffer de teclado!!!!
procedure ClearInputMessages;
var
Msg: TMsg;
begin
while PeekMessage(Msg, 0, WM_KEYFIRST, WM_KEYLAST, PM_REMOVE) do ;
while PeekMessage(Msg, 0, WM_MOUSEFIRST, WM_MOUSELAST, PM_REMOVE) do ;
end;
function InKey(Secs: Double): integer;
var
Msg: TMsg;
TickCount: DWORD;
MSecs: DWORD;
lResult: BOOL;
begin
ClearInputMessages;
Result := 0;
MSecs := Trunc(Secs * 1000);
TickCount := GetTickCount();
repeat
lResult := PeekMessage(Msg, 0, WM_KEYFIRST, WM_KEYLAST, PM_REMOVE)
until (GetTickCount() - TickCount >= MSecs) or lResult;
if lResult then
Result := Msg.wParam;
end;
function InKey(MSecs: LongWord): integer;
var
Msg: TMsg;
TickCount: DWORD;
lResult: Boolean;
begin
ClearInputMessages;
Result := 0;
TickCount := GetTickCount();
repeat
lResult := PeekMessage(Msg, 0, WM_KEYFIRST, WM_KEYLAST, PM_REMOVE)
until (GetTickCount() - TickCount >= MSecs) or lResult;
if lResult then
Result := Msg.wParam;
end;
end.

April 24th, 2008 at 9:45 am
Camarada,
Aqui é o MP, ex-frequentador do news de Delphi ^^
Deixa eu fazer um pequeno comentário sobre o perigo de usar o PeekMessage e não executa-la depois obter a mensagem.
PeekMessage(….. PM_REMOVE); // Retira a mensagem da fila de processamento de mensagens.
TranslateMessage(Msg); // Reprocessa a mensagem em caso de possibilidade de conversão para caractere.
DispatchMessage(Msg); // Manda a mensagem por caminho de processamento, vulgo GWL_WNDPROC linkado ao handle.
Se você não usar o TranslateMessage e o DispatchMessage para fazer os componentes manipularem a mensagem, você está tirando o processamento da mensagem do seu aplicativo, e fazer isso a nível de multithreading é um risco grande, pois outras partes do seu aplicativo podem precisar das tais mensagens.
A solução é:
Application.ProcessMessages;
antes de começar.
ou se quiser processar somente os Mouse e o Keyboard usa
PeekMessage(…., PM_REMOVE + PM_QS_INPUT)
Abraços ae!
April 24th, 2008 at 3:37 pm
Bem observado, meu caro! De fato, depois que eu publiquei a dica, eu tava vendo que tava faltando alguma coisa. Valeu pela dica!
Vou rever o código da unit e repostar o mais breve possível!